fork download
  1. ; phone numbers
  2.  
  3. (define (range . args)
  4. (case (length args)
  5. ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  6. ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  7. ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  8. (let loop ((x(car args)) (xs '()))
  9. (if (le? (cadr args) x)
  10. (reverse xs)
  11. (loop (+ x (caddr args)) (cons x xs))))))
  12. (else (error 'range "unrecognized arguments"))))
  13.  
  14. (define (mappend f . xss) (apply append (apply map f xss)))
  15.  
  16. (define (list-minus xs ys)
  17. (filter (lambda (y) (not (member y ys))) xs))
  18.  
  19. (define (undigits ds . args)
  20. (let ((b (if (null? args) 10 (car args))))
  21. (let loop ((ds ds) (n 0))
  22. (if (null? ds) n
  23. (loop (cdr ds) (+ (* n b) (car ds)))))))
  24.  
  25. (define (phone-numbers len skips)
  26. (let loop ((len (- len 1))
  27. (nums (map list (list-minus (range 1 10) skips))))
  28. (if (zero? len)
  29. (map undigits (map reverse nums))
  30. (loop (- len 1)
  31. (mappend (lambda (xs)
  32. (filter (lambda (xs)
  33. (not (= (car xs) (cadr xs))))
  34. (map (lambda (x)
  35. (cons x xs))
  36. (list-minus (range 10) (cons 4 skips)))))
  37. nums)))))
  38.  
  39. (display (phone-numbers 3 '(1 3 5 7 9))) (newline)
Success #stdin #stdout 0.02s 42848KB
stdin
Standard input is empty
stdout
(202 206 208 260 262 268 280 282 286 402 406 408 420 426 428 460 462 468 480 482 486 602 606 608 620 626 628 680 682 686 802 806 808 820 826 828 860 862 868)