How to fix a space leak caused by laziness when your algorithm relies on laziness

Question

I have an algorithm that generates a search tree:

data SearchTree a = Solution a | Contradiction | Search [ SearchTree a ] deriving (Show, Functor) 

The algorithm generates this tree lazily. I also identified a simple evaluator, which in fact is only the first search for depth.

 simpleEval :: MonadPlus m => SearchTree a -> ma simpleEval (Solution a) = return a simpleEval Contradiction = mzero simpleEval (Search ps) = foldr mplus mzero $ map simpleEval ps 

I noticed that many of the solutions that my algorithm produces look like the following search tree:

 nest :: Int -> SearchTree a -> SearchTree a nest 0 = id nest n = nest (n-1) . Search . (:[]) tree0 = Search ts where ts = cycle $ t0 : replicate 100 t1 ++ [t2] t0 = nest 100 $ Solution 'a' t1 = nest 1000 $ Contradiction t2 = nest 4 $ Solution 'b' 

Namely, they have many very deep branches without solutions, several deep branches with a solution and very few small branches with a solution. Based on this, I decided that I want another appraiser who will “give up” on branches that are too deep. Name it cutoffEval . cutoffEval 5 tree0 should find only b , because for this there are infinitely many branches of depth less than 5, and they contain only b s. I implemented it like this:

 cutoff :: (MonadPlus m) => Int -> SearchTree a -> (ma, [SearchTree a]) cutoff cu = go cu where plus ~(m0, l0) ~(m1, l1) = (mplus m0 m1, l0 ++ l1) zero = (mzero, []) go 0 x = (mzero, [x]) go _ Contradiction = zero go _ (Solution a) = (return a, []) go d (Search ps) = foldr plus zero $ map (go $ d-1) ps cutoffEval :: MonadPlus m => Int -> SearchTree a -> ma cutoffEval cu = go where go t = case cutoff cu t of (r,ts) -> foldr mplus mzero $ r : map go ts 

But this function creates a huge space leak compared to simpleEval :

 putStrLn $ take 4000 $ simpleEval tree0 -- 2MB residency putStrLn $ take 4000 $ cutoffEval 10 tree0 -- 600MB residency 

Profiling shows that almost all selection happens in cutoff.go ; and most of the highlighting is due to the mysterious type main:Tree.sat_s5jg and constructor (,) . It seems to me because of irrefutable templates, tuple constructors are built as thunks, and not forced plus ; and, as a rule, the solution to the problem of space leakage should make your function more strict, but here the removal of irrefutable templates causes cutoff hang, so I can not do this.

I tested this with GHC 7.6, 7.8 and 7.10. A problem was discovered in each of them.

So my questions are: is it possible to write a cutoffEval to work in a constant space like simpleEval ? And in general, how can I fix a space leak if I cannot make my implementation more strict, because the algorithm depends on it?

Answer 1

It seems to me that the cause of the memory leak is actually an implementation error. Your cutoff function combines cutting too deep branches with a top estimate. And then in cutoffEval , you go down to the bottom, cut branches and continue to explore them recursively. This is essentially a breadth-first search passing through the cu levels in each pass. This means that the whole tree will eventually be built and stored in memory until the end! (Unlike the case of depth searches, where visited subtrees can be restored by GC).

If you just want to cut branches that are too deep, getting the first part of the cutoff result is what you want.

In any case, I propose to separate the evaluator and the cutoff (see below). In this case, you can simply use the original evaluator on the trimmed version of the tree.

One more note: from the MonadPlus restriction you use only the monoidal part - mzero and mplus . It would be cleaner and more general to use only Monoid . There are more monoids than monads (e.g., Sum to simply recount solutoins or Last to find the last solution).

 simpleEval :: (Monoid m) => (a -> m) -> SearchTree a -> m simpleEval f = go where go (Solution a) = fa go Contradiction = mempty go (Search ps) = mconcat $ map go ps cutoff :: Int -> SearchTree a -> SearchTree a cutoff cu = go cu where go 0 _ = Contradiction -- too deep branches are just failures go d (Search ps) = Search $ map (go (d - 1)) ps go _ x = x cutoffEval :: (Monoid m) => Int -> (a -> m) -> SearchTree a -> m cutoffEval cu f = simpleEval f . cutoff cu