; climb to a prime (define (flatten xs) (cond ((null? xs) xs) ((pair? xs) (append (flatten (car xs)) (flatten (cdr xs)))) (else (list xs)))) (define (uniq-c eql? xs) (if (null? xs) xs (let loop ((xs (cdr xs)) (prev (car xs)) (k 1) (result '())) (cond ((null? xs) (reverse (cons (cons prev k) result))) ((eql? (car xs) prev) (loop (cdr xs) prev (+ k 1) result)) (else (loop (cdr xs) (car xs) 1 (cons (cons prev k) result))))))) (define (factors n) (define (wheel w) (vector-ref '#(1 2 2 4 2 4 2 4 6 2 6) w)) (let loop ((n n) (f 2) (fs (list)) (w 0)) (if (< n (* f f)) (reverse (cons n fs)) (if (zero? (modulo n f)) (loop (/ n f) f (cons f fs) w) (if (< w 11) (loop n (+ f (wheel w)) fs (+ w 1)) (loop n (+ f (wheel 3)) fs 4)))))) (define (bring-down-powers fs) (string->number (apply string-append (map number->string (filter (lambda (n) (not (= n 1))) (flatten (uniq-c = fs))))))) (define (climb-to-a-prime n) (let loop ((n n)) (let ((fs (factors n))) (display fs) (newline) (when (pair? (cdr fs)) (loop (bring-down-powers fs)))))) (climb-to-a-prime 90) (newline) (climb-to-a-prime 234) (newline) (climb-to-a-prime 13532385396179) (newline)