[Project Euler] Problem 21 「友愛数」

d(n) を n の真の約数の和と定義する. (真の約数とは n 以外の約数のことである. )
もし, d(a) = b かつ d(b) = a (a ≠ b のとき) を満たすとき, a と b は友愛数(親和数)であるという.

例えば, 220 の約数は 1, 2, 4, 5, 10, 11, 20, 22, 44, 55, 110 なので d(220) = 284 である.
また, 284 の約数は 1, 2, 4, 71, 142 なので d(284) = 220 である.

それでは10000未満の友愛数の和を求めよ.

素因数分解をして, すべての約数を求めれば, 友愛数を計算できます.

1. 素因数分解し, すべての約数を求める.
2. すべての約数の和を求めて, dを計算する.
3. dを計算した結果から, 友愛数を求める.

長くなりますが, 定義した手続きは次のとおりです.

(require srfi/1)

(define (square n) (* n n))

(define (divides? a b)
  (= (remainder b a) 0))

(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (+ test-divisor 1)))))

(define (smallest-divisor n)
  (find-divisor n 2))

;; 素因数分解
(define (prime-factorization n)
  (let ((a (smallest-divisor n)))
    (if (= a n)
        (list n)
        (cons a (prime-factorization (/ n a))))))

;; sizeの数の変数を持つ真理値表を作る
(define (0-1-table size)
  (define (loop ans n)
    (if (= n 0)
        ans
        (loop (append (map (lambda (lst) (cons #f lst)) ans)
                      (map (lambda (lst) (cons #t lst)) ans))
              (- n 1))))
  (loop '(()) size))

;; リストから集合を作る. つまり重複する要素を取り除く.
(define (make-set items)
  (define (loop ans rest)
    (cond ((null? rest) ans)
          ((find (lambda (a) (= (car rest) a)) ans) (loop ans (cdr rest)))
          (else (loop (cons (car rest) ans) (cdr rest)))))
  (loop '() items))

;; すべての約数を求める.
(define (all-divisor nbr)
  (let* ((pf (prime-factorization nbr))
         (tbl (0-1-table (length pf))))
    (sort 
     (make-set (map (lambda (row) 
                      (apply * (map (lambda (a b) (if a 1 b))
                                    row 
                                    pf)))
                    tbl))
     <)))
       
;; 友愛数を求める
(define (d n)
  (- (fold + 0 (all-divisor n))
     n))

(define d-list 
  (map (lambda (n) (list n (d n)))
       (iota 10000 1)))

(define a-list
  (filter (lambda (pair) 
            (and (not (equal? pair (reverse pair)))
                 (member pair d-list)))
          (map reverse d-list)))

計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (make-set (apply append a-list))
(6232 6368 5020 5564 2620 2924 1184 1210 220 284)
> (+ 6232 6368 5020 5564 2620 2924 1184 1210 220 284)
31626
>