; a divisor apology (define (unique eql? xs) (cond ((null? xs) '()) ((null? (cdr xs)) xs) ((eql? (car xs) (cadr xs)) (unique eql? (cdr xs))) (else (cons (car xs) (unique eql? (cdr xs)))))) (define (primes n) ; list of primes not exceeding n (let* ((len (quotient (- n 1) 2)) (bits (make-vector len #t))) (let loop ((i 0) (p 3) (ps (list 2))) (cond ((< n (* p p)) (do ((i i (+ i 1)) (p p (+ p 2)) (ps ps (if (vector-ref bits i) (cons p ps) ps))) ((= i len) (reverse ps)))) ((vector-ref bits i) (do ((j (+ (* 2 i i) (* 6 i) 3) (+ j p))) ((<= len j) (loop (+ i 1) (+ p 2) (cons p ps))) (vector-set! bits j #f))) (else (loop (+ i 1) (+ p 2) ps)))))) (define (factors n) ; 2,3,5-wheel (let ((wheel (vector 1 2 2 4 2 4 2 4 6 2 6))) (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) (loop n (+ f (vector-ref wheel w)) fs (if (= w 10) 3 (+ w 1)))))))) (define (divisors1 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))))))))) (display (length (divisors1 (apply * (primes 25))))) (newline) (define (divisors2 n) (let ((divs (list 1))) (do ((fs (factors n) (cdr fs))) ((null? fs) (unique = (sort divs <))) (set! divs (append (map (lambda (d) (* d (car fs))) divs) divs))))) (display (length (divisors2 (apply * (primes 25))))) (newline) (define (divisors3 n) (let ((divs (list 1))) (do ((fs (factors n) (cdr fs))) ((null? fs) divs) (set! divs (unique = (sort (append (map (lambda (d) (* d (car fs))) divs) divs) <)))))) (display (length (divisors3 (apply * (primes 25))))) (newline) (define (merge-uniq xs ys) (let loop ((xs xs) (ys ys) (zs (list))) (cond ((and (null? xs) (null? ys)) (reverse zs)) ((null? xs) (loop xs (cdr ys) (cons (car ys) zs))) ((null? ys) (loop (cdr xs) ys (cons (car xs) zs))) ((< (car xs) (car ys)) (loop (cdr xs) ys (cons (car xs) zs))) ((< (car ys) (car xs)) (loop xs (cdr ys) (cons (car ys) zs))) (else (loop xs (cdr ys) zs))))) (define (divisors4 n) (let loop ((fs (factors n)) (divs (list 1))) (if (null? fs) divs (loop (cdr fs) (merge-uniq (map (lambda (d) (* d (car fs))) divs) divs))))) (display (length (divisors4 (apply * (primes 25))))) (newline)