问题 项目Euler 14：与C和memoization相比的性能

在用优化编译之后，C程序仍然存在一些差异

• 你用 div虽然C程序使用机器分割（截断）[但任何自尊的C编译器将其转换为移位，因此使其更快]，这将是 quot 在哈斯克尔;这使运行时间缩短了约15％。
• C程序使用固定宽度的64位（甚至32位，但它只是运气得到正确的答案，因为一些中间值超过32位范围）整数，Haskell程序使用任意精度 Integer秒。如果你有64位 Int在你的GHC（Windows以外的64位操作系统）中，替换 Integer 同 Int。这样可以将运行时间缩短约3倍。如果您使用的是32位系统，那么运气不好，GHC不会在那里使用本机64位指令，这些操作是作为C调用实现的，但仍然相当慢。

对于备忘录，您可以将其外包给hackage上的一个memoisation包，我唯一记得的是 数据memocombinators，但还有其他人。或者你可以自己做，例如保留以前计算的值的地图 - 这将最有效 State 单子，

import Control.Monad.State.Strict
import qualified Data.Map as Map
import Data.Map (Map, singleton)

type Memo = Map Integer Int

syr :: Integer -> State Memo Int
syr n = do
    mb <- gets (Map.lookup n)
    case mb of
      Just l -> return l
      Nothing -> do
          let m = if even n then n `quot` 2 else 3*n+1
          l <- syr m
          let l' = l+1
          modify (Map.insert n l')
          return l'

solve :: Integer -> Int -> Integer -> State Memo (Integer,Int)
solve maxi len start
    | len > 1000000 = return (maxi,len)
    | otherwise = do
         l <- syr start
         if len < l
             then solve start l (start+1)
             else solve maxi len (start+1)

p14 :: (Integer,Int)
p14 = evalState (solve 0 0 500000) (singleton 1 1)

但这可能不会获得太多（即使你已经添加了必要的严格性）。麻烦在于查找 Map不太便宜，插入相对昂贵。

另一种方法是为查找保留一个可变数组。代码变得更加复杂，因为您必须为要缓存的值选择合理的上限（应该不比起始值的界限大很多）并处理落在记忆范围之外的序列部分。但是数组查找和写入速度很快。如果你有64位 Ints，下面的代码运行得相当快，这里需要0.03s的限制为100万，0.33s限制为1000万，相应的（尽可能合理）C代码运行0.018 resp。 0.2S。

module Main (main) where

import System.Environment (getArgs)
import Data.Array.ST
import Data.Array.Base
import Control.Monad.ST
import Data.Bits
import Data.Int

main :: IO ()
main = do
    args <- getArgs
    let bd = case args of
               a:_ -> read a
               _   -> 100000
    print $ collMax bd

next :: Int -> Int
next n
    | n .&. 1 == 0  = n `unsafeShiftR` 1
    | otherwise     = 3*n + 1

collMax :: Int -> (Int,Int16)
collMax upper = runST $ do
    arr <- newArray (0,upper) 0 :: ST s (STUArray s Int Int16)
    let go l m
            | upper < m = go (l+1) $ next m
            | otherwise = do
                l' <- unsafeRead arr m
                case l' of
                  0 -> do
                      l'' <- go 1 $ next m
                      unsafeWrite arr m (l'' + 1)
                      return (l+l'')
                  _ -> return (l+l'-1)
        collect mi ml i
            | upper < i = return (mi, ml)
            | otherwise = do
                l <- go 1 i
                if l > ml
                  then collect i l (i+1)
                  else collect mi ml (i+1)
    unsafeWrite arr 1 1
    collect 1 1 2