Haskell ソリューション、実行時間 2 秒。
thomashartman@yucca:~/collatz>ghc -O3 -fforce-recomp --make collatz.hs
[1 of 1] Compiling Main ( collatz.hs, collatz.o )
Linking collatz ...
thomashartman@yucca:~/collatz>time ./collatz
SPOILER REDACTED
real 0m2.881s
-- マップの代わりにハッシュを使用すると、もう少し速く取得できたかもしれません。
import qualified Data.Map as M
import Control.Monad.State.Strict
import Data.List (maximumBy)
import Data.Function (on)
nextCollatz :: Integer -> Integer
nextCollatz n | even n = n `div` 2
| otherwise = 3 * n + 1
newtype CollatzLength = CollatzLength Integer
deriving (Read,Show,Eq,Ord)
main = print longestCollatzSequenceUnderAMill
longestCollatzSequenceUnderAMill = longestCollatzLength [1..1000000]
-- sanity checks
tCollatzLengthNaive = CollatzLength 10 == collatzLengthNaive 13
tCollatzLengthMemoized = (CollatzLength 10) == evalState (collatzLengthMemoized 13) M.empty
-- theoretically could be nonterminating. Since we're not in Agda, we'll not worry about it.
collatzLengthNaive :: Integer -> CollatzLength
collatzLengthNaive 1 = CollatzLength 1
collatzLengthNaive n = let CollatzLength nextLength = collatzLengthNaive (nextCollatz n)
in CollatzLength $ 1 + nextLength
-- maybe it would be better to use hash here?
type CollatzLengthDb = M.Map Integer CollatzLength
type CollatzLengthState = State CollatzLengthDb
-- handy for testing
cLM :: Integer -> CollatzLength
cLM n = flip evalState M.empty $ (collatzLengthMemoized n)
collatzLengthMemoized :: Integer -> CollatzLengthState CollatzLength
collatzLengthMemoized 1 = return $ CollatzLength 1
collatzLengthMemoized n = do
lengthsdb <- get
case M.lookup n lengthsdb of
Nothing -> do let n' = nextCollatz n
CollatzLength lengthN' <- collatzLengthMemoized n'
put $ M.insert n' (CollatzLength lengthN') lengthsdb
return $ CollatzLength $ lengthN' + 1
Just lengthN -> return lengthN
longestCollatzLength :: [Integer] -> (Integer,CollatzLength)
longestCollatzLength xs = flip evalState M.empty $ do
foldM f (1,CollatzLength 1) xs
where f maxSoFar@(maxN,lengthMaxN) nextN = do
lengthNextN <- collatzLengthMemoized nextN
let newMaxCandidate = (nextN,lengthNextN)
return $ maximumBy (compare `on` snd) [maxSoFar, newMaxCandidate]
================================================== ==============================
そして、monad-memo パッケージを使用した別の Haskell ソリューションを次に示します。残念ながら、これにはスタック スペース エラーがあり、上記の自分だけのメモライザーには影響しません。
./collatzMemo +RTS -K83886080 -RTS # これで答えが出ますが、スペースリークを無くした方が良いでしょう
{-# Language GADTs, TypeOperators #-}
import Control.Monad.Memo
import Data.List (maximumBy)
import Data.Function (on)
nextCollatz :: Integer -> Integer
nextCollatz n | even n = n `div` 2
| otherwise = 3 * n + 1
newtype CollatzLength = CollatzLength Integer
deriving (Read,Show,Eq,Ord)
main = print longestCollatzSequenceUnderAMill
longestCollatzSequenceUnderAMill = longestCollatzLength [1..1000000]
collatzLengthMemoized :: Integer -> Memo Integer CollatzLength CollatzLength
collatzLengthMemoized 1 = return $ CollatzLength 1
collatzLengthMemoized n = do
CollatzLength nextLength <- memo collatzLengthMemoized (nextCollatz n)
return $ CollatzLength $ 1 + nextLength
{- Stack space error
./collatzMemo
Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize -RTS' to increase it.
Stack error does not effect rolled-my-own memoizer at
http://stackoverflow.com/questions/2643260/project-euler-question-14-collatz-problem
-}
longestCollatzLength :: [Integer] -> (Integer,CollatzLength)
longestCollatzLength xs = startEvalMemo $ do
foldM f (1,CollatzLength 1) xs
where f maxSoFar nextN = do
lengthNextN <- collatzLengthMemoized nextN
let newMaxCandidate = (nextN,lengthNextN)
return $ maximumBy (compare `on` snd) [maxSoFar, newMaxCandidate]
{-
-- sanity checks
tCollatzLengthNaive = CollatzLength 10 == collatzLengthNaive 13
tCollatzLengthMemoized = (CollatzLength 10) ==startEvalMemo (collatzLengthMemoized 13)
-- theoretically could be nonterminating. Since we're not in Agda, we'll not worry about it.
collatzLengthNaive :: Integer -> CollatzLength
collatzLengthNaive 1 = CollatzLength 1
collatzLengthNaive n = let CollatzLength nextLength = collatzLengthNaive (nextCollatz n)
in CollatzLength $ 1 + nextLength
-}
==================================================
別のものは、よりうまく因数分解されます。それほど速くはありませんが、それでも1分未満です
import qualified Data.Map as M
import Control.Monad.State
import Data.List (maximumBy, nubBy)
import Data.Function (on)
nextCollatz :: Integer -> Integer
nextCollatz n | even n = n `div` 2
| otherwise = 3 * n + 1
newtype CollatzLength = CollatzLength Integer
deriving (Read,Show,Eq,Ord)
main = print longestCollatzSequenceUnderAMillStreamy -- AllAtOnce
collatzes = evalState collatzesM M.empty
longestCollatzSequenceUnderAMillAllAtOnce = winners . takeWhile ((<=1000000) .fst) $ collatzes
longestCollatzSequenceUnderAMillStreamy = takeWhile ((<=1000000) .fst) . winners $ collatzes
-- sanity checks
tCollatzLengthNaive = CollatzLength 10 == collatzLengthNaive 13
tCollatzLengthMemoized = (CollatzLength 10) == evalState (collatzLengthMemoized 13) M.empty
-- maybe it would be better to use hash here?
type CollatzLengthDb = M.Map Integer CollatzLength
type CollatzLengthState = State CollatzLengthDb
collatzLengthMemoized :: Integer -> CollatzLengthState CollatzLength
collatzLengthMemoized 1 = return $ CollatzLength 1
collatzLengthMemoized n = do
lengthsdb <- get
case M.lookup n lengthsdb of
Nothing -> do let n' = nextCollatz n
CollatzLength lengthN' <- collatzLengthMemoized n'
put $ M.insert n' (CollatzLength lengthN') lengthsdb
return $ CollatzLength $ lengthN' + 1
Just lengthN -> return lengthN
collatzesM :: CollatzLengthState [(Integer,CollatzLength)]
collatzesM = mapM (\x -> do (CollatzLength l) <- collatzLengthMemoized x
return (x,(CollatzLength l)) ) [1..]
winners :: Ord b => [(a, b)] -> [(a, b)]
winners xs = (nubBy ( (==) `on` snd )) $ scanl1 (maxBy snd) xs
maxBy :: Ord b => (a -> b) -> a -> a -> a
maxBy f x y = if f x > f y then x else y