graphite 0.0.2.0 → 0.2.0.0

raw patch · 9 files changed

+399/−380 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• graphite.cabal +3/−3
• src/Data/Graph/Connectivity.hs +12/−12
• src/Data/Graph/DGraph.hs +32/−45
• src/Data/Graph/Graph.hs +0/−249
• src/Data/Graph/Types.hs +112/−25
• src/Data/Graph/UGraph.hs +194/−0
• src/Data/Graph/Visualize.hs +8/−8
• test/Data/Graph/GraphSpec.hs +0/−38
• test/Data/Graph/UGraphSpec.hs +38/−0

@@ -1,5 +1,5 @@ name:                graphite-version:             0.0.2.0+version:             0.2.0.0 synopsis:            Graphs and networks library description:         Represent, analyze and visualize graphs homepage:            https://github.com/alx741/graphite#readme@@ -16,7 +16,7 @@ library   hs-source-dirs:      src   exposed-modules:     Data.Graph.Types-                     , Data.Graph.Graph+                     , Data.Graph.UGraph                      , Data.Graph.DGraph                      , Data.Graph.Visualize                      , Data.Graph.Connectivity@@ -40,7 +40,7 @@                      , QuickCheck   other-modules:       Data.Graph.TypesSpec                      , Data.Graph.DGraphSpec-                     , Data.Graph.GraphSpec+                     , Data.Graph.UGraphSpec   ghc-options:         -threaded -rtsopts -with-rtsopts=-N   default-language:    Haskell2010 

@@ -1,37 +1,37 @@ -- | For Connectivity analisis purposes a 'DGraph' can be converted into a--- | 'Graph' using 'toUndirected'+-- | 'UGraph using 'toUndirected'  module Data.Graph.Connectivity where -import Data.Graph.Graph+import Data.Graph.UGraph import Data.Graph.DGraph --- | Tell if a 'Graph' is connected+-- | Tell if a 'UGraph is connected -- | An Undirected Graph is @connected@ when there is a path between every pair -- | of vertices-isConnected :: Graph v e -> Bool+isConnected :: UGraph v e -> Bool isConnected = undefined --- | Tell if a 'Graph' is disconnected+-- | Tell if a 'UGraph 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 :: UGraph v e -> Bool isDisconnected = not . isConnected --- | Tell if two vertices of a 'Graph' are connected+-- | Tell if two vertices of a 'UGraph are connected -- | Two vertices are @connected@ if it exists a path between them-areConnected :: Graph v e -> v -> v -> Bool+areConnected :: UGraph v e -> v -> v -> Bool areConnected = undefined --- | Tell if two vertices of a 'Graph' are disconnected+-- | Tell if two vertices of a 'UGraph are disconnected -- | Two vertices are @disconnected@ if it doesn't exist a path between them-areDisconnected :: Graph v e -> v -> v -> Bool+areDisconnected :: UGraph v e -> v -> v -> Bool areDisconnected = undefined --- | Retrieve all the unreachable vertices of a 'Graph'+-- | Retrieve all the unreachable vertices of a 'UGraph -- | The @unreachable vertices@ are those with no adjacent 'Edge's-unreachableVertices :: Graph v e -> [v]+unreachableVertices :: UGraph v e -> [v] unreachableVertices = undefined  -- | Tell if a 'DGraph' is weakly connected

