【问题标题】:Any way to create the unmemo-monad?有什么方法可以创建 unmemo-monad?
【发布时间】:2011-09-06 16:07:18
【问题描述】:

假设有人编写了一个程序来下棋或解数独。在这种程序中,有一个表示游戏状态的树结构是有意义的。

这棵树会很大,“几乎是无限的”。这本身不是问题,因为 Haskell 支持无限数据结构。

一个熟悉的无限数据结构示例:

fibs = 0 : 1 : zipWith (+) fibs (tail fibs)

节点仅在第一次使用时才分配,因此列表占用有限的内存。如果他们不保留对其头部的引用,也可以迭代无限列表,从而允许垃圾收集器收集不再需要的部分。

回到树的例子——假设对树进行了一些迭代,如果树的根仍然需要,则迭代的树节点可能不会被释放(例如在迭代深化搜索中,树将被迭代多次,因此需要保留根)。

我想到的一个可能的解决方案是使用“unmemo-monad”。

我将尝试使用 monadic 列表来演示这个 monad 应该做什么:

import Control.Monad.ListT (ListT)  -- cabal install List
import Data.Copointed  -- cabal install pointed
import Data.List.Class
import Prelude hiding (enumFromTo)

nums :: ListT Unmemo Int  -- What is Unmemo?
nums = enumFromTo 0 1000000

main = print $ div (copoint (foldlL (+) 0 nums)) (copoint (lengthL nums))

使用nums :: [Int],程序将占用大量内存,因为lengthL nums 在迭代foldlL (+) 0 nums 时需要对nums 的引用。

Unmemo 的目的是让运行时不让节点不断迭代。

我尝试将((->) ()) 用作Unmemo,但它产生的结果与nums :: [Int] 的结果相同——程序使用了大量内存,通过+RTS -s 运行它就可以看出。

有没有实现我想要的Unmemo

【问题讨论】:

标签: performance haskell


【解决方案1】:

与流相同的技巧——不直接捕获余数,而是捕获一个值和一个产生余数的函数。您可以根据需要在此之上添加记忆。

data UTree a = Leaf a | Branch a (a -> [UTree a]) 

我现在还没有心情准确地弄清楚它,但我敢肯定,这个结构自然地作为一个相当简单的函子上的 cofree 共单子出现了。

编辑

找到它:http://hackage.haskell.org/packages/archive/comonad-transformers/1.6.3/doc/html/Control-Comonad-Trans-Stream.html

或者这可能更容易理解:http://hackage.haskell.org/packages/archive/streams/0.7.2/doc/html/Data-Stream-Branching.html

在任何一种情况下,诀窍是您的f 可以选择为类似于data N s a = N (s -> (s,[a])) 的适当s(s 是流的状态参数的类型——展开的种子,如果你愿意)。这可能不完全正确,但应该做一些接近的事情......

当然,对于实际工作,你可以放弃所有这些,直接像上面那样编写数据类型。

编辑 2

以下代码说明了如何防止共享。请注意,即使在没有共享的版本中,配置文件中也有驼峰,表明 sum 和 length 调用没有在恒定空间中运行。我想我们需要一个明确的严格积累才能将它们击倒。

{-# LANGUAGE DeriveFunctor #-}
import Data.Stream.Branching(Stream(..))
import qualified Data.Stream.Branching as S
import Control.Arrow
import Control.Applicative
import Data.List

data UM s a = UM (s -> Maybe a) deriving Functor
type UStream s a = Stream (UM s) a

runUM s (UM f) = f s
liftUM x = UM $ const (Just x)
nullUM = UM $ const Nothing

buildUStream :: Int -> Int -> Stream (UM ()) Int
buildUStream start end = S.unfold (\x -> (x, go x)) start
    where go x
           | x < end = liftUM (x + 1)
           | otherwise = nullUM

sumUS :: Stream (UM ()) Int -> Int
sumUS x = S.head $ S.scanr (\x us -> maybe 0 id (runUM () us) + x) x

lengthUS :: Stream (UM ()) Int -> Int
lengthUS x = S.head $ S.scanr (\x us -> maybe 0 id (runUM () us) + 1) x

sumUS' :: Stream (UM ()) Int -> Int
sumUS' x = last $ usToList $ liftUM $ S.scanl (+) 0  x

lengthUS' :: Stream (UM ()) Int -> Int
lengthUS' x = last $ usToList $ liftUM $ S.scanl (\acc _ -> acc + 1) 0 x

usToList x = unfoldr (\um -> (S.head &&& S.tail) <$> runUM () um) x

maxNum = 1000000
nums = buildUStream 0 maxNum

numsL :: [Int]
numsL = [0..maxNum]

-- All these need to be run with increased stack to avoid an overflow.

-- This generates an hp file with two humps (i.e. the list is not shared)
main = print $ div (fromIntegral $ sumUS' nums) (fromIntegral $ lengthUS' nums)

-- This generates an hp file as above, and uses somewhat less memory, at the cost of
-- an increased number of GCs. -H helps a lot with that.
-- main = print $ div (fromIntegral $ sumUS nums) (fromIntegral $ lengthUS nums)

-- This generates an hp file with one hump (i.e. the list is shared)
-- main = print $ div (fromIntegral $ sum $ numsL) (fromIntegral $ length $ numsL)

【讨论】:

  • 我尝试用这些术语实现Unmemodata Unmemo a where Unmemo :: s -&gt; (s -&gt; a) -&gt; Unmemo a。这并不能解决空间泄漏问题。我想如果下一个孩子的函数对于整棵树来说是恒定的,这可能会解决问题,这可能对数独等有意义,但我仍然想要一个更通用的解决方案。谢谢
  • @yairchu:这个定义有点错误。你想要Unmemo :: s -&gt; (s -&gt; (a, Unmemo a)) -&gt; Unmemo a - 关键是你没有将“尾巴”打包成一个thunk,而是明确地保留了生成它的函数。但是该函数需要为流中的当前位置生成a剩余的尾部。
  • 进一步说明——我给出了无限流的类型。如果你想要一个有限的(即列表的 iso),那么你在里面扔一个 Maybe:s -&gt; (s -&gt; Maybe (a, Unmemo a)) -&gt; Unmemo a - 注意与 unfoldr :: (b -&gt; Maybe (a, b)) -&gt; b -&gt; [a] 的类型签名的相似性。
  • 我认为 yairchu 的“Unmemo a”是在 ListT 的上下文中使用的(即:ListT UnMemo a)所以“a”实际上包括“当前元素”和“尾部”到期到 ListT 结构。
  • 经过进一步思考,我意识到您无法使用ListT 获得所需的效果,因为ListT 的语义要求它不会重新运行效果多次。因此,我们必须坚持生产出来的价值。不是错误,而是一个功能:-)
猜你喜欢
  • 1970-01-01
  • 2020-02-09
  • 2013-08-04
  • 1970-01-01
  • 2015-12-17
  • 2012-09-29
  • 1970-01-01
  • 1970-01-01
  • 2016-10-01
相关资源
最近更新 更多