Haskell中的Memoization？

Question

任何关于如何在Haskell中高效地求解以下函数的建议，对于大数(n > 108)

f(n) = max(n, f(n/2) + f(n/3) + f(n/4))

我在Haskell中见过解决fibonacci数的记忆法的例子，这涉及到(懒惰地)计算直到所需的n的所有fibonacci数。但在这种情况下，对于给定的n，我们只需要计算很少的中间结果。

谢谢

Answer 1

我们可以通过建立一个可以在次线性时间内索引的结构来非常有效地做到这一点。

但首先，

{-# LANGUAGE BangPatterns #-}

import Data.Function (fix)

让我们定义f，但是让它使用“开放递归”而不是直接调用它自己。

f :: (Int -> Int) -> Int -> Int
f mf 0 = 0
f mf n = max n $ mf (n `div` 2) +
                 mf (n `div` 3) +
                 mf (n `div` 4)

您可以使用fix f获取无内存的f

这将允许您通过调用以下命令来测试f是否按照您对f的小值执行的操作，例如：fix f 123 = 144

我们可以通过定义以下内容来记住这一点：

f_list :: [Int]
f_list = map (f faster_f) [0..]

faster_f :: Int -> Int
faster_f n = f_list !! n

这执行得还不错，并用记忆中间结果的东西取代了将要花费O(n^3)时间的东西。

但它仍然需要线性时间，仅仅是索引就可以找到mf的记忆答案。这意味着结果如下：

*Main Data.List> faster_f 123801
248604

是可以容忍的，但结果不会比这更好。我们可以做得更好！

首先，让我们定义一个无限树：

data Tree a = Tree (Tree a) a (Tree a)
instance Functor Tree where
    fmap f (Tree l m r) = Tree (fmap f l) (f m) (fmap f r)

然后我们将定义一种方法来索引它，这样我们就可以在O(log )时间内找到索引为n的节点：

index :: Tree a -> Int -> a
index (Tree _ m _) 0 = m
index (Tree l _ r) n = case (n - 1) `divMod` 2 of
    (q,0) -> index l q
    (q,1) -> index r q

..。我们可能会发现一棵满是自然数的树很方便，这样我们就不必摆弄这些索引了：

nats :: Tree Int
nats = go 0 1
    where
        go !n !s = Tree (go l s') n (go r s')
            where
                l = n + s
                r = l + s
                s' = s * 2

因为我们可以建立索引，所以您可以将树转换为列表：

toList :: Tree a -> [a]
toList as = map (index as) [0..]

您可以通过验证toList nats为您提供[0..]来检查到目前为止的工作

现在,

f_tree :: Tree Int
f_tree = fmap (f fastest_f) nats

fastest_f :: Int -> Int
fastest_f = index f_tree

它的工作原理与上面的列表类似，但不是用线性时间来查找每个节点，而是可以在对数时间内找到它。

结果要快得多：

*Main> fastest_f 12380192300
67652175206

*Main> fastest_f 12793129379123
120695231674999

事实上，它的速度要快得多，你可以通过上面的Integer替换Int，几乎在瞬间就能得到大得离谱的答案

*Main> fastest_f' 1230891823091823018203123
93721573993600178112200489

*Main> fastest_f' 12308918230918230182031231231293810923
11097012733777002208302545289166620866358

对于实现基于树的memoization的开箱即用库，使用MemoTrie

$ stack repl --package MemoTrie

Prelude> import Data.MemoTrie
Prelude Data.MemoTrie> :set -XLambdaCase
Prelude Data.MemoTrie> :{
Prelude Data.MemoTrie| fastest_f' :: Integer -> Integer
Prelude Data.MemoTrie| fastest_f' = memo $ \case
Prelude Data.MemoTrie|   0 -> 0
Prelude Data.MemoTrie|   n -> max n (fastest_f'(n `div` 2) + fastest_f'(n `div` 3) + fastest_f'(n `div` 4))
Prelude Data.MemoTrie| :}
Prelude Data.MemoTrie> fastest_f' 12308918230918230182031231231293810923
11097012733777002208302545289166620866358

Answer 2

Edward's answer是一个很棒的宝石，我复制了它，并提供了memoList和memoTree组合器的实现，它们以开放递归的形式记忆函数。

{-# LANGUAGE BangPatterns #-}

import Data.Function (fix)

f :: (Integer -> Integer) -> Integer -> Integer
f mf 0 = 0
f mf n = max n $ mf (div n 2) +
                 mf (div n 3) +
                 mf (div n 4)


-- Memoizing using a list

-- The memoizing functionality depends on this being in eta reduced form!
memoList :: ((Integer -> Integer) -> Integer -> Integer) -> Integer -> Integer
memoList f = memoList_f
  where memoList_f = (memo !!) . fromInteger
        memo = map (f memoList_f) [0..]

faster_f :: Integer -> Integer
faster_f = memoList f


-- Memoizing using a tree

data Tree a = Tree (Tree a) a (Tree a)
instance Functor Tree where
    fmap f (Tree l m r) = Tree (fmap f l) (f m) (fmap f r)

index :: Tree a -> Integer -> a
index (Tree _ m _) 0 = m
index (Tree l _ r) n = case (n - 1) `divMod` 2 of
    (q,0) -> index l q
    (q,1) -> index r q

nats :: Tree Integer
nats = go 0 1
    where
        go !n !s = Tree (go l s') n (go r s')
            where
                l = n + s
                r = l + s
                s' = s * 2

toList :: Tree a -> [a]
toList as = map (index as) [0..]

-- The memoizing functionality depends on this being in eta reduced form!
memoTree :: ((Integer -> Integer) -> Integer -> Integer) -> Integer -> Integer
memoTree f = memoTree_f
  where memoTree_f = index memo
        memo = fmap (f memoTree_f) nats

fastest_f :: Integer -> Integer
fastest_f = memoTree f

Answer 3

这不是最有效的方法，但可以记住：

f = 0 : [ g n | n <- [1..] ]
    where g n = max n $ f!!(n `div` 2) + f!!(n `div` 3) + f!!(n `div` 4)

请求f !! 144时，会检查f !! 143是否存在，但不会计算其准确值。它仍然被设置为某种未知的计算结果。计算出的唯一精确值是所需的值。

所以一开始，就算出了多少，程序什么也不知道。

f = .... 

当我们发出请求f !! 12时，它开始执行一些模式匹配：

f = 0 : g 1 : g 2 : g 3 : g 4 : g 5 : g 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...

现在它开始计算

f !! 12 = g 12 = max 12 $ f!!6 + f!!4 + f!!3

这会递归地对f产生另一个需求，因此我们计算

f !! 6 = g 6 = max 6 $ f !! 3 + f !! 2 + f !! 1
f !! 3 = g 3 = max 3 $ f !! 1 + f !! 1 + f !! 0
f !! 1 = g 1 = max 1 $ f !! 0 + f !! 0 + f !! 0
f !! 0 = 0

现在我们可以回流一些

f !! 1 = g 1 = max 1 $ 0 + 0 + 0 = 1

这意味着程序现在知道：

f = 0 : 1 : g 2 : g 3 : g 4 : g 5 : g 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...

继续往上滴：

f !! 3 = g 3 = max 3 $ 1 + 1 + 0 = 3

这意味着程序现在知道：

f = 0 : 1 : g 2 : 3 : g 4 : g 5 : g 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...

现在我们继续计算f!!6

f !! 6 = g 6 = max 6 $ 3 + f !! 2 + 1
f !! 2 = g 2 = max 2 $ f !! 1 + f !! 0 + f !! 0 = max 2 $ 1 + 0 + 0 = 2
f !! 6 = g 6 = max 6 $ 3 + 2 + 1 = 6

这意味着程序现在知道：

f = 0 : 1 : 2 : 3 : g 4 : g 5 : 6 : g 7 : g 8 : g 9 : g 10 : g 11 : g 12 : ...

现在我们继续计算f!!12

f !! 12 = g 12 = max 12 $ 6 + f!!4 + 3
f !! 4 = g 4 = max 4 $ f !! 2 + f !! 1 + f !! 1 = max 4 $ 2 + 1 + 1 = 4
f !! 12 = g 12 = max 12 $ 6 + 4 + 3 = 13

这意味着程序现在知道：

f = 0 : 1 : 2 : 3 : 4 : g 5 : 6 : g 7 : g 8 : g 9 : g 10 : g 11 : 13 : ...

所以计算是相当懒惰的。程序知道f !! 8的一些值存在，它等于g 8，但它不知道g 8是什么。