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。