; three-way minimum sum partitions

(define (take-while pred? xs)
  (let loop ((xs xs) (ys '()))
    (if (or (null? xs) (not (pred? (car xs))))
        (reverse ys)
        (loop (cdr xs) (cons (car xs) ys)))))

(define (sum xs) (apply + xs))

(define (factors n)
  (let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6)))
    (let loop ((n n) (f 2) (w 0) (fs (list)))
      (if (< n (* f f)) (reverse (cons n fs))
        (if (zero? (modulo n f))
          (loop (/ n f) f w (cons f fs))
          (loop n (+ f (vector-ref wheel w))
                  (if (= w 10) 3 (+ w 1)) fs))))))

(define (divisors n) ; divisors of n, including 1 and n
  (let ((divs (list 1)))
    (do ((fs (factors n) (cdr fs))) ((null? fs) (sort divs <))
      (let ((temp (list)))
        (do ((ds divs (cdr ds)))
            ((null? ds) (set! divs (append divs temp)))
          (let ((d (* (car fs) (car ds))))
            (when (not (member d divs))
            (set! temp (cons d temp)))))))))

(define (iroot k n)
  (let ((k-1 (- k 1)))
    (let loop ((u n) (s (+ n 1)))
      (if (<= s u) s
        (loop (quotient (+ (* k-1 u) (quotient n (expt u k-1))) k) u)))))

(define (maxle n xs) ; assume xs in non-decreasing order
  (let ((xs (take-while (lambda (x) (<= x n)) xs)))
    (if (null? xs) #f (apply max xs))))

(define (f1 n)
  (let ((xyz (list n n n)))
    (do ((xs (divisors n) (cdr xs))) ((null? xs) (sort xyz <))
      (do ((ys (divisors (/ n (car xs))) (cdr ys))) ((null? ys))
        (let ((z (/ n (car xs) (car ys))))
          (when (< (+ (car xs) (car ys) z) (sum xyz))
            (set! xyz (list (car xs) (car ys) z))))))))

(define (f2 n)
  (let* ((x (maxle (iroot 3 n) (divisors n)))
         (y (maxle (iroot 2 (/ n x)) (divisors (/ n x))))
         (z (/ n x y)))
    (sort (list x y z) <)))

(define (f3 n)
  (let* ((x1 (maxle (iroot 3 n) (divisors n)))
         (y1 (maxle (iroot 2 (/ n x1)) (divisors (/ n x1))))
         (z1 (/ n x1 y1))
         (x2 (apply max (factors n)))
         (y2 (maxle (iroot 2 (/ n x2)) (divisors (/ n x2))))
         (z2 (/ n x2 y2)))
    (if (< (+ x1 y1 z1) (+ x2 y2 z2))
        (sort (list x1 y1 z1) <)
        (sort (list x2 y2 z2) <))))

(display (f1 1890)) (newline)
(display (f2 1890)) (newline)
(display (f3 1890)) (newline)