Project Euler – 問題20

n!はnx(n-1)x…x3x2x1という意味である。

100!の全ての数字の和を求めよ。

100の階乗とは1から100までの数の積である。そこに問題16で定義した sumDigitsを適用すると答えが求まる。

euler020 = sumDigits $ product [1..100]

Project Euler – 問題19

以下のような情報が与えられている。さらに自分自身で調べてもよい。

1900年1月1日は月曜である
9月4月6月11月は30日である
それ以外の月は31日である
ただし2月は28日である
うるう年の場合は29日である
4で割り切れる年がうるう年であるが、 世紀の年は400で割り切れなければうるう年ではない

20世紀の間で月の初めが日曜日であった回数を求めよ。

Zellerの公式というものを使うと年・月・日から曜日を計算できるらしい。そ の式をHaskellで記述したものが以下のzeller関数である。月が1または2の時は 前年の13または14として計算する。以下の式を計算した値が0のときが日曜日で ある。そこで20世紀の全ての月の最初の日の曜日のリストを生成し、その中で 値が0であるものの数を数えると答えを求めることができる。

zeller y m d = if m < 3
               then zeller' (y - 1) (m + 12)
               else zeller' y m
    where zeller' y m = (y + y `div` 4 - y `div` 100 + y `div` 400
                         + (13 * m + 8) `div` 5 + d) `mod` 7

euler019 = length $ filter (== 0) [zeller y m 1
                                   | y <- [1901..2000], m <- [1..12]]

Project Euler – 問題18

以下の三角形の一番上から隣接した数字を移動して一番下まで移動したときの 合計の最大値は23である。(データ省略)

以下の三角形を一番上から下まで移動したときの合計の最大値を求めよ。(デー タ省略)

(注)この問題は16384通りしかないので、すべての経路を計算することも可能 である。しかし、この問題の発展問題である問題67では100列のデータがあるの で、総当りでは答えを求めることが出来ない。

問題のデータはProject Eulerのサイトを参照してほしい。ここではそのデータ がeuler018.datというテキストファイルに入っているとして扱うことにする。 まずはファイルからデータを読み込み三角形のに並んだ数字をリストのリスト として表現する。HaskellではreadFile関数でファイルの中身を文字列として読 み込むことができる。ここでdo表記を使うと以下のコードのようにファイルの 中身全体が変数xに入る。Haskellの入出力の関数はIOモナドというもので表現 されており、型の整合性を考えるとdo表記の最後に値を返すにはreturn関数を 使うことになる。ここではIOモナドについては詳しくは立ち入らない。

全体のプログラムの構造が上のように決まったところで中身の処理を考えると、 まず文字列を解析してリストにする必要がある。linesは文字列を一行ごとの文 字列のリストに分解する関数。wordsは文字列を単語ごとの文字列のリストに分 解する関数。linesの結果にmapで一行ごとにwordsを適用することで単語ごとの リストのリストに分解できる。ここでmapでreadを適用することで文字列を数値 に変換する。上から下までたどったときのすべてのルートの和のリストを求め る関数travelを定義し、最後にmaximumで最大値を求める。

三角形を上から下にたどるときにとりえるルートはそれぞれの地点で、右下に いくか左下にいくかの二通りなので、現時点までの和をもとめつつ再帰的にリ ストを連結していくようにtravelを定義する。これは全てのルートについて計 算することになるので非常に低速であるが、ここでは特に問題にならない。問 題67では同じ問題でデータが100行に増えたバージョンがあり、そこでもっと効 率的なプログラムを考えることにする。

euler018 = do x <- readFile "euler018.dat"
              return $ maximum $ travel 0 0 15 0
                         $ map ((map read) . words) $ lines x
    where travel i j n x a
              | i == (n - 1) = [x + y]
              | otherwise    = travel (i + 1) j n (x + y) a
                               ++ travel (i + 1) (j + 1) n (x + y) a
              where y = a !! i !! j

ほとんどどうでもいい話だが

最近の電車はドアの上に液晶がついていて
そこに次の駅などが表示されるので大変便利である。

電車が駅に到着してから、はっとわれにかえって、
あわててここはどこの駅だろうと確認することって結構あると思う。

しかし、しかし!!
停車中はドアが開いてる側の液晶にしか駅の名前が表示されてない!!
なんとも微妙に不便である。

山手線だと反対側のドアには山手線の各駅までの所要時間が、
東横線だとその電車の終点が書いてある。

