23か月前公開・23か月前更新・9 min read

【積最大の隣接】一緒に考えませんか？ #Project Euler

https://cdn.magicode.io/media/notebox/7f7071d4-caff-48ad-ace3-221c061d7417.jpeg

問8

以下の1000桁の数字の列から隣接する13桁の積が最大の部分を探す

(答えはその積)

7316717653133062491922511967442657474235534919493496983520312774506326239578318016984801869478851843858615607891129494954595017379583319528532088055111254069874715852386305071569329096329522744304355766896648950445244523161731856403098711121722383113622298934233803081353362766142828064444866452387493035890729629049156044077239071381051585930796086670172427121883998797908792274921901699720888093776657273330010533678812202354218097512545405947522435258490771167055601360483958644670632441572215539753697817977846174064955149290862569321978468622482839722413756570560574902614079729686524145351004748216637048440319989000889524345065854122758866688116427171479924442928230863465674813919123162824586178664583591245665294765456828489128831426076900422421902267105562632111110937054421750694165896040807198403850962455444362981230987879927244284909188845801561660979191338754992005240636899125607176060588611646710940

4桁の積が最大の部分は

"9989" → 9*9*8*9 = 5832

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