[ create a new paste ] login | about

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

programmingpraxis - Scheme, pasted on Aug 4:
; 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 " "))


Output:
1
2
3
1879426 cpu time: 2378 real time: 3642 gc time: 1323

Timeout


Create a new paste based on this one


Comments: