; minimal palindromic base

(define (range . args)
  (case (length args)
    ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
    ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
    ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
           (let loop ((x(car args)) (xs '()))
             (if (le? (cadr args) x)
                 (reverse xs)
                 (loop (+ x (caddr args)) (cons x xs))))))
    (else (error 'range "unrecognized arguments"))))

(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 (f1 n)
  (let loop ((b 2))
    (let ((ds (digits n b)))
      (if (equal? ds (reverse ds)) b
        (loop (+ b 1))))))

(time (display (apply + (map f1 (range 3 10000)))) (display " "))

(define (f2 n)
  (let loop ((b 2))
    (if (< n (+ b b)) (- n 1)
      (let ((ds (digits n b)))
        (if (equal? ds (reverse ds)) b
          (loop (+ b 1)))))))

(time (display (apply + (map f2 (range 3 10000)))) (display " "))

(define (f3 n)
  (let loop ((b 2))
    (if (< n (+ b b)) (- n 1)
      (if (zero? (modulo n b)) (loop (+ b 1))
        (let ((ds (digits n b)))
          (if (equal? ds (reverse ds)) b
            (loop (+ b 1))))))))

(time (display (apply + (map f3 (range 3 10000)))) (display " "))

1879426 cpu time: 2387 real time: 3061 gc time: 1373
1879426 cpu time: 1913 real time: 2192 gc time: 1013
1879426 cpu time: 1911 real time: 2172 gc time: 984