Любой способ создать не-мемо-монаду?

Question

Предположим, кто-то создает программу для игры в шахматы или решает судоку. В такой программе имеет смысл иметь древовидную структуру, представляющую игровые состояния.

Это дерево было бы очень большим, "практически бесконечным". Что само по себе не является проблемой, поскольку Haskell поддерживает бесконечные структуры данных.

Знакомый пример бесконечной структуры данных:

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

Узлы выделяются только при первом использовании, поэтому список занимает ограниченную память. Можно также перебирать бесконечный список, если они не сохраняют ссылки на его заголовок, что позволяет сборщику мусора собирать его части, которые больше не нужны.

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

Одним из возможных решений этой проблемы, о котором я подумал, является использование «unmemo-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], программе потребовалось бы много памяти, так как ссылка на nums необходима для lengthL nums, пока она повторяется по foldlL (+) 0 nums.

Цель Unmemo - сделать так, чтобы среда выполнения не поддерживала повторение узлов.

Я попытался использовать ((->) ()) в качестве Unmemo, но он дает те же результаты, что и nums :: [Int] - программа использует много памяти, что очевидно, если запустить ее с +RTS -s.

Есть ли способ реализовать Unmemo, который делает то, что я хочу?

Answer 1

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

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

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

Редактировать

Нашел: 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)