@@ -15,6 +15,34 @@ newtype DGraph v e = DGraph { unDGraph :: HM.HashMap v (Links v e) }     deriving (Eq, Show) +instance Graph DGraph where+    empty = DGraph HM.empty+    order (DGraph g) = HM.size g+    size = length . arcs+    vertices (DGraph g) = HM.keys g+    edgePairs = arcs'++    containsVertex (DGraph g) = flip HM.member g+    adjacentVertices = undefined++    -- | The total number of inbounding and outbounding 'Arc's of a vertex+    vertexDegree g v = vertexIndegree g v + vertexOutdegree g v++    insertVertex v (DGraph g) = DGraph $ hashMapInsert v HM.empty g+    insertVertices vs g = foldl' (flip insertVertex) g vs++    containsEdgePair = containsArc'+    incidentEdgePairs g v = fmap toPair $ incidentArcs g v+    insertEdgePair (v1, v2) g = insertArc (Arc v1 v2 ()) g+    removeEdgePair = removeArc'+    removeEdgePairAndVertices = removeArcAndVertices'++    isSimple = undefined+    isRegular = undefined++    fromAdjacencyMatrix = undefined+    toAdjacencyMatrix = undefined+ -- | The Degree Sequence of a 'DGraph' is a list of pairs (Indegree, Outdegree) type DegreeSequence = [(Int, Int)] @@ -22,15 +50,6 @@  => Arbitrary (DGraph v e) where     arbitrary = insertArcs <$> arbitrary <*> pure empty --- | 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@@ -38,11 +57,6 @@     $ (\(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@@ -59,7 +73,7 @@ -- | @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+removeArc = removeArc' . toPair  -- | Same as 'removeArc' but the arc is an ordered pair removeArc' :: (Hashable v, Eq v) => (v, v) -> DGraph v e -> DGraph v e@@ -71,27 +85,13 @@ -- | @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+removeArcAndVertices = removeArcAndVertices' . toPair  -- | 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@@ -104,15 +104,11 @@ -- | 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+arcs' g = toPair <$> arcs 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+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@@ -133,10 +129,6 @@ 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@@ -153,11 +145,6 @@ -- | 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

