Jak naprawić przestrzeń wycieku spowodowanego przez lenistwo, gdy algorytm opiera się na lenistwo

Question

Mam algorytmu, który generuje drzewo przeszukiwania:

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

Algorytm generujący tego drzewa leniwie. Zdefiniowałem również prosty ewaluator, który jest po prostu głębokim pierwszym wyszukiwaniem.

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

Zauważyłem, że wiele rozwiązań, które mój algorytm produkuje wyglądać jak na poniższym wyszukiwania drzewa:

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' 

Mianowicie, mają wiele bardzo głębokich oddziałów bez rozwiązań, kilka głębokich gałęzie z rozwiązaniem i bardzo niewiele płytkich gałęzi z rozwiązaniem. Na tej podstawie postanowiłem, że chcę innego oceniającego, który "zrezygnuje" z oddziałów, które są zbyt głębokie. Nazywają to cutoffEval. cutoffEval 5 tree0 powinien znaleźć tylko b s, ponieważ istnieje nieskończenie wiele gałęzi o głębokości mniejszej niż 5 do rozważenia, i zawierają one tylko b s. I wprowadziły go tak:

cutoff :: (MonadPlus m) => Int -> SearchTree a -> (m a, [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 -> m a 
cutoffEval cu = go where 
    go t = case cutoff cu t of (r,ts) -> foldr mplus mzero $ r : map go ts 

Ale ta funkcja daje ogromny wyciek przestrzeń, w porównaniu do simpleEval:

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

Profilowanie wynika, że ​​prawie cały przydział odbywa się w cutoff.go; a większość alokacji wynika z czegoś tajemniczego o nazwie main:Tree.sat_s5jg i konstruktora (,). Wydaje mi się, że ze względu na niezaprzeczalne wzorce, konstruktorzy krotki są budowani jako ciosy zamiast zmuszani przez plus; i normalnie rozwiązaniem problemu wycieku przestrzeni jest sprawienie, aby twoja funkcja była bardziej rygorystyczna, ale tutaj usunięcie niepotwierdzonych wzorców powoduje zawieszenie się cutoff, więc nie mogę tego zrobić.

Testowałem to z GHC 7.6, 7.8 i 7.10. Problem został znaleziony w każdym z nich.

Moje pytania brzmią: czy można napisać, że cutoffEval działa w stałej przestrzeni, takiej jak simpleEval? A bardziej ogólnie, jak mogę naprawić wyciek przestrzeni, jeśli nie mogę uczynić mojej implementacji bardziej rygorystyczną, ponieważ zależy od tego algorytm?

Answer 1

Wydaje mi się, że przyczyna wycieku pamięci jest w rzeczywistości błędem w implementacji. Twoja funkcja cutoff łączy razem odcinanie zbyt głębokich gałęzi z oceną górnej części. A następnie w cutoffEval, idziesz głębiej w dół, przecinasz gałęzie i kontynuujesz ich eksplorację. To jest zasadniczo pierwsze wyszukiwanie, przechodzenie przez poziomy cu w każdym przebiegu. Oznacza to, że całe drzewo zostanie ostatecznie zbudowane i zachowane w pamięci aż do końca! (W odróżnieniu od pierwszego wyszukiwania w głębi, gdy odwiedzone poddrzewa mogą być odzyskane przez GC.)

Jeśli chcesz po prostu odciąć gałęzie, które są zbyt głębokie, uzyskanie pierwszej części wyniku cutoff czego chcesz.

W każdym razie sugeruję oddzielenie oceniającego od części odcięcia (patrz poniżej). W takim przypadku możesz po prostu użyć oryginalnego ewaluatora w cut-off wersji drzewa.

Jedna dodatkowa uwaga, od ograniczenia MonadPlus używasz tylko części monoidalnej - mzero i mplus. Byłoby czystsze i bardziej ogólne używać tylko Monoid.Istnieje więcej monoidów niż monad (na przykład Sum, aby liczyć tylko solutoiny, lub Last, aby znaleźć ostatnie rozwiązanie).

simpleEval :: (Monoid m) => (a -> m) -> SearchTree a -> m 
simpleEval f = go 
    where 
    go (Solution a) = f a 
    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