fork download
  1. ; highly abundant numbers
  2.  
  3. (define (range . args)
  4. (case (length args)
  5. ((1) (range 0 (car args) (if (negative? (car args)) -1 1)))
  6. ((2) (range (car args) (cadr args) (if (< (car args) (cadr args)) 1 -1)))
  7. ((3) (let ((le? (if (negative? (caddr args)) >= <=)))
  8. (let loop ((x(car args)) (xs '()))
  9. (if (le? (cadr args) x)
  10. (reverse xs)
  11. (loop (+ x (caddr args)) (cons x xs))))))
  12. (else (error 'range "unrecognized arguments"))))
  13.  
  14. (define (add1 n) (+ n 1))
  15.  
  16. (define (factors n) ; factors of n in increasing order by 2,3,5-wheel
  17. (define (last-pair xs) (if (null? (cdr xs)) xs (last-pair (cdr xs))))
  18. (define (cycle . xs) (set-cdr! (last-pair xs) xs) xs)
  19. (define wheel (cons 1 (cons 2 (cons 2 (cycle 4 2 4 2 4 6 2 6)))))
  20. (let loop ((n n) (f 2) (wheel wheel) (fs (list)))
  21. (if (< n (* f f)) (reverse (cons n fs))
  22. (if (zero? (modulo n f)) (loop (/ n f) f wheel (cons f fs))
  23. (loop n (+ f (car wheel)) (cdr wheel) fs)))))
  24.  
  25. (define (sigma n) ; sum of divisors of n
  26. (if (= n 1) 1
  27. (let ((fs (factors n)))
  28. (let loop ((fs (cdr fs)) (f (car fs)) (prod (car fs)) (sum 1))
  29. (if (null? fs) (* sum (/ (- (* prod f) 1) (- f 1)))
  30. (if (= (car fs) f) (loop (cdr fs) f (* prod f) sum)
  31. (loop (cdr fs) (car fs) (car fs)
  32. (* sum (/ (- (* prod f) 1) (- f 1))))))))))
  33.  
  34. (define (records lt? xs) ; index and value at each new maximum
  35. (if (null? xs) (error 'records "no data")
  36. (let loop ((xs (cdr xs)) (k 1) (recs (list (cons 0 (car xs)))))
  37. (if (null? xs) (reverse recs)
  38. (if (lt? (cdar recs) (car xs))
  39. (loop (cdr xs) (+ k 1) (cons (cons k (car xs)) recs))
  40. (loop (cdr xs) (+ k 1) recs))))))
  41.  
  42. (define (hans n)
  43. (map add1 (map car (records < (map sigma (range 1 (+ n 1)))))))
  44.  
  45. (display (hans 2100)) (newline)
Success #stdin #stdout 0.42s 10200KB
stdin
Standard input is empty
stdout
(1 2 3 4 6 8 10 12 16 18 20 24 30 36 42 48 60 72 84 90 96 108 120 144 168 180 210 216 240 288 300 336 360 420 480 504 540 600 630 660 720 840 960 1008 1080 1200 1260 1440 1560 1620 1680 1800 1920 1980 2100)