我想计算Ackermann函数（参见维基百科）的A(3, 20)值，应该是2^23 - 3 = 8388605，使用Data.MemoCombinators。我的代码如下：
{-# LANGUAGE BangPatterns #-}
import Data.MemoCombinators as Memo
ack = Memo.memo2 Memo.integral Memo.integral ack'
where
ack' 0 !n = n+1
ack' !m 0 = ack (m-1) 1
ack' !m !n = ack (m-1) $! (ack m (n-1))
main = print $ ack 3 20
但最终会出现堆栈溢出错误;-) 它能被调整吗？还是计算链真的很长，甚至记忆化也无济于事？
Ackermann函数的一个问题是使用递归计算会导致非常深的递归栈。
递归深度与结果大约相等（取决于如何计数，可能多几层或少几层），不使用记忆化。不幸的是，如果按照调用树来填充备忘录表，记忆化并不能带来太多好处。
让我们跟踪计算 ack 3 2：
ack 3 2
ack 2 $ ack 3 1
ack 2 $ ack 2 $ ack 3 0
ack 2 $ ack 2 $ ack 2 1
ack 2 $ ack 2 $ ack 1 $ ack 2 0
ack 2 $ ack 2 $ ack 1 $ ack 1 1
ack 2 $ ack 2 $ ack 1 $ ack 0 $ ack 1 0
ack 2 $ ack 2 $ ack 1 $ ack 0 $ ack 0 1 -- here's the first value we can compute and put in the map
ack 2 $ ack 2 $ ack 1 $ ack 0 2 -- next three, (0,2) -> 3, (1,1)->3 and (2,0)->3
ack 2 $ ack 2 $ ack 1 3 -- need to unfold that
ack 2 $ ack 2 $ ack 0 $ ack 1 2
ack 2 $ ack 2 $ ack 0 $ ack 0 $ ack 1 1 -- we know that, it's 3
ack 2 $ ack 2 $ ack 0 $ ack 0 3 -- okay, easy (0,3)->4, (1,2)->4
ack 2 $ ack 2 $ ack 0 4 -- (0,4)->5, (1,3)->5, (2,1)->5
ack 2 $ ack 2 5 -- unfold
ack 2 $ ack 1 $ ack 2 4
ack 2 $ ack 1 $ ack 1 $ ack 2 3
ack 2 $ ack 1 $ ack 1 $ ack 1 $ ack 2 2
ack 2 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 2 1
ack 2 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 2 0 -- we know that one, 3
ack 2 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 3 -- that one too, it's 5
ack 2 $ ack 1 $ ack 1 $ ack 1 $ ack 1 5 -- but not that
ack 2 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 1 4
ack 2 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 $ ack 1 3 -- look up
ack 2 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 5 -- easy (0,5)->6
ack 2 $ ack 1 $ ack 1 $ ack 1 $ ack 0 6 -- now (1,5)->7 is known too, and (2,2)->7
ack 2 $ ack 1 $ ack 1 $ ack 1 7
ack 2 $ ack 1 $ ack 1 $ ack 0 $ ack 1 6
ack 2 $ ack 1 $ ack 1 $ ack 0 $ ack 0 $ ack 1 5
ack 2 $ ack 1 $ ack 1 $ ack 0 $ ack 0 7 -- here (1,6)->8 becomes known
ack 2 $ ack 1 $ ack 1 $ ack 0 8 -- and here (1,7)->9, (2,3)->9
ack 2 $ ack 1 $ ack 1 9
ack 2 $ ack 1 $ ack 0 $ ack 1 8
ack 2 $ ack 1 $ ack 0 $ ack 0 $ ack 1 7 -- known
ack 2 $ ack 1 $ ack 0 $ ack 0 9 -- here we can add (1,8)->10
ack 2 $ ack 1 $ ack 0 10 -- and (1,9)->11, (2,4)->11
ack 2 $ ack 1 11
ack 2 $ ack 0 $ ack 1 10
ack 2 $ ack 0 $ ack 0 $ ack 1 9 -- known
ack 2 $ ack 0 $ ack 0 11 -- (1,10)->12
ack 2 $ ack 0 12 -- (1,11)->13, (2,5)->13
ack 2 13
ack 1 $ ack 2 12
ack 1 $ ack 1 $ ack 2 11
ack 1 $ ack 1 $ ack 1 $ ack 2 10
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 2 9
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 2 8
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 2 7
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 2 6
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 2 5 -- uff
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 13
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 1 12
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 $ ack 1 11 -- uff
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 13 -- (1,12)->14
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 14 -- (1,13)->15, (2,6)->15
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 15
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 1 14
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 $ ack 1 13
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 15 -- (1,14)->16
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 16 -- (1,15)->17, (2,7)->17
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 17
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 1 16
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 $ ack 1 15
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 17 -- (1,16)->18
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 18 -- (1,17)->19, (2,8)->19
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 1 19
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 1 18
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 $ ack 1 17
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 19 -- (1,18)->20
ack 1 $ ack 1 $ ack 1 $ ack 1 $ ack 0 20 -- (1,19)->21, (2,9)->21
ack 1 $ ack 1 $ ack 1 $ ack 1 21
ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 1 20
ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 $ ack 1 19 -- known
ack 1 $ ack 1 $ ack 1 $ ack 0 $ ack 0 21 -- (1,20)->22
ack 1 $ ack 1 $ ack 1 $ ack 0 22 -- (1,21)->23, (2,10)->23
ack 1 $ ack 1 $ ack 1 23
ack 1 $ ack 1 $ ack 0 $ ack 1 22
ack 1 $ ack 1 $ ack 0 $ ack 0 $ ack 1 21 -- known
ack 1 $ ack 1 $ ack 0 $ ack 0 23 -- (1,22)->24
ack 1 $ ack 1 $ ack 0 24 -- (1,23)->25, (2,11)->25
ack 1 $ ack 1 25
ack 1 $ ack 0 $ ack 1 24
ack 1 $ ack 0 $ ack 0 $ ack 1 23 -- known
ack 1 $ ack 0 $ ack 0 25 -- (1,24)->26
ack 1 $ ack 0 26 -- (1,25)->27, (2,12)-> 27
ack 1 27
ack 0 $ ack 1 26
ack 0 $ ack 0 $ ack 1 25
ack 0 $ ack 0 27
ack 0 28
29
ack 1 n时，你需要计算两个新的ack 0 n，当你需要一个新的ack 2 n时，你需要计算两个新的ack 1 n，因此需要四个新的ack 0 n，这些都不太戏剧化。ack 3 n时，你需要计算ack 3 (n-1) - ack 3 (n-2)个新的ack 2 k。总之，在计算了ack 3 k之后，你需要计算2^(k+2)个ack 2 n的新值，由于调用结构嵌套，所以你会得到一个包含2^(k+2)个嵌套thunk的堆栈。ack (m-1) k。 ack' m 1 = ack (m-1) $! ack (m-1) 1
ack' m n = foldl1' max [ack (m-1) k | k <- [ack m (n-2) .. ack m (n-1)]]
这使得计算可以使用较小的堆栈（但仍需要大量的堆），需要定制的备忘录策略。
仅存储m >= 2的ack m n，并将ack 1 n评估为已备忘可减少必要的内存，以至于使用不到1GB的堆即可计算出ack 3 20（使用Int而非Integer可以使其运行速度提高约两倍）：
{-# LANGUAGE BangPatterns #-}
module Main (main) where
import qualified Data.Map as M
import Control.Monad.State.Strict
import Control.Monad
type Table = M.Map (Integer,Integer) Integer
ack :: Integer -> Integer -> State Table Integer
ack 0 n = return (n+1)
ack 1 n = return (n+2)
ack m 0 = ack (m-1) 1
ack m 1 = do
!n <- ack (m-1) 1
ack (m-1) n
ack m n = do
mb <- gets (M.lookup (m,n))
case mb of
Just v -> return v
Nothing -> do
!s <- ack m (n-2)
!t <- ack m (n-1)
let foo a b = do
c <- ack (m-1) b
let d = max a c
return $! d
!v <- foldM foo 0 [s .. t]
mp <- get
put $! M.insert (m,n) v mp
return v
main :: IO ()
main = print $ evalState (ack 3 20) M.empty
A(3,16)可以在几秒钟内计算完成。 - Cartesius00