Haskell中的记忆?
关于如何高效地解决下面的函数在Haskell,对于大量(n > 108)
Haskell中的记忆?
f(n) = max(n, f(n/2) + f(n/3) + f(n/4))
我已经看到在Haskell记忆化的实施例来解决斐波纳契 号码,这涉及到计算(懒惰)所有的斐波纳契任何指针号码 直至所需的n。但在这种情况下,对于给定的n,我们只需要 就可以计算出很少的中间结果。
感谢
我们可以非常有效地做到这一点,使我们可以在亚线性时间索引的结构。
但首先,
{-# 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
得到unmemoized f
这将让你测试f
做你的意思为f
小的值通过调用,例如:fix f 123 = 144
我们可以memoize的这通过定义:
f_list :: [Int]
f_list = map (f faster_f) [0..]
faster_f :: Int -> Int
faster_f n = f_list !! n
这表现得很好,而且repl王牌什么是要采取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)的时间找到索引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
我试过这段代码,有趣的是,f_faster似乎比f慢。我想这些列表引用真的放慢了速度。 nats和index的定义对我来说似乎很神秘,所以我添加了我自己的答案,这可能会让事情变得更加清晰。 – Pitarou 2012-06-16 04:41:33
@EdwardKmett我花了数小时的时间学习/研究这是如何工作的,它非常聪明。但是我不能找到的是,为什么无限列表需要更多的记忆,然后无限树?例如,如果您在观看ghci的内存使用情况时调用“speeds_f 111111111”,则可以看到它几乎无用。但是当你调用faster_f 111111111时,它使用大约1.5GB,然后ghci结束,因为我内存不足。我已经使用ghci's:set + s测试了他们的后续调用,并且faster_f确实将速度提高到几乎没有,而且faster_f也提高了。发生什么了? – QuantumKarl 2013-12-08 22:01:14
无限列表案例必须处理长111111111项的链表。树状结构处理的是log n *达到的节点数量。 – 2013-12-17 07:15:31
不是最有效的方式,但确实memoize的:
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
是什么。
谢谢你。我对Haskell仍然很陌生,所以我的答案中有很多东西需要理解,但我会尝试。 – 2010-07-08 22:03:51
谢谢你这个。你将如何创建和使用2维解决方案空间?这是列表清单吗?和'g n m =(某物)f !! a !! b' – vikingsteve 2014-01-06 08:21:12
当然,你可以。不过,对于真正的解决方案,我可能会使用memoization库,如[memocombinators](http://ocharles.org.uk/blog/posts/2013-12-08-24-days-of-hackage-data -memocombinators.html) – rampion 2014-01-07 03:14:08
这是Edward Kmett的出色答案的附录。
当我尝试他的代码时,nats
和index
的定义看起来很神秘,所以我编写了一个我觉得更容易理解的替代版本。
根据index'
和nats'
定义index
和nats
。
index' t n
定义在范围[1..]
。 (回想一下,index t
定义在范围[0..]
上。)它的工作原理是将n
视为一串比特,然后反向读取比特。如果该位是1
,则需要右手分支。如果该位是0
,它将采用左侧分支。它在到达最后一位时停止(它必须是1
)。
index' (Tree l m r) 1 = m
index' (Tree l m r) n = case n `divMod` 2 of
(n', 0) -> index' l n'
(n', 1) -> index' r n'
正如nats
为index
定义,以便index nats n == n
始终是真实的,nats'
为index'
定义。
nats' = Tree l 1 r
where
l = fmap (\n -> n*2) nats'
r = fmap (\n -> n*2 + 1) nats'
nats' = Tree l 1 r
现在,nats
和index
只是nats'
和index'
但与1移值:
index t n = index' t (n+1)
nats = fmap (\n -> n-1) nats'
谢谢。我正在记忆一个多元函数,这真的帮助我确定了索引和nats实际上在做什么。 – Kittsil 2017-03-03 05:55:31
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
另一个增编爱德华Kmett的回答是:一个自包含的例子:
fib = memoNat f
where f 0 = 0
f 1 = 1
f n = fib (n-1) + fib (n-2)
:
data NatTrie v = NatTrie (NatTrie v) v (NatTrie v)
memo1 arg_to_index index_to_arg f = (\n -> index nats (arg_to_index n))
where nats = go 0 1
go i s = NatTrie (go (i+s) s') (f (index_to_arg i)) (go (i+s') s')
where s' = 2*s
index (NatTrie l v r) i
| i < 0 = f (index_to_arg i)
| i == 0 = v
| otherwise = case (i-1) `divMod` 2 of
(i',0) -> index l i'
(i',1) -> index r i'
memoNat = memo1 id id
如下,以memoize的用一个整数ARG的功能(如斐波那契)使用它
只有非负参数的值才会被缓存。
要也为负参数缓存值,使用memoInt
,定义如下:
memoInt = memo1 arg_to_index index_to_arg
where arg_to_index n
| n < 0 = -2*n
| otherwise = 2*n + 1
index_to_arg i = case i `divMod` 2 of
(n,0) -> -n
(n,1) -> n
要高速缓存的值对于具有两个整数参数使用memoIntInt
,函数定义如下:
memoIntInt f = memoInt (\n -> memoInt (f n))
作为在Edward Kmett的回答中指出,为了加快速度,您需要缓存昂贵的计算并能够快速访问它们。
为了保持函数非单调性,使用合适的方式来索引它(如前面的帖子所示),构建一棵无限延迟树的解决方案实现了该目标。如果放弃函数的非单调性质,可以将Haskell中的标准关联容器与“状态”单元(如State或ST)结合使用。
虽然主要缺点是您获得了非一元函数,您不必再自己索引结构,并且可以使用关联容器的标准实现。
要做到这一点,首先需要重新写你函数接受任何类型的单子:
fm :: (Integral a, Monad m) => (a -> m a) -> a -> m a
fm _ 0 = return 0
fm recf n = do
recs <- mapM recf $ div n <$> [2, 3, 4]
return $ max n (sum recs)
对于你的测试,你还可以定义不使用Data.Function没有记忆化的功能。修复,虽然这是一个有点冗长:
noMemoF :: (Integral n) => n -> n
noMemoF = runIdentity . fix fm
然后,您可以使用状态单子结合Data.Map加快速度:
import qualified Data.Map.Strict as MS
withMemoStMap :: (Integral n) => n -> n
withMemoStMap n = evalState (fm recF n) MS.empty
where
recF i = do
v <- MS.lookup i <$> get
case v of
Just v' -> return v'
Nothing -> do
v' <- fm recF i
modify $ MS.insert i v'
return v'
有了细微的变化,你可以用Data.HashMap代码适应工作,而不是:
import qualified Data.HashMap.Strict as HMS
withMemoStHMap :: (Integral n, Hashable n) => n -> n
withMemoStHMap n = evalState (fm recF n) HMS.empty
where
recF i = do
v <- HMS.lookup i <$> get
case v of
Just v' -> return v'
Nothing -> do
v' <- fm recF i
modify $ HMS.insert i v'
return v'
而是持久数据结构,你也可以尝试可变数据结构(如Data.HashTable)结合在ST单子:
import qualified Data.HashTable.ST.Linear as MHM
withMemoMutMap :: (Integral n, Hashable n) => n -> n
withMemoMutMap n = runST $
do ht <- MHM.new
recF ht n
where
recF ht i = do
k <- MHM.lookup ht i
case k of
Just k' -> return k'
Nothing -> do
k' <- fm (recF ht) i
MHM.insert ht i k'
return k'
相比没有任何记忆化的实现,这些实现可以让你,巨额的投入,来获得,而不必等待几秒钟在微秒的成绩。
以Criterion为基准,我可以观察到Data.HashMap的实现实际上比Data.Map和Data.HashTable的执行稍微好一点(大约20%),其定时非常相似。
我发现基准的结果有点令人惊讶。我最初的感觉是HashTable会超越HashMap的实现,因为它是可变的。这个最后的实现中可能会隐藏一些性能缺陷。
GHC在围绕不可变结构进行优化方面做得非常好。来自C的直觉并不总是平息。 – 2015-05-24 16:47:18
几年后,我看着这个和实现有和一个简单的方法以线性时间来memoize的这种使用zipWith
一个辅助功能:
dilate :: Int -> [x] -> [x]
dilate n xs = replicate n =<< xs
dilate
有方便的属性,dilate n xs !! i == xs !! div i n
。
所以,假如我们给出F(0),这简化了计算,以
fs = f0 : zipWith max [1..] (tail $ fs#/2 .+. fs#/3 .+. fs#/4)
where (.+.) = zipWith (+)
infixl 6 .+.
(#/) = flip dilate
infixl 7 #/
找了很多像我们原来的问题描述,并给出一个线性解决方案(sum $ take n fs
将采取为O(n) )。
一个没有索引的解决方案,不是基于Edward KMETT的。
我分解出到公共父共同子树(f(n/4)
是f(n/2)
和f(n/4)
之间共享,并且f(n/6)
被f(2)
和f(3)
之间共享)。通过将它们保存为父变量中的单个变量,子树的计算只需执行一次。
data Tree a =
Node {datum :: a, child2 :: Tree a, child3 :: Tree a}
f :: Int -> Int
f n = datum root
where root = f' n Nothing Nothing
-- Pass in the arg
-- and this node's lifted children (if any).
f' :: Integral a => a -> Maybe (Tree a) -> Maybe (Tree a)-> a
f' 0 _ _ = leaf
where leaf = Node 0 leaf leaf
f' n m2 m3 = Node d c2 c3
where
d = if n < 12 then n
else max n (d2 + d3 + d4)
[n2,n3,n4,n6] = map (n `div`) [2,3,4,6]
[d2,d3,d4,d6] = map datum [c2,c3,c4,c6]
c2 = case m2 of -- Check for a passed-in subtree before recursing.
Just c2' -> c2'
Nothing -> f' n2 Nothing (Just c6)
c3 = case m3 of
Just c3' -> c3'
Nothing -> f' n3 (Just c6) Nothing
c4 = child2 c2
c6 = f' n6 Nothing Nothing
main =
print (f 123801)
-- Should print 248604.
代码不容易扩展到一般的记忆化功能(至少,我不知道该怎么做),你真的必须想出如何子问题重叠,但战略应该适用于一般的多个非整数参数。 (我认为它适用于两个字符串参数)。
备注在每次计算后都会被丢弃。 (同样,我在考虑两个字符串参数。)
我不知道这是否比其他答案更有效。每个查询在技术上只有一到两个步骤(“看看你的孩子或你的孩子的孩子”),但可能会有很多额外的内存使用。
编辑:此解决方案尚未正确。分享不完整。
编辑:它应该现在正确地共享子女,但我意识到这个问题有很多不平凡的共享:n/2/2/2
和n/3/3
可能是相同的。这个问题不适合我的策略。
这功课吗? – 2010-07-08 21:54:58
只是在某种意义上说,这是我在家里做的一些工作:-) – 2010-07-08 21:58:50