packages feed

graphite (empty) → 0.0.1.0

raw patch · 13 files changed

+795/−0 lines, 13 filesdep +QuickCheckdep +basedep +graphitesetup-changed

Dependencies added: QuickCheck, base, graphite, graphviz, hashable, hspec, process, random, unordered-containers

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Daniel Campoverde [alx741] (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Daniel Campoverde [alx741] nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,3 @@+# graphite++An experimental Haskell graph library
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ graphite.cabal view
@@ -0,0 +1,49 @@+name:                graphite+version:             0.0.1.0+synopsis:            Graphs and networks library+description:         Represent, analyze and visualize graphs+homepage:            https://github.com/alx741/graphite#readme+license:             BSD3+license-file:        LICENSE+author:              Daniel Campoverde+maintainer:          alx@sillybytes.net+copyright:           2017 Daniel Campoverde+category:            Data Structures, Graphs+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  hs-source-dirs:      src+  exposed-modules:     Data.Graph.Types+                     , Data.Graph.Graph+                     , Data.Graph.DGraph+                     , Data.Graph.Visualize+                     , Data.Graph.Connectivity+  build-depends:       base >= 4.7 && < 5+                     , hashable+                     , random+                     , process+                     , graphviz+                     , unordered-containers+                     , QuickCheck+  ghc-options:         -Wall+  default-language:    Haskell2010++test-suite graphite-test+  type:                exitcode-stdio-1.0+  hs-source-dirs:      test+  main-is:             Spec.hs+  build-depends:       base+                     , graphite+                     , hspec+                     , QuickCheck+  other-modules:       Data.Graph.TypesSpec+                     , Data.Graph.DGraphSpec+                     , Data.Graph.GraphSpec+  ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++source-repository head+  type:     git+  location: https://github.com/alx741/graphite
+ src/Data/Graph/Connectivity.hs view
@@ -0,0 +1,57 @@+-- | For Connectivity analisis purposes a 'DGraph' can be converted into a+-- | 'Graph' using 'toUndirected'++module Data.Graph.Connectivity where++import Data.Graph.Graph+import Data.Graph.DGraph++-- | Tell if a 'Graph' is connected+-- | An Undirected Graph is @connected@ when there is a path between every pair+-- | of vertices+isConnected :: Graph v e -> Bool+isConnected = undefined++-- | Tell if a 'Graph' is disconnected+-- | An Undirected Graph is @disconnected@ when its not @connected@. See+-- | 'isConnected'+-- TODO: An edgeles graph with two or more vertices is disconnected+isDisconnected :: Graph v e -> Bool+isDisconnected = not . isConnected++-- | Tell if two vertices of a 'Graph' are connected+-- | Two vertices are @connected@ if it exists a path between them+areConnected :: Graph v e -> v -> v -> Bool+areConnected = undefined++-- | Tell if two vertices of a 'Graph' are disconnected+-- | Two vertices are @disconnected@ if it doesn't exist a path between them+areDisconnected :: Graph v e -> v -> v -> Bool+areDisconnected = undefined++-- | Retrieve all the unreachable vertices of a 'Graph'+-- | The @unreachable vertices@ are those with no adjacent 'Edge's+unreachableVertices :: Graph v e -> [v]+unreachableVertices = undefined++-- | Tell if a 'DGraph' is weakly connected+-- | A Directed Graph is @weakly connected@ if the equivalent undirected graph+-- | is @connected@+isWeaklyConnected :: DGraph v e -> Bool+isWeaklyConnected = undefined -- isConnected . toUndirected++-- TODO+-- * connected component+-- * strong components+-- * vertex cut+-- * vertex connectivity+--     * biconnectivity+--     * triconnectivity+--     * separable+-- * bridge+-- * edge-connectivity+-- * maximally connected+-- * maximally edge-connected+-- * super-connectivity+-- * hyper-connectivity+-- * Menger's theorem
+ src/Data/Graph/DGraph.hs view
@@ -0,0 +1,211 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Graph.DGraph where++import Data.List (foldl')++import           Data.Hashable+import qualified Data.HashMap.Lazy as HM+import           Test.QuickCheck++import Data.Graph.Types++-- | Directed Graph of Vertices in /v/ and Arcs with attributes in /e/+newtype DGraph v e = DGraph { unDGraph :: HM.HashMap v (Links v e) }+    deriving (Eq, Show)++instance (Arbitrary v, Arbitrary e, Hashable v, Num v, Ord v)+ => Arbitrary (DGraph v e) where+    arbitrary = insertArcs <$> arbitrary <*> pure empty++-- | The Degree Sequence un a 'DGraph' is a list of pairs (Indegree, Outdegree)+type DegreeSequence = [(Int, Int)]++-- | The Empty (order-zero) 'DGraph' with no vertices and no arcs+empty :: (Hashable v) => DGraph v e+empty = DGraph HM.empty++-- | @O(log n)@ Insert a vertex into a 'DGraph'+-- | If the graph already contains the vertex leave the graph untouched+insertVertex :: (Hashable v, Eq v) => v -> DGraph v e -> DGraph v e+insertVertex v (DGraph g) = DGraph $ hashMapInsert v HM.empty g++-- | @O(n)@ Remove a vertex from a 'DGraph' if present+-- | Every 'Arc' incident to this vertex is also removed+removeVertex :: (Hashable v, Eq v) => v -> DGraph v e -> DGraph v e+removeVertex v g = DGraph+    $ (\(DGraph g') -> HM.delete v g')+    $ foldl' (flip removeArc) g $ incidentArcs g v++-- | @O(m*log n)@ Insert a many vertices into a 'DGraph'+-- | New vertices are inserted and already contained vertices are left untouched+insertVertices :: (Hashable v, Eq v) => [v] -> DGraph v e -> DGraph v e+insertVertices vs g = foldl' (flip insertVertex) g vs++-- | @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+insertArc :: (Hashable v, Eq v) => Arc v e -> DGraph v e -> DGraph v e+insertArc (Arc fromV toV edgeAttr) g = DGraph+    $ 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) => [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+-- | The involved vertices are left untouched+removeArc :: (Hashable v, Eq v) => Arc v e -> DGraph v e -> DGraph v e+removeArc = removeArc' . toOrderedPair++-- | 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) (DGraph g) = case HM.lookup v1 g of+    Nothing -> DGraph g+    Just v1Links -> DGraph $ HM.adjust (const v1Links') v1 g+        where v1Links' = HM.delete v2 v1Links++-- | @O(log n)@ 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 = removeArcAndVertices' . toOrderedPair++-- | Same as 'removeArcAndVertices' but the arc is an ordered pair+removeArcAndVertices' :: (Hashable v, Eq v) => (v, v) -> DGraph v e -> DGraph v e+removeArcAndVertices' (v1, v2) g =+    removeVertex v2 $ removeVertex v1 $ removeArc' (v1, v2) g++-- | @O(n)@ Retrieve the vertices of a 'DGraph'+vertices :: DGraph v e -> [v]+vertices (DGraph g) = HM.keys g++-- | @O(n)@ Retrieve the order of a 'DGraph'+-- | The @order@ of a graph is its number of vertices+order :: DGraph v e -> Int+order (DGraph g) = HM.size g++-- | @O(n*m)@ Retrieve the size of a 'DGraph'+-- | The @size@ of a directed graph is its number of 'Arc's+size :: (Hashable v, Eq v) => DGraph v e -> Int+size = length . arcs++-- | @O(n*m)@ Retrieve the 'Arc's of a 'DGraph'+arcs :: forall v e . (Hashable v, Eq v) => DGraph v e -> [Arc v e]+arcs (DGraph g) = linksToArcs $ zip vs links+    where+        vs :: [v]+        vs = vertices $ DGraph g+        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 = toOrderedPair <$> arcs g++-- | @O(log n)@ Tell if a vertex exists in the graph+containsVertex :: (Hashable v, Eq v) => DGraph v e -> v -> Bool+containsVertex (DGraph g) = flip HM.member g++-- | @O(log n)@ 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 . toOrderedPair++-- | 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++-- | Retrieve the inbounding 'Arc's of a Vertex+inboundingArcs :: (Hashable v, Eq v) => DGraph v e -> v -> [Arc v e]+inboundingArcs g v = filter (\(Arc _ toV _) -> v == toV) $ arcs g++-- | Retrieve the outbounding 'Arc's of a Vertex+outboundingArcs :: (Hashable v, Eq v) => DGraph v e -> v -> [Arc v e]+outboundingArcs g v = filter (\(Arc fromV _ _) -> v == fromV) $ arcs g++-- | Retrieve the incident 'Arc's of a Vertex+-- | Both inbounding and outbounding arcs+incidentArcs :: (Hashable v, Eq v) => DGraph v e -> v -> [Arc v e]+incidentArcs g v = inboundingArcs g v ++ outboundingArcs g v++-- | Retrieve the adjacent vertices of a vertex+adjacentVertices :: DGraph v e -> v -> [v]+adjacentVertices = undefined++-- | Tell if a 'DGraph' is symmetric+-- | All of its 'Arc's are bidirected+isSymmetric :: DGraph v e -> Bool+isSymmetric = undefined++-- | Tell if a 'DGraph' is oriented+-- | There are none bidirected 'Arc's+-- | Note: This is /not/ the opposite of 'isSymmetric'+isOriented :: DGraph v e -> Bool+isOriented = undefined++-- | Tell if a 'DGraph' is isolated+-- | A graph is @isolated@ if it has no edges, that is, it has a degree of 0+-- | TODO: What if it has a loop?+isIsolated :: DGraph v e -> Bool+isIsolated = undefined++-- | Degree of a vertex+-- | The total number of inbounding and outbounding 'Arc's of a vertex+vertexDegree :: DGraph v e -> v -> Int+vertexDegree g v = vertexIndegree g v + vertexOutdegree g v++-- | Indegree of a vertex+-- | The number of inbounding 'Arc's to a vertex+vertexIndegree :: DGraph v e -> v -> Int+vertexIndegree = undefined++-- | Outdegree of a vertex+-- | The number of outbounding 'Arc's from a vertex+vertexOutdegree :: DGraph v e -> v -> Int+vertexOutdegree = undefined++-- | Indegrees of all the vertices in a 'DGraph'+indegrees :: DGraph v e -> [Int]+indegrees = undefined++-- | Outdegree of all the vertices in a 'DGraph'+outdegrees :: DGraph v e -> [Int]+outdegrees = undefined++-- | Tell if a 'DGraph' is balanced+-- | A Directed Graph is @balanced@ when its @indegree = outdegree@+isBalanced :: DGraph v e -> Bool+isBalanced g = sum (indegrees g) == sum (outdegrees g)++-- | Tell if a 'DGraph' is regular+-- | A Directed Graph is @regular@ when all of its vertices have the same number+-- | of adjacent vertices AND when the @indegree@ and @outdegree@ of each vertex+-- | are equal to each toher.+isRegular :: DGraph v e -> Bool+isRegular _ = undefined++-- | Tell if a vertex is a source+-- | A vertex is a @source@ when its @indegree = 0@+isSource :: DGraph v e -> v -> Bool+isSource g v = vertexIndegree g v == 0++-- | Tell if a vertex is a sink+-- | A vertex is a @sink@ when its @outdegree = 0@+isSink :: DGraph v e -> v -> Bool+isSink g v = vertexOutdegree g v == 0++-- | Tell if a vertex is internal+-- | A vertex is a @internal@ when its neither a @source@ nor a @sink@+isInternal :: DGraph v e -> v -> Bool+isInternal g v = not $ isSource g v || isSink g v++-- | Tell if a 'DegreeSequence' is a Directed Graphic+-- | A @Directed Graphic@ is a Degree Sequence for wich a 'DGraph' exists+-- TODO: Kleitman–Wang | Fulkerson–Chen–Anstee theorem algorithms+isDirectedGraphic :: DegreeSequence -> Bool+isDirectedGraphic = undefined
+ src/Data/Graph/Graph.hs view
@@ -0,0 +1,188 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Graph.Graph where++import Control.Monad (replicateM)+import Data.List     (foldl')+import Data.Maybe    (fromMaybe)+import System.Random++import           Data.Hashable+import qualified Data.HashMap.Lazy as HM+import           Test.QuickCheck++import Data.Graph.Types++-- | Undirected Graph of Vertices in /v/ and Edges with attributes in /e/+newtype Graph v e = Graph { unGraph :: HM.HashMap v (Links v e) }+    deriving (Eq, Show)++instance (Arbitrary v, Arbitrary e, Hashable v, Num v, Ord v)+ => Arbitrary (Graph v e) where+    arbitrary = insertEdges <$> arbitrary <*> pure empty++-- | Generate a random 'Graph' of @n@ vertices+randomGraphIO :: Int -> IO (Graph Int ())+randomGraphIO n = replicateM n randRow+    >>= (\m -> return $ fromMaybe empty (fromAdjacencyMatrix m))+    where randRow = replicateM n (randomRIO (0,1)) :: IO [Int]++-- | The Empty (order-zero) 'Graph' with no vertices and no edges+empty :: (Hashable v) => Graph v e+empty = Graph HM.empty++-- | @O(log n)@ Insert a vertex into a 'Graph'+-- | If the graph already contains the vertex leave the graph untouched+insertVertex :: (Hashable v, Eq v) => v -> Graph v e -> Graph v e+insertVertex v (Graph g) = Graph $ hashMapInsert v HM.empty g++-- | @O(n)@ Remove a vertex from a 'Graph' if present+-- | Every 'Edge' incident to this vertex is also removed+removeVertex :: (Hashable v, Eq v) => v -> Graph v e -> Graph v e+removeVertex v g = Graph+    $ (\(Graph g') -> HM.delete v g')+    $ foldl' (flip removeEdge) g $ incidentEdges g v++-- | @O(m*log n)@ Insert a many vertices into a 'Graph'+-- | New vertices are inserted and already contained vertices are left untouched+insertVertices :: (Hashable v, Eq v) => [v] -> Graph v e -> Graph v e+insertVertices vs g = foldl' (flip insertVertex) g vs++-- | @O(log n)@ Insert an undirected 'Edge' into a 'Graph'+-- | The involved vertices are inserted if don't exist. If the graph already+-- | contains the Edge, its attribute is updated+insertEdge :: (Hashable v, Eq v) => Edge v e -> Graph v e -> Graph v e+insertEdge (Edge v1 v2 edgeAttr) g = Graph $ link v2 v1 $ link v1 v2 g'+    where+        g' = unGraph $ insertVertices [v1, v2] g+        link fromV toV = HM.adjust (insertLink toV edgeAttr) fromV++-- | @O(m*log n)@ Insert many directed 'Edge's into a 'Graph'+-- | Same rules as 'insertEdge' are applied+insertEdges :: (Hashable v, Eq v) => [Edge v e] -> Graph v e -> Graph v e+insertEdges as g = foldl' (flip insertEdge) g as++-- | @O(log n)@ Remove the undirected 'Edge' from a 'Graph' if present+-- | The involved vertices are left untouched+removeEdge :: (Hashable v, Eq v) => Edge v e -> Graph v e -> Graph v e+removeEdge = removeEdge' . toUnorderedPair++-- | Same as 'removeEdge' but the edge is an unordered pair+removeEdge' :: (Hashable v, Eq v) => (v, v) -> Graph v e -> Graph v e+removeEdge' (v1, v2) graph@(Graph g)+    | containsVertex graph v1 && containsVertex graph v2 =+        Graph $ update v2Links v2 $ update v1Links v1 g+    | otherwise = Graph g+    where+        v1Links = HM.delete v2 $ getLinks v1 g+        v2Links = HM.delete v1 $ getLinks v2 g+        update = HM.adjust . const++-- | @O(log n)@ Remove the undirected 'Edge' from a 'Graph' if present+-- | The involved vertices are also removed+removeEdgeAndVertices :: (Hashable v, Eq v) => Edge v e -> Graph v e -> Graph v e+removeEdgeAndVertices = removeEdgeAndVertices' . toUnorderedPair++-- | Same as 'removeEdgeAndVertices' but the edge is an unordered pair+removeEdgeAndVertices' :: (Hashable v, Eq v) => (v, v) -> Graph v e -> Graph v e+removeEdgeAndVertices' (v1, v2) g =+    removeVertex v2 $ removeVertex v1 $ removeEdge' (v1, v2) g++-- | @O(n)@ Retrieve the vertices of a 'Graph'+vertices :: Graph v e -> [v]+vertices (Graph g) = HM.keys g++-- | @O(n)@ Retrieve the order of a 'Graph'+-- | The @order@ of a graph is its number of vertices+order :: Graph v e -> Int+order (Graph g) = HM.size g++-- | @O(n*m)@ Retrieve the size of a 'Graph'+-- | The @size@ of an undirected graph is its number of 'Edge's+size :: (Hashable v, Eq v) => Graph v e -> Int+size = length . edges++-- | @O(n*m)@ Retrieve the 'Edge's of a 'Graph'+edges :: forall v e . (Hashable v, Eq v) => Graph v e -> [Edge v e]+edges (Graph g) = linksToEdges $ zip vs links+    where+        vs :: [v]+        vs = vertices $ Graph g+        links :: [Links v e]+        links = fmap (`getLinks` g) vs++-- | Same as 'edges' but the edges are unordered pairs, and their attributes+-- | are discarded+edges' :: (Hashable v, Eq v) => Graph v e -> [(v, v)]+edges' g = toUnorderedPair <$> edges g++-- | @O(log n)@ Tell if a vertex exists in the graph+containsVertex :: (Hashable v, Eq v) => Graph v e -> v -> Bool+containsVertex (Graph g) = flip HM.member g++-- | @O(log n)@ Tell if an undirected 'Edge' exists in the graph+containsEdge :: (Hashable v, Eq v) => Graph v e -> Edge v e -> Bool+containsEdge g = containsEdge' g . toUnorderedPair++-- | Same as 'containsEdge' but the edge is an unordered pair+containsEdge' :: (Hashable v, Eq v) => Graph v e -> (v, v) -> Bool+containsEdge' graph@(Graph g) (v1, v2) =+    containsVertex graph v1 && containsVertex graph v2 && v2 `HM.member` v1Links+    where v1Links = getLinks v1 g++-- | Retrieve the incident 'Edge's of a Vertex+incidentEdges :: (Hashable v, Eq v) => Graph v e -> v -> [Edge v e]+incidentEdges g v = filter (\(Edge v1 v2 _) -> v == v1 || v == v2) $ edges g++-- | Degree of a vertex+-- | The total number incident 'Edge's of a vertex+vertexDegree :: (Hashable v, Eq v) => Graph v e -> v -> Int+vertexDegree g = length . incidentEdges g++-- | Degrees of a all the vertices in a 'Graph'+degrees :: (Hashable v, Eq v) => Graph v e -> [Int]+degrees g = vertexDegree g <$> vertices g++-- | Maximum degree of a 'Graph'+maxDegree :: (Hashable v, Eq v) => Graph v e -> Int+maxDegree = maximum . degrees++-- | Minimum degree of a 'Graph'+minDegree :: (Hashable v, Eq v) => Graph v e -> Int+minDegree = minimum . degrees++-- | Tell if an 'Edge' forms a loop+-- | An 'Edge' forms a loop with both of its ends point to the same vertex+isLoop :: (Eq v) => Edge v e -> Bool+isLoop (Edge v1 v2 _) = v1 == v2++-- | Tell if a 'Graph' is simple+-- | A 'Graph' is @simple@ if it has no multiple edges nor loops+isSimple :: (Hashable v, Eq v) => Graph v e -> Bool+isSimple = not . any isLoop . edges++-- | Tell if a 'Graph' is regular+-- | An Undirected Graph is @regular@ when all of its vertices have the same+-- | number of adjacent vertices+isRegular :: Graph v e -> Bool+isRegular = undefined++-- | Generate a directed 'Graph' of Int vertices from an adjacency+-- | square matrix+fromAdjacencyMatrix :: [[Int]] -> Maybe (Graph Int ())+fromAdjacencyMatrix m+    | length m /= length (head m) = Nothing+    | otherwise = Just $ insertEdges (foldl genEdges [] labeledM) empty+        where+            labeledM :: [(Int, [(Int, Int)])]+            labeledM = zip [1..] $ fmap (zip [1..]) m++            genEdges :: [Edge Int ()] -> (Int, [(Int, Int)]) -> [Edge Int ()]+            genEdges es (i, vs) = es ++ fmap (\v -> Edge i v ()) connected+                where connected = fst <$> filter (\(_, v) -> v /= 0) vs++-- | Get the adjacency matrix representation of a directed 'Graph'+toAdjacencyMatrix :: Graph v e -> [[Int]]+toAdjacencyMatrix = undefined
+ src/Data/Graph/Types.hs view
@@ -0,0 +1,124 @@+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Graph.Types where++import Data.List (nubBy)+import GHC.Float (float2Double)++import           Data.Hashable+import qualified Data.HashMap.Lazy as HM+import           Test.QuickCheck++-- | 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)++-- | Directed Arc with attribute of type /e/ between to Vertices of type /v/+data Arc v e = Arc v v e+    deriving (Show, Read, Ord)++-- | Each vertex maps to a 'Links' value so it can poit to other vertices+type Links v e = HM.HashMap v e++-- | 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+    (Edge v1 v2 a) == (Edge v1' v2' a') =+        (a == a')+        && (v1 == v1' && v2 == v2')+        || (v1 == v2' && v2 == v1')++-- | To 'Arc's are equal if they point to the same vertices, and the directions+-- | is the same+instance (Eq v, Eq a) => Eq (Arc v a) where+    (Arc v1 v2 a) == (Arc v1' v2' a') = (a == a') && (v1 == v1' && v2 == v2')++-- | Weighted Edge attributes+-- | Useful for computing some algorithms on graphs+class Weighted a where+    weight :: a -> Double++-- | Labeled Edge attributes+-- | Useful for graph plotting+class Labeled a where+    label :: a -> String++instance Weighted Int where+    weight = fromIntegral++instance Weighted Float where+    weight = float2Double++instance Weighted Double where+    weight = id++instance Labeled String where+    label = id++instance Weighted (Double, String) where+    weight = fst++instance Labeled (Double, String) where+    label = snd++instance (Arbitrary v, Arbitrary e, Num v, Ord v) => Arbitrary (Edge v e) where+    arbitrary = arbitraryEdge Edge++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++-- | Construct an undirected 'Edge' between two vertices+(<->) :: (Hashable v) => v -> v -> Edge v ()+(<->) v1 v2 = Edge v1 v2 ()++-- | Construct a directed 'Arc' between two vertices+(-->) :: (Hashable v) => v -> v -> Arc v ()+(-->) v1 v2 = Arc v1 v2 ()++-- | Convert an 'Arc' to an ordered pair discarding its attribute+toOrderedPair :: Arc v a -> (v, v)+toOrderedPair (Arc fromV toV _) = (fromV, toV)++-- | Convert an 'Edge' to an unordered pair discarding its attribute+toUnorderedPair :: Edge v a -> (v, v)+toUnorderedPair (Edge v1 v2 _) = (v1, v2)++-- | Insert a link directed to *v* with attribute *a*+-- | If the connnection already exists, the attribute is replaced+insertLink :: (Hashable v, Eq v) => v -> a -> Links v a -> Links v a+insertLink = HM.insert++-- | Get the links for a given vertex+getLinks :: (Hashable v, Eq v) => v -> HM.HashMap v (Links v e) -> Links v e+getLinks = HM.lookupDefault HM.empty++-- | 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+    where+        toArc :: (v, Links v a) -> [Arc v a]+        toArc (fromV, links) = fmap (\(v, a) -> Arc 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 ls = nubBy shallowEdgeEq $ concat $ fmap toEdge ls+    where+        toEdge :: (v, Links v a) -> [Edge v a]+        toEdge (fromV, links) = fmap (\(v, a) -> Edge fromV v a) (HM.toList links)+        shallowEdgeEq (Edge v1 v2 _) (Edge v1' v2' _) =+               (v1 == v1' && v2 == v2')+            || (v1 == v2' && v2 == v1')++-- | 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+-- | intact.+hashMapInsert :: (Eq k, Hashable k) => k -> v -> HM.HashMap k v -> HM.HashMap k v+hashMapInsert k v m = if not (HM.member k m) then HM.insert k v m else m
+ src/Data/Graph/Visualize.hs view
@@ -0,0 +1,40 @@+module Data.Graph.Visualize+    ( plotIO+    , plotXdgIO+    ) where++import Data.GraphViz+import Data.GraphViz.Attributes.Complete+import Data.Hashable+import Data.Monoid                       ((<>))+import System.Process++import qualified Data.Graph.Graph as G+import           Data.Graph.Types++-- | Plot an undirected 'Graph' to a PNG image file+plotIO :: (Show e) => G.Graph Int e -> FilePath -> IO FilePath+plotIO g fp = addExtension (runGraphvizCommand Sfdp $ toDot' g) Png fp++-- | Same as 'plotIO' but open the resulting image with /xdg-open/+plotXdgIO :: (Show e) => G.Graph Int e -> FilePath -> IO ()+plotXdgIO g fp = do+    fp' <- plotIO g fp+    _ <- system $ "xdg-open " <> fp'+    return ()++labeledNodes :: (Show v) => G.Graph v e -> [(v, String)]+labeledNodes g = fmap (\v -> (v, show v)) $ G.vertices g++labeledEdges :: (Hashable v, Eq v, Show e) => G.Graph v e -> [(v, v, String)]+labeledEdges g = fmap (\(Edge v1 v2 attr) -> (v1, v2, show attr)) $ G.edges g++toDot' :: (Show e) => G.Graph Int e -> DotGraph Int+toDot' g = graphElemsToDot params (labeledNodes g) (labeledEdges g)+    where params = nonClusteredParams+            { isDirected = False+            , globalAttributes = [GraphAttrs+                [ NodeSep 1, Overlap ScaleOverlaps+                , Shape Circle+                ]]+            }
+ test/Data/Graph/DGraphSpec.hs view
@@ -0,0 +1,34 @@+module Data.Graph.DGraphSpec where++import Test.Hspec+import Test.QuickCheck++import Data.Graph.DGraph+import Data.Graph.Types++spec :: Spec+spec = do+    describe "Directed Graph (DGraph)" $ do+        it "Can tell if a vertex exists" $ property $ do+            let g = insertVertex 1 empty :: DGraph Int ()+            let g' = insertVertex 2 empty :: DGraph Int ()+            containsVertex g 1 `shouldBe` True+            containsVertex g' 1 `shouldBe` False++        it "Can tell if an arc exists" $ property $ do+            let g = insertArc (1 --> 2) empty :: DGraph Int ()+            let g' = insertArc (2 --> 1) empty :: DGraph Int ()+            containsArc g (1 --> 2) `shouldBe` True+            containsArc g' (1 --> 2) `shouldBe` False++        it "Increments its order when a new vertex is inserted" $ property $+            \g v -> (not $ g `containsVertex` v)+                ==> order g + 1 == order (insertVertex v (g :: DGraph Int ()))+        it "Increments its size when a new arc is inserted" $ property $+            \g arc -> (not $ g `containsArc` arc)+                ==> size g + 1 == size (insertArc arc (g :: DGraph Int ()))++        it "Is id when inserting and removing a new vertex" $ property $+            \g v -> (not $ g `containsVertex` v)+                ==> ((removeVertex v . insertVertex v) g)+                    == (g :: DGraph Int ())
+ test/Data/Graph/GraphSpec.hs view
@@ -0,0 +1,38 @@+module Data.Graph.GraphSpec where++import Test.Hspec+import Test.QuickCheck++import Data.Graph.Graph+import Data.Graph.Types++spec :: Spec+spec = do+    describe "Undirected Graph (Graph)" $ do+        it "Can tell if a vertex exists" $ property $ do+            let g = insertVertex 1 empty :: Graph Int ()+            let g' = insertVertex 2 empty :: Graph Int ()+            containsVertex g 1 `shouldBe` True+            containsVertex g' 1 `shouldBe` False++        it "Can tell if an edge exists" $ property $ do+            let g = insertEdge (1 <-> 2) empty :: Graph Int ()+            containsEdge g (1 <-> 2) `shouldBe` True++        it "Stores symetrical edges" $ property $ do+            let g = insertEdge (2 <-> 1) $ insertEdge (1 <-> 2) empty :: Graph Int ()+            containsEdge g (1 <-> 2) `shouldBe` True+            containsEdge g (2 <-> 1) `shouldBe` True+            length (edges g) `shouldBe` 1++        it "Increments its order when a new vertex is inserted" $ property $+            \g v -> (not $ g `containsVertex` v)+                ==> order g + 1 == order (insertVertex v (g :: Graph Int ()))+        it "Increments its size when a new edge is inserted" $ property $+            \g edge -> (not $ g `containsEdge` edge)+                ==> size g + 1 == size (insertEdge edge (g :: Graph Int ()))++        it "Is id when inserting and removing a new vertex" $ property $+            \g v -> (not $ g `containsVertex` v)+                ==> ((removeVertex v . insertVertex v) g)+                    == (g :: Graph Int ())
+ test/Data/Graph/TypesSpec.hs view
@@ -0,0 +1,18 @@+module Data.Graph.TypesSpec where++import Test.Hspec+import Test.QuickCheck++import Data.Graph.Types++spec :: Spec+spec = do+    describe "Undirected Edge" $ do+        it "Satisfies equality for two vertices regardless of their order" $ property $+            \(Edge v1 v2 ()) -> (v1 <-> v2) == ((v2 <-> v1) :: Edge Int ())++    describe "Directed Arc" $ do+        it "Satisfies equality for two vertices when order is preserved" $ property $+            \(Arc v1 v2 ()) -> (v1 --> v2) == ((v1 --> v2) :: Arc Int ())+        it "Fails equality for two vertices when order is reversed" $ property $+            \(Arc v1 v2 ()) -> (v1 /= v2) ==> (v1 --> v2) == ((v1 --> v2) :: Arc Int ())
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}