[compute transitive reduction of dependency graph to avoid repeated merging of data
John Meacham <john@repetae.net>**20090810200307
 Ignore-this: dd8c887e21397ce777d74be18e5984dc
] hunk ./src/Ho/Build.hs 370
-    let gr = G.newGraph cug  fst (fst . snd)
-    let gr' = G.transitiveClosure gr
-    mapM_ print [ (snd $ snd v, map (snd . snd) vs) | (v,vs) <- G.fromGraph gr]
---    putStrLn $ drawForest (map (fmap (show . snd . snd))  (G.dff gr))
-    putStrLn "dff"
-    mapM_ print [ (snd $ snd v, map (snd . snd) vs) | (v,vs) <- G.fromGraph gr']
---    putStrLn $ drawForest (map (fmap (show . snd . snd))  (G.dff gr'))
---    putStrLn "dfx"
---    mapM_ print [ (snd $ snd v, map (snd . snd) vs) | (v,vs) <- G.fromGraph (G.graph2Plus gr)]
-    exitSuccess
-    return (rhash,cug')
+    let gr = G.newGraph cug'  fst (fst . snd)
+        gr' = G.transitiveReduction gr
+--    putStrLn "gr"
+ --   mapM_ print [ (snd $ snd v, map (snd . snd) vs) | (v,vs) <- G.fromGraph gr]
+ --   putStrLn "grr"
+ --   mapM_ print [ (snd $ snd v, map (snd . snd) vs) | (v,vs) <- G.fromGraph gr']
+    return (rhash,[ (h,([ d | (d,_) <- ns ],cu)) | ((h,(_,cu)),ns) <- G.fromGraph gr' ])
+
+--    return (rhash,cug')
hunk ./src/Util/Graph2.hs 8
-import Data.Array
-import Data.Array.ST (STArray, newArray, readArray, writeArray,getAssocs)
-import Control.Monad.ST
+import Data.Array.MArray
+import Data.Array.IArray
+import Data.Array.ST
hunk ./src/Util/Graph2.hs 112
+type IAdjacencyMatrix  = Array (Vertex,Vertex) Bool
hunk ./src/Util/Graph2.hs 114
+transitiveClosureAM :: AdjacencyMatrix s -> ST s ()
hunk ./src/Util/Graph2.hs 116
+    bnds@(_,(max_v,_)) <- getBounds arr
hunk ./src/Util/Graph2.hs 118
-        forM_ [0 .. max_v] $ \i -> do
-            forM_ [0 .. max_v] $ \j -> do
+        forM_ (range bnds) $ \ (i,j) -> do
hunk ./src/Util/Graph2.hs 124
+
+
+transitiveReductionAM :: AdjacencyMatrix s -> ST s ()
+transitiveReductionAM arr = do
+    bnds@(_,(max_v,_)) <- getBounds arr
+    transitiveClosureAM arr
+    (farr :: IAdjacencyMatrix) <- freeze arr
+    forM_ [0 .. max_v] $ \k -> do
+        forM_ (range bnds) $ \ (i,j) -> do
+            if farr!(k,i) && farr!(i,j) then
+                writeArray arr (k,j) False
+             else return ()
+
+toAdjacencyMatrix :: G.Graph -> ST s (AdjacencyMatrix s)
+toAdjacencyMatrix g = do
+    let (0,max_v) = bounds g
+    arr <- newArray ((0,0),(max_v,max_v)) False :: ST s (STArray s (Vertex,Vertex) Bool)
+    sequence_ [ writeArray arr (v,u) True | (v,vs) <- assocs g, u <- vs ]
+    return arr
+
+fromAdjacencyMatrix :: AdjacencyMatrix s -> ST s G.Graph
+fromAdjacencyMatrix arr = do
+    bnds@(_,(max_v,_)) <- getBounds arr
+    rs <- getAssocs arr
+    let rs' = [ x | (x,True) <- rs ]
+    return (listArray (0,max_v) [ [ v | (n',v) <- rs', n == n' ] | n <- [ 0 .. max_v] ])
+
hunk ./src/Util/Graph2.hs 153
-    (0,max_v) = bounds g
-    tc :: G.Graph -> ST s G.Graph
hunk ./src/Util/Graph2.hs 154
-        arr <- newArray ((0,0),(max_v,max_v)) False :: ST s (STArray s (Vertex,Vertex) Bool)
-        sequence_ [ writeArray arr (v,u) True | (v,vs) <- assocs g, u <- vs ]
-        forM_ [0 .. max_v] $ \k -> do
-            forM_ [0 .. max_v] $ \i -> do
-                forM_ [0 .. max_v] $ \j -> do
-                    dij <- readArray arr (i,j)
-                    dik <- readArray arr (i,k)
-                    dkj <- readArray arr (k,j)
-                    writeArray arr (i,j) (dij || (dik && dkj))
-                    return ()
-        rs <- getAssocs arr
-        let rs' = [ x | (x,True) <- rs ]
---        unsafeIOToST $ print rs'
-        return (listArray (bounds g) [ [ v | (n',v) <- rs', n == n' ] | n <- vertices g ])
+        a <- toAdjacencyMatrix g
+        transitiveClosureAM a
+        fromAdjacencyMatrix a
+
+transitiveReduction :: Graph n -> Graph n
+transitiveReduction (Graph g ns) = let g' = runST (tc g) in (Graph g' ns) where
+    tc g = do
+        a <- toAdjacencyMatrix g
+        transitiveReductionAM a
+        fromAdjacencyMatrix a