カテゴリー: Project Euler

テキストファイルに含まれる5000個以上の名前をアルファベット順にソートし て、その位置と文字から計算した値の積がその名前の得点とする。

例えばCOLINは3+15+12+9+14=53で、938番目に位置するので 938×53=49714が得点となる。

ファイルに含まれる全ての名前の得点の和を求めよ。

与えられたデータファイルはダブルコーテーションでくくられた名前をカンマ で区切ったものであるが、その最初と最後に[]を追加するとHaskellからread関 数で読み込めて便利なので、ここではデータファイルをエディタ等で書き換え ることとする。書き換えたファイルのファイル名はeuler022.datとする。

まずはファイルをreadFileで読み込み、それをreadでStringの配列に変換する。 次にsort関数でソートし、その結果に対してscore関数をmapして文字列の得点 を計算する。得点の計算にはord関数を用いて文字を数値に変換し、Aが1になる ように64を引いている。1から始まる自然数の数列を順番としてzipWithでかけ て和を計算すると解が求まる。

euler022 = do x <- readFile "euler022.dat"
              return $ sum $ zipWith (*) (map score (sort $ read x)) [1..]
    where score s = sum $ map (\x -> ord x - 64) s

d(n)をnの真の約数（nの約数でnより小さいもの）の和と定義する。

a≠bでd(a)=bかつd(b)=aのとき、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未満の全ての友愛数の和を求めよ。

友愛数とは2つの異なる自然数a,bで自分自身を含まない約数の和が他方と等し くなるものである。まずは問題12で定義したfactorsを元に自分自身を含まない 約数のリストを求めるproperFactorsを定義する。1で割り切れるか試す部分を 特別扱いし2以降についてはfactorsと同様に処理することで自分自身を含まな い約数のリストを求めることができる。

次に友愛数かどうかのチェックをする関数amicableを定義する。ここでは友愛 数の定義をそのまま実装し、引数aの約数の和bを求め、aとbが異なり、bの約数 の和がaであった場合に友愛数であると判定する。最後に10000未満の数のリス トからfilterで友愛数を取り出しsumで和を求める。

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

amicable a = b /= a && (sum $ properFactors b) == a
    where b = sum $ properFactors a

euler021 = sum $ filter amicable [1..9999]

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

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

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

euler020 = sumDigits $ product [1..100]

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

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

以下の三角形の一番上から隣接した数字を移動して一番下まで移動したときの 合計の最大値は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

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"

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)

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

正の整数に対して以下のような反復数列を定義する。
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

以下の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