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
_______________________________________________
Glasgow-haskell-bugs mailing list
[email protected]
http://www.haskell.org/mailman/listinfo/glasgow-haskell-bugs