Memoizing的effectful功能

Question

我开始在项目定义一个细胞自动机作为本地转移函数工作：

newtype Cellular g a = Cellular { delta :: (g -> a) -> a } 

每当g是Monoid，可以通过申请前将重心转移到定义一个全局转变当地的过渡。这给了我们以下step功能：

step :: Monoid g => Cellular g a -> (g -> a) -> (g -> a) 
step cell init g = delta cell $ init . (g <>) 

现在，我们可以简单地通过使用iterate运行自动机。通过memo重新计算的定义的每一个步骤一个：我们可以节省很多（它确实可以节省时间和我意味着很多）：

run :: (Monoid g, Memoizable g) => Cellular g a -> (g -> a) -> [g -> a] 
run cell = iterate (memo . step cell) 

我的问题是，我全身Cellular到CelluarT使我将能够使用本地规则副作用（例如复制一个随机的邻居）：

newtype CellularT m g a = Cellular { delta :: (g -> m a) -> m a } 

但是，我只希望要运行的影响一次所以，如果你问一个细胞多次什么它的价值是，答案都是一致的。 memo使我们在这里失败，因为它节省了有效计算而不是其结果。

我不希望这可以在不使用不安全功能的情况下实现。我试着用unsafePerformIO，一个IORef和Map g a存储已经计算出的值有在一搏：

memoM :: (Ord k, Monad m) => (k -> m v) -> (k -> m v) 
memoM = 
    let ref = unsafePerformIO (newIORef empty) in 
    ref `seq` loopM ref 

loopM :: (Monad m, Ord k) => IORef (Map k v) -> (k -> m v) -> (k -> m v) 
loopM ref f k = 
    let m = unsafePerformIO (readIORef ref) in 
    case Map.lookup k m of 
    Just v -> return v 
    Nothing -> do 
     v <- f k 
     let upd = unsafePerformIO (writeIORef ref $ insert k v m) 
     upd `seq` return v 

但不可预知的方式行为：memoM putStrLn正确memoized同时memoM (\ str -> getLine)保持尽管取线同样的论点被传递给它。

Answer 1

首先，停止尝试使用unsafePerformIO。它的名字有一个原因。

你试图做的不是记忆，它实际上是控制对内部monad的调用。部分线索是Cellular不是monad，所以CellularT不是monad变压器。

我认为你需要做的是有一个纯函数来计算每个单元格所需的效果，然后遍历单元格对这些效果进行排序。这将你的细胞autometon机制（你已经拥有，看起来不错）与有效的机制分离开来。目前你似乎试图在计算它们的同时执行效果，这会导致你的问题。

它可能是你的影响需要分成输入阶段和输出阶段，或类似的东西。或者你的效果实际上更像是一个状态机，每个单元的每次迭代产生一个结果并期待一个新的输入。在这种情况下，请参阅my question here了解有关如何执行此操作的一些想法。

Answer 2

如果您给自己分配参考地图的机会，可以安全地实现此功能。

import Control.Monad.IO.Class 

memoM :: (Ord k, MonadIO m) => (k -> m v) -> m (k -> m v) 
       |       | 
       |  opportunity to allocate the map 
       get to IO correctly 

我将使用MVar而不是IORef得到最正确的并发的。这是为了正确，如果它同时使用，而不是性能。对于性能，我们可能比这更奇特，并使用双重检查锁或具有更精细锁定粒度的并发映射。

import Control.Concurrent  
import Control.Monad.IO.Class  
import qualified Data.Map as Map 

memoM :: (Ord k, Monad m, MonadIO m) => (k -> m v) -> m (k -> m v) 
memoM once = do 
    mapVar <- liftIO $ newMVar Map.empty  
    return (\k -> inMVar mapVar (lookupInsertM once k)) 

-- like withMVar, but isn't exception safe 
inMVar :: (MonadIO m) => MVar a -> (a -> m (a, b)) -> m b 
inMVar mvar step = do 
    (a, b) <- liftIO (takeMVar mvar) >>= step 
    liftIO $ putMVar mvar a 
    return b 

lookupInsertM :: (Ord k, Monad m) => (k -> m v) -> k -> Map.Map k v -> m (Map.Map k v, v) 
lookupInsertM once k map = 
    case Map.lookup k map of 
     Just v -> return (map, v) 
     Nothing -> do 
      v <- once k 
      return (Map.insert k v map, v) 

我们并不是真的在使用IO，我们只是传递状态。任何monad都应该可以应用变压器，所以我们为什么要在IO里捣乱？这是因为我们希望能够分配这些地图，以便memoM可以用于多个不同的功能。如果我们只关心一个单一的memoized有效函数，我们可以用一个状态转换器来代替。

{-# LANGUAGE GeneralizedNewtypeDeriving #-} 

import Control.Applicative 
import Control.Monad.Trans.Class 
import Control.Monad.Trans.State 

newtype MemoT k v m a = MemoT {getMemoT :: StateT (k -> m v, Map.Map k v) m a} 
    deriving (Functor, Applicative, Monad, MonadIO) 

instance MonadTrans (MemoT k v) where 
    lift = MemoT . lift 

这种变压器添加了从memoized effectful功能

lookupMemoT :: (Ord k, Monad m) => k -> MemoT k v m v 
lookupMemoT k = MemoT . StateT $ \(once, map) -> do 
                (map', v) <- lookupInsertM once k map 
                return (v, (once, map')) 

要运行它，并在底层的单子拿到查找一个值的能力，我们需要提供我们想memoize的的effectful功能。

runMemoT :: (Monad m) => MemoT k v m a -> (k -> m v) -> m a 
runMemoT memo once = evalStateT (getMemoT memo) (once, Map.empty) 

我们MemoT使用Map为每个函数。某些功能可能会以其他方式记忆。 monad-memo软件包有一个mtl类型的monads类，它为特定功能提供记忆功能，还有一种更复杂的构建机制，它不一定使用Map s。