投稿者: jun-s

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