[Project Euler] Problem 30 「各桁の5乗」

驚くべきことに, 各桁を4乗した数の和が元の数と一致する数は3つしかない.

1634 = 1⁴ + 6⁴ + 3⁴ + 4⁴
8208 = 8⁴ + 2⁴ + 0⁴ + 8⁴
9474 = 9⁴ + 4⁴ + 7⁴ + 4⁴

ただし, 1=1⁴は含まないものとする.

この数たちの和は 1634 + 8208 + 9474 = 19316 である.

各桁を5乗した数の和が元の数と一致するような数の総和を求めよ.

9⁵は59049ですから, 対象となる数の30万を超えることはありません.

1. 2から30万までの整数のリストを作る.
2. 各桁を5乗した結果の和を求める.
3. 元の数と和が一致するものだけを残す.

手続きは次のようになります.

(require srfi/1)

(define (decimal-format nbr)
  (define (loop ans n)
    (if (= 0 n)
        ans
        (loop (cons (remainder n 10) ans) (quotient n 10))))
  (loop () nbr))

(define (digit-fifth-powers n)
  (fold + 0 (map (lambda (x) (* x x x x x)) (decimal-format n))))

計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
443839
> (filter (lambda (n) (= n (digit-fifth-powers n)))
          (iota 300000 2))
(4150 4151 54748 92727 93084 194979)
> (+ 4150 4151 54748 92727 93084 194979)
443839
> 

[Project Euler] Problem 29 「個別のべき乗」

2 ≤ a ≤ 5 と 2 ≤ b ≤ 5について, ab を全て考えてみよう:

2²=4, 2³=8, 2⁴=16, 2⁵=32
3²=9, 3³=27, 3⁴=81, 3⁵=243
4²=16, 4³=64, 4⁴=256, 4⁵=1024
5²=25, 5³=125, 5⁴=625, 5⁵=3125

これらを小さい順に並べ, 同じ数を除いたとすると, 15個の項を得る:

4, 8, 9, 16, 25, 27, 32, 64, 81, 125, 243, 256, 625, 1024, 3125

2 ≤ a ≤ 100, 2 ≤ b ≤ 100 で同じことをしたときいくつの異なる項が存在するか?

aとbの直積集合を求められれば答えは求まりそうです.

1. aとbの直積集合を求める.
2. aのb乗を求める.
3. 重複を取り除く.

手続きは次のようになります.

(require srfi/1)

;; 直積集合を求める.
(define (product list-a list-b)
  (apply append
         (map (lambda (a)
                (map (lambda (b) (list a b))
                     list-b))
              list-a)))

;; 重複した要素を取り除く
(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 dp 
  (map (lambda (a) (apply expt a))
       (product (iota 99 2) (iota 99 2))))

計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (take dp 20)
(4
 8
 16
 32
 64
 128
 256
 512
 1024
 2048
 4096
 8192
 16384
 32768
 65536
 131072
 262144
 524288
 1048576
 2097152)
> (length (make-set dp))
9183
> 

[Project Euler] Problem 28 「螺旋状に並んだ数の対角線」

1から初めて右方向に進み時計回りに数字を増やしていき, 5×5の螺旋が以下のように生成される:

21 22 23 24 25
20 07 08 09 10
19 06 01 02 11
18 05 04 03 12
17 16 15 14 13

両対角線上の数字の合計は101であることが確かめられる.
1001×1001の螺旋を同じ方法で生成したとき, 対角線上の数字の和はいくつか?

対角線上の数の増え方にパターンがあります. 一番内側が+2, その外側が+4となっています. まず, そのような数のリストを作ります.

(require srfi/1)

(define c
  (fold (lambda (n ans)
          (cons (+ (car ans) n) ans))
        '(1)
        (apply append
               (map (lambda (n) (list n n n n))
                    (iota 500 2 2)))))

計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (take (reverse c) 20)
(1 3 5 7 9 13 17 21 25 31 37 43 49 57 65 73 81 91 101 111)
> (fold + 0 c)
669171001
> 

