graphite 0.4.2.0 → 0.5.0.0

raw patch · 14 files changed

+334/−141 lines, 14 filesdep +criteriondep +deepseqdep +dequeuedep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: criterion, deepseq, dequeue

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• README.md +1/−0
• benchmark/Main.hs +45/−0
• graphite.cabal +24/−9
• src/Data/Graph/Connectivity.hs +1/−1
• src/Data/Graph/DGraph.hs +25/−33
• src/Data/Graph/DGraph/DegreeSequence.hs +5/−0
• src/Data/Graph/Generation.hs +21/−14
• src/Data/Graph/Read.hs +22/−12
• src/Data/Graph/Types.hs +42/−17
• src/Data/Graph/UGraph.hs +38/−39
• src/Data/Graph/Visualize.hs +9/−2
• src/Scratch.hs +73/−0
• test/Data/Graph/DGraphSpec.hs +15/−8
• test/Data/Graph/UGraphSpec.hs +13/−6

@@ -2,6 +2,7 @@  [![](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)  # graphite 

@@ -0,0 +1,45 @@+module Main where++import Criterion.Main++import Control.DeepSeq+import Data.Graph.Generation++import Data.Graph.DGraph+import Data.Graph.Types+import Data.Graph.UGraph++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 ())++    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 ())++    defaultMain+        [ bgroup "generation"+            [ bench "gnp_100" $ nfIO (erdosRenyi 100 0.3 :: IO (UGraph Int ()))+            , bench "gnp_500" $ nfIO (erdosRenyi 500 0.3 :: IO (UGraph Int ()))+            , bench "gnp_1000" $ nfIO (erdosRenyi 1000 0.3 :: IO (UGraph Int ()))+            , bench "gnp_5000" $ nfIO (erdosRenyi 2000 0.3 :: IO (UGraph Int ()))+            ]++        , bgroup "edges"+            [ bench "edges_ug100" $ nf edges ug100+            , bench "edges_ug500" $ nf edges ug500+            , bench "edges_ug1000" $ nf edges ug1000++            , bench "arcs_dg100" $ nf arcs dg100+            , bench "arcs_dg500" $ nf arcs dg500+            , bench "arcs_dg1000" $ nf arcs dg1000+            ]++        , bgroup "properties"+            [ bench "order_ug100" $ whnf order ug100+            , bench "size_ug100" $ whnf size ug100+            , bench "order_ug500" $ whnf order ug500+            , bench "size_ug500" $ whnf size ug500+            ]+        ]

@@ -1,5 +1,5 @@ name:                graphite-version:             0.4.2.0+version:             0.5.0.0 synopsis:            Graphs and networks library description:         Represent, analyze and visualize graphs homepage:            https://github.com/alx741/graphite#readme@@ -22,19 +22,23 @@                      , Data.Graph.Morphisms                      , Data.Graph.Read                      , Data.Graph.UGraph+                     , Data.Graph.DGraph.DegreeSequence                      , Data.Graph.UGraph.DegreeSequence                      , Data.Graph.Visualize+  other-modules:       Scratch   build-depends:       base >= 4.7 && < 5-                     , hashable-                     , vector-                     , containers-                     , unordered-containers-                     , bytestring-                     , random-                     , process-                     , graphviz                      , QuickCheck+                     , bytestring                      , cassava+                     , containers+                     , deepseq+                     , dequeue+                     , graphviz+                     , hashable+                     , process+                     , random+                     , unordered-containers+                     , vector   ghc-options:         -Wall   default-language:    Haskell2010 @@ -50,6 +54,17 @@                      , Data.Graph.DGraphSpec                      , Data.Graph.UGraphSpec   ghc-options:         -threaded -rtsopts -with-rtsopts=-N+  default-language:    Haskell2010++benchmark graphite-benchmark+  type:                exitcode-stdio-1.0+  hs-source-dirs:      benchmark+  main-is:             Main.hs+  build-depends:       base+                     , graphite+                     , deepseq+                     , criterion+  ghc-options:         -O2   default-language:    Haskell2010  source-repository head

