Любой способ создать unmemo-monad?

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

Это дерево было бы очень большим, "практически бесконечным". Это само по себе не проблема, поскольку 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, что делает то, что я хочу?

Ответы

Ответ 1

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

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

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

Edit

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

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

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