[Project Euler] Problem 27 「二次式素数」

オイラーは以下の二次式を考案している:

n2 + n + 41.

この式は, n を0から39までの連続する整数としたときに40個の素数を生成する. しかし, n = 40 のとき 40² + 40 + 41 = 40(40 + 1) + 41 となり41で割り切れる. また, n = 41 のときは 41² + 41 + 41 であり明らかに41で割り切れる.

計算機を用いて, 二次式 n² - 79n + 1601 という式が発見できた. これは n = 0 から 79 の連続する整数で80個の素数を生成する. 係数の積は, -79 × 1601 で -126479である.

さて, |a| < 1000, |b| < 1000 として以下の二次式を考える (ここで |a| は絶対値): 例えば |11| = 11, |-4| = 4である。

n² + an + b

n = 0 から始めて連続する整数で素数を生成したときに最長の長さとなる上の二次式の, 係数 a, b の積を答えよ.

素数の表があれば解けそうです.

1. 素数の表を作る.
2. 係数a, bから二次式を作る手続きを用意する.
3. 二次式から素数のリストを作る手続きを用意する.
4. aとbを与えられた範囲で変化させ, 素数のリストを作る.
5. 素数のリストが一番長いものを求める.

手続きは次のようになります.

(require srfi/1)

;; エラトステネスのふるい
(define (sieve pv n)
  (define (loop i)
    (when (< i (vector-length pv))
      (vector-set! pv i #f)
      (loop (+ i n))))
  (loop (+ n n)))

(define (find-prime pv start)
  (cond ((<= (vector-length pv) start) #f)
        ((vector-ref pv start) start)
        (else (find-prime pv (+ start 1)))))

(define (eratosthenes pv)
  (define (loop n)
    (when (and n (< n (sqrt (vector-length pv))))
      (sieve pv n)
      (loop (find-prime pv (+ n 1)))))
  (loop 2))
  
(define (prime-vector n)
  (let ((pv (make-vector (+ n 1) #t)))
    (eratosthenes pv)
    (vector-set! pv 0 #f)
    (vector-set! pv 1 #f)
    pv))

(define (prime-vect-to-list pv)
  (define (loop ans n)
    (if (< n (vector-length pv))
        (let ((p (find-prime pv n)))
          (if p 
              (loop (cons p ans) (+ p 1)) 
              (reverse ans)))
        (reverse ans)))
  (loop () 2))

;; 1000万以下の素数表を作る
(define prime-vect (prime-vector 10000000))

(define (prime? n) (vector-ref prime-vect (abs n)))

(define (quadric a b)
  (lambda (n) (+ (* n n)
                 (* a n)
                 b)))

(define (make-prime-list a b)
  (define (loop rslt n)
    (let ((v ((quadric a b) n)))
      (if (prime? v)
          (loop (cons v rslt) (+ n 1))
          (list a b (reverse rslt)))))
  (loop () 0))

(define ans
  (apply append
         (map (lambda (a)
                (map (lambda (b) (make-prime-list a b))
                     (iota 1999 -999)))
              (iota 1999 -999))))
 
(define sorted 
  (sort ans 
        (lambda (x y) (> (length (list-ref x 2)) 
                         (length (list-ref y 2))))))

計算してみます. 少し時間がかかります.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (make-prime-list 1 41)
(1
 41
 (41 43 47 53 61 71 83 97 113 131 151 173 197 223 251 281
  313 347 383 421 461 503 547 593 641 691 743 797 853 911
  971 1033 1097 1163 1231 1301 1373 1447 1523 1601))
> (car sorted)
(-61
 971
 (971 911 853 797 743 691 641 593 547 503 461 421 383 347
  313 281 251 223 197 173 151 131 113 97 83 71 61 53 47 43
  41 41 43 47 53 61 71 83 97 113 131 151 173 197 223 251 281
  313 347 383 421 461 503 547 593 641 691 743 797 853 911 971
  1033 1097 1163 1231 1301 1373 1447 1523 1601))
> (* -61 971)
-59231
> 

[Fieldrunners2] HOME ON DERANGEの攻略

HOME ON DERANGEの難易度HEROICを攻略する方法を紹介します。

GATLING TOWERを設置します。

 GATLING TOWERを伸ばしていきます。2箇所、Level 3までアップグレードします。

Round 12までに通路を完成させます。Round 13終了後、GATLING TOWERを売り、FLAMETHROWERを設置します。

FLAMETHROWERをLevel 3までアップグレードし、OIL TOWERも設置します。Level 3までアップグレードします。

FLAMETHROWERとOIL TOWERを追加します。追加したOIL TOWERはLevel 2までアップグレードしたところでやめておきます。

Round 30の軽戦車に対応するために、TESLA TOWERとGLUE TOWERを設置します。

FLAMETHROWERとGLUE TOWERを設置します。Round 42で現れる飛行機を確実に仕留めるためにGLUE TOWERを設置しています。

FLAMETHROWER、TESLA TOWER、OIL TOWERを追加します。

更にTESLA TOWERを追加し、通路を伸ばします。通路の途中でGLUE TOWERを設置しています。これは、敵ユニットを分散させてTESLA TOWERに近づけるためです。

Round 70を攻略したときのTOWERの配置です。TOWERをもう一つ使えるので、ENDLESSのためにRAILGUNを用意しておいても良さそうです。

[Project Euler] Problem 26 「逆数の循環節 その1」

単位分数とは分子が1の分数である. 分母が2から10の単位分数を10進数で表記すると次のようになる.

1/2 = 0.5
1/3 = 0.(3)
1/4 = 0.25
1/5 = 0.2
1/6 = 0.1(6)
1/7 = 0.(142857)
1/8 = 0.125
1/9 = 0.(1)
1/10 = 0.1

0.1(6)は 0.166666... という数字であり, 1桁の循環節を持つ. 1/7 の循環節は6桁ある.
d < 1000 なる 1/d の中で小数部の循環節が最も長くなるような d を求めよ.

割り算の筆算をすればよさそうです.

1. 1をdで割る.
2. 余りをリストに貯めこむ.
3. 余りを10倍し, dで割る.
4. 余りがリストにあれば循環している.

手続きは次のようになります.

(require srfi/1)

(define (make r q) (cons (* r 10) q))

(define (r-of t) (car t))

(define (q-of t) (cdr t))
  
(define (cycle? ts r)
  (find (lambda (t) (= (* r 10) (r-of t))) ts))

(define (cycles d rslt r)
  (if (< r d)
      (cycles d (cons (make r 0) rslt) (* r 10))
      (let ((q2 (quotient r d))
            (r2 (remainder r d)))
        (cond ((= 0 r2) (cons #f (reverse (cons (make r2 q2) rslt))))
              ((cycle? rslt r2) (cons #t (reverse (cons (make r2 q2) rslt))))
              (else (cycles d (cons (make r2 q2) rslt) (* r2 10)))))))


(define (reciprocal-cycles d)
  (let ((ans (cycles d '() 1)))
    (if (car ans)
        (map cdr (cdr ans))
        '())))
  
(define ans
  (sort (map (lambda (d) (list d (reciprocal-cycles d))) (iota 999 1))
        (lambda (a b) (< (length (list-ref a 1)) (length (list-ref b 1))))))

テストも含めて計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (cycles 7 '() 1)
(#t (10 . 0) (30 . 1) (20 . 4) (60 . 2) (40 . 8) (50 . 5) (10 . 7))
> (map cdr (cdr (cycles 7 '() 1)))
(0 1 4 2 8 5 7)
> (car (reverse ans))
(983
 (0 0 0 1 0 1 7 2 9 3 9 9 7 9 6 5 4 1 2 0 0 4 0 6 9 1 7 5 9 9 1 8 6 1
  6 4 8 0 1 6 2 7 6 7 0 3 9 6 7 4 4 6 5 9 2 0 6 5 1 0 6 8 1 5 8 6 9 7
  8 6 3 6 8 2 6 0 4 2 7 2 6 3 4 7 9 1 4 5 4 7 3 0 4 1 7 0 9 0 5 3 9 1
  6 5 8 1 8 9 2 1 6 6 8 3 6 2 1 5 6 6 6 3 2 7 5 6 8 6 6 7 3 4 4 8 6 2
  6 6 5 3 1 0 2 7 4 6 6 9 3 7 9 4 5 0 6 6 1 2 4 1 0 9 8 6 7 7 5 1 7 8
  0 2 6 4 4 9 6 4 3 9 4 7 1 0 0 7 1 2 1 0 5 7 9 8 5 7 5 7 8 8 4 0 2 8
  4 8 4 2 3 1 9 4 3 0 3 1 5 3 6 1 1 3 9 3 6 9 2 7 7 7 2 1 2 6 1 4 4 4
  5 5 7 4 7 7 1 1 0 8 8 5 0 4 5 7 7 8 2 2 9 9 0 8 4 4 3 5 4 0 1 8 3 1
  1 2 9 1 9 6 3 3 7 7 4 1 6 0 7 3 2 4 5 1 6 7 8 5 3 5 0 9 6 6 4 2 9 2
  9 8 0 6 7 1 4 1 4 0 3 8 6 5 7 1 7 1 9 2 2 6 8 5 6 5 6 1 5 4 6 2 8 6
  8 7 6 9 0 7 4 2 6 2 4 6 1 8 5 1 4 7 5 0 7 6 2 9 7 0 4 9 8 4 7 4 0 5
  9 0 0 3 0 5 1 8 8 1 9 9 3 8 9 6 2 3 6 0 1 2 2 0 7 5 2 7 9 7 5 5 8 4
  9 4 4 0 4 8 8 3 0 1 1 1 9 0 2 3 3 9 7 7 6 1 9 5 3 2 0 4 4 7 6 0 9 3
  5 9 1 0 4 7 8 1 2 8 1 7 9 0 4 3 7 4 3 6 4 1 9 1 2 5 1 2 7 1 6 1 7 4
  9 7 4 5 6 7 6 5 0 0 5 0 8 6 4 6 9 9 8 9 8 2 7 0 6 0 0 2 0 3 4 5 8 7
  9 9 5 9 3 0 8 2 4 0 0 8 1 3 8 3 5 1 9 8 3 7 2 3 2 9 6 0 3 2 5 5 3 4
  0 7 9 3 4 8 9 3 1 8 4 1 3 0 2 1 3 6 3 1 7 3 9 5 7 2 7 3 6 5 2 0 8 5
  4 5 2 6 9 5 8 2 9 0 9 4 6 0 8 3 4 1 8 1 0 7 8 3 3 1 6 3 7 8 4 3 3 3
  6 7 2 4 3 1 3 3 2 6 5 5 1 3 7 3 3 4 6 8 9 7 2 5 3 3 0 6 2 0 5 4 9 3
  3 8 7 5 8 9 0 1 3 2 2 4 8 2 1 9 7 3 5 5 0 3 5 6 0 5 2 8 9 9 2 8 7 8
  9 4 2 0 1 4 2 4 2 1 1 5 9 7 1 5 1 5 7 6 8 0 5 6 9 6 8 4 6 3 8 8 6 0
  6 3 0 7 2 2 2 7 8 7 3 8 5 5 5 4 4 2 5 2 2 8 8 9 1 1 4 9 5 4 2 2 1 7
  7 0 0 9 1 5 5 6 4 5 9 8 1 6 8 8 7 0 8 0 3 6 6 2 2 5 8 3 9 2 6 7 5 4
  8 3 2 1 4 6 4 9 0 3 3 5 7 0 7 0 1 9 3 2 8 5 8 5 9 6 1 3 4 2 8 2 8 0
  7 7 3 1 4 3 4 3 8 4 5 3 7 1 3 1 2 3 0 9 2 5 7 3 7 5 3 8 1 4 8 5 2 4
  9 2 3 7 0 2 9 5 0 1 5 2 5 9 4 0 9 9 6 9 4 8 1 1 8 0 0 6 1 0 3 7 6 3
  9 8 7 7 9 2 4 7 2 0 2 4 4 1 5 0 5 5 9 5 1 1 6 9 8 8 8 0 9 7 6 6 0 2
  2 3 8 0 4 6 7 9 5 5 2 3 9 0 6 4 0 8 9 5 2 1 8 7 1 8 2 0 9 5 6 2 5 6
  3 5 8 0 8 7 4 8 7 2 8 3 8 2 5 0 2 5 4 3 2 3 4 9 9 4 9 1 3 5 3))
> 

このコードでは, 循環の２回めが始まる小数点以下の桁数を求めているため正確ではありませんが, 答えが合っていたので良しとします.

[Project Euler] Problem 25 「1000桁のフィボナッチ数」

フィボナッチ数列は以下の漸化式で定義される:

F_n = F_n-1 + F_n-2 　(ただし F₁ = 1, F₂ = 1)

最初の12項は以下である.

F₁ = 1
F₂ = 1
F₃ = 2
F₄ = 3
F₅ = 5
F₆ = 8
F₇ = 13
F₈ = 21
F₉ = 34
F₁₀ = 55
F₁₁ = 89
F₁₂ = 144

12番目の項, F₁₂が3桁になる最初の項である.
1000桁になる最初の項の番号を答えよ.

フィボナッチ数を求めていけばよさそうです.

1. SICPの反復的プロセスを生成する手続きを参考にフィボナッチ数を求める.
2. フィボナッチ数を求める手続きの中で1000桁を超えたか判定する.

手続きは次のようになります.

(require srfi/1)

(define (decimal-format nbr)
  (define (loop ans n)
    (if (= 0 n)
        ans
        (loop (cons (remainder n 10) ans) (quotient n 10))))
  (loop () nbr))

(define (fib-list)
  (define (loop r a b)
    (if (<= 1000 (length (decimal-format a)))
        (reverse (cons a r))
        (loop (cons a r) b (+ a b))))
  (loop () 1 1))

計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (length (fib-list))
4782
> 

[Project Euler] Problem 24 「辞書式順列」

順列とはモノの順番付きの並びのことである. たとえば, 3124は数 1, 2, 3, 4 の一つの順列である. すべての順列を数の大小でまたは辞書式に並べたものを辞書順と呼ぶ. 0と1と2の順列を辞書順に並べると次のようになる.

012 021 102 120 201 210

0,1,2,3,4,5,6,7,8,9からなる順列を辞書式に並べたときの100万番目はいくつか?

力技で行きます.

1. 順列を求める.
2. 100万番目の要素を求める.

順列を求める過程でソートし, 辞書順になるようにしておきます. 手続きは次のようになります.

(require srfi/1)

;; リストから要素を一つ取り除く
(define (remove-one lst obj)
  (cond ((null? lst) ())
        ((equal? (car lst) obj) (cdr lst))
        (else (cons (car lst) (remove-one (cdr lst) obj)))))

;; 順列を求める
(define (permutation items)
  (if (null? items)
      '(())
      (apply append
             (map (lambda (item)
                    (map (lambda (p) (cons item p))
                         (permutation (remove-one items item))))
                  (sort items <)))))

(define ans (permutation '(0 1 2 3 4 5 6 7 8 9)))

計算します. メモリは２GB必要です.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (list-ref ans 999999)
(2 7 8 3 9 1 5 4 6 0)
> 

[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
> 

[Project Euler] Problem 22 「名前のスコア」

5000個以上の名前が書かれている46Kのテキストファイル names.txt を用いる. まずアルファベット順にソートせよ.
のち, 各名前についてアルファベットに値を割り振り, リスト中の出現順の数と掛け合わせることで, 名前のスコアを計算する.

たとえば, リストがアルファベット順にソートされているとすると, COLINはリストの938番目にある. またCOLINは 3 + 15 + 12 + 9 + 14 = 53 という値を持つ. よってCOLINは 938 × 53 = 49714 というスコアを持つ.

ファイル中の全名前のスコアの合計を求めよ.

素直に解いていきます.

1. アルファベットを数値に変換する手続きを定義する.
2. string->listを使って文字列を文字のリストに変換し, 名前の値を計算する.
3. name.txtを読み込むのも面倒なので, ソースコードに埋め込む.
4. 名前のソートは, sort手続きを使う.
5. mapとfoldを使って, 求める値を計算する.

手続きは次のとおりです. name.txtの内容については一部, 省略します.

(require srfi/1)

(define (alpha-value c)
  (cdr 
   (assoc c
          (map cons
               (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
               (iota 26 1)))))

(define (name-score name)
  (fold + 0 (map alpha-value (string->list name))))

(define name-list
  (sort (list
         "MARY" "PATRICIA" "LINDA" "BARBARA" "ELIZABETH" "JENNIFER" "MARIA" 
         "SUSAN" "MARGARET" "DOROTHY" "LISA" "NANCY" "KAREN" "BETTY" "HELEN"
         "SANDRA" "DONNA" "CAROL" "RUTH" "SHARON" "MICHELLE" "LAURA" "SARAH" 
         "KIMBERLY" "DEBORAH" "JESSICA" "SHIRLEY" "CYNTHIA" "ANGELA" "MELISSA" 

         ... 省略 ...

         "LUCIUS" "KRISTOFER" "BOYCE" "BENTON" "HAYDEN" "HARLAND" "ARNOLDO" "RUEBEN"
         "LEANDRO" "KRAIG" "JERRELL" "JEROMY" "HOBERT" "CEDRICK" "ARLIE" "WINFORD"
         "WALLY" "LUIGI" "KENETH" "JACINTO" "GRAIG" "FRANKLYN" "EDMUNDO" "SID"
         "PORTER" "LEIF" "JERAMY" "BUCK" "WILLIAN" "VINCENZO" "SHON" "LYNWOOD"
         "JERE" "HAI" "ELDEN" "DORSEY" "DARELL" "BRODERICK" "ALONSO"
         )
        string<?))

計算します.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (fold + 
        0
        (map *
             (map name-score name-list)
             (iota (length name-list) 1)))
871198282
> 

[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
> 

[Project Euler] Problem 20 「階乗の数字和」

n × (n - 1) × ... × 3 × 2 × 1 を n! と表す.

例えば, 10! = 10 × 9 × ... × 3 × 2 × 1 = 3628800 となる.
この数の各桁の合計は 3 + 6 + 2 + 8 + 8 + 0 + 0 = 27 である.

では, 100! の各桁の数字の和を求めよ.

素直に100!を求めて, 各桁の和を求めます. 手続きは次のようになります.

(require srfi/1)

(define (decimal-format nbr)
  (define (loop ans n)
    (if (= 0 n)
        ans
        (loop (cons (remainder n 10) ans) (quotient n 10))))
  (loop () nbr))

計算します. foldを使って100!を計算をしています.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> (fold * 1 (iota 99 1))
933262154439441526816992388562667004907159682643816214685929
638952175999932299156089414639761565182862536979208272237582
511852109168640000000000000000000000
> (fold + 0 (decimal-format (fold * 1 (iota 99 1))))
648
>

[Project Euler] Problem 19 「日曜日の数え上げ」

次の情報が与えられている.

• 1900年1月1日は月曜日である.
• 9月, 4月, 6月, 11月は30日まであり, 2月を除く他の月は31日まである.
• 2月は28日まであるが, うるう年のときは29日である.
• うるう年は西暦が4で割り切れる年に起こる. しかし, 西暦が400で割り切れず100で割り切れる年はうるう年でない.

20世紀（1901年1月1日から2000年12月31日）中に月の初めが日曜日になるのは何回あるか?

ポイントは, うるう年を求めることと毎月の1日が1900年１月１日から経過した日数を求めることです.

1. うるう年を求める手続きを定義する.
2. 年と月からその月の日数を求める手続きを定義する.
3. 1900年から2000年までの期間で月ごとの日数を求める.
4. 月ごとの日数を足して, 1900年１月１日からの経過した日数を求める.
5. 毎月の１日の日数を７で割り, 余りが０なら日曜日.

手続きは次のようになります.

(require srfi/1)

;; うるう年か判定する
(define (leap? n)
  (or (= 0 (remainder n 400))
      (and (not (= 0 (remainder n 100)))
           (= 0 (remainder n 4)))))

;; 月の日数を求める
(define (days y m)
  (cond ((= m 1) 31)
        ((= m 2) (if (leap? y) 29 28))
        ((= m 3) 31)
        ((= m 4) 30)
        ((= m 5) 31)
        ((= m 6) 30)
        ((= m 7) 31)
        ((= m 8) 31)
        ((= m 9) 30)
        ((= m 10) 31)
        ((= m 11) 30)
        ((= m 12) 31)))

;; 月ごとの日数のリストを求める
(define y-m 
  (apply append
         (map (lambda (y) 
                (map (lambda (m) (list (days y m) y m))
                     (iota 12 1)))
              (iota 101 1900))))

;; 月ごとの日数を足しこんで, 経過した日数を求める.
(define (acc count items)
  (if (null? items) 
      ()
      (let ((head (car items))
            (tail (cdr items)))
        (cons (cons (+ count (car head)) head)
              (acc (+ count (car head)) tail)))))

(define c-y-m (acc 0 y-m))
 
;; 7で割った余りが0なら日曜日
(define ans (filter (lambda (c) (= (remainder (+ (car c) 1) 7) 0))
                    c-y-m))

計算してみます.

ようこそ DrRacket, バージョン 5.3.3 [3m].
言語: Pretty Big; memory limit: 2048 MB.
> y-m
((31 1900 1)
 (28 1900 2)
 (31 1900 3)
 (30 1900 4)
 (31 1900 5)
 (30 1900 6)

 ... 省略 ...

 (31 2000 7)
 (31 2000 8)
 (30 2000 9)
 (31 2000 10)
 (30 2000 11)
 (31 2000 12))
> c-y-m
((31 31 1900 1)
 (59 28 1900 2)
 (90 31 1900 3)
 (120 30 1900 4)
 (151 31 1900 5)
 (181 30 1900 6)

 ... 省略 ...

 (36737 31 2000 7)
 (36768 31 2000 8)
 (36798 30 2000 9)
 (36829 31 2000 10)
 (36859 30 2000 11)
 (36890 31 2000 12))
> ans
((90 31 1900 3)
 (181 30 1900 6)
 (608 31 1901 8)
 (699 30 1901 11)
 (881 31 1902 5)
 (1126 31 1903 1)

 ... 省略 ...

 (35580 31 1997 5)
 (35825 31 1998 1)
 (35853 28 1998 2)
 (36098 31 1998 10)
 (36371 31 1999 7)
 (36798 30 2000 9))
> (length ans)
173
> 

計算は1900年からしていますが, 問題は期間の始まりを1901年１月１日からにしていることに注意が必要です.

[論理学をつくる] 定理4 : Unique Readability Theorem

「論理学をつくる」の定理４の証明で躓きました。テキストから定理を引用します。

【定理4 : unique readability theorem】A, B, Cはすべて論理式とする。
　また, △, ▲は任意の相異なる２項結合子（→, ∨, ∧）のどれかとする。
　（１） (A △ B) = (C ▲ D)というようなことはない。
　（２） (A △ B) = (¬ C)というようなことはない。
　（３） (A △ B) = (C △ D)ならばA=C, B=Dである。

続けて、（１）の証明の前半を引用します。

（１）仮に(A ∧ B) = (C → D)であるとする。そうするとA ∧ B) = C → D)である。このとき, A=Cでなくてはならない。なぜなら, さもないとA, Cの一方が他方の始切片ということになるが,

「他方の始切片ということになるが」で、議論を追えなくなりました。しばらく悩んだ末に私がたどり着いた考えをここに書いておきます。

まず、=（等号）の定義の確認しておきます。この証明において、等号は左辺と右辺の記号列が等しいことを表しています。論理式の値や意味と別の視点で見ます。

論理式を構成する記号列の話をしているので、両辺の左端から左括弧を取り除いても

A ∧ B) = C → D)

が成り立ちます。

ここで、論理式AとCを構成する記号列について考えます。まず、論理式Aの記号列とCの記号列の長さが異なるとします。仮に、Cの記号列の方が短いとします。模式的に書くと次のようになります。

　　A = ◯◯◯◯◯◯◯
　　C = ◎◎◎◎◎

証明の仮定(A ∧ B) = (C → D)から、論理式Aの記号列の左から５つ目までは、論理式Cの記号列と一致しなくてはなりません。（等号の定義に注意）

つまり、論理式Cの記号列は論理式Aの始切片であるといえます。

定理の仮定で、Cは論理式であるとしています。しかし、定理３によれば、論理式の始切片は論理式ではありません。ここで矛盾が生じました。

矛盾が生じた原因は、論理式AとCの記号列の長さが異なるとしたことによります。これにより、AとCの長さが等しいためA=Cであるといえます。

これ以降の証明については、テキストに書いてある通りに理解できると思います。

[Fieldrunners2] TANGLED TURNPIKEの攻略

動画を追加しました。時間が経つと、攻略方法が変わっていました。(2014.11.20)

TANGLED TURNPIKEの難易度HEROICを攻略する方法を紹介します。ノーミスでのクリアーを目指さなければ、それほど難しくはありませんでした。

図のようにGATLING TOWERを設置し、Level 3にまでアップグレードします。Round 8までこのままにしておきます。

 図のようにFLAMETHROWERを設置します。そのまま、Level 3にまでアップグレードします。

 HIVE TOWERを上に設置し、Level 3にアップグレードします。その後、下にHIVE TOWERを設置し、Level 3にアップグレードします。

 GATLING TOWERを売り、HIVE TOWERを設置します。これで、Round 30の戦車を破壊できます。

 HIVE TOWERとOIL TOWERを追加します。

 Round 45を過ぎると、倒しきれない敵ユニットが出てくるので、TESLA TOWERを設置します。

ほとんど趣味の問題です。LASER TOWERを設置してみました。

Round 70を攻略したときの配置です。飛行ユニットに逃げられないように、HIVE TOWERを並べておくと安心です。

[Fieldrunners2] TANGLED EXPRESSの攻略

クリアした時の動画を貼り付けておきます。(2014.11.01)

TANGLED EXPRESSの難易度HEROICを攻略する方法を紹介します。

図のようにGATLING TOWERを設置します。Level 3にアップグレードし、お金が貯まるまで待ちます。

真ん中にFLAMETHROWERを設置します。この状態で、 Level 3にアップグレードします。

 HIVE TOWERを設置します。これもLevel 3にアップグレードします。

 FLAMETHROWERの下にHIVE TOWERを設置します。これもLevel 3にアップグレードします。

この手順でTOWERを配置し、アップグレードすれば、図のように敵ユニットを231体倒した状態で爆弾を使えるようになっています。この配置でこいつらを倒すことはできませんので爆弾を使います。爆弾を使わなくてもクリアすることはできます。

クリアー条件を上回る、267体を倒すことが出来ました