codepad
[
create a new paste
]
login
|
about
Language:
C
C++
D
Haskell
Lua
OCaml
PHP
Perl
Plain Text
Python
Ruby
Scheme
Tcl
; two-base palindromes (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-syntax define-generator (lambda (x) (syntax-case x (lambda) ((stx name (lambda formals e0 e1 ...)) (with-syntax ((yield (datum->syntax-object (syntax stx) 'yield))) (syntax (define name (lambda formals (let ((resume #f) (return #f)) (define yield (lambda args (call-with-current-continuation (lambda (cont) (set! resume cont) (apply return args))))) (lambda () (call-with-current-continuation (lambda (cont) (set! return cont) (cond (resume (resume)) (else (let () e0 e1 ...) (error 'name "unexpected return")))))))))))) ((stx (name . formals) e0 e1 ...) (syntax (stx name (lambda formals e0 e1 ...))))))) (define-generator (palindromes b) (do ((k 0 (+ k 1))) ((= k b)) (yield k)) (do ((i 1 (* i b))) (#f) (do ((j i (+ j 1))) ((= j (* b i))) (let ((ds (digits j b))) (yield (undigits (append ds (reverse ds)) b)))) (do ((j i (+ j 1))) ((= j (* b i))) (let ((ds (digits j b))) (do ((k 0 (+ k 1))) ((= k b)) (yield (undigits (append ds (list k) (reverse ds)) b))))))) (let ((p10 (palindromes 10)) (p8 (palindromes 8))) (let loop ((a (p10)) (b (p8))) (cond ((< a b) (loop (p10) b)) ((< b a) (loop a (p8))) (else (display (digits a)) (display " ") (display (digits b 8)) (newline) (loop (p10) (p8))))))
Private
[
?
]
Run code
Submit