考えてみて欲しいのだが、
駅に到着してから駅名を確認するときに、
もしドアが開く側を向いているのなら、
液晶を見なくてもホームの看板などで駅名がわかるのだ。
一方、ドアが開かない側を向いているときは、
ホームも見えなければ液晶も駅名じゃないというダブルパンチ。

はてさて、この微妙にもどかしい感じが伝わっただろうか^^

Project Euler – 問題17

1から5までの数を単語にするとone,two,three,four,fiveとなり、全部で 3+3+5+4+4=19文字になる。

1から1000までの全ての数を単語にすると何文字になるか求めよ。

(注)スペースやハイフンは数に含めない。例えば342(three hundred and forty-two)は23文字、115(one hundred and fifteen)は20文字である。andの使 い方はイギリス方式である。

題意のとおりに、1から1000までの数を単語であらわしたものを求め、その文字 数の和を求めることにする。数を単語であらわす関数inwordsを以下のように定 義する。20以下の場合は単語のリストから単語を取り出す。20以上の場合は10 の位と1の位をそれぞれリストから求める。100以上になるとさらに100の位を別 に求めて連結する。問題自体は決して難しくないが、ネイティブでない場合、 数の英語表記を間違えないように注意する必要がある。とくにつづりを間違え ただけでも答えを間違ってしまう。100の位とその下の間にandをつけるがちょ うど100の時にはつけないなども注意が必要だ。

euler017 = sum $ map (length . inwords) [1..1000]
    where words1  = [ "",
                      "one",
                      "two",
                      "three",
                      "four",
                      "five",
                      "six",
                      "seven",
                      "eight",
                      "nine",
                      "ten",
                      "eleven",
                      "twelve",
                      "thirteen",
                      "fourteen",
                      "fifteen",
                      "sixteen",
                      "seventeen",
                      "eighteen",
                      "nineteen"]
          words10 = [ "",
                      "",
                      "twenty",
                      "thirty",
                      "forty",
                      "fifty",
                      "sixty",
                      "seventy",
                      "eighty",
                      "ninety" ]
          inwords n
              | n < 20 = words1 !! n
              | n >= 20 && n < 100 = let (d, m) = divMod n 10
                                     in words10 !! d ++ inwords m
              | n >= 100 && n < 1000 = let (d, m) = divMod n 100
                                           lower  = if m /= 0
                                                    then "and" ++ inwords m
                                                    else ""
                                       in inwords d ++ "hundred" ++ lower
              | n == 1000 = "onethousand"

Project Euler – 問題16

2^15=32768で、その全ての数字の和は3+2+7+6+8=26である。

2の1000乗の全ての数字の和を求めよ。

これも大きな数を扱う問題であるが、Haskellを使用すると非常に簡単に求める ことが出来る。ここでは全ての数字の和を求める関数sumDigitsを以下のように 定義した。showで数値を文字列に変換し、文字列は文字のリストなので digitToIntをmapすることで一桁の数値のリストに変換し、sumで合計を求める。 問題の答えは2^1000にsumDigitsを適用することで求められる。

sumDigits n = sum $ map digitToInt $ show n

euler016 = sumDigits (2 ^ 1000)

Project Euler – 問題15

2×2の格子を左上から出発して逆戻りせずに右下に移動するには6通りの経路が ある。(図はProject Eulerのサイト参照)

20×20の格子の場合の経路の数を求めよ。

この問題はプログラムを書かなくても答えを求めることができる。逆戻りをせ ずに移動する場合、どんなルートを通っても右に20回、下に20回の計40回移動 することになる。つまりは40回の移動のうちのいずれか20回が右への移動であ る組み合わせの数を求めればいいわけだ。式で書く と40C20ということになる。ここではcombinationを Haskellで書いて計算してみることにする。定義は以下のようにmに関する再帰 で直感的なものとした。これは割り算を使っているので決して高速ではないが、 今回の用途には問題ない。

combination n 1 = n
combination n m = (combination (n - 1) (m - 1)) * n `div` m

euler015 = combination 40 20

Project Euler – 問題14

正の整数に対して以下のような反復数列を定義する。
n→n/2(nが偶数のとき)
n→3n+1(nが奇数のとき)

この規則を13から適用すると次のような数列ができる。13→40→20→10→5→ 16→8→4→2→1

この数列は10の項から成り立っているのがわかる。これはCollatz問題と呼ばれ 証明はされていないが、全ての数から始まる数列が1で終わると考えられている。

1000000未満の数でもっとも長い数列を生成する数を求めよ。

(注)数列の途中で1000000を超えることはある。

