; 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)