; factoring factorials
(define (primes n)
(let ((sieve (make-vector (+ n 1) #t)))
(let loop ((p 2) (ps (list)))
(if (< n p) (reverse ps)
(if (vector-ref sieve p)
(do ((i (* p p) (+ i p)))
((< n i) (loop (+ p 1) (cons p ps)))
(vector-set! sieve i #f))
(loop (+ p 1) ps))))))
(define (fact-fact n) ; prime factors of n factorial
(let loop ((ps (primes n)) (fs (list)))
(cond ((null? ps) (reverse fs))
((< (* (car ps) (car ps)) n)
(let ((p (car ps)))
(let ((k (let loop ((q p) (k 0))
(if (< n q) k
(loop (* q p) (+ k (quotient n q)))))))
(loop (cdr ps) (cons (cons (car ps) k) fs)))))
((< (+ (car ps) (car ps)) n)
(loop (cdr ps) (cons (cons (car ps) (quotient n (car ps))) fs)))
(else (loop (cdr ps) (cons (cons (car ps) 1) fs))))))
(display (fact-fact 33)) (newline)
(display
(let loop ((xs (fact-fact 33)) (fact 1))
(if (null? xs) fact
(loop (cdr xs) (* fact (expt (caar xs) (cdar xs)))))))
(newline)
(define (fact n) (if (= n 1) 1 (* n (fact (- n 1)))))
(display (fact 33)) (newline)