graphite 0.8.0.0 → 0.9.0.0
raw patch · 9 files changed
+310/−66 lines, 9 filesdep −dequeuePVP ok
version bump matches the API change (PVP)
Dependencies removed: dequeue
API changes (from Hackage documentation)
- Data.Graph.DGraph: fromList :: (Hashable v, Eq v) => [Arc v e] -> DGraph v e
- Data.Graph.DGraph: toList :: (Hashable v, Eq v) => DGraph v e -> [Arc v e]
- Data.Graph.UGraph: fromList :: (Hashable v, Eq v) => [Edge v e] -> UGraph v e
- Data.Graph.UGraph: toList :: (Hashable v, Eq v) => UGraph v e -> [Edge v e]
+ Data.Graph.DGraph: fromArcsList :: (Hashable v, Eq v) => [Arc v e] -> DGraph v e
+ Data.Graph.DGraph: instance Data.Hashable.Class.Hashable v => Data.Semigroup.Semigroup (Data.Graph.DGraph.DGraph v e)
+ Data.Graph.DGraph: instance Data.Hashable.Class.Hashable v => GHC.Base.Monoid (Data.Graph.DGraph.DGraph v e)
+ Data.Graph.DGraph: prettyPrint :: (Hashable v, Eq v, Show v, Show e) => DGraph v e -> String
+ Data.Graph.DGraph: toArcsList :: (Hashable v, Eq v) => DGraph v e -> [Arc v e]
+ Data.Graph.Traversal: bfsVertices :: (Graph g, Hashable v, Eq v, Ord v) => g v e -> v -> [v]
+ Data.Graph.Traversal: dfsVertices :: (Graph g, Hashable v, Eq v, Ord v) => g v e -> v -> [v]
+ Data.Graph.Types: attribute :: IsEdge e => e v a -> a
+ Data.Graph.Types: destinationVertex :: IsEdge e => e v a -> v
+ Data.Graph.Types: edgeTriple :: (Graph g, Hashable v, Eq v) => g v e -> v -> v -> Maybe (v, v, e)
+ Data.Graph.Types: fromList :: (Graph g, Hashable v, Eq v) => [(v, [(v, e)])] -> g v e
+ Data.Graph.Types: fromPair :: IsEdge e => (v, v) -> e v ()
+ Data.Graph.Types: fromTriple :: IsEdge e => (v, v, a) -> e v a
+ Data.Graph.Types: intersection :: Graph g => g v e -> g v e -> g v e
+ Data.Graph.Types: join :: Graph g => g v e -> g v e -> g v e
+ Data.Graph.Types: originVertex :: IsEdge e => e v a -> v
+ Data.Graph.Types: pairToTriple :: (a, b) -> (a, b, ())
+ Data.Graph.Types: toList :: (Graph g, Hashable v, Eq v) => g v e -> [(v, [(v, e)])]
+ Data.Graph.Types: tripleAttribute :: (v, v, e) -> e
+ Data.Graph.Types: tripleDestVertex :: (v, v, e) -> v
+ Data.Graph.Types: tripleOriginVertex :: (v, v, e) -> v
+ Data.Graph.Types: union :: Graph g => g v e -> g v e -> g v e
+ Data.Graph.UGraph: fromEdgesList :: (Hashable v, Eq v) => [Edge v e] -> UGraph v e
+ Data.Graph.UGraph: instance Data.Hashable.Class.Hashable v => Data.Semigroup.Semigroup (Data.Graph.UGraph.UGraph v e)
+ Data.Graph.UGraph: instance Data.Hashable.Class.Hashable v => GHC.Base.Monoid (Data.Graph.UGraph.UGraph v e)
+ Data.Graph.UGraph: prettyPrint :: (Hashable v, Eq v, Show v, Show e) => UGraph v e -> String
+ Data.Graph.UGraph: toEdgesList :: (Hashable v, Eq v) => UGraph v e -> [Edge v e]
- Data.Graph.Types: class Graph g where size = length . edgePairs edgePairs g = tripleToPair <$> edgeTriples g adjacentVertices g v = (\ (_, v', _) -> v') <$> adjacentVertices' g v reachableAdjacentVertices g v = (\ (_, v', _) -> v') <$> reachableAdjacentVertices' g v degrees g = vertexDegree g <$> vertices g maxDegree = maximum . degrees minDegree = minimum . degrees avgDegree g = fromIntegral (2 * size g) / fromIntegral (order g) density g = (2 * (e - n + 1)) / (n * (n - 3) + 2) where n = fromIntegral $ order g e = fromIntegral $ size g insertVertices vs g = foldl' (flip insertVertex) g vs incidentEdgePairs g v = tripleToPair <$> incidentEdgeTriples g v insertEdgeTriples es g = foldl' (flip insertEdgeTriple) g es insertEdgePair (v1, v2) = insertEdgeTriple (v1, v2, ()) insertEdgePairs es g = foldl' (flip insertEdgePair) g es removeVertices vs g = foldl' (flip removeVertex) g vs removeEdgePairs es g = foldl' (flip removeEdgePair) g es removeEdgePairAndVertices (v1, v2) g = removeVertex v2 $ removeVertex v1 $ removeEdgePair (v1, v2) g
+ Data.Graph.Types: class Graph g where size = length . edgePairs density g = (2 * (e - n + 1)) / (n * (n - 3) + 2) where n = fromIntegral $ order g e = fromIntegral $ size g edgePairs g = tripleToPair <$> edgeTriples g adjacentVertices g v = tripleDestVertex <$> adjacentVertices' g v reachableAdjacentVertices g v = tripleDestVertex <$> reachableAdjacentVertices' g v degrees g = vertexDegree g <$> vertices g maxDegree = maximum . degrees minDegree = minimum . degrees avgDegree g = fromIntegral (2 * size g) / fromIntegral (order g) insertVertices vs g = foldl' (flip insertVertex) g vs incidentEdgePairs g v = tripleToPair <$> incidentEdgeTriples g v insertEdgeTriples es g = foldl' (flip insertEdgeTriple) g es insertEdgePair (v1, v2) = insertEdgeTriple (v1, v2, ()) insertEdgePairs es g = foldl' (flip insertEdgePair) g es removeVertices vs g = foldl' (flip removeVertex) g vs removeEdgePairs es g = foldl' (flip removeEdgePair) g es removeEdgePairAndVertices (v1, v2) g = removeVertex v2 $ removeVertex v1 $ removeEdgePair (v1, v2) g fromList links = go links empty where go [] g = g go ((v, es) : rest) g = go rest $ foldr (\ (v', e) g' -> insertEdgeTriple (v, v', e) g') (insertVertex v g) es
- Data.Graph.Visualize: plotDGraph :: (Show e) => DGraph Int e -> IO ()
+ Data.Graph.Visualize: plotDGraph :: (Show e) => DGraph Int e -> IO ThreadId
- Data.Graph.Visualize: plotUGraph :: (Show e) => UGraph Int e -> IO ()
+ Data.Graph.Visualize: plotUGraph :: (Show e) => UGraph Int e -> IO ThreadId
Files
- README.md +8/−9
- benchmark/Main.hs +21/−0
- graphite.cabal +3/−4
- src/Data/Graph/DGraph.hs +50/−12
- src/Data/Graph/Traversal.hs +47/−0
- src/Data/Graph/Types.hs +114/−23
- src/Data/Graph/UGraph.hs +57/−13
- src/Data/Graph/Visualize.hs +6/−4
- test/Data/Graph/UGraphSpec.hs +4/−1
README.md view
@@ -1,17 +1,16 @@-+# graphite - A Haskell graphs and networks library -[](https://hackage.haskell.org/package/graphite)+[](https://hackage.haskell.org/package/graphite) -[](https://circleci.com/gh/alx741/graphite)+[](https://circleci.com/gh/alx741/graphite)+[](http://haskell-graphite.readthedocs.io/) -# graphite+ Represent, analyze and visualize graphs & networks. -# Current state--Most of what you'll find here are *undefined* functions, sort of like a wish-list to be eventually fulfilled.+## Documentation -The basic graph types `UGraph` and `DGraph` could already be used if desired.+* Tutorial (under construction): http://haskell-graphite.readthedocs.io/+* Haddock: https://hackage.haskell.org/package/graphite#modules
benchmark/Main.hs view
@@ -9,14 +9,18 @@ import Data.Graph.Types import Data.Graph.UGraph +import Data.Graph.Traversal+ main = do ug100 <- force <$> erdosRenyi 100 0.3 :: IO (UGraph Int ()) ug500 <- force <$> erdosRenyi 500 0.3 :: IO (UGraph Int ()) ug1000 <- force <$> erdosRenyi 1000 0.3 :: IO (UGraph Int ())+ ug2000 <- force <$> erdosRenyi 2000 0.3 :: IO (UGraph Int ()) dg100 <- force <$> erdosRenyi 100 0.3 :: IO (DGraph Int ()) dg500 <- force <$> erdosRenyi 500 0.3 :: IO (DGraph Int ()) dg1000 <- force <$> erdosRenyi 1000 0.3 :: IO (DGraph Int ())+ dg2000 <- force <$> erdosRenyi 2000 0.3 :: IO (DGraph Int ()) defaultMain [ bgroup "generation"@@ -51,4 +55,21 @@ , bench "order_dg1000" $ nf order dg500 , bench "size_dg1000" $ nf size dg500 ]++ , bgroup "traversal"+ [ bench "bfs_ug100" $ nf (bfsVertices ug100) 1+ , bench "bfs_dg100" $ nf (bfsVertices dg100) 1+ , bench "bfs_ug500" $ nf (bfsVertices ug500) 1+ , bench "bfs_dg500" $ nf (bfsVertices dg500) 1+ , bench "bfs_ug1000" $ nf (bfsVertices ug1000) 1+ , bench "bfs_dg1000" $ nf (bfsVertices dg1000) 1++ , bench "dfs_ug100" $ nf (dfsVertices ug100) 1+ , bench "dfs_dg100" $ nf (dfsVertices dg100) 1+ , bench "dfs_ug500" $ nf (dfsVertices ug500) 1+ , bench "dfs_dg500" $ nf (dfsVertices dg500) 1+ , bench "dfs_ug1000" $ nf (dfsVertices ug1000) 1+ , bench "dfs_dg1000" $ nf (dfsVertices dg1000) 1+ ]+ ]
graphite.cabal view
@@ -1,5 +1,5 @@ name: graphite-version: 0.8.0.0+version: 0.9.0.0 synopsis: Graphs and networks library description: Represent, analyze and visualize graphs homepage: https://github.com/alx741/graphite#readme@@ -18,11 +18,12 @@ exposed-modules: Data.Graph.Types , Data.Graph.Connectivity , Data.Graph.DGraph+ , Data.Graph.DGraph.DegreeSequence , Data.Graph.Generation , Data.Graph.Morphisms , Data.Graph.Read+ , Data.Graph.Traversal , Data.Graph.UGraph- , Data.Graph.DGraph.DegreeSequence , Data.Graph.UGraph.DegreeSequence , Data.Graph.Visualize build-depends: base >= 4.7 && < 5@@ -31,7 +32,6 @@ , cassava , containers , deepseq- , dequeue , graphviz , hashable , process@@ -63,7 +63,6 @@ , graphite , deepseq , criterion- ghc-options: -O2 default-language: Haskell2010 source-repository head
src/Data/Graph/DGraph.hs view
@@ -4,8 +4,9 @@ module Data.Graph.DGraph where -import Data.List (foldl')-import GHC.Generics (Generic)+import Data.List (foldl')+import Data.Semigroup+import GHC.Generics (Generic) import Control.DeepSeq import Data.Hashable@@ -32,6 +33,20 @@ xs <- readPrec return (fromList xs) +instance (Hashable v) => Monoid (DGraph v e) where+ mempty = empty+ mappend = union++instance (Hashable v) => Semigroup (DGraph v e) where+ (<>) = mappend++-- instance (Hashable v, Eq v) => Functor (DGraph v) where+-- fmap f g = fromList $ fmap (\(Arc v1 v2 e) -> Arc v1 v2 (f e)) $ toList g++-- instance (Hashable v, Eq v) => Foldable (DGraph v) where+-- foldMap f g = foldMap f (fmap attribute $ toList g)+-- foldr f acc g = foldr f acc (fmap attribute $ toList g)+ instance (NFData v, NFData e) => NFData (DGraph v e) instance Graph DGraph where@@ -41,6 +56,11 @@ vertices (DGraph _ g) = HM.keys g edgeTriples g = toTriple <$> arcs g + edgeTriple (DGraph _ g) v1 v2 =+ let mAttr = HM.lookup v2 $ getLinks v1 g+ in case mAttr of+ Just attr -> Just (v1, v2, attr)+ Nothing -> Nothing containsVertex (DGraph _ g) = flip HM.member g @@ -51,17 +71,15 @@ (\v' -> containsEdgePair g (v, v') || containsEdgePair g (v', v)) (vertices g) - adjacentVertices' g v = fmap- (\(fromV, toV, e) -> if fromV == v then (fromV, toV, e) else (toV, fromV, e)) $- filter- (\(fromV, toV, _) -> fromV == v || toV == v)- (toTriple <$> toList g)+ adjacentVertices' g v = filter+ (\(fromV, toV, _) -> fromV == v || toV == v)+ (toTriple <$> toArcsList g) reachableAdjacentVertices (DGraph _ g) v = HM.keys (getLinks v g) reachableAdjacentVertices' g v = filter (\(fromV, _, _) -> fromV == v)- (toTriple <$> toList g)+ (toTriple <$> toArcsList g) -- | The total number of inbounding and outbounding 'Arc's of a vertex vertexDegree g v = vertexIndegree g v + vertexOutdegree g v@@ -90,6 +108,15 @@ isSimple g = foldl' go True $ vertices g where go bool v = bool && not (HM.member v $ getLinks v $ unDGraph g) ++ union = undefined+ intersection = undefined+ join = undefined+++ toList (DGraph _ g) = zip vs $ fmap (\v -> HM.toList $ getLinks v g) vs+ where vs = HM.keys g+ fromAdjacencyMatrix m | length m /= length (head m) = Nothing | otherwise = Just $ insertArcs (foldl' genArcs [] labeledM) empty@@ -236,9 +263,20 @@ -- | Convert a 'DGraph' to a list of 'Arc's -- | Same as 'arcs'-toList :: (Hashable v, Eq v) => DGraph v e -> [Arc v e]-toList = arcs+toArcsList :: (Hashable v, Eq v) => DGraph v e -> [Arc v e]+toArcsList = arcs -- | Construct a 'DGraph' from a list of 'Arc's-fromList :: (Hashable v, Eq v) => [Arc v e] -> DGraph v e-fromList as = insertArcs as empty+fromArcsList :: (Hashable v, Eq v) => [Arc v e] -> DGraph v e+fromArcsList as = insertArcs as empty+++-- * Pretty printing++prettyPrint :: (Hashable v, Eq v, Show v, Show e) => DGraph v e -> String+prettyPrint g =+ "Isolated Vertices: "+ <> show (filter (\v -> vertexDegree g v == 0) $ vertices g)+ <> " "+ <> "Arcs: "+ <> show (arcs g)
+ src/Data/Graph/Traversal.hs view
@@ -0,0 +1,47 @@+module Data.Graph.Traversal+ ( bfsVertices+ , dfsVertices+ ) where++import Data.List (foldl')++import Data.Hashable+import qualified Data.Set as S++import Data.Graph.Types++-- | breadh-first-search vertices starting at a particular vertex+bfsVertices :: (Graph g, Hashable v, Eq v, Ord v) => g v e -> v -> [v]+bfsVertices g fromV = go [fromV] S.empty []+ where+ go [] _ popped = popped+ go (v:vs) visited popped =+ let reachables = nonVisitedReachables g visited v+ in go+ (vs ++ reachables)+ (setInsertMany visited $ v : reachables)+ (popped ++ [v])++-- | depth-first-search vertices starting at a particular vertex+dfsVertices :: (Graph g, Hashable v, Eq v, Ord v) => g v e -> v -> [v]+dfsVertices g fromV = go [fromV] S.empty []+ where+ go [] _ popped = popped+ go (v:vs) visited popped =+ let reachables = nonVisitedReachables g visited v+ in go+ (reachables ++ vs)+ (setInsertMany visited $ v : reachables)+ (popped ++ [v])++nonVisitedReachables :: (Graph g, Hashable v, Eq v, Ord v)+ => g v e+ -> S.Set v+ -> v+ -> [v]+nonVisitedReachables g visited v = filter+ (\v' -> not $ S.member v' visited)+ (reachableAdjacentVertices g v)++setInsertMany :: Ord a => S.Set a -> [a] -> S.Set a+setInsertMany = foldl' (flip S.insert)
src/Data/Graph/Types.hs view
@@ -14,6 +14,9 @@ import Test.QuickCheck class Graph g where++ -- * Properties+ -- | The Empty (order-zero) graph with no vertices and no edges empty :: (Hashable v) => g v e @@ -26,6 +29,18 @@ size :: (Hashable v, Eq v) => g v e -> Int size = length . edgePairs + -- | Density of a graph+ -- | The ratio of the number of existing edges in the graph to the number of+ -- | posible edges+ density :: (Hashable v, Eq v) => g v e -> Double+ density g = (2 * (e - n + 1)) / (n * (n - 3) + 2)+ where+ n = fromIntegral $ order g+ e = fromIntegral $ size g+++ -- * Operations+ -- | Retrieve the vertices of a graph vertices :: g v e -> [v] @@ -44,7 +59,7 @@ -- | Retrieve the adjacent vertices of a vertex adjacentVertices :: (Hashable v, Eq v) => g v e -> v -> [v]- adjacentVertices g v = (\(_, v', _) -> v') <$> adjacentVertices' g v+ adjacentVertices g v = tripleDestVertex <$> adjacentVertices' g v -- | Same as 'adjacentVertices' but gives back the connecting edges adjacentVertices' :: (Hashable v, Eq v) => g v e -> v -> [(v, v, e)]@@ -56,7 +71,7 @@ -- | 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 = (\(_, v', _) -> v') <$> reachableAdjacentVertices' g v+ reachableAdjacentVertices g v = tripleDestVertex <$> reachableAdjacentVertices' g v -- | Same as 'reachableAdjacentVertices' but gives back the connecting edges reachableAdjacentVertices' :: (Hashable v, Eq v) => g v e -> v -> [(v, v, e)]@@ -80,15 +95,6 @@ avgDegree :: (Hashable v, Eq v) => g v e -> Double 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- -- | posible edges- density :: (Hashable v, Eq v) => g v e -> Double- density g = (2 * (e - n + 1)) / (n * (n - 3) + 2)- where- n = fromIntegral $ order g- e = fromIntegral $ size g- -- | Insert a vertex into a graph -- | If the graph already contains the vertex leave the graph untouched insertVertex :: (Hashable v, Eq v) => v -> g v e -> g v e@@ -109,6 +115,9 @@ incidentEdgePairs :: (Hashable v, Eq v) => g v e -> v -> [(v, v)] incidentEdgePairs g v = tripleToPair <$> incidentEdgeTriples g v + -- | Get the edge between to vertices if it exists+ edgeTriple :: (Hashable v, Eq v) => g v e -> v -> v -> Maybe (v, v, e)+ -- | 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@@ -153,13 +162,47 @@ -- | A graph is @simple@ if it has no loops isSimple :: (Hashable v, Eq v) => g v e -> Bool - -- | Generate a graph of Int vertices from an adjacency- -- | square matrix- fromAdjacencyMatrix :: [[Int]] -> Maybe (g Int ()) - -- | Get the adjacency matrix representation of a grah+ -- * Binary operations++ -- | Union of two graphs+ union :: g v e -> g v e -> g v e++ -- | Intersection of two graphs+ intersection :: g v e -> g v e -> g v e++ -- | Join two graphs+ -- |+ -- | The @join@ of two graphs G1 and G2 is a new graph where each vertex of+ -- | G1 has an edge to all the vertices of G2+ join :: g v e -> g v e -> g v e+++ -- * Transformations++ -- | Convert a graph to an adjacency list with edge attributes in /e/+ toList :: (Hashable v, Eq v) => g v e -> [(v, [(v, e)])]++ -- | Construct a graph from an adjacency list with edge attributes in /e/+ fromList :: (Hashable v, Eq v) => [(v, [(v, e)])] -> g v e+ fromList links = go links empty+ where+ go [] g = g+ go ((v, es):rest) g = go+ rest $+ foldr+ (\(v', e) g' -> insertEdgeTriple (v, v', e) g')+ (insertVertex v g)+ es++ -- TODO: make this [[Bool]]+ -- | Get the adjacency binary matrix representation of a grah toAdjacencyMatrix :: g v e -> [[Int]] + -- | Generate a graph of Int vertices from an adjacency+ -- | square binary matrix+ fromAdjacencyMatrix :: [[Int]] -> Maybe (g Int ())+ -- | Undirected Edge with attribute of type /e/ between to Vertices of type /v/ data Edge v e = Edge v v e deriving (Show, Read, Ord, Generic)@@ -168,22 +211,42 @@ data Arc v e = Arc v v e deriving (Show, Read, Ord, Generic) --- | Construct an undirected 'Edge' between two vertices+-- | Construct an attributeless undirected 'Edge' between two vertices (<->) :: (Hashable v) => v -> v -> Edge v () (<->) v1 v2 = Edge v1 v2 () --- | Construct a directed 'Arc' between two vertices+-- | Construct an attributeless directed 'Arc' between two vertices (-->) :: (Hashable v) => v -> v -> Arc v () (-->) v1 v2 = Arc v1 v2 () class IsEdge e where- -- | Convert an edge to a pair discargind its attribute+ -- | Retrieve the origin vertex of the edge+ originVertex :: e v a -> v++ -- | Retrieve the destination vertex of the edge+ destinationVertex :: e v a -> v++ -- | Retrieve the attribute of the edge+ attribute :: e v a -> a++ -- * Conversion++ -- | Convert an edge to a pair discarding its attribute toPair :: e v a -> (v, v) + -- | Convert a pair to an edge, where it's attribute is unit+ fromPair :: (v, v) -> e v ()+ -- | Convert an edge to a triple, where the 3rd element it's the edge -- | attribute toTriple :: e v a -> (v, v, a) + -- | Convert a triple to an edge+ fromTriple :: (v, v, a) -> e v a+++ -- * Properties+ -- | 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@@ -192,13 +255,23 @@ instance (NFData v, NFData e) => NFData (Arc v e) instance IsEdge Edge where+ originVertex (Edge v _ _) = v+ destinationVertex (Edge _ v _) = v+ attribute (Edge _ _ e) = e toPair (Edge v1 v2 _) = (v1, v2)+ fromPair (v1, v2) = Edge v1 v2 () toTriple (Edge v1 v2 e) = (v1, v2, e)+ fromTriple (v1, v2, e) = Edge v1 v2 e isLoop (Edge v1 v2 _) = v1 == v2 instance IsEdge Arc where+ originVertex (Arc v _ _) = v+ destinationVertex (Arc _ v _) = v+ attribute (Arc _ _ e) = e toPair (Arc fromV toV _) = (fromV, toV)+ fromPair (fromV, toV) = Arc fromV toV () toTriple (Arc fromV toV e) = (fromV, toV, e)+ fromTriple (fromV, toV, e) = Arc fromV toV e isLoop (Arc v1 v2 _) = v1 == v2 -- | Weighted Edge attributes@@ -235,6 +308,12 @@ instance (Arbitrary v, Arbitrary e, Num v, Ord v) => Arbitrary (Arc v e) where arbitrary = arbitraryEdge Arc +-- | Edges generator+arbitraryEdge :: (Arbitrary v, Arbitrary e, Ord v, Num v)+ => (v -> v -> e -> edge) -> Gen edge+arbitraryEdge edgeType = edgeType <$> vert <*> vert <*> arbitrary+ where vert = getPositive <$> arbitrary+ -- | To 'Edge's are equal if they point to the same vertices, regardless of the -- | direction instance (Eq v, Eq a) => Eq (Edge v a) where@@ -248,16 +327,28 @@ instance (Eq v, Eq a) => Eq (Arc v a) where (Arc v1 v2 a) == (Arc v1' v2' a') = (a == a') && (v1 == v1' && v2 == v2') ++-- * Triples convenience functions+ -- | 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-arbitraryEdge edgeType = edgeType <$> vert <*> vert <*> arbitrary- where vert = getPositive <$> arbitrary+-- | Convert a pair to a triple where the 3rd element is unit+pairToTriple :: (a, b) -> (a, b, ())+pairToTriple (a, b) = (a, b, ()) +-- | Get the origin vertex from an edge triple+tripleOriginVertex :: (v, v, e) -> v+tripleOriginVertex (v, _, _) = v++-- | Get the destination vertex from an edge triple+tripleDestVertex :: (v, v, e) -> v+tripleDestVertex (_, v, _) = v++-- | Get the attribute from an edge triple+tripleAttribute :: (v, v, e) -> e+tripleAttribute (_, _, e) = e
src/Data/Graph/UGraph.hs view
@@ -1,13 +1,15 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE DeriveGeneric #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE ViewPatterns #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE ViewPatterns #-} module Data.Graph.UGraph where -import qualified Data.Foldable as F (toList)-import Data.List (foldl')-import GHC.Generics (Generic)+import qualified Data.Foldable as F (toList)+import Data.List (foldl')+import Data.Semigroup+import GHC.Generics (Generic) import Control.DeepSeq import Data.Hashable@@ -34,6 +36,20 @@ xs <- readPrec return (fromList xs) +instance (Hashable v) => Monoid (UGraph v e) where+ mempty = empty+ mappend = union++instance (Hashable v) => Semigroup (UGraph v e) where+ (<>) = mappend++-- instance (Hashable v, Eq v) => Functor (UGraph v) where+-- fmap f g = fromList $ fmap (\(Edge v1 v2 e) -> Edge v1 v2 (f e)) $ toList g++-- instance (Hashable v, Eq v) => Foldable (UGraph v) where+-- foldMap f g = foldMap f (fmap attribute $ toList g)+-- foldr f acc g = foldr f acc (fmap attribute $ toList g)+ instance (NFData v, NFData e) => NFData (UGraph v e) instance (Arbitrary v, Arbitrary e, Hashable v, Num v, Ord v)@@ -47,10 +63,18 @@ vertices (UGraph _ g) = HM.keys g edgeTriples g = toTriple <$> edges g + edgeTriple (UGraph _ g) v1 v2 =+ let mAttr = HM.lookup v2 $ getLinks v1 g+ in case mAttr of+ Just attr -> Just (v1, v2, attr)+ Nothing -> Nothing+ 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- adjacentVertices' (UGraph _ g) v = fmap (\(toV, e) -> (v, toV, e)) $ HM.toList $ getLinks v g+ adjacentVertices' (UGraph _ g) v = fmap (\(toV, e) -> (v, toV, e)) $+ HM.toList $ getLinks v g+ reachableAdjacentVertices = adjacentVertices reachableAdjacentVertices' = adjacentVertices' vertexDegree (UGraph _ g) v = length $ HM.keys $ getLinks v g@@ -79,6 +103,14 @@ isSimple g = foldl' go True $ vertices g where go bool v = bool && not (HM.member v $ getLinks v $ unUGraph g) ++ union = undefined+ intersection = undefined+ join = undefined++ toList (UGraph _ g) = zip vs $ fmap (\v -> HM.toList $ getLinks v g) vs+ where vs = HM.keys g+ fromAdjacencyMatrix m | length m /= length (head m) = Nothing | otherwise = Just $ insertEdges (foldl' genEdges [] labeledM) empty@@ -145,11 +177,23 @@ -- * Lists --- | Convert a 'UGraph' to a list of 'Edge's--- | Same as 'edges'-toList :: (Hashable v, Eq v) => UGraph v e -> [Edge v e]-toList = edges+-- | Convert a 'UGraph' to a list of 'Edge's ignoring isolated vertices+-- |+-- | Note that: fromEdgesList . toEdgesList /= id+toEdgesList :: (Hashable v, Eq v) => UGraph v e -> [Edge v e]+toEdgesList = edges -- | Construct a 'UGraph' from a list of 'Edge's-fromList :: (Hashable v, Eq v) => [Edge v e] -> UGraph v e-fromList es = insertEdges es empty+fromEdgesList :: (Hashable v, Eq v) => [Edge v e] -> UGraph v e+fromEdgesList es = insertEdges es empty+++-- * Pretty printing++prettyPrint :: (Hashable v, Eq v, Show v, Show e) => UGraph v e -> String+prettyPrint g =+ "Isolated Vertices: "+ <> show (filter (\v -> vertexDegree g v == 0) $ vertices g)+ <> " "+ <> "Edges: "+ <> show (edges g)
src/Data/Graph/Visualize.hs view
@@ -6,6 +6,8 @@ , plotDGraphPng ) where +import Control.Concurrent+ import Data.GraphViz import Data.GraphViz.Attributes.Complete import Data.Hashable@@ -15,16 +17,16 @@ import Data.Graph.UGraph -- | Plot an undirected 'UGraph'-plotUGraph :: (Show e) => UGraph Int e -> IO ()-plotUGraph g = runGraphvizCanvas Sfdp (toUndirectedDot g) Xlib+plotUGraph :: (Show e) => UGraph Int e -> IO ThreadId+plotUGraph g = forkIO $ runGraphvizCanvas Sfdp (toUndirectedDot g) Xlib -- | Plot an undirected 'UGraph' to a PNG image file plotUGraphPng :: (Show e) => UGraph Int e -> FilePath -> IO FilePath plotUGraphPng g = addExtension (runGraphvizCommand Sfdp $ toUndirectedDot g) Png -- | Plot a directed 'DGraph'-plotDGraph :: (Show e) => DGraph Int e -> IO ()-plotDGraph g = runGraphvizCanvas Sfdp (toDirectedDot g) Xlib+plotDGraph :: (Show e) => DGraph Int e -> IO ThreadId+plotDGraph g = forkIO $ runGraphvizCanvas Sfdp (toDirectedDot g) Xlib -- | Plot a directed 'DGraph' to a PNG image file plotDGraphPng :: (Show e) => DGraph Int e -> FilePath -> IO FilePath
test/Data/Graph/UGraphSpec.hs view
@@ -3,8 +3,8 @@ import Test.Hspec import Test.QuickCheck -import Data.Graph.UGraph import Data.Graph.Types+import Data.Graph.UGraph spec :: Spec spec = do@@ -65,3 +65,6 @@ \g v -> (not $ g `containsVertex` v) ==> (removeVertex v $ insertVertex v g) == (g :: UGraph Int ())++ it "Can be represented as a list" $ property $+ \g -> (fromList . toList) g == (g :: UGraph Int ())