@@ -1,249 +0,0 @@-{-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE ScopedTypeVariables #-}--module Data.Graph.Graph where--import Control.Monad (replicateM)-import Data.List     (foldl', reverse, sort)-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---- | Probability value between 0 and 1-newtype Probability = P Float deriving (Eq, Ord, Show)---- | Construct a 'Probability' value-probability :: Float -> Probability-probability v | v >= 1 = P 1 | v <= 0 = P 0 | otherwise = P v---- | Generate a random 'Graph' of the Erdős–Rényi G(n, p) model-erdosRenyiIO :: Int -> Probability -> IO (Graph Int ())-erdosRenyiIO n (P p) = go [1..n] p empty-    where-        go :: [Int] -> Float -> Graph Int () -> IO (Graph Int ())-        go [] _ g = return g-        go (v:vs) pv g = do-            rnds <- randomRs (0.0, 1.0) <$> newStdGen-            let vs' = zip rnds vs-            go vs pv $! (foldl' (putV pv v) g vs')--        putV :: Float -> Int -> Graph Int () -> (Float, Int) -> Graph Int ()-        putV pv v g (p', v') | p' < pv = insertEdge (v <-> v') g | otherwise = g---randomMatIO :: Int -> IO [[Int]]-randomMatIO n = replicateM n randRow-    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 es g = foldl' (flip insertEdge) g es---- | @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 adjacent vertices of a vertex-adjacentVertices :: (Hashable v, Eq v) => Graph v e -> v -> [v]-adjacentVertices (Graph g) v = HM.keys $ getLinks v g---- | Retrieve the incident 'Edge's of a Vertex-incidentEdges :: (Hashable v, Eq v) => Graph v e -> v -> [Edge v e]-incidentEdges (Graph g) v = fmap (uncurry (Edge v)) (HM.toList (getLinks v 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 (Graph g) v = length $ HM.keys $ getLinks v 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 g = foldl' go True $ vertices g-    where go bool v = bool && (not $ HM.member v $ getLinks v $ unGraph g)---- | 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---- | Tell if two 'Graph's are isomorphic-areIsomorphic :: Graph v e -> Graph v' e' -> Bool-areIsomorphic = undefined--isomorphism :: Graph v e -> Graph v' e' -> (v -> v')-isomorphism = 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----- | The Degree Sequence of a simple 'Graph' is a list of degrees-newtype DegreeSequence = DegreeSequence { unDegreeSequence :: [Int]}-    deriving (Eq, Ord, Show)---- | Construct a 'DegreeSequence' from a list of degrees--- | Negative degree values are discarded-degreeSequence :: [Int] -> DegreeSequence-degreeSequence = DegreeSequence . reverse . sort . filter (>0)---- | Get the 'DegreeSequence' of a simple 'Graph'--- | If the graph is not @simple@ (see 'isSimple') the result is Nothing-getDegreeSequence :: (Hashable v, Eq v) => Graph v e -> Maybe DegreeSequence-getDegreeSequence g-    | (not . isSimple) g = Nothing-    | otherwise = Just $ degreeSequence $ degrees g---- | Tell if a 'DegreeSequence' is a Graphical Sequence--- | A Degree Sequence is a @Graphical Sequence@ if a corresponding 'Graph' for--- | it exists-isGraphicalSequence :: DegreeSequence -> Bool-isGraphicalSequence = even . length . filter odd . unDegreeSequence---- | Get the corresponding 'Graph' of a 'DegreeSequence'--- | If the 'DegreeSequence' is not graphical (see 'isGraphicalSequence') the--- | result is Nothing-fromGraphicalSequence :: DegreeSequence -> Maybe (Graph Int ())-fromGraphicalSequence = undefined

@@ -10,6 +10,76 @@ import qualified Data.HashMap.Lazy as HM import           Test.QuickCheck +class Graph g where+    -- | The Empty (order-zero) graph with no vertices and no edges+    empty :: (Hashable v) => g v e++    -- | Retrieve the order of a graph+    -- | The @order@ of a graph is its number of vertices+    order :: g v e -> Int++    -- | Retrieve the size of a graph+    -- | The @size@ of a graph is its number of edges+    size :: (Hashable v, Eq v) => g v e -> Int++    -- | Retrieve the vertices of a graph+    vertices :: g v e -> [v]++    -- | Retrieve the edges of a graph as pairs+    edgePairs :: (Hashable v, Eq v) => g v e -> [(v, v)]++    -- | Tell if a vertex exists in the graph+    containsVertex :: (Hashable v, Eq v) => g v e -> v -> Bool++    -- | Retrieve the adjacent vertices of a vertex+    adjacentVertices :: (Hashable v, Eq v) => g v e -> v -> [v]++    -- | Total number of incident edges of a vertex+    vertexDegree :: (Hashable v, Eq v) => g v e -> v -> Int++    -- | Degrees of a all the vertices in a graph+    degrees :: (Hashable v, Eq v) => g v e -> [Int]+    degrees g = vertexDegree g <$> vertices g++    -- | Maximum degree of a graph+    maxDegree :: (Hashable v, Eq v) => g v e -> Int+    maxDegree = maximum . degrees++    -- | Minimum degree of a graph+    minDegree :: (Hashable v, Eq v) => g v e -> Int+    minDegree = minimum . degrees++    -- | 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++    -- | Insert a many vertices into a graph+    -- | New vertices are inserted and already contained vertices are left+    -- | untouched+    insertVertices :: (Hashable v, Eq v) => [v] -> g v e -> g v e++    containsEdgePair :: (Hashable v, Eq v) => g v e -> (v, v) -> Bool+    incidentEdgePairs :: (Hashable v, Eq v) => g v e -> v -> [(v, v)]+    insertEdgePair :: (Hashable v, Eq v) => (v, v) -> g v () -> g v ()+    removeEdgePair :: (Hashable v, Eq v) => (v, v) -> g v e -> g v e+    removeEdgePairAndVertices :: (Hashable v, Eq v) => (v, v) -> g v e -> g v e++    -- | Tell if a graph is simple+    -- | A graph is @simple@ if it has no multiple edges nor loops+    isSimple :: (Hashable v, Eq v) => g v e -> Bool++    -- | Tell if a graph is regular+    -- | A graph is @regular@ when all of its vertices have the same+    -- | number of adjacent vertices+    isRegular :: 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+    toAdjacencyMatrix :: g v e -> [[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)@@ -18,22 +88,30 @@ 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+-- | Construct an undirected 'Edge' between two vertices+(<->) :: (Hashable v) => v -> v -> Edge v ()+(<->) v1 v2 = Edge v1 v2 () --- | 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')+-- | Construct a directed 'Arc' between two vertices+(-->) :: (Hashable v) => v -> v -> Arc v ()+(-->) v1 v2 = Arc v1 v2 () --- | 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')+class IsEdge e where+    -- | Convert an edge to a pair discargind its attribute+    toPair :: e v a -> (v, v) +    -- | 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++instance IsEdge Edge where+    toPair (Edge v1 v2 _) = (v1, v2)+    isLoop (Edge v1 v2 _) = v1 == v2++instance IsEdge Arc where+    toPair (Arc fromV toV _) = (fromV, toV)+    isLoop (Arc v1 v2 _) = v1 == v2+ -- | Weighted Edge attributes -- | Useful for computing some algorithms on graphs class Weighted a where@@ -68,6 +146,19 @@ instance (Arbitrary v, Arbitrary e, Num v, Ord v) => Arbitrary (Arc v e) where     arbitrary = arbitraryEdge Arc +-- | 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')+ -- | Edges generator arbitraryEdge :: (Arbitrary v, Arbitrary e, Ord v, Num v)  => (v -> v -> e -> edge)@@ -75,21 +166,17 @@ 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)+++-- ###########+-- ## Internal+-- ###########++-- | Each vertex maps to a 'Links' value so it can poit to other vertices+type Links v e = HM.HashMap v e  -- | Insert a link directed to *v* with attribute *a* -- | If the connnection already exists, the attribute is replaced

@@ -0,0 +1,194 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE ScopedTypeVariables #-}++module Data.Graph.UGraph where++import Control.Monad (replicateM)+import Data.List     (foldl', reverse, sort)+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 UGraph v e = UGraph { unUGraph :: HM.HashMap v (Links v e) }+    deriving (Eq, Show)++instance Graph UGraph where+    empty = UGraph HM.empty+    order (UGraph g) = HM.size g+    size = length . edges+    vertices (UGraph g) = HM.keys g+    edgePairs g = toPair <$> edges g++    containsVertex (UGraph g) = flip HM.member g+    adjacentVertices (UGraph g) v = HM.keys $ getLinks v g+    vertexDegree (UGraph g) v = length $ HM.keys $ getLinks v g+    insertVertex v (UGraph g) = UGraph $ hashMapInsert v HM.empty g+    insertVertices vs g = foldl' (flip insertVertex) g vs++    containsEdgePair = containsEdge'+    incidentEdgePairs g v = fmap toPair $ incidentEdges g v+    insertEdgePair (v1, v2) g = insertEdge (Edge v1 v2 ()) g+    removeEdgePair = removeEdge'+    removeEdgePairAndVertices = removeEdgeAndVertices'++    isSimple g = foldl' go True $ vertices g+        where go bool v = bool && (not $ HM.member v $ getLinks v $ unUGraph g)++    isRegular = undefined++    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++    toAdjacencyMatrix = undefined++++instance (Arbitrary v, Arbitrary e, Hashable v, Num v, Ord v)+ => Arbitrary (UGraph v e) where+    arbitrary = insertEdges <$> arbitrary <*> pure empty++-- | Probability value between 0 and 1+newtype Probability = P Float deriving (Eq, Ord, Show)++-- | Construct a 'Probability' value+probability :: Float -> Probability+probability v | v >= 1 = P 1 | v <= 0 = P 0 | otherwise = P v++-- | Generate a random 'UGraph of the Erdős–Rényi G(n, p) model+erdosRenyiIO :: Int -> Probability -> IO (UGraph Int ())+erdosRenyiIO n (P p) = go [1..n] p empty+    where+        go :: [Int] -> Float -> UGraph Int () -> IO (UGraph Int ())+        go [] _ g = return g+        go (v:vs) pv g = do+            rnds <- randomRs (0.0, 1.0) <$> newStdGen+            let vs' = zip rnds vs+            go vs pv $! (foldl' (putV pv v) g vs')++        putV :: Float -> Int -> UGraph Int () -> (Float, Int) -> UGraph Int ()+        putV pv v g (p', v') | p' < pv = insertEdge (v <-> v') g | otherwise = g+++randomMatIO :: Int -> IO [[Int]]+randomMatIO n = replicateM n randRow+    where randRow = replicateM n (randomRIO (0,1)) :: IO [Int]++-- | @O(n)@ Remove a vertex from a 'UGraph if present+-- | Every 'Edge' incident to this vertex is also removed+removeVertex :: (Hashable v, Eq v) => v -> UGraph v e -> UGraph v e+removeVertex v g = UGraph+    $ (\(UGraph g') -> HM.delete v g')+    $ foldl' (flip removeEdge) g $ incidentEdges g v++-- | @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+insertEdge :: (Hashable v, Eq v) => Edge v e -> UGraph v e -> UGraph v e+insertEdge (Edge v1 v2 edgeAttr) g = UGraph $ link v2 v1 $ link v1 v2 g'+    where+        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+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+-- | 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 g)+    | containsVertex graph v1 && containsVertex graph v2 =+        UGraph $ update v2Links v2 $ update v1Links v1 g+    | otherwise = UGraph 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 '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++-- | Same as 'removeEdgeAndVertices' but the edge is an unordered pair+removeEdgeAndVertices' :: (Hashable v, Eq v) => (v, v) -> UGraph v e -> UGraph v e+removeEdgeAndVertices' (v1, v2) g =+    removeVertex v2 $ removeVertex v1 $ removeEdgePair (v1, v2) g++-- | @O(n*m)@ Retrieve the 'Edge's of a 'UGraph+edges :: forall v e . (Hashable v, Eq v) => UGraph v e -> [Edge v e]+edges (UGraph g) = linksToEdges $ zip vs links+    where+        vs :: [v]+        vs = vertices $ UGraph g+        links :: [Links v e]+        links = fmap (`getLinks` g) vs++-- | @O(log n)@ 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++-- | Retrieve the incident 'Edge's of a Vertex+incidentEdges :: (Hashable v, Eq v) => UGraph v e -> v -> [Edge v e]+incidentEdges (UGraph g) v = fmap (uncurry (Edge v)) (HM.toList (getLinks v g))++-- | Tell if two 'UGraph are isomorphic+areIsomorphic :: UGraph v e -> UGraph v' e' -> Bool+areIsomorphic = undefined++isomorphism :: UGraph v e -> UGraph v' e' -> (v -> v')+isomorphism = undefined+++-- | The Degree Sequence of a simple 'UGraph is a list of degrees+newtype DegreeSequence = DegreeSequence { unDegreeSequence :: [Int]}+    deriving (Eq, Ord, Show)++-- | Construct a 'DegreeSequence' from a list of degrees+-- | Negative degree values are discarded+degreeSequence :: [Int] -> DegreeSequence+degreeSequence = DegreeSequence . reverse . sort . filter (>0)++-- | Get the 'DegreeSequence' of a simple 'UGraph+-- | If the graph is not @simple@ (see 'isSimple') the result is Nothing+getDegreeSequence :: (Hashable v, Eq v) => UGraph v e -> Maybe DegreeSequence+getDegreeSequence g+    | (not . isSimple) g = Nothing+    | otherwise = Just $ degreeSequence $ degrees g++-- | Tell if a 'DegreeSequence' is a Graphical Sequence+-- | A Degree Sequence is a @Graphical Sequence@ if a corresponding 'UGraph for+-- | it exists+isGraphicalSequence :: DegreeSequence -> Bool+isGraphicalSequence = even . length . filter odd . unDegreeSequence++-- | Get the corresponding 'UGraph of a 'DegreeSequence'+-- | If the 'DegreeSequence' is not graphical (see 'isGraphicalSequence') the+-- | result is Nothing+fromGraphicalSequence :: DegreeSequence -> Maybe (UGraph Int ())+fromGraphicalSequence = undefined

@@ -9,27 +9,27 @@ import Data.Monoid                       ((<>)) import System.Process -import qualified Data.Graph.Graph as G+import qualified Data.Graph.UGraph 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+-- | Plot an undirected 'UGraph to a PNG image file+plotIO :: (Show e) => G.UGraph 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 :: (Show e) => G.UGraph 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+labeledNodes :: (Show v) => G.UGraph v e -> [(v, String)]+labeledNodes g = fmap (\v -> (v, show v)) $ vertices g -labeledEdges :: (Hashable v, Eq v, Show e) => G.Graph v e -> [(v, v, String)]+labeledEdges :: (Hashable v, Eq v, Show e) => G.UGraph 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' :: (Show e) => G.UGraph Int e -> DotGraph Int toDot' g = graphElemsToDot params (labeledNodes g) (labeledEdges g)     where params = nonClusteredParams             { isDirected = False

@@ -1,38 +0,0 @@-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 ())

@@ -0,0 +1,38 @@+module Data.Graph.UGraphSpec where++import Test.Hspec+import Test.QuickCheck++import Data.Graph.UGraph+import Data.Graph.Types++spec :: Spec+spec = do+    describe "Undirected Graph (UGraph)" $ do+        it "Can tell if a vertex exists" $ property $ do+            let g = insertVertex 1 empty :: UGraph Int ()+            let g' = insertVertex 2 empty :: UGraph 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 :: UGraph Int ()+            containsEdge g (1 <-> 2) `shouldBe` True++        it "Stores symetrical edges" $ property $ do+            let g = insertEdge (2 <-> 1) $ insertEdge (1 <-> 2) empty :: UGraph 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 :: UGraph 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 :: UGraph Int ()))++        it "Is id when inserting and removing a new vertex" $ property $+            \g v -> (not $ g `containsVertex` v)+                ==> ((removeVertex v . insertVertex v) g)+                    == (g :: UGraph Int ())