Something in the past
125874とその2倍の251748は同じ数字を違う順序で並べたものである。
その数と2, 3, 4, 5, 6倍が全て同じ数字でできている最小の整数を求めよ。
1から順番にその数のrepeatと1..6をzipWithでかけたものが同じ数字でできて いるかどうかをチェックしていき、最初に見つかったものが解である。
同じ数字でできているかどうかのチェックはintToListで数を各桁の数字のリス トに分解し、それをソートしたものが全て同一かどうかでチェックする。同一 の場合はnubするとリストの長さが1になる。
euler052 = head $ head $ filter same [zipWith (*) (repeat i) [1..6] | i <- [1..]]
where same xs = (length $ nub $ map (sort . intToList) xs) == 1
*57の一番上の桁を入れ替えることで以下の6つの素数を作り出すことができる： 157, 257, 457, 557, 757, 857。
56**3の上から3桁目と4桁目を同じ数字で置き換えることで56003, 56113, 56333, 56443, 56663, 56773という素数の族を作り出すことができる。これは 7つの素数になる一番最初の数である。ここでこの族の中の一番最初の数56003 がこの属性を持つ最小の素数ということになる。
（連続している必要はない）一部の桁を同じ数字で置き換えることで8つの素数 を作り出せる最小の素数を求めよ。
順番に調べていけば必ず答えが見つかるというのは想像に難くないが、少ない 計算量で最小の答えが見つかる方法が全く見当がつかない。ここでは以下の方 針で地道に計算することにする。
まずn桁の素数について考える。最初にn桁の全素数のリストを生成する。次に n桁のうちの置き換える場所が1〜n箇所の全てのパターンを考える。素数の中か らそのパターンに当てはまる（置き換えようと思っている場所が同じ数字）も のだけをとりだす。パターン以外の部分が等しいものでグループに分ける。同 じグループに要素が8個あったらそれが解である。
このやり方では必ずしも最初に最小の解が見つかるとも限らないので、とりあ えず目測で5桁と6桁の数で要素数が7より大きいものを取り出して表示すること にする。
checkというのがn桁の素数のうちi箇所を置き換えたものを調べる関数で、ここ ではnが5,6のときにiが1からnについて全て調べ、concatでリストを連結した後 に、長さが7より大きいものをfilterで取り出している。
checkの中身はpsが対象とするn桁の素数全体、posが置き換える場所のパターン のリスト、それぞれのパターンについて、当てはまるものをfilterでとりだし、 family関数で分類している。
このプログラムは非常に計算に時間がかかるが幸運にも答えが求まったのでこ こはこれでよしとする。
euler051 = filter ((> 7) . length)
$ concat $ [check i n | n <- [5..6], i <- [1..n]]
where
makePos i n
| i == 0 = [take n $ repeat 0]
| i == n = [take n $ repeat 1]
| otherwise = (map (1 :) $ makePos (i - 1) (n - 1))
++ (map (0 :) $ makePos i (n - 1))
match p n = length (delete (-1) $ nub $ zipWith m' p ns) == 1
where ns = intToList n
m' 0 i = -1
m' 1 i = i
family p [] = []
family p [n] = [[n]]
family p (n:ns) = (n : filter (eqn n) ns)
: (family p $ filter (not . (eqn n)) ns)
where eqn x y = all eqn' $ zip3 p xs ys
where xs = intToList x
ys = intToList y
eqn' (p, x, y) = p == 1 || x == y
check i n = concat [family p $ filter (match p) ps | p <- pos]
where ps = takeWhile (< 10 ^ n) $ dropWhile (< 10 ^ (n - 1)) primes
pos = makePos i n
素数41は次のように6つの連続した素数の和で表すことができる。41 = 2 + 3 + 5 + 7 + 11 + 13
これは100未満の素数で最長の連続した素数の和である。
1000未満の素数で最長の連続した素数の和になるものは953で、21項含んでいる。
1000000未満の素数で最長の連続した素数の和で表されるものを求めよ。
素数の和が1000000未満なので、500000未満の素数を対象に考える。連続した数 が最大のものを求めるわけだが、連続した素数の和が1000000未満で、少なくと も953は21の素数の和なので、ここでは550から20までの連続数について多いほ うから順番に調べていくことにする。
consecsは引数に渡された数の和が素数になるすべての場合を求める関数である。 連続する数が多いほうから順番に試して、一番最初に見つかったものが解とな る。consecsの処理は対象とするpsのすべての項からn個の和を求め、その中で 1000000未満でかつ素数であるものを求めている。
euler050 = head $ concat $ map consecs [550,549..20]
where consecs n = filter isPrime $ takeWhile (< 1000000)
[sum $ take n $ drop i ps | i <- [0..]]
ps = takeWhile (< 500000) primes
差が3330の等差数列、1487,4817,8147は二つの変わった点がある。1. 3つの項 全てが素数である。2. それぞれが別の項の4つの数字を並び替えたものになっ ている。
1,2,3桁の3つの素数からなる等差数列でこの性質を持っているものは存在しな いが、4桁のものはもう一つ存在する。
その3つの数字を連結した12桁の数字を求めよ。
4桁の素数の順列を求め、その中に等差数列があるかどうかをチェックするとい う方針にする。リストの中からn個の組み合わせを求める部分は他の用途でも使 えそうなので独立した関数combinationListにする。引数に指定されたリストの 要素を引数で指定された個数だけ使って組み合わせたリストのリストを返す。 例えば、ある素数の順列が4つあったときに、その中から3つをつかった数列を 作るときに使用する。
primes4は4桁の素数のリストである。そこにpermList関数をmapすることで、4 桁の素数の順列のリストを生成する。permListは対象とする数を各桁ごとに分 解し、順列を求め、数値に戻し、それが4桁の素数であるものを重複を除いて、 数値順にソートしたものである。この順列のリストから重複を除き、3以上の長 さのものについて、先のcombinationListをconcatMapすることで、3個の数列の リストを求める。concatMapはmapした結果をconcatするものである。一つの要 素に対して複数の答えを返すような関数を適用するときに、答え全体のリスト を求めるときに便利である。
最後に等差数列になっているものを関数arithでfilterして答えを求める。答え はふたつ存在し、一つは問題文で示されているもので、もう一つがこの問題の 答えとなる。
combinationList 0 _ = [[]]
combinationList 1 [x] = [[x]]
combinationList n (x:xs)
| length xs < n = [x:xs]
| otherwise = (map (x :) $ combinationList (n - 1) xs)
++ (combinationList n xs)
euler049 = filter arith $ concatMap (combinationList 3)
$ filter ((> 2) . length) $ nub $ map permList primes4
where
primes4 = takeWhile (< 10000) $ dropWhile (< 1000) primes
permList n = sort $ nub $ filter (>= 1000) $ filter isPrime
$ map listToInt $ permutation $ intToList n
arith [a, b, c] = c - b == b - a
1^1 + 2^2 + 3^3 + … + 10^10 = 10405071317である。
1^1 + 2^2 + 3^3 + … + 1000^1000の下10桁と求めよ。
そのまま計算可能である。
euler048 = sum [i ^ i | i <- [1..1000]] `mod` (10 ^ 10)
二つの連続した数が二つの異なる素因数をもつ最初の組み合わせは 14 = 2 x 7, 15 = 3 x 5である。
三つの連続した数が三つの異なる素因数をもつ最初の組み合わせは 644 = 2^2 x 7 x 23, 645 = 3 x 5 x 43, 646 = 2 x 17 x 19である。
四つの連続した数が四つの異なる素因数をもつ最初の組み合わせの、四つの中 の最初の数を求めよ。
まずは2以上の数とその異なる素因数の数のタプルのリストを生成する。異なる 素因数の数を求める関数dpsはnを素因数分解し、nubで重複を取り除き、リスト の長さを求めている。次に関数consecsで異なる素因数の数が4の場合が4つ連続 しているものを再帰的に求める。
consecsの引数は最初が異なる素因数の数が4の場合が連続している数、次が連 続が始まった数、次に最初のリスト。連続している数が4になった場合、その連 続が始まった数が答えである。リストの先頭の異なる素因数の数が4の場合、そ れが連続の最初ならそのときの値を途中なら渡された値を渡して連続している 数を1増やす。
euler047 = consecs 0 0 [(n, dps n) | n <- [2..]]
where dps n = length $ nub $ primeFactorize n
consecs 4 s _ = s
consecs 0 _ ((n, 4):xs) = consecs 1 n xs
consecs i s ((_, 4):xs) = consecs (i + 1) s xs
consecs _ _ (_:xs) = consecs 0 0 xs
クリスチャン・ゴールドバッハは全ての奇数の合成数は素数と平方数の2倍の和 で表せると提唱しました。9 = 7 + 2 * 1 ^ 2, 15 = 7 + 2 * 2 ^ 2, 21 = 3 + 2 x 3 ^ 2, 25 = 7 + 2 * 3 ^ 2, 27 = 19 + 2 * 2 ^ 2, 33 = 31 + 2 * 1 ^ 2
しかしこの予想は間違いでした。
奇数の合成数で素数と平方数の2倍の和で表せない最小のものを求めよ。
奇数のなかで素数でないものをfilterで選ぶことで奇数の合成数を求める。次 にgoldbach関数で予想を満たさないものをfilterし、headで最小の要素が求ま る。
goldbach関数では対象となる値より小さい素数を引いたリストを求め、その差 が平方数の2倍のリストの中にあれば条件を満たすというのをintersectを用い て求めている。
euler046 = head $ filter goldbach $ filter (not . isPrime) [3,5..]
where squares2 = map (* 2) squares
goldbach n = intersect (map (n -) ps) ss == []
where ps = takeWhile (< n) primes
ss = takeWhile (< n) squares2
三角数、五角数、六角数はそれぞれ次の式で求められる。 三角数、Tn = n (n + 1) / 2、1, 3, 6, 10, 15, … 五角数、Pn = n (3n – 1) / 2、1, 5, 12, 22, 35, … 六角数、Hn = n (2n – 1)、1, 6, 15, 28, 45, …
ここでT285 = P165 = H143 = 40755ということがわかる。
次に三角数かつ五角数かつ六角数となる値を求めよ。
三角数、五角数については以前に定義したものを使う。六角数は以下のように 無限リストで定義する。
三角数について、関数alsoでその値が五角数および六角数に含まれているかを filterし、求まったリストの2番目で解が求まる。
hexagonals = 1 : zipWith (+) hexagonals diffs
where diffs = [5,9..]
euler045 = (filter also triangles) !! 2
where also n = (n == (last $ takeWhile (<= n) pentagonals))
&& (n == (last $ takeWhile (<= n) hexagonals))
五角数はPn = n (3n – 1) / 2という式で生成できる。五角数の最初の10項は次 の通りである。1, 5, 12, 22, 35, 51, 70, 92, 117, 145, …
P4 + P7 = 22 + 70 = 92 = P8 であることがわかる。しかし、その差 70 – 22 = 48は五角数ではない。
二つの五角数PjとPkで、その和と差が五角数であるものうち、差が最小になる ときのその差を求めよ。
まず五角数を以下のように定義する。問題文では各項を求める式で定義してあ るが、五角数の無限リストを定義する場合には、以下のように差が3n+1になる ような数列として定義することもできる。
次に、リストの内包表記を用いて、二つの五角数で、その和も差も五角数であ るものの差のリストを求め、そのリストの最小値を求める。ここでは計算時間 の都合上、5000項目までを計算しているが、解が存在しなければ対象とする範 囲を大きくする必要がある。
pentagonals = 1 : zipWith (+) pentagonals diffs
where diffs = [4,7..]
euler044 = minimum [k - j | j <- ps, k <- ps, j < k,
elem (j + k) ps, elem (k - j) ps]
where ps = take 5000 pentagonals
1406357289は0から9までの数字を1回ずつ使った数で、その一部を取り出したと きに以下のような面白い特性がある。
d1を1桁目の数字、d2を2桁目の数字としたときに、 d2d3d4 = 406は2で割り切れる、 d3d4d5 = 063は3で割り切れる、 d4d5d6 = 635は5で割り切れる、 d5d6d7 = 357は7で割り切れる、 d6d7d8 = 572は11で割り切れる、 d7d8d9 = 728は13で割り切れる、 d8d9d10 = 289は17で割り切れる。
この特性を持った全ての数の和を求めよ。
まず0から9のpermutationを求め、その中で問題の割り算の特性を持ったものだ けをfilterで取り出し、その和を求めることにする。ただしpermutationは各桁 の数字のリストなのでsumを適用する前にmapでlistToIntを適用する。
割り算の特性が成り立っているかどうかは関数divisibleで判別する。それぞれ の位置から3桁とりだし、割る数（素数を小さいほうから順番に並べたもの）で 割ったあまりのリストを求め、それが全て0のときに条件を満たす。
euler043 = sum $ map listToInt $ filter divisible $ permutation [0..9]
where divisible ns = all (== 0) [(listToInt $ take 3 $ drop (i - 1) ns)
`mod` (primes !! (i - 2))
| i <- [2..8]]