packages feed

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 view
@@ -1,17 +1,16 @@-![Graphite Logo](./logo/logo.png)+# graphite - A Haskell graphs and networks library -[![](https://img.shields.io/hackage/v/graphite.svg)](https://hackage.haskell.org/package/graphite)+[![Hackage](https://img.shields.io/hackage/v/graphite.svg)](https://hackage.haskell.org/package/graphite) ![Hackage-Deps](https://img.shields.io/hackage-deps/v/graphite.svg)-[![CircleCI](https://circleci.com/gh/alx741/graphite.svg?style=svg)](https://circleci.com/gh/alx741/graphite)+[![CircleCI](https://img.shields.io/circleci/project/github/alx741/graphite.svg)](https://circleci.com/gh/alx741/graphite)+[![Docs](https://readthedocs.org/projects/haskell-graphite/badge/?version=latest)](http://haskell-graphite.readthedocs.io/) -# graphite+![Graphite Logo](./logo/logo.png)  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 ())