素数関連のプログラム

素数関連の問題は次の関数群を使うことにしました。

prime.scm とでもしておきます。

(use util.stream)

(define divisible? (lambda (n d) (= (modulo n d) 0)))
(define square (lambda (x) (* x x)))

; n 以上の整数ストリーム
(define (integers-starting-from n)
    (stream-cons n (integers-starting-from (+ n 1))))

; n が素数か(sqrt(n) 以下の素数で割り切れたら素数ではない)
(define (prime? n)
  (define (iter ps)
    (cond ((> (square (stream-car ps)) n) #t)
          ((divisible? n (stream-car ps)) #f)
          (else (iter (stream-cdr ps)))))
  (if (= n 1) #f (iter primes)))

; 素数ストリーム
(define primes
  (stream-cons
    2
    (stream-filter prime? (integers-starting-from 3))))

; ハッシュのコピー
(define (copy-hash-table dst src)
  (hash-table-for-each src (lambda (k v) (hash-table-put! dst k v)))
  dst)

; メモ化用ハッシュテーブル
(define factorized-ht (make-hash-table))

; num を素因数分解。ハッシュが返る。
(define (prime-factorize num)
  (if (hash-table-get factorized-ht num #f)
    (hash-table-get factorized-ht num) ; メモ化済み
    (let1 ht (make-hash-table)
          (let loop ((n num)
                     (p primes))
            (if (= n 1)
              (begin
                (hash-table-put! factorized-ht num ht) ; メモ化しておく
                ht)
              (let* ((prime (stream-car p))
                     (div? (divisible? n prime))
                     (q (quotient n prime)))
                (when div? ; 素因数を発見
                  (let ((qhash (hash-table-get factorized-ht q #f)))
                    (when qhash
                      (copy-hash-table ht qhash)
                      (set! q 1)) ; 次のループで終了させるため
                    (hash-table-put! ht prime (+ (hash-table-get ht prime 0) 1)))) 
                (loop (if div? q n)
                      (if div? p (stream-cdr p)))))))))

; num の約数の数
(define (num-of-divisor num)
  (hash-table-fold (prime-factorize num)
                   (lambda (k v p) (* p (+ v 1)))
                   1))