@@ -66,7 +66,7 @@ isBridgeless :: (Hashable v, Eq v, Ord v) => UGraph v e -> Bool -- FIXME: Use a O(n) algorithm isBridgeless g =-    foldl' (\b vs -> b && isConnected (removeEdgePair g vs)) True (edgePairs g)+    foldl' (\b vs -> b && isConnected (removeEdgePair vs g)) True (edgePairs g)  -- | Tell if a 'UGraph' is orietable -- | An undirected graph is @orietable@ if it can be converted into a directed

@@ -1,10 +1,13 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE ScopedTypeVariables #-}  module Data.Graph.DGraph where -import Data.List (foldl')+import Data.List    (foldl')+import GHC.Generics (Generic) +import           Control.DeepSeq import           Data.Hashable import qualified Data.HashMap.Lazy as HM import           Test.QuickCheck@@ -15,7 +18,7 @@  -- | 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)+    deriving (Eq, Generic)  instance (Hashable v, Eq v, Show v, Show e) => Show (DGraph v e) where     showsPrec d m = showParen (d > 10) $@@ -27,6 +30,8 @@         xs <- readPrec         return (fromList xs) +instance (NFData v, NFData e) => NFData (DGraph v e)+ instance Graph DGraph where     empty = DGraph HM.empty     order (DGraph g) = HM.size g@@ -44,15 +49,17 @@     -- | The total number of inbounding and outbounding 'Arc's of a vertex     vertexDegree g v = vertexIndegree g v + vertexOutdegree g v -    insertVertex (DGraph g) v = DGraph $ hashMapInsert v HM.empty g-    insertVertices = foldl' insertVertex+    insertVertex v (DGraph g) = DGraph $ hashMapInsert v HM.empty g      containsEdgePair = containsArc'     incidentEdgePairs g v = fmap toPair $ incidentArcs g v-    insertEdgePair g (v1, v2) = insertArc g (Arc v1 v2 ())+    insertEdgePair (v1, v2) g = insertArc (Arc v1 v2 ()) g     removeEdgePair = removeArc'-    removeEdgePairAndVertices = removeArcAndVertices' +    removeVertex v g = DGraph+        $ (\(DGraph g') -> HM.delete v g')+        $ foldl' (flip removeArc) g $ incidentArcs g v+     isSimple g = foldl' go True $ vertices g         where go bool v = bool && (not $ HM.member v $ getLinks v $ unDGraph g) @@ -69,54 +76,39 @@      toAdjacencyMatrix = undefined --- | The Degree Sequence of a 'DGraph' is a list of pairs (Indegree, Outdegree)-type DegreeSequence = [(Int, Int)]- instance (Arbitrary v, Arbitrary e, Hashable v, Num v, Ord v)  => Arbitrary (DGraph v e) where     arbitrary = insertArcs <$> pure empty <*> arbitrary --- | @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' removeArc g $ incidentArcs g v- -- | @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) => DGraph v e -> Arc v e -> DGraph v e-insertArc g (Arc fromV toV edgeAttr) = DGraph+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 g [fromV, toV]+    where g' = unDGraph $ insertVertices [fromV, toV] g  -- | @O(m*log n)@ Insert many directed 'Arc's into a 'DGraph' -- | Same rules as 'insertArc' are applied insertArcs :: (Hashable v, Eq v) => DGraph v e -> [Arc v e] -> DGraph v e-insertArcs g as = foldl' insertArc g as+insertArcs g as = 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) => DGraph v e -> Arc v e -> DGraph v e-removeArc g = removeEdgePair g . toPair+removeArc :: (Hashable v, Eq v) => Arc v e -> DGraph v e -> DGraph v e+removeArc = removeEdgePair . toPair  -- | Same as 'removeArc' but the arc is an ordered pair-removeArc' :: (Hashable v, Eq v) => DGraph v e -> (v, v) -> DGraph v e-removeArc' (DGraph g) (v1, v2) = case HM.lookup v1 g of+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) => DGraph v e -> Arc v e -> DGraph v e-removeArcAndVertices g = removeEdgePairAndVertices g . toPair---- | Same as 'removeArcAndVertices' but the arc is an ordered pair-removeArcAndVertices' :: (Hashable v, Eq v) => DGraph v e -> (v, v) -> DGraph v e-removeArcAndVertices' g (v1, v2) =-    removeVertex v2 $ removeVertex v1 $ removeEdgePair g (v1, v2)+removeArcAndVertices :: (Hashable v, Eq v) => Arc v e -> DGraph v e -> DGraph v e+removeArcAndVertices = removeEdgePairAndVertices . toPair  -- | @O(n*m)@ Retrieve the 'Arc's of a 'DGraph' arcs :: forall v e . (Hashable v, Eq v) => DGraph v e -> [Arc v e]@@ -192,7 +184,7 @@ -- | 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.+-- | are equal to each other. isRegular :: DGraph v e -> Bool isRegular _ = undefined @@ -223,7 +215,7 @@ -- | Convert a directed 'DGraph' to an undirected 'UGraph' by converting all of -- | its 'Arc's into 'Edge's toUndirected :: (Hashable v, Eq v) => DGraph v e -> UG.UGraph v e-toUndirected g = UG.insertEdges empty (fmap arcToEdge $ arcs g)+toUndirected g = UG.insertEdges (fmap arcToEdge $ arcs g) empty     where arcToEdge (Arc fromV toV attr) = Edge fromV toV attr  

