haskell - 内存一个有效的功能

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在 memoM (\ str -> getLine) 时被正确内存尽管将相同的参数传递给它，但仍会继续获取行。

Answer 1

如果您给自己一个机会来分配引用来保存 map ，则可以安全地实现这一点。

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可以用于不止一种不同的功能。如果我们只关心一个记忆化的有效函数，我们可以只使用状态转换器。

{-# 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

这个转换器增加了从内存的有效函数中查找值的能力

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'))

为了运行它并获得底层的 monad，我们需要提供我们想要内存的有效函数。

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 monad 的 -style 类，为特定函数提供内存，以及构建它们的更精细的机制，不一定使用 Map s。