(define (divisors n)
(let ((divs (make-vector (+ n 1) (list)))
(cnts (make-vector (+ n 1) 0))
(sums (make-vector (+ n 1) 0)))
(do ((i 1 (+ i 1))) ((<= n i) (values divs cnts sums))
(do ((j i (+ j i))) ((<= n j))
(vector-set! divs j (cons i (vector-ref divs j)))
(vector-set! cnts j (+ 1 (vector-ref cnts j)))
(vector-set! sums j (+ i (vector-ref sums j)))))))
(define divs #f)
(define cnts #f)
(define sums #f)
(define max-d 0)
(define (update n)
(call-with-values
(lambda () (divisors n))
(lambda (d c s)
(set! divs d)
(set! cnts c)
(set! sums s)))
(set! max-d n))
(define (perfect n)
(define (s n) (- (vector-ref sums n) n))
(when (< max-d n) (update n))
(let ((ps (list)))
(do ((p 1 (+ p 1)))
((< n p) (reverse ps))
(when (= p (s p))
(set! ps (cons p ps))))))
(time (display (perfect 10000)) (newline))
(define (amicable n)
(define (s n) (- (vector-ref sums n) n))
(when (< max-d (* 5 n)) (update (* 5 n)))
(let loop ((a 1) (as (list)))
(cond ((< n a) (reverse as))
((and (= a (s (s a))) (< a (s a)))
(loop (+ a 1) (cons a as)))
(else (loop (+ a 1) as)))))
(time (display (amicable 10000)) (newline))