@@ -0,0 +1,5 @@+module Data.Graph.DGraph.DegreeSequence where++-- | The Degree Sequence of a 'DGraph' is a list of pairs (Indegree, Outdegree)+newtype DegreeSequence = DegreeSequence { unDegreeSequence :: [(Int, Int)] }+    deriving (Eq, Ord, Show)

@@ -6,33 +6,40 @@ import Data.List     (foldl') import System.Random +import Data.Graph.DGraph import Data.Graph.Types---- | Probability value between 0 and 1-newtype Probability = P Double deriving (Eq, Ord, Show)---- | Construct a 'Probability' value-probability :: Double -> Probability-probability v | v >= 1 = P 1 | v <= 0 = P 0 | otherwise = P v+import Data.Graph.UGraph --- | Generate a random Erdős–Rényi  G(n, p) model graph-erdosRenyi :: Graph g => Int -> Probability -> IO (g Int ())-erdosRenyi n (P p) = go [1..n] p empty+-- | Generate a random Erdős–Rényi G(n, p) model graph of /n/ vertices with a+-- | /p/ connection probability+erdosRenyi :: Graph g => Int -> Float -> IO (g Int ())+erdosRenyi n p = go [1..n] (probability p) empty     where-        go :: Graph g => [Int] -> Double -> g Int () -> IO (g Int ())+        go :: Graph g => [Int] -> Float -> g Int () -> IO (g Int ())         go [] _ g = return g         go (v:vs) pv g = do             rnds <- replicateM (length vs + 1) $ randomRIO (0.0, 1.0)             flipDir <- randomRIO (True, False)             let vs' = zip rnds vs-            let g' = insertVertex g v+            let g' = insertVertex v g             go vs pv $! (foldl' (putV pv v flipDir) g' vs') -        putV :: Graph g => Double -> Int -> Bool -> g Int () -> (Double, Int) -> g Int ()+        putV :: Graph g => Float -> Int -> Bool -> g Int () -> (Float, Int) -> g Int ()         putV pv v flipDir g (p', v')-            | p' < pv = insertEdgePair g pair+            | p' < pv = insertEdgePair pair g             | otherwise = g                 where pair = if flipDir then (v', v) else (v, v')++        probability :: Float -> Float+        probability v | v >= 1 = 1 | v <= 0 = 0 | otherwise = v++-- | 'erdosRenyi' convinience 'UGraph' generation function+erdosRenyiU :: Int -> Float -> IO (UGraph Int ())+erdosRenyiU  = erdosRenyi++-- | 'erdosRenyi' convinience 'DGraph' generation function+erdosRenyiD :: Int -> Float -> IO (DGraph Int ())+erdosRenyiD  = erdosRenyi  -- | Generate a random square binary matrix -- | Useful for use with 'fromAdjacencyMatrix'

@@ -2,31 +2,41 @@  module Data.Graph.Read where -import Data.ByteString.Lazy as BS+import Data.ByteString.Lazy as BS hiding (empty) import Data.Csv             as CSV import Data.Hashable-import Data.Vector          as V hiding (fromList)+import Data.Vector          as V hiding (empty, fromList)  import Data.Graph.Types-import Data.Graph.UGraph  -- | Read a 'UGraph' from a CSV file -- | The line "1,2,3,4" translates to the list of edges -- | "(1 <-> 2), (1 <-> 3), (1 <-> 4)"-csvToUGraph :: (Hashable v, Eq v, FromField v)-    => FilePath-    -> IO (Either String (UGraph v ()))-csvToUGraph fp = do+fromCsv :: Graph g => (Hashable v, Eq v, FromField v)+ => FilePath+ -> IO (Either String (g v ()))+fromCsv fp = do     content <- BS.readFile fp     let dec = decode NoHeader content     case dec of-        Left err  -> return $ Left err-        Right vec -> return $ Right $ fromList $ toEdges $ V.toList vec+        Left err -> return $ Left err+        Right vec -> return $ Right $ (flip insertEdgePairs) empty $ toEdges $ V.toList vec      where-        toEdges :: [[v]] -> [Edge v ()]+        toEdges :: [[v]] -> [(v, v)]         toEdges ns = Prelude.concat $ fmap nodeEdges ns -        nodeEdges :: [v] -> [Edge v ()]+        nodeEdges :: [v] -> [(v, v)]         nodeEdges []     = []-        nodeEdges (n:ns) = fmap (\n' -> Edge n n' ()) ns+        nodeEdges (n:ns) = fmap (\n' -> (n, n')) ns+++-- | Same as 'fromCsv' but rise an exception when parsing fails+fromCsv' :: Graph g => (Hashable v, Eq v, FromField v)+ => FilePath+ -> IO (g v ())+fromCsv' fp = do+    eitherG <- fromCsv fp+    case eitherG of+        Left err -> error err+        Right g -> return g

@@ -1,11 +1,14 @@+{-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE FlexibleInstances   #-} {-# LANGUAGE ScopedTypeVariables #-}  module Data.Graph.Types where -import Data.List (nubBy)-import GHC.Float (float2Double)+import Data.List    (foldl')+import GHC.Float    (float2Double)+import GHC.Generics (Generic) +import           Control.DeepSeq import           Data.Hashable import qualified Data.HashMap.Lazy as HM import           Test.QuickCheck@@ -75,12 +78,13 @@      -- | Insert a vertex into a graph     -- | If the graph already contains the vertex leave the graph untouched-    insertVertex :: (Hashable v, Eq v) => g v e -> v -> g v e+    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) => g v e -> [v] -> g v e+    insertVertices :: (Hashable v, Eq v) => [v] -> g v e -> g v e+    insertVertices vs g = foldl' (flip insertVertex) g vs      -- | Tell if an edge exists in the graph     containsEdgePair :: (Hashable v, Eq v) => g v e -> (v, v) -> Bool@@ -91,15 +95,33 @@     -- | 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-    insertEdgePair :: (Hashable v, Eq v) => g v () -> (v, v) -> g v ()+    insertEdgePair :: (Hashable v, Eq v) => (v, v) -> g v () -> g v () -    -- | Remove the edge from a graph present+    -- | Same as 'insertEdgePair' but for multiple edges+    insertEdgePairs :: (Hashable v, Eq v) => [(v, v)] -> g v () -> g v ()+    insertEdgePairs es g = foldl' (flip insertEdgePair) g es++    -- | Remove a vertex from a graph if present+    -- | Every edge incident to this vertex is also removed+    removeVertex :: (Hashable v, Eq v) => v -> g v e -> g v e++    -- | Same as 'removeVertex' but for multiple vertices+    removeVertices :: (Hashable v, Eq v) => [v] -> g v e -> g v e+    removeVertices vs g = foldl' (flip removeVertex) g vs++    -- | Remove an edge from a graph if present     -- | The involved vertices are left untouched-    removeEdgePair :: (Hashable v, Eq v) => g v e -> (v, v) -> g v e+    removeEdgePair :: (Hashable v, Eq v) => (v, v) -> g v e -> g v e +    -- | Same as 'removeEdgePair' but for multple edges+    removeEdgePairs :: (Hashable v, Eq v) => [(v, v)] -> g v e -> g v e+    removeEdgePairs es g = foldl' (flip removeEdgePair) g es+     -- | Remove the edge from a graph if present     -- | The involved vertices are also removed-    removeEdgePairAndVertices :: (Hashable v, Eq v) => g v e -> (v, v) -> g v e+    removeEdgePairAndVertices :: (Hashable v, Eq v) => (v, v) -> g v e -> g v e+    removeEdgePairAndVertices (v1, v2) g =+        removeVertex v2 $ removeVertex v1 $ removeEdgePair (v1, v2) g      -- | Tell if a graph is simple     -- | A graph is @simple@ if it has no loops@@ -114,11 +136,11 @@  -- | 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)+    deriving (Show, Read, Ord, Generic)  -- | 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)+    deriving (Show, Read, Ord, Generic)  -- | Construct an undirected 'Edge' between two vertices (<->) :: (Hashable v) => v -> v -> Edge v ()@@ -136,6 +158,9 @@     -- | An edge forms a @loop@ if both of its ends point to the same vertex     isLoop :: (Eq v) => e v a -> Bool +instance (NFData v, NFData e) => NFData (Edge v e)+instance (NFData v, NFData e) => NFData (Arc v e)+ instance IsEdge Edge where     toPair (Edge v1 v2 _) = (v1, v2)     isLoop (Edge v1 v2 _) = v1 == v2@@ -193,8 +218,7 @@  -- | Edges generator arbitraryEdge :: (Arbitrary v, Arbitrary e, Ord v, Num v)- => (v -> v -> e -> edge)- -> Gen edge+ => (v -> v -> e -> edge) -> Gen edge arbitraryEdge edgeType = edgeType <$> vert <*> vert <*> arbitrary     where vert = getPositive <$> arbitrary @@ -227,14 +251,15 @@         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+linksToEdges :: [(v, Links v a)] -> [Edge v a]+linksToEdges ls = 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')++-- | Get 'Edge's from an association list of vertices and their links+linksToEdges' :: (Eq v) => (v, Links v a) -> [Edge v a]+linksToEdges' (fromV, links) = fmap (\(v, a) -> Edge fromV v a) (HM.toList links)  -- | 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

@@ -1,13 +1,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-{-# LANGUAGE FlexibleInstances   #-}+{-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE ViewPatterns        #-}  module Data.Graph.UGraph where -import Data.List (foldl')+import qualified Data.Foldable as F (toList)+import           Data.List     (foldl')+import           GHC.Generics  (Generic) +import           Control.DeepSeq import           Data.Hashable import qualified Data.HashMap.Lazy as HM+import qualified Data.Sequence     as S import           Test.QuickCheck import           Text.Read @@ -15,7 +20,7 @@  -- | 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)+    deriving (Eq, Generic)  instance (Hashable v, Eq v, Show v, Show e) => Show (UGraph v e) where     showsPrec d m = showParen (d > 10) $@@ -27,9 +32,11 @@         xs <- readPrec         return (fromList xs) +instance (NFData v, NFData e) => NFData (UGraph v e)+ instance (Arbitrary v, Arbitrary e, Hashable v, Num v, Ord v)  => Arbitrary (UGraph v e) where-    arbitrary = insertEdges <$> pure empty <*> arbitrary+    arbitrary = insertEdges <$> arbitrary <*> pure empty  instance Graph UGraph where     empty = UGraph HM.empty@@ -42,21 +49,23 @@     adjacentVertices (UGraph g) v = HM.keys $ getLinks v g     directlyReachableVertices g v = v : (adjacentVertices g v)     vertexDegree (UGraph g) v = length $ HM.keys $ getLinks v g-    insertVertex (UGraph g) v = UGraph $ hashMapInsert v HM.empty g-    insertVertices = foldl' insertVertex+    insertVertex v (UGraph g) = UGraph $ hashMapInsert v HM.empty g      containsEdgePair = containsEdge'     incidentEdgePairs g v = fmap toPair $ incidentEdges g v-    insertEdgePair g (v1, v2) = insertEdge g (Edge v1 v2 ())+    insertEdgePair (v1, v2) g = insertEdge (Edge v1 v2 ()) g     removeEdgePair = removeEdge'-    removeEdgePairAndVertices = removeEdgeAndVertices' +    removeVertex v g = UGraph+        $ (\(UGraph g') -> HM.delete v g')+        $ foldl' (flip removeEdge) g $ incidentEdges g v+     isSimple g = foldl' go True $ vertices g         where go bool v = bool && (not $ HM.member v $ getLinks v $ unUGraph g)      fromAdjacencyMatrix m         | length m /= length (head m) = Nothing-        | otherwise = Just $ insertEdges empty (foldl' genEdges [] labeledM)+        | otherwise = Just $ insertEdges (foldl' genEdges [] labeledM) empty             where                 labeledM :: [(Int, [(Int, Int)])]                 labeledM = zip [1..] $ fmap (zip [1..]) m@@ -69,38 +78,31 @@   --- | @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' 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) => UGraph v e -> Edge v e -> UGraph v e-insertEdge g (Edge v1 v2 edgeAttr) = UGraph $ link v2 v1 $ link v1 v2 g'+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 g [v1, v2]+        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) => UGraph v e -> [Edge v e] -> UGraph v e-insertEdges = foldl' insertEdge+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) => UGraph v e -> Edge v e -> UGraph v e-removeEdge g = removeEdgePair g . toPair+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) => UGraph v e -> (v, v) -> UGraph v e-removeEdge' graph@(UGraph g) (v1, v2)+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+    | otherwise = graph     where         v1Links = HM.delete v2 $ getLinks v1 g         v2Links = HM.delete v1 $ getLinks v2 g@@ -108,22 +110,19 @@  -- | @O(log n)@ Remove the undirected 'Edge' from a 'UGraph' if present -- | The involved vertices are also removed-removeEdgeAndVertices :: (Hashable v, Eq v) => UGraph v e -> Edge v e -> UGraph v e-removeEdgeAndVertices g = removeEdgePairAndVertices g . toPair---- | Same as 'removeEdgeAndVertices' but the edge is an unordered pair-removeEdgeAndVertices' :: (Hashable v, Eq v) => UGraph v e -> (v, v) -> UGraph v e-removeEdgeAndVertices' g (v1, v2) =-    removeVertex v2 $ removeVertex v1 $ removeEdgePair g (v1, v2)+removeEdgeAndVertices :: (Hashable v, Eq v) => Edge v e -> UGraph v e -> UGraph v e+removeEdgeAndVertices = removeEdgePairAndVertices . toPair  -- | @O(n*m)@ Retrieve the 'Edge's of a 'UGraph' edges :: forall v e . (Hashable v, Eq v) => UGraph v e -> [Edge v e]-edges (UGraph g) = linksToEdges $ zip vs links+edges g = F.toList $ go g S.empty     where-        vs :: [v]-        vs = vertices $ UGraph g-        links :: [Links v e]-        links = fmap (`getLinks` g) vs+        go (order -> 0) es = es+        go g' es =+            let v = head $ vertices g'+            in go+                (removeVertex v g')+                (es S.>< (S.fromList $ incidentEdges g' v))  -- | @O(log n)@ Tell if an undirected 'Edge' exists in the graph containsEdge :: (Hashable v, Eq v) => UGraph v e -> Edge v e -> Bool@@ -149,4 +148,4 @@  -- | Construct a 'UGraph' from a list of 'Edge's fromList :: (Hashable v, Eq v) => [Edge v e] -> UGraph v e-fromList = insertEdges empty+fromList es = insertEdges es empty

@@ -7,6 +7,7 @@     ) where  import Data.GraphViz+import Data.GraphViz.Attributes.Complete import Data.Hashable  import Data.Graph.DGraph@@ -40,8 +41,14 @@  toUndirectedDot :: (Show e) => UGraph Int e -> DotGraph Int toUndirectedDot g = graphElemsToDot params (labeledNodes g) (labeledEdges g)-    where params = nonClusteredParams { isDirected = False }+    where params = nonClusteredParams+            { isDirected = False+            , globalAttributes = [GraphAttrs [Overlap ScaleOverlaps]]+            }  toDirectedDot :: (Show e) => DGraph Int e -> DotGraph Int toDirectedDot g = graphElemsToDot params (labeledNodes g) (labeledArcs g)-    where params = nonClusteredParams { isDirected = True }+    where params = nonClusteredParams+            { isDirected = True+            , globalAttributes = [GraphAttrs [Overlap ScaleOverlaps]]+            }

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

@@ -10,25 +10,32 @@ spec = do     describe "Directed Graph (DGraph)" $ do         it "Can tell if a vertex exists" $ property $ do-            let g = insertVertex empty 1 :: DGraph Int ()-            let g' = insertVertex empty 2 :: DGraph Int ()+            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 empty (1 --> 2) :: DGraph Int ()-            let g' = insertArc empty (2 --> 1) :: DGraph Int ()+            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 (g :: DGraph Int ()) 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 (g :: DGraph Int ()) arc)+            \g a -> (not $ g `containsArc` a)+                ==> size g + 1 == size (insertArc a (g :: DGraph Int ())) +        it "order is conserved" $ property $+            \g v -> (not $ g `containsVertex` v)+                ==> order g == order (removeVertex v $ insertVertex v (g :: DGraph Int ()))+        it "size is conserved" $ property $+            \g a -> (not $ g `containsArc` a)+                ==> size g == size (removeArc a $ insertArc a (g :: DGraph Int ()))+         it "Is id when inserting and removing a new vertex" $ property $             \g v -> (not $ g `containsVertex` v)-                ==> (removeVertex v $ insertVertex g v)+                ==> (removeVertex v $ insertVertex v g)                     == (g :: DGraph Int ())

@@ -10,8 +10,8 @@ spec = do     describe "Undirected Graph (UGraph)" $ do         it "Can tell if a vertex exists" $ property $ do-            let g = insertVertex empty 1 :: UGraph Int ()-            let g' = insertVertex empty 2 :: UGraph Int ()+            let g = insertVertex 1 empty :: UGraph Int ()+            let g' = insertVertex 2 empty :: UGraph Int ()             containsVertex g 1 `shouldBe` True             containsVertex g' 1 `shouldBe` False @@ -27,12 +27,19 @@          it "Increments its order when a new vertex is inserted" $ property $             \g v -> (not $ g `containsVertex` v)-                ==> order g + 1 == order (insertVertex (g :: UGraph Int ()) 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 ()))+            \g e -> (not $ g `containsEdge` e)+                ==> size g + 1 == size (insertEdge e (g :: UGraph Int ())) +        it "order is conserved" $ property $+            \g v -> (not $ g `containsVertex` v)+                ==> order g == order (removeVertex v $ insertVertex v (g :: UGraph Int ()))+        it "size is conserved" $ property $+            \g e -> (not $ g `containsEdge` e)+                ==> size g == size (removeEdge e $ insertEdge e (g :: UGraph Int ()))+         it "Is id when inserting and removing a new vertex" $ property $             \g v -> (not $ g `containsVertex` v)-                ==> (removeVertex v $ insertVertex g v)+                ==> (removeVertex v $ insertVertex v g)                     == (g :: UGraph Int ())