比較の対象は数列の長さで求める数は最初の数なので、最初の数と数列の長さ を組み合わせたものを扱うことにする。Haskellでは一般的にtupleと呼ばれる ()でくくったデータの組をひとつのデータとして扱うことができる。まずリス トの内包表記で1から999999の数についてその数とその数から始まる数列の長さ のtupleのリストを生成する。ここで数列の長さは定義をそのまま実装したもの で求める。

そしてそのリストからtupleの2番目の値が最大である要素を求め、最後に関数 fstで最初の値をとりだす。maximumByは指定した関数で比較して最大値を求め る関数で、cmpSndとしてtupleの2つめの要素を比較する関数を定義し使用して いる。このプログラムは若干時間がかかるが待てないほどではないのでここで はこれでよしとする。

cmpSnd (_, x) (_, y) = compare x y

euler014 = fst $ maximumBy cmpSnd [(n, collatzLength n) | n <- [1..999999]]
    where collatzLength n
              | n == 1    = 1
              | even n    = (collatzLength (n `div` 2)) + 1
              | otherwise = (collatzLength (n * 3 + 1)) + 1

Project Euler – 問題13

以下の100個の50桁の数の和の最初の10桁を求めよ。(データ省略)

大きな数の足し算をどのように実現するかという問題であるが、Haskellの場合 はデフォルトで処理が可能なので単純な計算問題になる。データの扱いかたが 一考の余地があるが、ここではまたしてもプログラム中にリテラルとして埋め 込んだ。ソースコードは無駄に長くなるので一部省略して掲載した。全てのデー タが知りたい場合はProject Eulerのサイトを参照して欲しい。このデータに sumを適用するだけで和を求めることができる。非常に便利である。答えを showで文字列に変換しtake 10で最初の10桁を求められる。

euler013Digits = [ 37107287533902102798797998220837590246510135740250,
                   46376937677490009712648124896970078050417018260538,
                   74324986199524741059474233309513058123726617309629,
                   91942213363574161572522430563301811072406154908250,
                   23067588207539346171171980310421047513778063246676,
                   89261670696623633820136378418383684178734361726757,
                   28112879812849979408065481931592621691275889832738,
                   44274228917432520321923589422876796487670272189318,
                   47451445736001306439091167216856844588711603153276,

                   ... 省略 ...

                   82616570773948327592232845941706525094512325230608,
                   22918802058777319719839450180888072429661980811197,
                   77158542502016545090413245809786882778948721859617,
                   72107838435069186155435662884062257473692284509516,
                   20849603980134001723930671666823555245252804609722,
                   53503534226472524250874054075591789781264330331690]

euler013 = take 10 $ show $ sum euler013Digits

Project Euler – 問題12

三角数の数列は自然数の和で生成することができる。したがって7番目の三角数 は1+2+3+4+5+6+7=28である。三角数の最初の10項は 1,3,6,10,15,21,28,36,45,55,…となる。

最初の7つの三角数の約数を列挙すると以下のようになる。
1: 1
3: 1, 3
6: 1, 2, 3, 6
10: 1, 2, 5, 10
15: 1, 3, 5, 15
21: 1, 3, 7, 21
28: 1, 2, 4, 7, 14, 28

ここで、7番目の三角数である28が約数の数が5を超える最初の三角数であるこ とがわかる。約数の数が500より大きくなる最初の三角数を求めよ。

まず無限に続く三角数のリストを以下のように定義する。いろいろな書き方が できると思うが、n番目の三角数はn-1番目の三角数にnを足したものであるとい う考えでzipWithを使って定義している。次に全ての約数のリストを求める関数 factorsを定義する。1から順番に割り切れるか試している。割り切れた場合に はその数と商が約数となる。呼び出すときに余計な初期値を指定しなくてもい いようにfactorsを定義し、実際の処理はローカル関数のfactors’で行っている。

三角数のリストにmapでfactorsを適用し約数のリストのリストを求める。そし てfilterを使用して、その中から約数のリストの長さが500より大きいものをと りだし、headで最初のものを求める。求まった約数のリストの最後尾をlastで 取り出し解として表示する。アドホックであるが、約数の中で一番最後のもの が三角数そのものであることを利用している。

triangles = zipWith (+) [1..] (0 : triangles)

factors n = factors' n 1 []
    where factors' n x l
              | x * x > n      = l
              | x * x == n     = x : l
              | n `mod` x == 0 = x : factors' n (x + 1) ((n `div` x) : l)
              | otherwise      = factors' n (x + 1) l

euler012 = last $ head $ filter (\x -> length x > 500) $ map factors triangles