Воспоминание функции Аккермана

Я хотел бы вычислить значение 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

Но он заканчивается ошибкой;-) Может ли он быть настроен или цепочка вычислений на самом деле так долго и даже memoization не может помочь?

ОТВЕТЫ

Ответ 1

Одна из точек функции Аккермана состоит в том, что вычисление ее рекурсивно приводит к очень глубокой рекурсии.

Глубина рекурсии примерно равна результату (в зависимости от того, как вы считаете, это несколько уровней более или менее) без извращения. К сожалению, memoisation не покупает вас много, если вы заполняете таблицу заметок в соответствии с деревом вызовов.

Пусть последует вычисление 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 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 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 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, и, следовательно, 4 новых ack 0 n, что все не слишком драматично.

Но если вам нужен новый ack 3 n, вам нужно ack 3 (n-1) - ack 3 (n-2) new ack 2 k. Все сказанное, после вычисления ack 3 k, вам нужно вычислить 2^(k+2) новые значения ack 2 n, а по структуре вызова - вложенные вызовы, поэтому вы получите стек 2^(k+2) вложенных thunks.

Чтобы избежать этого вложения, вам необходимо провести реструктуризацию вычислений, например. заставляя новый необходимый ack (m-1) k в порядке возрастания 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)]]

который позволяет вычислению запускаться (медленно) с небольшим стеклом (но ему еще нужно много жука кучи, по-видимому, требуется стратегия создания memoation).

Сохранение только ack m n для m >= 2 и оценка ack 1 n, как если бы оно было замечено, уменьшает необходимую память достаточно далеко, чтобы вычисление ack 3 20 заканчивалось использованием менее 1 Гбайт кучи (используя 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

Ответ 3

Функция рекурсивна, и вы внедрили ее правильно. Я думаю, вы просто попали в верхнюю часть стека. Это неудивительно, потому что счет рекурсии увеличивается экспоненциально, когда m=3. Это неизбежно, что у вас закончится стека. Увеличение общей памяти не поможет, если вы не выполняете другую реализацию, которая использует какой-либо метод, отличный от рекурсии.

Чтобы ответить на ваш вопрос, вам понадобится другая форма памяти для продолжения. Или, по крайней мере, вам нужно будет использовать RAM по-разному.