21.scm

   1 (require (planet "memoize.ss" ("dherman" "memoize.plt" 2 1)))\r
   2 \r
   3 (define (divides? n k)\r
   4   (= 0\r
   5      (modulo n k)))\r
   6 \r
   7 (define/memo (sum-of-proper-divisors n)\r
   8   (define (other k)\r
   9     (if (or (= k 1)\r
  10             (= (* k k) n))\r
  11         0\r
  12         (/ n k)))\r
  13   \r
  14   (let ((ceil (floor (sqrt n))))\r
  15     (let loop ((try 1)\r
  16                (total 0))\r
  17       (if (>= try ceil)\r
  18           total\r
  19           (if (divides? n try)\r
  20               (loop (add1 try) (+ total try (other try)))\r
  21               (loop (add1 try) total))))))\r
  22 \r
  23 (let loop ((n 1)\r
  24            (S 0))\r
  25   (if (= n 10000)\r
  26       S\r
  27       (let* ((sopd (sum-of-proper-divisors n))\r
  28              (sopd* (sum-of-proper-divisors sopd)))\r
  29         (if (and (= n sopd*) (< n sopd))\r
  30             (begin\r
  31               (display (format "~a:~a" n sopd))(newline)\r
  32               (loop (add1 n) (+ S n sopd)))\r
  33             (loop (add1 n) S)))))