libgraph 1.3 → 1.4

raw patch · 7 files changed

+42/−24 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Data/Graph/Libgraph/Core.hs +4/−0
• Data/Graph/Libgraph/Cycles.hs +13/−7
• Data/Graph/Libgraph/Dagify.hs +1/−1
• Data/Graph/Libgraph/DepthFirst.hs +9/−7
• Data/Graph/Libgraph/Dominance.hs +1/−1
• Data/Graph/Libgraph/Dot.hs +13/−7
• libgraph.cabal +1/−1

@@ -82,6 +82,10 @@ -------------------------------------------------------------------------------- -- Some other helper functions +nothingIsFalse :: Maybe Bool -> Bool+nothingIsFalse (Just b) = b+nothingIsFalse Nothing  = False+ lookup' :: Eq a => a -> [(a, b)] -> String -> b lookup' x ys msg = case lookup x ys of   Nothing -> error msg

@@ -84,9 +84,9 @@   -- Part a and b of Havlak's algorithm-state0 :: Ord vertex => Graph vertex arc -> CycleNest vertex+state0 :: (Show vertex, Ord vertex) => Graph vertex arc -> CycleNest vertex state0 g = s0-  where ps   = map (\w -> partition (isAncestor (dfs s0) w) (preds (graph s0) w)) [1..n s0]+  where ps   = map (\w -> partition (isAncestor' (dfs s0) w) (preds (graph s0) w)) [1..n s0]         bps  = map fst ps         nbps = map snd ps         dfsg = dfsGraph g@@ -104,7 +104,11 @@           , uf           = UF.fromList [1..n s0]           } -getCycleNest :: Ord vertex => Graph vertex arc -> CycleNest vertex+isAncestor' d v w = case isAncestor d v w of +  Just b  -> b+  Nothing -> error "Havlak's algorithm only works for connected graphs!"++getCycleNest :: (Show vertex, Ord vertex) => Graph vertex arc -> CycleNest vertex getCycleNest g = execState (analyse . reverse $ [1..n s0]) s0   where s0 = state0 g @@ -164,7 +168,7 @@   y' <- uf_find y   d  <- gets dfs   p  <- gets body-  if not $ isAncestor d w y' then do+  if not $ isAncestor' d w y' then do     modifyVertexType (w,IrredHead)     y' `addToNonBackPredsOf` w   else if not (y' `elem` p) && y' /= w then do@@ -175,11 +179,13 @@  -- Some helper functions -dfsGraph :: Ord vertex => Graph vertex arc -> (Graph Int (), Int -> vertex)+dfsGraph :: (Show vertex, Ord vertex) => Graph vertex arc -> (Graph Int (), Int -> vertex) dfsGraph g = (mapGraph v2i g', i2v)   where preorder = getPreorder (getDfs g)-        i2v i = lookup' i (zip [1..] preorder) "Libraph.dfsGraph: lookup failed"-        v2i v = lookup' v (zip preorder [1..]) "Libraph.dfsGraph: lookup failed"+        i2v i = lookup' i (zip [1..] preorder) +              $ "Libraph.dfsGraph: unreachable from root " ++ show i+        v2i v = lookup' v (zip preorder [1..])+              $ "Libraph.dfsGraph: unreachable from root " ++ show v         g' = unitGraph g  modifyVertexType :: (Int,VertexType) -> S vertex ()

