[ create a new paste ] login | about

Link: http://codepad.org/AloHmePH    [ raw code | output | fork ]

programmingpraxis - Scheme, pasted on Aug 27:
; generating 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)
  (do ((k 0 (+ k 1))) ((= k 10))
    (yield k))
  (do ((i 1 (* i 10))) (#f)
    (do ((j i (+ j 1))) ((= j (* 10 i)))
      (let ((ds (digits j)))
        (yield (undigits (append ds (reverse ds))))))
    (do ((j i (+ j 1))) ((= j (* 10 i)))
      (let ((ds (digits j)))
        (do ((k 0 (+ k 1))) ((= k 10))
          (yield (undigits (append ds (list k) (reverse ds)))))))))

(define (nth-palindrome n)
  (let ((p (palindromes)))
    (do ((n n (- n 1))) ((= n 1) (p)) (p))))

(let ((p (palindromes)))
  (do ((n 100 (- n 1))) ((zero? n) (newline))
    (display (p)) (newline)))

(display (nth-palindrome 100)) (newline)
(display (nth-palindrome 10000)) (newline)


Output:
0
1
2
3
4
5
6
7
8
9
11
22
33
44
55
66
77
88
99
101
111
121
131
141
151
161
171
181
191
202
212
222
232
242
252
262
272
282
292
303
313
323
333
343
353
363
373
383
393
404
414
424
434
444
454
464
474
484
494
505
515
525
535
545
555
565
575
585
595
606
616
626
636
646
656
666
676
686
696
707
717
727
737
747
757
767
777
787
797
808
818
828
838
848
858
868
878
888
898
909

909
9000009


Create a new paste based on this one


Comments: