Project EulerをSchemeで(21-25)

今回は問21から問25の5問。処理系はGauche。
そういえば25問解いたのは全体の18%しか居ないらしい…

まずはユーティリティ関数とか。factorizeは前に定義したのとちょっと変えてたり。

(use srfi-1)

;; Sieve of Eratosthenes                                                                                                
; (primes 10) => (2 3 5 7)                                                                                              
(define (primes n)
  (if (<= n 2)
      '()
      (let1 u (truncate (sqrt n))
        (let loop ((ps '(2))
                   (l (unfold (cut < n <>) values (cut + 2 <>) 3)))
          (let1 m (car l)
            (if (> m u)
                (append (reverse ps) l)
                (loop (cons m ps)
                      (remove (lambda (x) (zero? (modulo x m))) l))))))))

; (factorize 20 '(2 3 5 7)) => ((2 2) (5 1))                                                                            
(define (factorize n ps)
  (map (lambda (p)
         (let loop ((n (/ n p)) (c 1))
           (if (zero? (modulo n p))
               (loop (/ n p) (+ c 1))
               (list p c))))
       (filter (lambda (p) (and (<= p n) (zero? (modulo n p))))
               ps)))

;; sum of proper divisor                                                                                                
; (D 12 '(2 3 5)) => 16 ;(+ 1 2 3 4 6)                                                                                  
; (D 11 '(2 3 5)) => 1                                                                                                  
(define (D n ps)
  (let1 d (apply * (map
                    (lambda (l) (apply + (map (cut expt (car l) <>)
                                              (iota (+ 1 (cadr l))))))
                    (factorize n ps)))
    (- d (if (= d 1) 0 n))))

問21.

10000未満の友愛数の合計を求める問題。

(define (e21)
  (let1 ps (primes 5000)
    (apply + (filter (lambda (a) (let1 b (D a ps)
                                   (and (not (= a b))
                                        (= a (D b ps)))))
                     (iota 9998 2)))))

問22.

指定のテキストファイル中の全名前のスコア(指定の方法で算出)の合計を求める問題。

(use gauche.sequence)

(define (e22)
  (define (score s)
    (apply + (map (lambda (c) (- (char->integer c) 64))
                  (string->list s))))
  (apply + (map-with-index (lambda (i s) (* (+ 1 i) (score s)))
                           (sort (map (lambda (s) (substring s 1 (- (string-length s) 1)))
                                      (string-split (call-with-input-file "./names.txt" read-line) ","))
                                 string<?))))

問23.

2つの過剰数の和で書き表せない正の整数の総和を求める問題。
過剰数の和で書ける = その数から過剰数を引くと過剰数になるような過剰数のペアがある
初めは過剰数の判定にリスト(al)で比較していたけど、処理が全く終わらないのでベクタを使用。

(define (e23)
  (let* ((m 28123)
         (ps (primes (quotient m 2)))
         (fv (make-vector (+ m 1) #f))
         (al (filter (lambda (n) (< n (D n ps)))
                     (iota m 1))))
    (for-each (cut vector-set! fv <> #t) al)
    (apply + (remove (lambda (x)
                       (any (lambda (y) (vector-ref fv (- x y)))
                            (filter (cut > x <>) al)))
                     (iota m 1)))))

問24.

0,1,2,3,4,5,6,7,8,9からなる順列を辞書式に並べたときの100万番目を求める問題。
permutations-for-eachで順番にアクセスして100万番目で終了するにはcall/ccを使うとよいみたい。
けどまだ勉強不足なので今回は使えない。
総数は高々10!通り(3,628,800通り)なのでpermutationsで全て生成して100万番目を取得。

(use util.combinations)

(define (e24)
  (list-ref (permutations (iota 10)) (- 1000000 1)))

(追記)

という理解でcall/cc使うと

(define (e24-call/cc)
  (let1 c 1
    (call/cc (lambda (return)
               (permutations-for-each (lambda (n)
                                        (when (= c 1000000) (return n))
                                        (inc! c))
                                      (iota 10))))))

ってなります。

問25.

フィボナッチ数列において1000桁になる最初の項の番号を求める問題。

(define (e25)
  (let1 goal (expt 10 999)
    (let loop ((a 1) (b 1) (n 3))
      (let1 c (+ a b)
        (if (< goal c)
            n
            (loop b c (+ 1 n)))))))