Решение на 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]
=============================================== =================================
А вот еще одно решение haskell, использующее пакет monad-memo. К сожалению, у этого есть ошибка стекового пространства, которая не затрагивает вышеупомянутый мемоизер roll-my-own.
. / 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
/1802469/proekt-eilera-vopros-14-problema-kollattsa
-}
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
-}
=============================================== ===
еще один, более приятный факторинг. не бежит так быстро, но все еще намного меньше минуты
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