@hammar 已经指出了太懒的问题maximum，以及如何解决这个问题（使用foldl1'的严格版本foldl1）。
但是代码中还有进一步的低效率。
cSeq n = length $ game n
cSeq让我们game构造一个列表，只计算它的长度。不幸的是，length不是一个“好消费者”，所以中间列表的构建并没有被融合掉。这是相当多的不必要的分配和花费时间。消除这些列表
cSeq n = coll (1 :: Int) n
where
coll acc 1 = acc
coll acc m
| even m = coll (acc + 1) (m `div` 2)
| otherwise = coll (acc + 1) (3*m+1)
减少了大约 65% 的分配和大约 20% 的运行时间（仍然很慢）。下一点，您正在使用div，它在正常除法之外执行符号检查。由于所涉及的所有数字都是正数，因此使用quotinstead 确实会加快速度（这里不多，但稍后会变得很重要）。
下一个重点是，由于您没有给出类型签名，因此数字的类型（除了在我的重写中由使用length或由表达式类型签名确定的地方）是. 上的操作比 上的相应操作慢得多，因此如果可能，您应该使用(or ) 而不是在速度很重要的时候。如果您有 64 位 GHC，则足以进行这些计算，使用 时，运行时间减少约一半，使用时减少约 70% ，使用本机代码生成器时，使用 LLVM 后端时，运行时间使用时减少约 70%，使用时减少约 95% 。(1 :: Int)IntegerIntegerIntIntWordIntegerIntdivquotdivquot
本机代码生成器和 LLVM 后端之间的差异主要是由于一些基本的低级优化。
even并且odd被定义
even, odd :: (Integral a) => a -> Bool
even n = n `rem` 2 == 0
odd = not . even
在GHC.Real. 当类型为Int时，LLVM 知道将用于确定模数的除以 2 替换为按位和 ( n .&. 1 == 0)。本机代码生成器（尚未）执行许多这些低级优化。如果您手动执行此操作，则 NCG 和 LLVM 后端生成的代码执行几乎相同。
使用div时，NCG 和 LLVM 都无法用短的移位和加法序列替换除法，因此您会通过符号测试获得相对较慢的机器除法指令。使用quot，两者都可以做到这一点Int，因此您可以获得更快的代码。
所有出现的数字都是正数的知识允许我们用简单的右移替换除以 2，而无需任何代码来纠正负参数，这将 LLVM 后端生成的代码再加速约 33%，奇怪的是它没有对 NCG 没有影响。
因此，从最初花费了 8 秒加/减一点（NCG 少一点，LLVM 后端多一点）的原始版本，我们已经去了
module Main (main)
where
import Data.List
import Data.Bits
main = print (answer (1000000 :: Int))
-- Count the length of the sequences
-- count' creates a tuple with the second value
-- being the starting number of the game
-- and the first value being the total
-- length of the chain
count' n = (cSeq n, n)
cSeq n = go (1 :: Int) n
where
go !acc 1 = acc
go acc m
| even' m = go (acc+1) (m `shiftR` 1)
| otherwise = go (acc+1) (3*m+1)
even' :: Int -> Bool
even' m = m .&. 1 == 0
-- Find the maximum chain value of the game
answer n = foldl1' max $ map count' [1..n]
在我的设置中，使用 NCG 需要 0.37 秒，使用 LLVM 后端需要 0.27 秒。
运行时间有微小的改进，但可以通过foldl1' max手动递归替换 来获得巨大的分配减少，
answer n = go 1 1 2
where
go ml mi i
| n < i = (ml,mi)
| l > ml = go l i (i+1)
| otherwise = go ml mi (i+1)
where
l = cSeq i
这使其分别为0.35。0.25 秒（并产生一个微小的52,936 bytes allocated in the heap）。
现在，如果这仍然太慢，您可以考虑一个好的记忆策略。我知道的最好的（1）是使用未装箱的数组来存储不超过限制的数字的链长度，
{-# LANGUAGE BangPatterns #-}
module Main (main) where
import System.Environment (getArgs)
import Data.Array.ST
import Data.Array.Base
import Control.Monad.ST
import Data.Bits
main :: IO ()
main = do
args <- getArgs
let bd = case args of
a:_ -> read a
_ -> 100000
print $ mxColl bd
mxColl :: Int -> (Int,Int)
mxColl bd = runST $ do
arr <- newArray (0,bd) 0
unsafeWrite arr 1 1
goColl arr bd 1 1 2
goColl :: STUArray s Int Int -> Int -> Int -> Int -> Int -> ST s (Int,Int)
goColl arr bd ms ml i
| bd < i = return (ms,ml)
| otherwise = do
nln <- collatzLength arr bd i
if ml < nln
then goColl arr bd i nln (i+1)
else goColl arr bd ms ml (i+1)
collatzLength :: STUArray s Int Int -> Int -> Int -> ST s Int
collatzLength arr bd n = go 1 n
where
go !l 1 = return l
go l m
| bd < m = go (l+1) $ case m .&. 1 of
0 -> m `shiftR` 1
_ -> 3*m+1
| otherwise = do
l' <- unsafeRead arr m
case l' of
0 -> do
l'' <- go 1 $ case m .&. 1 of
0 -> m `shiftR` 1
_ -> 3*m+1
unsafeWrite arr m (l''+1)
return (l + l'')
_ -> return (l+l'-1)
当使用 NCG 编译时，它在 0.04 秒内完成了 1000000 的限制，使用 LLVM 后端编译为 0.05 （显然，这在优化STUArray代码方面不如 NCG 好）。
如果您没有 64 位 GHC，则不能简单地使用Int，因为对于某些输入会溢出。但是计算的绝大部分仍然是在Int范围内执行的，所以你应该尽可能使用它，并且只移动到Integer需要的地方。
switch :: Int
switch = (maxBound - 1) `quot` 3
back :: Integer
back = 2 * fromIntegral (maxBound :: Int)
cSeq :: Int -> Int
cSeq n = goInt 1 n
where
goInt acc 1 = acc
goInt acc m
| m .&. 1 == 0 = goInt (acc+1) (m `shiftR` 1)
| m > switch = goInteger (acc+1) (3*toInteger m + 1)
| otherwise = goInt (acc+1) (3*m+1)
goInteger acc m
| fromInteger m .&. (1 :: Int) == 1 = goInteger (acc+1) (3*m+1)
| m > back = goInteger (acc+1) (m `quot` 2) -- yup, quot is faster than shift for Integer here
| otherwise = goInt (acc + 1) (fromInteger $ m `quot` 2)
使得优化循环变得更加困难，因此它比使用 的单循环慢Int，但仍然不错。在这里（循环从不运行），使用 NCG 需要 0.42 秒，使用 LLVM 后端需要 0.37 秒（这与在纯版本Integer中使用几乎相同）。quotInt
对记忆版本使用类似的技巧会产生类似的结果，它比纯Int版本慢得多，但与未记忆版本相比仍然快得惊人。
(1)对于这个特殊的（类型）问题，您需要记住一系列连续参数的结果。对于其他问题，一个Map或其他一些数据结构将是更好的选择。