[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体を倒すことが出来ました