Any way to create the unmemo-monad?

后端 未结 1 1654
遇见更好的自我
遇见更好的自我 2021-02-14 08:20

Suppose someone makes a program to play chess, or solve sudoku. In this kind of program it makes sense to have a tree structure representing game states.

This tree would

1条回答
  •  遥遥无期
    2021-02-14 09:18

    Same trick as with a stream -- don't capture the remainder directly, but instead capture a value and a function which yields a remainder. You can add memoization on top of this as necessary.

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

    I'm not in the mood to figure it out precisely at the moment, but this structure arises, I'm sure, naturally as the cofree comonad over a fairly straightforward functor.

    Edit

    Found it: http://hackage.haskell.org/packages/archive/comonad-transformers/1.6.3/doc/html/Control-Comonad-Trans-Stream.html

    Or this is perhaps simpler to understand: http://hackage.haskell.org/packages/archive/streams/0.7.2/doc/html/Data-Stream-Branching.html

    In either case, the trick is that your f can be chosen to be something like data N s a = N (s -> (s,[a])) for an appropriate s (s being the type of your state parameter of the stream -- the seed of your unfold, if you will). That might not be exactly correct, but something close should do...

    But of course for real work, you can scrap all this and just write the datatype directly as above.

    Edit 2

    The below code illustrates how this can prevent sharing. Note that even in the version without sharing, there are humps in the profile indicating that the sum and length calls aren't running in constant space. I'd imagine that we'd need an explicit strict accumulation to knock those down.

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

    0 讨论(0)
提交回复
热议问题