; the next palindrome
(define (take n xs)
(let loop ((n n) (xs xs) (ys '()))
(if (or (zero? n) (null? xs))
(reverse ys)
(loop (- n 1) (cdr xs)
(cons (car xs) ys)))))
(define (drop n xs)
(let loop ((n n) (xs xs))
(if (or (zero? n) (null? xs)) xs
(loop (- n 1) (cdr xs)))))
(define-syntax fold-of
(syntax-rules (range in is)
((_ "z" f b e) (set! b (f b e)))
((_ "z" f b e (v range fst pst stp) c ...)
(let* ((x fst) (p pst) (s stp)
(le? (if (positive? s) <= >=)))
(do ((v x (+ v s))) ((le? p v) b)
(fold-of "z" f b e c ...))))
((_ "z" f b e (v range fst pst) c ...)
(let* ((x fst) (p pst) (s (if (< x p) 1 -1)))
(fold-of "z" f b e (v range x p s) c ...)))
((_ "z" f b e (v range pst) c ...)
(fold-of "z" f b e (v range 0 pst) c ...))
((_ "z" f b e (x in xs) c ...)
(do ((t xs (cdr t))) ((null? t) b)
(let ((x (car t)))
(fold-of "z" f b e c ...))))
((_ "z" f b e (x is y) c ...)
(let ((x y)) (fold-of "z" f b e c ...)))
((_ "z" f b e p? c ...)
(if p? (fold-of "z" f b e c ...)))
((_ f i e c ...)
(let ((b i)) (fold-of "z" f b e c ...)))))
(define-syntax list-of (syntax-rules ()
((_ arg ...) (reverse (fold-of
(lambda (d a) (cons a d)) '() arg ...)))))
(define (all-nines? ds)
(cond ((null? ds) #t)
((not (char=? (car ds) #\9)) #f)
(else (all-nines? (cdr ds)))))
(define (lt? a b)
(cond ((< (length a) (length b)) #t)
((< (length b) (length a)) #f)
(else (let loop ((a a) (b b))
(cond ((null? a) #f)
((char<? (car a) (car b)) #t)
((char<? (car b) (car a)) #f)
(else (loop (cdr a) (cdr b))))))))
(define (plus1 ds)
(let loop ((ds (reverse ds)) (carry 0) (xs '()))
(cond ((null? ds)
(if (zero? carry)
(reverse xs)
(cons #\1 (reverse xs))))
((char=? (car ds) #\9)
(loop (cdr ds) 1 (cons #\0 xs)))
(else (append (reverse (cdr ds))
(list (integer->char
(+ (char->integer (car ds)) 1)))
(reverse xs))))))
(define (palin n)
(let* ((ds (string->list n)) (len (length ds)) (len2 (quotient len 2)))
(cond ((equal? ds (list #\9)) "11")
((= len 1) (list->string (plus1 ds)))
((all-nines? ds)
(let loop ((ds ds) (ps (list #\1)))
(if (null? ds)
(list->string (cons #\1 (cdr ps)))
(loop (cdr ds) (cons #\0 ps)))))
((even? len)
(let* ((left (take len2 ds)) (right (drop len2 ds)))
(if (lt? right (reverse left))
(list->string (append left (reverse left)))
(let ((x (plus1 left)))
(list->string (append x (reverse x)))))))
(else (let* ((left (take len2 ds))
(middle (car (drop len2 ds)))
(right (cdr (drop len2 ds))))
(if (lt? right (reverse left))
(list->string (append left (list middle) (reverse left)))
(if (char=? middle #\9)
(let ((x (plus1 left)))
(list->string (append x (list #\0) (reverse x))))
(list->string (append left (plus1 (list middle)) (reverse left))))))))))
(display (equal?
(list-of (list->string x)
(n range 1 1000002)
(x is (string->list (number->string n)))
(equal? x (reverse x)))
(let loop ((p "0") (ps '()))
(if (< 6 (string-length p)) (reverse ps)
(let ((x (palin p)))
(loop x (cons x ps)))))))
(newline)
(display (map palin '("0" "88" "808" "1999" "2133" "9999" "99999")))