Запоминание эффективной функции

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, И мы можем сэкономить много (и я действительно много значу: это буквально экономит часы) повторных вычислений memoizing каждого из шагов:

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

Этого можно достичь безопасно, если вы дадите себе возможность выделить ссылку для удержания карты.

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 Обходим штат. Любая монада должна быть в состоянии сделать это с примененным к ней трансформатором, так почему же мы копаемся в 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'))

Чтобы запустить его и добраться до базовой монады, нам нужно предоставить эффективную функцию, которую мы хотим запомнить.

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 -style для монад, которые обеспечивают запоминание для конкретной функции, и более сложный механизм их создания, который не обязательно использует Map s.

Answer 2

Во-первых, прекратите пытаться использовать unsafePerformIO. У этого имени есть причина.

То, что вы пытаетесь сделать, это не запоминание, это фактически контроль над вызовами внутренней монады. Часть подсказки в том, что Cellular не является монадой, поэтому CellularT не является преобразователем монад.

Я думаю, что вам нужно сделать, чтобы иметь чистую функцию, которая вычисляет требуемый эффект для каждой ячейки, а затем итерировать по ячейкам, чтобы упорядочить эффекты. Это отделяет вашу клеточную автомеханическую механику (которая у вас уже есть и которая выглядит хорошо) от вашей эффективной механики. В данный момент вы, похоже, пытаетесь выполнить эффекты одновременно с их вычислением, что приводит к вашим проблемам.

Возможно, ваши эффекты нужно разделить на фазу ввода и фазу вывода или что-то в этом роде. Или, возможно, ваши эффекты на самом деле больше похожи на конечный автомат, в котором каждая итерация каждой ячейки дает результат и ожидает новый ввод. В этом случае посмотрите мой вопрос здесь для некоторых идей о том, как это сделать.