・0 pv・9 min read
【積最大の隣接】一緒に考えませんか？ #Project Euler
問8
以下の1000桁の数字の列から隣接する13桁の積が最大の部分を探す
(答えはその積)
7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940
4桁の積が最大の部分は
Project Euler ※解法の公開は問1～100のみ可
考え方
一番シンプルにHaskellらしい書き方
digits1000 :: [Int]
digits1000 = [7,3,1,6,7..]
solve :: [Int] -> Int
solve = maximum $ map (product . take 13) $ tails digits1000
tailsで1つずつ先頭を除いたリストを作っていき、そのリストごとに最初の13個の積を求めて最大値を探すだけ
遅延評価のおかげか、リストがたくさん出来ても先頭13桁しか評価されないのでそこまで重い処理ではなさそう
しかも、簡潔でHaskellらしい書き方になっている
積を求めない方法
上記のやり方は、書き方としては美しい。しかし、誰がどう見ても積を計算して比較するのは無駄
少なくとも命令型の言語でならこんなに無駄な計算をせずにアルゴリズムを工夫するはず！
と、言うわけで考えてみる
出て行く数字、入ってくる数字
今現在、1000桁の数字の中のとある13桁の数字を最大値として持っているとする。
1,2,3,4, [3,5,6,8,2,4,5,3,7,4,5,1,9] x,2,7,8
次の数字xが今持っている13桁の先頭3よりも大きければ、間違いなく最大値になるはず
ghci> product [3,5,6,7,2,4,5,3,7,4,5,1,9]
95256000
ghci> product [5,6,7,2,4,5,3,7,4,5,1,9,4]
127008000
こういう考えで、digits1000を先頭から走査して、1つ進む毎に出てく値と入ってくる値を比較するという方法をとれれば積の計算はいらなさそう
問題点
このままではいくつかの障壁にぶち当たる
問題点1
常に最大を更新し続けるのなら簡単だが、出て行く値の方が大きくなった場合にどうするか?
例えば
1,2,3,4, [3,5,6,8,2,4,5,3,7,4,5,1,9] 4,2,7,8 = 95256000
-> 1,2,3,4,3, [5,6,8,2,4,5,3,7,4,5,1,9,4] ,2,7,8 大きくなった = 127008000 ※最大
-> 1,2,3,4,3,5, [6,8,2,4,5,3,7,4,5,1,9,4,2] ,7,8 小さくなった = 58060800
-> 1,2,3,4,3,5,6, [8,2,4,5,3,7,4,5,1,9,4,2,7] ,8 大きくなった = 67737600
最大値になるたびに保存したいが、大きくなるたびに最大値になるわけではないので結局積を比較しないといけない
問題点2
0をどうするか?
積を求める方法では、簡単に0が入っていることが分かるが今の方法ではどうするか
問題点3
13桁のリストを保存するのはもったいない?
解決策
問題点3
先頭のインデックスだけ保存しとけば良さそう
問題点2
0が入ってきたらカウントを"+"、出て行ったら"-"をしてカウントが0のときは13桁の中に0は含まれていないと出来る
問題点1
Rational (分数)を使おう!
Haskellには分数を簡単に扱う型Rationalがある
1,2,3,4, [3,5,6,8,2,4,5,3,7,4,5,1,9] 4,2,7,8 = 95256000
-> 1,2,3,4,3, [5,6,8,2,4,5,3,7,4,5,1,9,4] ,2,7,8 大きくなった = 127008000 = 95256000 * (4/3)
-> 1,2,3,4,3,5, [6,8,2,4,5,3,7,4,5,1,9,4,2] ,7,8 小さくなった = 58060800 = 12700800 * (2/5)
-> 1,2,3,4,3,5,6, [8,2,4,5,3,7,4,5,1,9,4,2,7] ,8 大きくなった = 67737600 = 58060800 * (7/6)
このように、積は"入ってくる値 / 出て行く値"倍になる
これを利用して分数が1より大きくなったら最大値が更新されたとし、分数を1に戻すという操作をすれば
1STEPの計算は簡単な分数のかけ算のみにできる
例
1,2,3,4, [3,5,6,8,2,4,5,3,7,4,5,1,9] 4,2,7,8 = 95256000 (Rational = 1)
-> 1,2,3,4,3, [5,6,8,2,4,5,3,7,4,5,1,9,4] ,2,7,8 大きくなった = 127008000: (Rational = 4/3) -> ここでRational1に戻す
-> 1,2,3,4,3,5, [6,8,2,4,5,3,7,4,5,1,9,4,2] ,7,8 小さくなった = 58060800: (Rational = 1 * 2/5)
-> 1,2,3,4,3,5,6, [8,2,4,5,3,7,4,5,1,9,4,2,7] ,8 大きくなった = 67737600: (Rational = 2/5 * 7/6 = 14/15) !!! 大きくなったが最大でない
import Control.Monad.State
import Data.Ratio (numerator, denominator)
import Data.Char
digits1000 :: [Int]
digits1000 = map digitToInt ("73167176531330624919225119674426574742355349194934"
++ "96983520312774506326239578318016984801869478851843"
++ "85861560789112949495459501737958331952853208805511"
++ "12540698747158523863050715693290963295227443043557"
++ "66896648950445244523161731856403098711121722383113"
++ "62229893423380308135336276614282806444486645238749"
++ "30358907296290491560440772390713810515859307960866"
++ "70172427121883998797908792274921901699720888093776"
++ "65727333001053367881220235421809751254540594752243"
++ "52584907711670556013604839586446706324415722155397"
++ "53697817977846174064955149290862569321978468622482"
++ "83972241375657056057490261407972968652414535100474"
++ "82166370484403199890008895243450658541227588666881"
++ "16427171479924442928230863465674813919123162824586"
++ "17866458359124566529476545682848912883142607690042"
++ "24219022671055626321111109370544217506941658960408"
++ "07198403850962455444362981230987879927244284909188"
++ "84580156166097919133875499200524063689912560717606"
++ "05886116467109405077541002256983155200055935729725"
++ "71636269561882670428252483600823257530420752963450"
)
-- | 積が最大となる連続する13桁の数字の先頭のインデックスを取得
solve :: [Int] -> Int
solve [] = -1
solve xs = do
let (initialList, shift13List) = splitAt 13 xs
-- 初期評価 ー- 0の数をカウント
cnt0 = length $ filter (== 0) initialList
evalState (searchMax 0 1 (zip shift13List xs)) (1::Rational, cnt0)
-- | リストを全走査し、最大値のインデックスを返す - 最大値のインデックスをans, 今のリストの位置(インデックス)をidxで持っている
searchMax :: Int -> Int -> [(Int, Int)] -> State (Rational, Int) Int
searchMax ans _ [] = return ans
searchMax ans idx (x:xs) = do
flg <- eval13Rows x
when flg $ put (1, 0) -- Rationalを1に戻す
searchMax (if flg then idx else ans) (idx+1) xs
eval13Rows :: (Int, Int) -> State (Rational, Int) Bool
eval13Rows (into, out) = do
-- 0ならカウントを操作 それ以外なら分母or分子に掛ける
modify (\(fraction, cnt) -> if into == 0 then (fraction, cnt+1) else (fraction * fromIntegral into, cnt))
modify (\(fraction, cnt) -> if out == 0 then (fraction, cnt-1) else (fraction / fromIntegral out, cnt))
-- 更新後の状態を評価しRationalが1より大きく、0がないならTrueを返す
(fraction, cnt0) <- get
return $ fraction > 1 && cnt0 == 0
print $ take 13 $ drop (solve digits1000) digits1000[5,5,7,6,6,8,9,6,6,4,8,9,5]
末筆ながら
ご意見求む!!
今の実力では限界だけどもっと綺麗に書けそう
純粋に上位互換のアルゴリズムがあるはず
Haskellerさんへ
計算量, 見やすさ, 文化的な観点から見て改善点や他回答があればぜひお願いします！
スキル指標
実務1年程度のへっぽこプログラマーなので暖かくも厳しく見守ってください
読んだ本
- すごいH本
- 関数プログラミング実践入門
- 関数プログラミングの楽しみ (途中)
型の面白さに気づき始めました