[ ghc-Bugs-1186431 ] mkGraph Stack Overflow

Bugs item #1186431, was opened at 2005-04-20 14:50
Message generated for change (Comment added) made by dons
You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=108032&aid=1186431&group_id=8032

Please note that this message will contain a full copy of the comment thread,
including the initial issue submission, for this request,
not just the latest update.
Category: libraries (other)
Group: 6.4
Status: Open
Resolution: None
Priority: 5
Submitted By: Nobody/Anonymous (nobody)
Assigned to: Nobody/Anonymous (nobody)
Summary: mkGraph Stack Overflow

Initial Comment:
module Data.Graph.Inductive.Graph

mkGraph :: [LNode a] -> [LEdge b] -> gr a b

mkGraph dies on large graphs.

'mkGraph nodes edges' gives stack overflow error.

length nodes -> 20000
length edges -> 400000



----------------------------------------------------------------------

Comment By: Don Stewart (dons)
Date: 2005-07-07 14:49

Message:
Logged In: YES 
user_id=880987

Here's a test program:

------------------------------------------------------------------------

module Main where

import Data.Graph.Inductive ( Gr, mkGraph )
import Control.Exception    ( evaluate )

type Graph = Gr () ()

main = do
        let nodes =  [ (n,()) | n <- [1 .. 20000] ] 
            edges =  [ (n,m,())  | (n,_) <- nodes, (m,_) <- nodes, n /= m ]
            g = mkGraph nodes edges :: Graph

        _ <- Control.Exception.evaluate g
        putStrLn "done" 

------------------------------------------------------------------------

Which will overflow:

    $ ghc -O -package fgl Test.hs
    $ ./a.out 
    Stack space overflow: current size 8388608 bytes.
    Use `+RTS -Ksize' to increase it.

Now, we can squash this bug by replacing the foldr in insEdges in
Data.Graph.Inductive.Tree with a foldl':

------------------------------------------------------------------------

    --- /home/dons/fptools/libraries/fgl/Data/Graph/Inductive/Tree.hs
    Thu Jul  7 11:58:34 2005
    +++ ./Tree2.hs  Thu Jul  7 14:07:38 2005
    @@ -3,6 +3,7 @@
     
     module Data.Graph.Inductive.Tree (Gr,UGr) where
     
    +import Data.List        (foldl')
     
     import Data.Graph.Inductive.Graph
     import Data.Graph.Inductive.Internal.FiniteMap
    @@ -44,7 +45,10 @@
       empty           = Gr emptyFM
       isEmpty (Gr g)  = case g of {Empty -> True; _ -> False}
       match           = matchGr
    -  mkGraph vs es   = (insEdges es . insNodes vs) empty
    +  mkGraph vs es   = (insEdges' es . insNodes vs) empty
    +        where
    +          insEdges' es g = foldl' (flip insEdge) g es
    +
       labNodes (Gr g) = map (\(v,(_,l,_))->(v,l)) (fmToList g)
       -- more efficient versions of derived class members
       --

------------------------------------------------------------------------

However, we'll still run out of heap after a couple of minutes anyway.
(this is for n=200 by the way)

    $ time ./a.out
    a.out: out of memory (requested 1048576 bytes)
    ./a.out  21.47s user 7.94s system 14% cpu 3:17.98 total

Down to n=50, some profiling reveals:
    COST CENTRE                    MODULE               %time %alloc

    updFM                          Tree2                 56.2   70.2
    updAdj                         Tree2                 37.5    9.3
    clearPred                      Tree2                  6.2   10.3

Adding some `seq`s to updFM helps a little bit, knocking 25% off the allocs:

    COST CENTRE                    MODULE               %time %alloc

    updFM                          Tree2                 35.7   61.1
    updAdj                         Tree2                 42.9   12.2
    clearPred                      Tree2                 21.4   13.5

Now n=200 still runs out of heap, just takes 25% longer.

Here's updFM, from Data/Graph/Inductive/Internal/FiniteMap.hs:

    updFM :: Ord a => FiniteMap a b -> a -> (b -> b) -> FiniteMap a b
    updFM (Node h l (j,x) r) i f 
           | i<j        =  Node h (updFM l i f) (j,x) r
           | i>j        =  Node h l (j,x) (updFM r i f) 
           | otherwise  =  Node h l (j,f x) r 

versus:
    updFM (Node h l (j,x) r) i f 
           | i<j        =  let l' = updFM l i f in l' `seq` Node h l' (j,x) r
           | i>j        =  let r' = updFM r i f in r' `seq` Node h l (j,x) r'
           | otherwise  =  Node h l (j,f x) r  

I wonder if a Graph implemented as a Data.Map would make any difference.

-- Don Stewart


----------------------------------------------------------------------

You can respond by visiting: 
https://sourceforge.net/tracker/?func=detail&atid=108032&aid=1186431&group_id=8032