; highly abundant numbers
(define (range . args)
(case (length args)
((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
((3) (let ((le? (if (negative? (caddr args)) >= <=)))
(let loop ((x(car args)) (xs '()))
(if (le? (cadr args) x)
(reverse xs)
(loop (+ x (caddr args)) (cons x xs))))))
(else (error 'range "unrecognized arguments"))))
(define (add1 n) (+ n 1))
(define (factors n) ; factors of n in increasing order by 2,3,5-wheel
(define (last-pair xs) (if (null? (cdr xs)) xs (last-pair (cdr xs))))
(define (cycle . xs) (set-cdr! (last-pair xs) xs) xs)
(define wheel (cons 1 (cons 2 (cons 2 (cycle 4 2 4 2 4 6 2 6)))))
(let loop ((n n) (f 2) (wheel wheel) (fs (list)))
(if (< n (* f f)) (reverse (cons n fs))
(if (zero? (modulo n f)) (loop (/ n f) f wheel (cons f fs))
(loop n (+ f (car wheel)) (cdr wheel) fs)))))
(define (sigma n) ; sum of divisors of n
(if (= n 1) 1
(let ((fs (factors n)))
(let loop ((fs (cdr fs)) (f (car fs)) (prod (car fs)) (sum 1))
(if (null? fs) (* sum (/ (- (* prod f) 1) (- f 1)))
(if (= (car fs) f) (loop (cdr fs) f (* prod f) sum)
(loop (cdr fs) (car fs) (car fs)
(* sum (/ (- (* prod f) 1) (- f 1))))))))))
(define (records lt? xs) ; index and value at each new maximum
(if (null? xs) (error 'records "no data")
(let loop ((xs (cdr xs)) (k 1) (recs (list (cons 0 (car xs)))))
(if (null? xs) (reverse recs)
(if (lt? (cdar recs) (car xs))
(loop (cdr xs) (+ k 1) (cons (cons k (car xs)) recs))
(loop (cdr xs) (+ k 1) recs))))))
(define (hans n)
(map add1 (map car (records < (map sigma (range 1 (+ n 1)))))))
(display (hans 2100)) (newline)