@@ -12,7 +12,7 @@   where isBackEdge a = getEdgetype (getDfs g) a == BackEdge         hasRedHead (Arc _ h _) = h `elem` getRedHeaders (getCycleNest g) -collapse :: (Ord v,Eq a) => ([v]->v) -> Graph v a -> Graph v a+collapse :: (Show v, Ord v,Eq a) => ([v]->v) -> Graph v a -> Graph v a collapse merge g = foldl collapseCycle g ics   where (CycleTree _ ts) = getCycles (getCycleNest g)         ics              = filter (\c -> case c of 

@@ -23,12 +23,14 @@   deriving Eq  -- | Is first vertex a (recursive) parent of second vertex?+--   May fail when one of the vertices is unreachable from the root. isAncestor :: (Eq vertex, Show vertex)-           => Dfs vertex arc -> vertex -> vertex -> Bool-isAncestor d w v = (n_w <= n_v && n_v <= l_w)-  where n_v    = lookup' v (num d) $ "LibGraph.isAncestor: lookup dfs number failed " ++ show v-        n_w    = lookup' w (num d) $ "LibGraph.isAncestor: lookup dfs number failed"-        l_w    = lookup' w (lastVisit d) $ "LibGraph.isAncestor: lookup dfs lasVisit-number failed"+           => Dfs vertex arc -> vertex -> vertex -> Maybe Bool+isAncestor d w v = do+  n_v <- lookup v (num d)+  n_w <- lookup w (num d)+  l_w <- lookup w (lastVisit d)+  return (n_w <= n_v && n_v <= l_w)  -- | The 'EdgeType' of an 'Arc'. getEdgetype :: (Eq vertex, Show vertex) => Dfs vertex arc -> Arc vertex arc -> EdgeType@@ -37,7 +39,7 @@   | w `isAnc` v                 = BackEdge   | v `isAnc` w                 = FwdEdge   | otherwise                   = CrossEdge-  where isAnc = isAncestor d+  where isAnc x y = nothingIsFalse (isAncestor d x y)  -- | Get list of vertices in the order they were visited by the depth-first search. getPreorder :: Dfs vertex arc -> [vertex]@@ -114,7 +116,7 @@  instance (Eq vertex,Show vertex) => Show (Dfs vertex arc) where   show d = showWith (graph d) showVertex showArc-    where showVertex v = show v ++ show (lkup v (num d), lkup v (lastVisit d))+    where showVertex v = (show v ++ show (lkup v (num d), lkup v (lastVisit d)),"")           showArc      = show . (getEdgetype d)           lkup v ds    = lookup' v ds "Libgraph.show: lookup dfs number failed" 

@@ -34,5 +34,5 @@  instance (Eq vertex,Show vertex) => Show (Domsets vertex arc) where   show d = showWith (graph d) showVertex showArc-    where showVertex v = show v ++ show (getDominators v d)+    where showVertex v = (show v ++ show (getDominators v d),"")           showArc _    = ""

@@ -7,20 +7,26 @@ import System.Process(runCommand)  -- | Convert Graph to String with functions to show vertices and arcs.-showWith :: Eq vertex => Graph vertex arc -> (vertex->String) -> (Arc vertex arc->String) -> String+showWith :: Eq vertex => Graph vertex arc -> (vertex->(String,String)) +                          -> (Arc vertex arc->String) -> String showWith g vLabel aLabel   = "diGraph G {\n"-  ++ "root [style=invis label=\"\"]\n"-  ++ foldl (\s v -> (showVertex vLabel v) ++ s) "" vs-  ++ "root -> " ++ vName r ++ "\n"+  ++ vName r ++ "[shape=none label=\".\"]\n"+  ++ foldl (\s v -> show1 v ++ s) "" vs   ++ foldl (\s a -> (showArc vs aLabel a) ++ s) "" (arcs g)   ++ "}\n"   where vs = zip (vertices g) [0..]         r  = lookup' (root g) vs "LibGraph.showWith: lookup root in vs failed"+        isRoot (v,_) = v == root g -showVertex :: (vertex->String) -> (vertex,Int) -> String-showVertex vLabel (v,i) -  = vName i ++ " [label=\"" ++ (escape . vLabel) v ++ "\"]\n"+        show1 v+          | isRoot v  = vName r ++ "[shape=none label=\".\"]\n"+          | otherwise = (showVertex vLabel v)++showVertex :: (vertex->(String,String)) -> (vertex,Int) -> String+showVertex vLabel (v,i) =+  let (lbl,extra) = vLabel v+  in  vName i ++ " [label=\"" ++ escape lbl ++ "\"" ++ extra ++ "]\n"  showArc :: Eq vertex => [(vertex,Int)] -> (Arc vertex arc->String) -> (Arc vertex arc) -> String showArc vs aLabel a

@@ -1,5 +1,5 @@ Name:           libgraph
-Version:        1.3
+Version:        1.4
 Homepage:      http://maartenfaddegon.nl
 Synopsis:       Store and manipulate data in a graph.
 Description:    A graph type, analysis of graphs and manipulation of graphs.