[Project Euler] Problem 23 「非過剰数和」

完全数とは, その数の真の約数の和がそれ自身と一致する数のことである. たとえば, 28の真の約数の和は, 1 + 2 + 4 + 7 + 14 = 28 であるので, 28は完全数である.

真の約数の和がその数よりも少ないものを不足数といい, 真の約数の和がその数よりも大きいものを過剰数と呼ぶ.

12は, 1 + 2 + 3 + 4 + 6 = 16 となるので, 最小の過剰数である. よって2つの過剰数の和で書ける最少の数は24である. 数学的な解析により, 28123より大きい任意の整数は2つの過剰数の和で書けることが知られている. 2つの過剰数の和で表せない最大の数がこの上限よりも小さいことは分かっているのだが, この上限を減らすことが出来ていない.

2つの過剰数の和で書き表せない正の整数の総和を求めよ.

この問題も, 約数を求められれば解けそうです.

1. 28123以下の過剰数をつくる.
2. 求めた過剰数のすべての組合せの和を求める.
3. 求めた和として表せない過剰数を取り出す.

手続きは次のとおりです.

(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 (product list-a list-b)
  (apply append
         (map (lambda (a)
                (map (lambda (b) (list a b))
                     list-b))
              list-a)))

(define (abundant? n)
  (< n (fold + 0 (cdr (all-divisor n)))))

;; 28123以下の過剰数をつくり、そのすべての組合せから和を求め、
;; その和に現れない数を求める。
(define ab-list (filter abundant? (iota 28123 1)))

(define v (make-vector 28124 #t))

(for-each (lambda (x)
            (for-each (lambda (y)
                        (when (< (+ x y) (vector-length v))
                          (vector-set! v (+ x y) #f)))
                      ab-list))
          ab-list)

(define (loop ans i)
  (cond ((<= (vector-length v) i) (reverse ans))
        ((vector-ref v i) (loop (cons i ans) (+ i 1)))
        (else (loop ans (+ i 1)))))

(define ans (loop '() 1))

計算します.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (fold + 0 ans)
4179871
>