codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; look and say (define (iterate n f . bs) (let loop ((n n) (b (car bs)) (bs (cdr bs)) (xs '())) (if (zero? n) (reverse xs) (let ((new-bs (append bs (list (apply f b bs))))) (loop (- n 1) (car new-bs) (cdr new-bs) (cons b xs)))))) (define (flatten xs) (cond ((null? xs) xs) ((pair? xs) (append (flatten (car xs)) (flatten (cdr xs)))) (else (list xs)))) (define (uniq-c eql? xs) (if (null? xs) xs (let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '())) (cond ((null? xs) (reverse (cons (cons prev k) result))) ((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result)) (else (loop (cdr xs) (car xs) 1 (cons (cons prev k) result))))))) (define (digits n . args) (let ((b (if (null? args) 10 (car args)))) (let loop ((n n) (d '())) (if (zero? n) d (loop (quotient n b) (cons (modulo n b) d)))))) (define (undigits ds . args) (let ((b (if (null? args) 10 (car args)))) (let loop ((ds ds) (n 0)) (if (null? ds) n (loop (cdr ds) (+ (* n b) (car ds))))))) (define (look-and-say n) (define (flip x) (cons (cdr x) (car x))) (undigits (flatten (map flip (uniq-c = (digits n)))))) (define (look-and-say-sequence n) (iterate n look-and-say 1)) (display (look-and-say-sequence 10))
Private
[
?
]
Run code
Submit