graphite 0.5.0.2 → 0.7.0.0

raw patch · 10 files changed

+155/−187 lines, 10 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• graphite.cabal +1/−2
• src/Data/Graph/Connectivity.hs +3/−3
• src/Data/Graph/DGraph.hs +57/−48
• src/Data/Graph/Generation.hs +1/−1
• src/Data/Graph/Read.hs +3/−3
• src/Data/Graph/Types.hs +50/−16
• src/Data/Graph/UGraph.hs +34/−35
• src/Data/Graph/UGraph/DegreeSequence.hs +1/−1
• src/Data/Graph/Visualize.hs +5/−5
• src/Scratch.hs +0/−73

@@ -1,5 +1,5 @@ name:                graphite-version:             0.5.0.2+version:             0.7.0.0 synopsis:            Graphs and networks library description:         Represent, analyze and visualize graphs homepage:            https://github.com/alx741/graphite#readme@@ -25,7 +25,6 @@                      , Data.Graph.DGraph.DegreeSequence                      , Data.Graph.UGraph.DegreeSequence                      , Data.Graph.Visualize-  other-modules:       Scratch   build-depends:       base >= 4.7 && < 5                      , QuickCheck                      , bytestring

@@ -24,7 +24,7 @@  -> Bool areConnected g fromV toV     | fromV == toV = True-    | otherwise = search (directlyReachableVertices g fromV) S.empty toV+    | otherwise = search (fromV : reachableAdjacentVertices g fromV) S.empty toV     where         search :: [v] -> S.Set v -> v -> Bool         search [] _ _ = False@@ -32,7 +32,7 @@             | v `S.member` banned = search vs banned v'             | v == v' = True             | otherwise =-                search (directlyReachableVertices g v) banned' v'+                search (v : reachableAdjacentVertices g v) banned' v'                 || search vs banned' v'             where banned' = v `S.insert` banned @@ -84,7 +84,7 @@ -- | A Directed Graph is @strongly connected@ if it contains a directed path -- | on every pair of vertices isStronglyConnected :: (Hashable v, Eq v, Ord v) => DGraph v e -> Bool-isStronglyConnected g = isConnected g+isStronglyConnected = isConnected  -- TODO -- * connected component

@@ -18,7 +18,7 @@  -- | Directed Graph of Vertices in /v/ and Arcs with attributes in /e/ data DGraph v e = DGraph-    { _size :: Int+    { _size    :: Int     , unDGraph :: HM.HashMap v (Links v e)     } deriving (Eq, Generic) @@ -39,36 +39,61 @@     order (DGraph _ g) = HM.size g     size (DGraph s _) = s     vertices (DGraph _ g) = HM.keys g-    edgePairs = arcs'+    edgePairs g = toPair <$> arcs g +     containsVertex (DGraph _ g) = flip HM.member g+     areAdjacent (DGraph _ g) v1 v2 =         HM.member v2 (getLinks v1 g) || HM.member v1 (getLinks v2 g)+     adjacentVertices g v = filter-        (\v' -> containsArc' g (v, v') || containsArc' g (v', v))+        (\v' -> containsEdgePair g (v, v') || containsEdgePair g (v', v))         (vertices g)-    directlyReachableVertices (DGraph _ g) v = v : (HM.keys $ getLinks v g) +    adjacentVertices' g v = fmap+        (\(fromV, toV, e) -> if fromV == v then (toV, e) else (fromV, e)) $+        filter+            (\(fromV, toV, _) -> fromV == v || toV == v)+            (toTriple <$> toList g)++    reachableAdjacentVertices (DGraph _ g) v = HM.keys (getLinks v g)++    reachableAdjacentVertices' g v = fmap (\(_, toV, e) -> (toV, e)) $+        filter+            (\(fromV, _, _) -> fromV == v)+            (toTriple <$> toList g)+     -- | The total number of inbounding and outbounding 'Arc's of a vertex     vertexDegree g v = vertexIndegree g v + vertexOutdegree g v      insertVertex v (DGraph s g) = DGraph s $ hashMapInsert v HM.empty g -    containsEdgePair = containsArc'-    incidentEdgePairs g v = fmap toPair $ incidentArcs g v-    insertEdgePair (v1, v2) g = insertArc (Arc v1 v2 ()) g-    removeEdgePair = removeArc'+    containsEdgePair graph@(DGraph _ g) (v1, v2) =+        containsVertex graph v1 && containsVertex graph v2 && v2 `HM.member` v1Links+        where v1Links = getLinks v1 g ++    incidentEdgePairs g v = toPair <$> incidentArcs g v+    insertEdgeTriple (v1, v2, e) = insertArc (Arc v1 v2 e)++    removeEdgePair (v1, v2) graph@(DGraph s g)+        | containsEdgePair graph (v1, v2) =+            DGraph (s - 1) $ HM.adjust (const v1Links') v1 g+        | otherwise = graph+            where v1Links' = HM.delete v2 $ getLinks v1 g++     removeVertex v g@(DGraph s _) = DGraph s         $ (\(DGraph _ g') -> HM.delete v g')         $ foldl' (flip removeArc) g $ incidentArcs g v      isSimple g = foldl' go True $ vertices g-        where go bool v = bool && (not $ HM.member v $ getLinks v $ unDGraph g)+        where go bool v = bool && not (HM.member v $ getLinks v $ unDGraph g)      fromAdjacencyMatrix m         | length m /= length (head m) = Nothing-        | otherwise = Just $ insertArcs empty (foldl' genArcs [] labeledM)+        | otherwise = Just $ insertArcs (foldl' genArcs [] labeledM) empty             where                 labeledM :: [(Int, [(Int, Int)])]                 labeledM = zip [1..] $ fmap (zip [1..]) m@@ -81,41 +106,36 @@  instance (Arbitrary v, Arbitrary e, Hashable v, Num v, Ord v)  => Arbitrary (DGraph v e) where-    arbitrary = insertArcs <$> pure empty <*> arbitrary+    arbitrary = insertArcs <$> arbitrary <*> pure empty --- | @O(log n)@ Insert a directed 'Arc' into a 'DGraph'--- | The involved vertices are inserted if don't exist. If the graph already--- | contains the Arc, its attribute is updated+-- | Insert a directed 'Arc' into a 'DGraph'+-- | The involved vertices are inserted if they don't exist. If the graph+-- | already contains the Arc, its attribute is updated insertArc :: (Hashable v, Eq v) => Arc v e -> DGraph v e -> DGraph v e insertArc (Arc fromV toV edgeAttr) g@(DGraph s _)     | containsEdgePair g (fromV, toV) = g     | otherwise = DGraph (s + 1) $ HM.adjust (insertLink toV edgeAttr) fromV g'     where g' = unDGraph $ insertVertices [fromV, toV] g --- | @O(m*log n)@ Insert many directed 'Arc's into a 'DGraph'--- | Same rules as 'insertArc' are applied-insertArcs :: (Hashable v, Eq v) => DGraph v e -> [Arc v e] -> DGraph v e-insertArcs g as = foldl' (flip insertArc) g as+-- | Same as 'insertArc' but for a list of 'Arc's+insertArcs :: (Hashable v, Eq v) => [Arc v e] -> DGraph v e -> DGraph v e+insertArcs as g = foldl' (flip insertArc) g as --- | @O(log n)@ Remove the directed 'Arc' from a 'DGraph' if present+-- | Remove the directed 'Arc' from a 'DGraph' if present -- | The involved vertices are left untouched removeArc :: (Hashable v, Eq v) => Arc v e -> DGraph v e -> DGraph v e removeArc = removeEdgePair . toPair --- | Same as 'removeArc' but the arc is an ordered pair-removeArc' :: (Hashable v, Eq v) => (v, v) -> DGraph v e -> DGraph v e-removeArc' (v1, v2) graph@(DGraph s g)-    | containsEdgePair graph (v1, v2) =-        DGraph (s - 1) $ HM.adjust (const v1Links') v1 g-    | otherwise = graph-        where v1Links' = HM.delete v2 $ getLinks v1 g+-- | Same as 'removeArc' but for a list of 'Arc's+removeArcs :: (Hashable v, Eq v) => [Arc v e] -> DGraph v e -> DGraph v e+removeArcs as g = foldl' (flip removeArc) g as --- | @O(log n)@ Remove the directed 'Arc' from a 'DGraph' if present+-- | Remove the directed 'Arc' from a 'DGraph' if present -- | The involved vertices are also removed removeArcAndVertices :: (Hashable v, Eq v) => Arc v e -> DGraph v e -> DGraph v e removeArcAndVertices = removeEdgePairAndVertices . toPair --- | @O(n*m)@ Retrieve the 'Arc's of a 'DGraph'+-- | Retrieve the 'Arc's of a 'DGraph' arcs :: forall v e . (Hashable v, Eq v) => DGraph v e -> [Arc v e] arcs (DGraph s g) = linksToArcs $ zip vs links     where@@ -124,20 +144,9 @@         links :: [Links v e]         links = fmap (`getLinks` g) vs --- | Same as 'arcs' but the arcs are ordered pairs, and their attributes are--- | discarded-arcs' :: (Hashable v, Eq v) => DGraph v e -> [(v, v)]-arcs' g = toPair <$> arcs g---- | @O(log n)@ Tell if a directed 'Arc' exists in the graph+-- | Tell if a directed 'Arc' exists in the graph containsArc :: (Hashable v, Eq v) => DGraph v e -> Arc v e -> Bool-containsArc g = containsArc' g . toPair---- | Same as 'containsArc' but the arc is an ordered pair-containsArc' :: (Hashable v, Eq v) => DGraph v e -> (v, v) -> Bool-containsArc' graph@(DGraph _ g) (v1, v2) =-    containsVertex graph v1 && containsVertex graph v2 && v2 `HM.member` v1Links-    where v1Links = getLinks v1 g+containsArc g = containsEdgePair g . toPair  -- | Retrieve the inbounding 'Arc's of a Vertex inboundingArcs :: (Hashable v, Eq v) => DGraph v e -> v -> [Arc v e]@@ -166,20 +175,20 @@ -- | Indegree of a vertex -- | The number of inbounding 'Arc's to a vertex vertexIndegree :: (Hashable v, Eq v) => DGraph v e -> v -> Int-vertexIndegree g v = length $ filter (\(_, v') -> v == v' ) $ arcs' g+vertexIndegree g v = length $ filter (\(_, v') -> v == v' ) $ edgePairs g  -- | Outdegree of a vertex -- | The number of outbounding 'Arc's from a vertex vertexOutdegree :: (Hashable v, Eq v) => DGraph v e -> v -> Int-vertexOutdegree g v = length $ filter (\(v', _) -> v == v' ) $ arcs' g+vertexOutdegree g v = length $ filter (\(v', _) -> v == v' ) $ edgePairs g  -- | Indegrees of all the vertices in a 'DGraph' indegrees :: (Hashable v, Eq v) => DGraph v e -> [Int]-indegrees g = fmap (vertexIndegree g) $ vertices g+indegrees g = vertexIndegree g <$> vertices g  -- | Outdegree of all the vertices in a 'DGraph' outdegrees :: (Hashable v, Eq v) => DGraph v e -> [Int]-outdegrees g = fmap (vertexOutdegree g) $ vertices g+outdegrees g = vertexOutdegree g <$> vertices g  -- | Tell if a 'DGraph' is balanced -- | A Directed Graph is @balanced@ when its @indegree = outdegree@@@ -214,13 +223,13 @@ -- | The @transpose@ of a directed graph is another directed graph where all of -- | its arcs are reversed transpose :: (Hashable v, Eq v) => DGraph v e -> DGraph v e-transpose g = insertArcs empty (fmap reverseArc $ arcs g)+transpose g = insertArcs (reverseArc <$> arcs g) empty     where reverseArc (Arc fromV toV attr) = Arc toV fromV attr  -- | Convert a directed 'DGraph' to an undirected 'UGraph' by converting all of -- | its 'Arc's into 'Edge's toUndirected :: (Hashable v, Eq v) => DGraph v e -> UG.UGraph v e-toUndirected g = UG.insertEdges (fmap arcToEdge $ arcs g) empty+toUndirected g = UG.insertEdges (arcToEdge <$> arcs g) empty     where arcToEdge (Arc fromV toV attr) = Edge fromV toV attr  @@ -233,4 +242,4 @@  -- | Construct a 'DGraph' from a list of 'Arc's fromList :: (Hashable v, Eq v) => [Arc v e] -> DGraph v e-fromList = insertArcs empty+fromList as = insertArcs as empty

@@ -22,7 +22,7 @@             flipDir <- randomRIO (True, False)             let vs' = zip rnds vs             let g' = insertVertex v g-            go vs pv $! (foldl' (putV pv v flipDir) g' vs')+            go vs pv $! foldl' (putV pv v flipDir) g' vs'          putV :: Graph g => Float -> Int -> Bool -> g Int () -> (Float, Int) -> g Int ()         putV pv v flipDir g (p', v')

@@ -20,11 +20,11 @@     let dec = decode NoHeader content     case dec of         Left err -> return $ Left err-        Right vec -> return $ Right $ (flip insertEdgePairs) empty $ toEdges $ V.toList vec+        Right vec -> return $ Right $ flip insertEdgePairs empty $ toEdges $ V.toList vec      where         toEdges :: [[v]] -> [(v, v)]-        toEdges ns = Prelude.concat $ fmap nodeEdges ns+        toEdges = Prelude.concatMap nodeEdges          nodeEdges :: [v] -> [(v, v)]         nodeEdges []     = []@@ -39,4 +39,4 @@     eitherG <- fromCsv fp     case eitherG of         Left err -> error err-        Right g -> return g+        Right g  -> return g

@@ -30,7 +30,11 @@     vertices :: g v e -> [v]      -- | Retrieve the edges of a graph+    edgeTriples :: (Hashable v, Eq v) => g v e -> [(v, v, e)]++    -- | Retrieve the edges of a graph, ignoring its attributes     edgePairs :: (Hashable v, Eq v) => g v e -> [(v, v)]+    edgePairs g = tripleToPair <$> edgeTriples g      -- | Tell if a vertex exists in the graph     containsVertex :: (Hashable v, Eq v) => g v e -> v -> Bool@@ -40,14 +44,25 @@      -- | Retrieve the adjacent vertices of a vertex     adjacentVertices :: (Hashable v, Eq v) => g v e -> v -> [v]+    adjacentVertices g v = fst <$> adjacentVertices' g v -    -- | Retrieve the vertices that are directly reachable from a particular-    -- | vertex.-    -- | A vertex is @directly reachable@ to other if there is an edge that-    -- | connects @from@ one vertex @to@ the other-    -- | Every vertex is directly reachable from itself-    directlyReachableVertices :: (Hashable v, Eq v) => g v e -> v -> [v]+    -- | Same as 'adjacentVertices' but pairs the vertex with the connecting+    -- | edge's attribute+    adjacentVertices' :: (Hashable v, Eq v) => g v e -> v -> [(v, e)] +    -- | Same as 'adjacentVertices' but gives back only those vertices for which+    -- | the connecting edge allows the vertex to be reached.+    -- |+    -- | For an undirected graph this is equivalent to 'adjacentVertices', but+    -- | for the case of a directed graph, the directed arcs will constrain the+    -- | reachability of the adjacent vertices.+    reachableAdjacentVertices :: (Hashable v, Eq v) => g v e -> v -> [v]+    reachableAdjacentVertices g v = fst <$> reachableAdjacentVertices' g v++    -- | Same as 'reachableAdjacentVertices' but pairs the vertex with the+    -- | connecting edge's attribute+    reachableAdjacentVertices' :: (Hashable v, Eq v) => g v e -> v -> [(v, e)]+     -- | Total number of incident edges of a vertex     vertexDegree :: (Hashable v, Eq v) => g v e -> v -> Int @@ -65,7 +80,7 @@      -- | Average degree of a graph     avgDegree :: (Hashable v, Eq v) => g v e -> Double-    avgDegree g = fromIntegral (2 * size g) / (fromIntegral $ order g)+    avgDegree g = fromIntegral (2 * size g) / fromIntegral (order g)      -- | Density of a graph     -- | The ratio of the number of existing edges in the graph to the number of@@ -90,14 +105,27 @@     containsEdgePair :: (Hashable v, Eq v) => g v e -> (v, v) -> Bool      -- | Retrieve the incident edges of a vertex+    incidentEdgeTriples :: (Hashable v, Eq v) => g v e -> v -> [(v, v, e)]++    -- | Retrieve the incident edges of a vertex, ignoring its attributes     incidentEdgePairs :: (Hashable v, Eq v) => g v e -> v -> [(v, v)]+    incidentEdgePairs g v = tripleToPair <$> incidentEdgeTriples g v      -- | Insert an edge into a graph     -- | The involved vertices are inserted if don't exist. If the graph already     -- | contains the edge, its attribute is updated+    insertEdgeTriple :: (Hashable v, Eq v) => (v, v, e) -> g v e -> g v e++    -- | Same as 'insertEdgeTriple' but for multiple edges+    insertEdgeTriples :: (Hashable v, Eq v) => [(v, v, e)] -> g v e -> g v e+    insertEdgeTriples es g = foldl' (flip insertEdgeTriple) g es++    -- | Same as 'insertEdgeTriple' but insert edge pairs in graphs with+    -- | attributeless edges     insertEdgePair :: (Hashable v, Eq v) => (v, v) -> g v () -> g v ()+    insertEdgePair (v1, v2) = insertEdgeTriple (v1, v2, ()) -    -- | Same as 'insertEdgePair' but for multiple edges+    -- | Same as 'insertEdgePair' for multiple edges     insertEdgePairs :: (Hashable v, Eq v) => [(v, v)] -> g v () -> g v ()     insertEdgePairs es g = foldl' (flip insertEdgePair) g es @@ -154,6 +182,10 @@     -- | Convert an edge to a pair discargind its attribute     toPair :: e v a -> (v, v) +    -- | Convert an edge to a triple, where the 3rd element it's the edge+    -- | attribute+    toTriple :: e v a -> (v, v, a)+     -- | Tell if an edge is a loop     -- | An edge forms a @loop@ if both of its ends point to the same vertex     isLoop :: (Eq v) => e v a -> Bool@@ -163,10 +195,12 @@  instance IsEdge Edge where     toPair (Edge v1 v2 _) = (v1, v2)+    toTriple (Edge v1 v2 e) = (v1, v2, e)     isLoop (Edge v1 v2 _) = v1 == v2  instance IsEdge Arc where     toPair (Arc fromV toV _) = (fromV, toV)+    toTriple (Arc fromV toV e) = (fromV, toV, e)     isLoop (Arc v1 v2 _) = v1 == v2  -- | Weighted Edge attributes@@ -216,6 +250,10 @@ instance (Eq v, Eq a) => Eq (Arc v a) where     (Arc v1 v2 a) == (Arc v1' v2' a') = (a == a') && (v1 == v1' && v2 == v2') +-- | Convert a triple to a pair by ignoring the third element+tripleToPair :: (a, b, c) -> (a, b)+tripleToPair (a, b, _) = (a, b)+ -- | Edges generator arbitraryEdge :: (Arbitrary v, Arbitrary e, Ord v, Num v)  => (v -> v -> e -> edge) -> Gen edge@@ -245,21 +283,17 @@  -- | Get 'Arc's from an association list of vertices and their links linksToArcs :: [(v, Links v a)] -> [Arc v a]-linksToArcs ls = concat $ fmap toArc ls+linksToArcs = concatMap toArc     where         toArc :: (v, Links v a) -> [Arc v a]-        toArc (fromV, links) = fmap (\(v, a) -> Arc fromV v a) (HM.toList links)+        toArc (fromV, links) = fmap (uncurry (Arc fromV)) (HM.toList links)  -- | Get 'Edge's from an association list of vertices and their links linksToEdges :: [(v, Links v a)] -> [Edge v a]-linksToEdges ls = concat $ fmap toEdge ls+linksToEdges = concatMap toEdge     where         toEdge :: (v, Links v a) -> [Edge v a]-        toEdge (fromV, links) = fmap (\(v, a) -> Edge fromV v a) (HM.toList links)---- | Get 'Edge's from an association list of vertices and their links-linksToEdges' :: (Eq v) => (v, Links v a) -> [Edge v a]-linksToEdges' (fromV, links) = fmap (\(v, a) -> Edge fromV v a) (HM.toList links)+        toEdge (fromV, links) = fmap (uncurry (Edge fromV)) (HM.toList links)  -- | O(log n) Associate the specified value with the specified key in this map. -- | If this map previously contained a mapping for the key, leave the map

@@ -20,7 +20,7 @@  -- | Undirected Graph of Vertices in /v/ and Edges with attributes in /e/ data UGraph v e = UGraph-    { _size :: Int+    { _size    :: Int     , unUGraph :: HM.HashMap v (Links v e)     } deriving (Eq, Generic) @@ -45,26 +45,39 @@     order (UGraph _ g) = HM.size g     size (UGraph s _) = s     vertices (UGraph _ g) = HM.keys g-    edgePairs g = toPair <$> edges g+    edgeTriples g = toTriple <$> edges g      containsVertex (UGraph _ g) = flip HM.member g     areAdjacent (UGraph _ g) v1 v2 = HM.member v2 $ getLinks v1 g     adjacentVertices (UGraph _ g) v = HM.keys $ getLinks v g-    directlyReachableVertices g v = v : (adjacentVertices g v)+    adjacentVertices' (UGraph _ g) v = HM.toList $ getLinks v g+    reachableAdjacentVertices = adjacentVertices+    reachableAdjacentVertices' = adjacentVertices'     vertexDegree (UGraph _ g) v = length $ HM.keys $ getLinks v g     insertVertex v (UGraph s g) = UGraph s $ hashMapInsert v HM.empty g -    containsEdgePair = containsEdge'-    incidentEdgePairs g v = fmap toPair $ incidentEdges g v-    insertEdgePair (v1, v2) g = insertEdge (Edge v1 v2 ()) g-    removeEdgePair = removeEdge'+    containsEdgePair graph@(UGraph _ g) (v1, v2) =+        containsVertex graph v1 && containsVertex graph v2 && v2 `HM.member` v1Links+        where v1Links = getLinks v1 g +    incidentEdgeTriples g v = toTriple <$> incidentEdges g v+    insertEdgeTriple (v1, v2, e) = insertEdge (Edge v1 v2 e)++    removeEdgePair (v1, v2) graph@(UGraph s g)+        | containsEdgePair graph (v1, v2) =+            UGraph (s - 1) $ update v2Links v2 $ update v1Links v1 g+        | otherwise = graph+        where+            v1Links = HM.delete v2 $ getLinks v1 g+            v2Links = HM.delete v1 $ getLinks v2 g+            update = HM.adjust . const+     removeVertex v g@(UGraph s _) = UGraph s         $ (\(UGraph _ g') -> HM.delete v g')         $ foldl' (flip removeEdge) g $ incidentEdges g v      isSimple g = foldl' go True $ vertices g-        where go bool v = bool && (not $ HM.member v $ getLinks v $ unUGraph g)+        where go bool v = bool && not (HM.member v $ getLinks v $ unUGraph g)      fromAdjacencyMatrix m         | length m /= length (head m) = Nothing@@ -81,9 +94,9 @@   --- | @O(log n)@ Insert an undirected 'Edge' into a 'UGraph'--- | The involved vertices are inserted if don't exist. If the graph already--- | contains the Edge, its attribute is updated+-- | Insert an undirected 'Edge' into a 'UGraph'+-- | The involved vertices are inserted if they don't exist. If the graph+-- | already contains the Edge, its attribute is updated insertEdge :: (Hashable v, Eq v) => Edge v e -> UGraph v e -> UGraph v e insertEdge (Edge v1 v2 edgeAttr) g@(UGraph s _)     | containsEdgePair g (v1, v2) = g@@ -92,33 +105,25 @@         g' = unUGraph $ insertVertices [v1, v2] g         link fromV toV = HM.adjust (insertLink toV edgeAttr) fromV --- | @O(m*log n)@ Insert many directed 'Edge's into a 'UGraph'--- | Same rules as 'insertEdge' are applied+-- | Same as 'insertEdge' but for a list of 'Edge's insertEdges :: (Hashable v, Eq v) => [Edge v e] -> UGraph v e -> UGraph v e insertEdges es g = foldl' (flip insertEdge) g es --- | @O(log n)@ Remove the undirected 'Edge' from a 'UGraph' if present+-- | Remove the undirected 'Edge' from a 'UGraph' if present -- | The involved vertices are left untouched removeEdge :: (Hashable v, Eq v) => Edge v e -> UGraph v e -> UGraph v e removeEdge = removeEdgePair . toPair --- | Same as 'removeEdge' but the edge is an unordered pair-removeEdge' :: (Hashable v, Eq v) => (v, v) -> UGraph v e -> UGraph v e-removeEdge' (v1, v2) graph@(UGraph s g)-    | containsEdgePair graph (v1, v2) =-        UGraph (s - 1) $ update v2Links v2 $ update v1Links v1 g-    | otherwise = graph-    where-        v1Links = HM.delete v2 $ getLinks v1 g-        v2Links = HM.delete v1 $ getLinks v2 g-        update = HM.adjust . const+-- | Same as 'removeEdge' but for a list of 'Edge's+removeEdges :: (Hashable v, Eq v) => [Edge v e] -> UGraph v e -> UGraph v e+removeEdges es g = foldl' (flip removeEdge) g es --- | @O(log n)@ Remove the undirected 'Edge' from a 'UGraph' if present+-- | Remove the undirected 'Edge' from a 'UGraph' if present -- | The involved vertices are also removed removeEdgeAndVertices :: (Hashable v, Eq v) => Edge v e -> UGraph v e -> UGraph v e removeEdgeAndVertices = removeEdgePairAndVertices . toPair --- | @O(n*m)@ Retrieve the 'Edge's of a 'UGraph'+-- | Retrieve the 'Edge's of a 'UGraph' edges :: forall v e . (Hashable v, Eq v) => UGraph v e -> [Edge v e] edges g = F.toList $ go g S.empty     where@@ -127,17 +132,11 @@             let v = head $ vertices g'             in go                 (removeVertex v g')-                (es S.>< (S.fromList $ incidentEdges g' v))+                (es S.>< S.fromList (incidentEdges g' v)) --- | @O(log n)@ Tell if an undirected 'Edge' exists in the graph+-- | Tell if an undirected 'Edge' exists in the graph containsEdge :: (Hashable v, Eq v) => UGraph v e -> Edge v e -> Bool-containsEdge g = containsEdge' g . toPair---- | Same as 'containsEdge' but the edge is an unordered pair-containsEdge' :: (Hashable v, Eq v) => UGraph v e -> (v, v) -> Bool-containsEdge' graph@(UGraph _ g) (v1, v2) =-    containsVertex graph v1 && containsVertex graph v2 && v2 `HM.member` v1Links-    where v1Links = getLinks v1 g+containsEdge g = containsEdgePair g . toPair  -- | Retrieve the incident 'Edge's of a Vertex incidentEdges :: (Hashable v, Eq v) => UGraph v e -> v -> [Edge v e]

@@ -34,7 +34,7 @@ isGraphicalSequence (DegreeSequence (x:xs))     | x > length xs = False     | otherwise = isGraphicalSequence $ degreeSequence seq'-        where seq' = (map (subtract 1) $ take x xs) ++ drop x xs+        where seq' = subtract 1 <$> take x xs ++ drop x xs  -- | Tell if a 'DegreeSequence' is a Directed Graphic -- | A @Directed Graphic@ is a Degree Sequence for wich a 'DGraph' exists

@@ -20,7 +20,7 @@  -- | Plot an undirected 'UGraph' to a PNG image file plotUGraphPng :: (Show e) => UGraph Int e -> FilePath -> IO FilePath-plotUGraphPng g fp = addExtension (runGraphvizCommand Sfdp $ toUndirectedDot g) Png fp+plotUGraphPng g = addExtension (runGraphvizCommand Sfdp $ toUndirectedDot g) Png  -- | Plot a directed 'DGraph' plotDGraph :: (Show e) => DGraph Int e -> IO ()@@ -28,16 +28,16 @@  -- | Plot a directed 'DGraph' to a PNG image file plotDGraphPng :: (Show e) => DGraph Int e -> FilePath -> IO FilePath-plotDGraphPng g fp = addExtension (runGraphvizCommand Sfdp $ toDirectedDot g) Png fp+plotDGraphPng g = addExtension (runGraphvizCommand Sfdp $ toDirectedDot g) Png  labeledNodes :: (Graph g, Show v) => g v e -> [(v, String)]-labeledNodes g = fmap (\v -> (v, show v)) $ vertices g+labeledNodes g = (\v -> (v, show v)) <$> vertices g  labeledEdges :: (Hashable v, Eq v, Show e) => UGraph v e -> [(v, v, String)]-labeledEdges g = fmap (\(Edge v1 v2 attr) -> (v1, v2, show attr)) $ edges g+labeledEdges g = (\(Edge v1 v2 attr) -> (v1, v2, show attr)) <$> edges g  labeledArcs :: (Hashable v, Eq v, Show e) => DGraph v e -> [(v, v, String)]-labeledArcs g = fmap (\(Arc v1 v2 attr) -> (v1, v2, show attr)) $ arcs g+labeledArcs g = (\(Arc v1 v2 attr) -> (v1, v2, show attr)) <$> arcs g  toUndirectedDot :: (Show e) => UGraph Int e -> DotGraph Int toUndirectedDot g = graphElemsToDot params (labeledNodes g) (labeledEdges g)

@@ -1,73 +0,0 @@-module Scratch where--import Data.List (foldl')--import qualified Data.Dequeue as Q-import qualified Data.Set     as S--import Data.Graph.Types-import Data.Graph.UGraph--testG :: UGraph Int ()-testG = fromList-    [ 1 <-> 2-    , 1 <-> 3-    , 1 <-> 5-    , 2 <-> 1-    , 2 <-> 4-    , 3 <-> 4-    , 3 <-> 6-    , 4 <-> 2-    , 4 <-> 3-    , 4 <-> 5-    , 5 <-> 1-    , 5 <-> 4-    , 5 <-> 6-    , 6 <-> 5-    , 6 <-> 3-    ]--path :: UGraph Int () -> Int -> Int -> [Int]-path g fromV toV-    | fromV == toV = [toV]-    | otherwise = search [fromV] S.empty []-    where-        search :: [Int] -> S.Set Int -> [Int] -> [Int]-        search (v:vs) banned popped-            | v == toV = popped ++ [v]-            | otherwise =-                let reachables = nonVisitedReachables banned v-                in search-                    (vs ++ reachables)-                    (setInsertMany banned $ v : reachables)-                    (popped ++ [v])--        nonVisitedReachables banned v = filter-            (\v' -> v' /= v && (not $ S.member v' banned))-            (directlyReachableVertices g v)--path' :: UGraph Int () -> Int -> Int -> [Int]-path' g fromV toV-    | fromV == toV = [toV]-    | otherwise = reverse $ search (Q.fromList [fromV]) S.empty []-    where-        search :: Q.BankersDequeue Int -> S.Set Int -> [Int] -> [Int]-        search queue banned popped = case Q.popFront queue of-            Nothing -> popped-            Just (v, queue') -> if v == toV then v : popped else-                let reachables = nonVisitedReachables banned v-                in search-                    (queue' `pushBackMany` reachables)-                    (setInsertMany banned $ v : reachables)-                    (v : popped)--        nonVisitedReachables banned v = filter-            (\v' -> v' /= v && (not $ S.member v' banned))-            (directlyReachableVertices g v)---setInsertMany :: Ord a => S.Set a -> [a] -> S.Set a-setInsertMany = foldl' (flip S.insert)--pushBackMany :: Q.BankersDequeue a  -> [a] -> Q.BankersDequeue a-pushBackMany = foldl' Q.pushBack