From f10fa475b4b7112a454be27a7abe2038b4777996 Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Mon, 27 May 2019 21:27:41 -0700
Subject: [PATCH 01/10] Add relationship query functions

---
 bower.json          |  3 +-
 src/Data/Graph.purs | 75 +++++++++++++++++++++++++++++++++++--
 test/Main.purs      | 90 ++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 162 insertions(+), 6 deletions(-)

diff --git a/bower.json b/bower.json
index b0be8df..ad2a0d7 100644
--- a/bower.json
+++ b/bower.json
@@ -23,6 +23,7 @@
     "purescript-catenable-lists": "^5.0.0"
   },
   "devDependencies": {
-    "purescript-console": "^4.1.0"
+    "purescript-console": "^4.1.0",
+    "purescript-spec": "^3.1.0"
   }
 }
diff --git a/src/Data/Graph.purs b/src/Data/Graph.purs
index 0e79795..32ae05a 100644
--- a/src/Data/Graph.purs
+++ b/src/Data/Graph.purs
@@ -7,20 +7,32 @@ module Data.Graph
   , vertices
   , lookup
   , outEdges
+  , children
+  , descendants
+  , parents
+  , ancestors
   , topologicalSort
+  , adjacent
+  , isAdjacent
+  , connected
+  , path
   ) where
 
 import Prelude
-import Data.Bifunctor (lmap)
+
+import Data.Bifunctor (lmap, rmap)
 import Data.CatList (CatList)
 import Data.CatList as CL
 import Data.Foldable (class Foldable)
+import Data.Foldable as Foldable
 import Data.List (List(..))
 import Data.List as L
 import Data.Map (Map)
 import Data.Map as M
-import Data.Maybe (Maybe(..), maybe)
-import Data.Tuple (Tuple(..), fst, snd)
+import Data.Maybe (Maybe(..), isJust, maybe)
+import Data.Set (Set)
+import Data.Set as Set
+import Data.Tuple (Tuple(..), fst, snd, uncurry)
 
 -- | A graph with vertices of type `v`.
 -- |
@@ -51,6 +63,35 @@ unfoldGraph ks label edges =
 fromMap :: forall k v. Map k (Tuple v (List k)) -> Graph k v
 fromMap = Graph
 
+-- | Check if the first key is adjacent to the second.
+isAdjacent :: forall k v. Ord k => k -> k -> Graph k v -> Boolean
+isAdjacent k1 k2 g = k1 `Set.member` adjacent k2 g
+
+-- | Find all keys adjacent to given key.
+adjacent :: forall k v. Ord k => k -> Graph k v -> Set k
+adjacent k g = children k g `Set.union` parents k g
+
+-- | Returns shortest path between start and end key if it exists.
+-- |
+-- | Will return bottom if the path includes but doesn't end on a cycle.
+path :: forall k v. Ord k => k -> k -> Graph k v -> Maybe (List k)
+path start end (Graph g) = L.reverse <$> go mempty start
+  where
+    go hist k =
+      if end == k
+      then Just hist'
+      else
+        case M.lookup k g of
+          Nothing -> Nothing
+          Just (Tuple _ ks) ->
+            L.head <<< L.catMaybes $ go hist' <$> ks
+      where
+        hist' = k `Cons` hist
+
+-- | Checks if there's a directed path between the start and end key.
+connected :: forall k v. Ord k => k -> k -> Graph k v -> Boolean
+connected start end g = isJust $ path start end g
+
 -- | List all vertices in a graph.
 vertices :: forall k v. Graph k v -> List v
 vertices (Graph g) = map fst (M.values g)
@@ -63,6 +104,34 @@ lookup k (Graph g) = map fst (M.lookup k g)
 outEdges :: forall k v. Ord k => k -> Graph k v -> Maybe (List k)
 outEdges k (Graph g) = map snd (M.lookup k g)
 
+-- | Returns immediate ancestors of given key.
+parents :: forall k v. Ord k => k -> Graph k v -> Set k
+parents k (Graph g) = M.keys <<< M.filter (Foldable.elem k <<< snd) $ g
+
+-- | Returns all ancestors of given key.
+-- |
+-- | Will return bottom if `k` is in cycle.
+ancestors :: forall k v. Ord k => k -> Graph k v -> Set k
+ancestors k' g = go k'
+  where
+   go k = Set.unions $ Set.insert da $ Set.map go da
+     where
+       da = parents k g
+
+-- | Returns immediate descendants of given key.
+children :: forall k v. Ord k => k -> Graph k v -> Set k
+children k (Graph g) = maybe mempty (Set.fromFoldable <<< snd) <<< M.lookup k $ g
+
+-- | Returns all descendants of given key.
+-- |
+-- | Will return bottom if `k` is in cycle.
+descendants :: forall k v. Ord k => k -> Graph k v -> Set k
+descendants k' g = go k'
+  where
+   go k = Set.unions $ Set.insert dd $ Set.map go dd
+     where
+       dd = children k g
+
 type SortState k v =
   { unvisited :: Map k (Tuple v (List k))
   , result :: List k
diff --git a/test/Main.purs b/test/Main.purs
index 16c9c16..1c2b76e 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -2,10 +2,20 @@ module Test.Main where
 
 import Prelude
 
+import Data.Graph (topologicalSort, unfoldGraph)
+import Data.Graph as Graph
+import Data.List (toUnfoldable, range)
+import Data.List as List
+import Data.Map as Map
+import Data.Maybe (Maybe(..))
+import Data.Set as Set
+import Data.Tuple (Tuple(..))
 import Effect (Effect, foreachE)
 import Effect.Console (logShow)
-import Data.Graph (unfoldGraph, topologicalSort)
-import Data.List (toUnfoldable, range)
+import Test.Spec (describe, it)
+import Test.Spec.Assertions (shouldEqual)
+import Test.Spec.Reporter.Console (consoleReporter)
+import Test.Spec.Runner (run)
 
 main :: Effect Unit
 main = do
@@ -13,3 +23,79 @@ main = do
                | otherwise      = []
       graph = unfoldGraph (range 1 100000) identity double
   foreachE (toUnfoldable (topologicalSort graph)) logShow
+  run [consoleReporter] do
+    let l = List.fromFoldable
+        --       4 - 8
+        --      /     \
+        -- 1 - 2 - 3 - 5 - 7
+        --          \
+        --           6
+        acyclicGraph =
+          Graph.fromMap (
+            Map.fromFoldable
+              [ Tuple 1 (Tuple 1 (l [ 2 ]))
+              , Tuple 2 (Tuple 2 (l [ 3, 4 ]))
+              , Tuple 3 (Tuple 3 (l [ 5, 6 ]))
+              , Tuple 4 (Tuple 4 (l [ 8 ]))
+              , Tuple 5 (Tuple 5 (l [ 7 ]))
+              , Tuple 6 (Tuple 6 (l [ ]))
+              , Tuple 7 (Tuple 7 (l [ ]))
+              , Tuple 8 (Tuple 8 (l [ 5 ]))
+              ])
+        --       2 - 4
+        --      / \
+        -- 5 - 1 - 3
+        cyclicGraph =
+          Graph.fromMap (
+            Map.fromFoldable
+              [ Tuple 1 (Tuple 1 (l [ 2 ]))
+              , Tuple 2 (Tuple 2 (l [ 3, 4 ]))
+              , Tuple 3 (Tuple 3 (l [ 1 ]))
+              , Tuple 4 (Tuple 4 (l [ ]))
+              , Tuple 5 (Tuple 5 (l [ 1 ]))
+              ])
+    describe "descendants" do
+      it "works for examples" do
+        Graph.descendants 1 acyclicGraph `shouldEqual` Set.fromFoldable [ 2, 3, 4, 5, 6, 7, 8 ]
+        Graph.descendants 2 acyclicGraph `shouldEqual` Set.fromFoldable [ 3, 4, 5, 6, 7, 8 ]
+        Graph.descendants 3 acyclicGraph `shouldEqual` Set.fromFoldable [ 5, 6, 7 ]
+        Graph.descendants 4 acyclicGraph `shouldEqual` Set.fromFoldable [ 5, 7, 8 ]
+        Graph.descendants 5 acyclicGraph `shouldEqual` Set.fromFoldable [ 7 ]
+        Graph.descendants 6 acyclicGraph `shouldEqual` Set.fromFoldable [ ]
+        Graph.descendants 7 acyclicGraph `shouldEqual` Set.fromFoldable [ ]
+        Graph.descendants 8 acyclicGraph `shouldEqual` Set.fromFoldable [ 5, 7 ]
+    describe "ancestors" do
+      it "works for examples" do
+        Graph.ancestors 1 acyclicGraph `shouldEqual` Set.fromFoldable [ ]
+        Graph.ancestors 2 acyclicGraph `shouldEqual` Set.fromFoldable [ 1 ]
+        Graph.ancestors 3 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2 ]
+        Graph.ancestors 4 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2 ]
+        Graph.ancestors 5 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2, 3, 4, 8 ]
+        Graph.ancestors 6 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2, 3 ]
+        Graph.ancestors 7 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2, 3, 4, 5, 8 ]
+        Graph.ancestors 8 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2, 4 ]
+    describe "adjacent" do
+      it "works for examples" do
+        Graph.adjacent 1 acyclicGraph `shouldEqual` Set.fromFoldable [ 2 ]
+        Graph.adjacent 2 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 3, 4 ]
+        Graph.adjacent 3 acyclicGraph `shouldEqual` Set.fromFoldable [ 2, 5, 6 ]
+        Graph.adjacent 4 acyclicGraph `shouldEqual` Set.fromFoldable [ 2, 8 ]
+        Graph.adjacent 5 acyclicGraph `shouldEqual` Set.fromFoldable [ 3, 7, 8 ]
+        Graph.adjacent 6 acyclicGraph `shouldEqual` Set.fromFoldable [ 3 ]
+        Graph.adjacent 7 acyclicGraph `shouldEqual` Set.fromFoldable [ 5 ]
+        Graph.adjacent 8 acyclicGraph `shouldEqual` Set.fromFoldable [ 4, 5 ]
+        Graph.adjacent 1 cyclicGraph `shouldEqual` Set.fromFoldable [ 2, 3, 5 ]
+        Graph.adjacent 2 cyclicGraph `shouldEqual` Set.fromFoldable [ 1, 3, 4 ]
+        Graph.adjacent 3 cyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2 ]
+        Graph.adjacent 4 cyclicGraph `shouldEqual` Set.fromFoldable [ 2 ]
+        Graph.adjacent 5 cyclicGraph `shouldEqual` Set.fromFoldable [ 1 ]
+    describe "path" do
+      it "works for examples" do
+        Graph.path 2 1 acyclicGraph `shouldEqual` Nothing
+        Graph.path 1 9 acyclicGraph `shouldEqual` Nothing
+        Graph.path 1 1 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 1 ])
+        Graph.path 1 2 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 1, 2 ])
+        Graph.path 1 7 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 1, 2, 3, 5, 7 ])
+        Graph.path 1 8 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 1, 2, 4, 8 ])
+        Graph.path 2 6 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 2, 3, 6 ])
+        Graph.path 5 3 cyclicGraph `shouldEqual` Just (List.fromFoldable [ 5, 1, 2, 3 ])

From ecc665a664834b507afa705f1ef492abd4b0601a Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Mon, 27 May 2019 21:29:46 -0700
Subject: [PATCH 02/10] Add cyclicity query functions

---
 src/Data/Graph.purs | 26 ++++++++++++++++++++++++++
 test/Main.purs      | 13 +++++++++++++
 2 files changed, 39 insertions(+)

diff --git a/src/Data/Graph.purs b/src/Data/Graph.purs
index 32ae05a..af2ad96 100644
--- a/src/Data/Graph.purs
+++ b/src/Data/Graph.purs
@@ -12,6 +12,9 @@ module Data.Graph
   , parents
   , ancestors
   , topologicalSort
+  , inCycle
+  , cyclic
+  , acyclic
   , adjacent
   , isAdjacent
   , connected
@@ -132,6 +135,29 @@ descendants k' g = go k'
      where
        dd = children k g
 
+-- | Checks if given key is part of a cycle.
+inCycle :: forall k v. Ord k => k -> Graph k v -> Boolean
+inCycle k' g = go mempty k'
+  where
+    go seen k =
+      case Tuple (dd == mempty) (k `Set.member` seen) of
+        Tuple true _ -> false
+        Tuple _ true -> k == k'
+        Tuple false false -> Foldable.any (go (Set.insert k seen)) dd
+      where
+        dd = children k g
+
+-- | Checks if there any cycles in graph.
+-- There's presumably a faster implementation but this is very easy to implement
+cyclic :: forall k v. Ord k => Graph k v -> Boolean
+cyclic g = Foldable.any (flip inCycle g) <<< keys $ g
+  where
+    keys (Graph g') = M.keys g'
+
+-- | Checks if there are not any cycles in the graph.
+acyclic :: forall k v. Ord k => Graph k v -> Boolean
+acyclic = not <<< cyclic
+
 type SortState k v =
   { unvisited :: Map k (Tuple v (List k))
   , result :: List k
diff --git a/test/Main.purs b/test/Main.purs
index 1c2b76e..fcbca79 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -74,6 +74,19 @@ main = do
         Graph.ancestors 6 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2, 3 ]
         Graph.ancestors 7 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2, 3, 4, 5, 8 ]
         Graph.ancestors 8 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2, 4 ]
+    describe "inCycle" do
+      it "works for examples" do
+        Graph.inCycle 1 cyclicGraph `shouldEqual` true
+        Graph.inCycle 2 cyclicGraph `shouldEqual` true
+        Graph.inCycle 3 cyclicGraph `shouldEqual` true
+        Graph.inCycle 4 cyclicGraph `shouldEqual` false
+        Graph.inCycle 5 cyclicGraph `shouldEqual` false
+    describe "cyclic" do
+      it "works for examples" do
+        Graph.cyclic cyclicGraph `shouldEqual` true
+        Graph.cyclic acyclicGraph `shouldEqual` false
+        Graph.acyclic cyclicGraph `shouldEqual` false
+        Graph.acyclic acyclicGraph `shouldEqual` true
     describe "adjacent" do
       it "works for examples" do
         Graph.adjacent 1 acyclicGraph `shouldEqual` Set.fromFoldable [ 2 ]

From 50d494d9ebc3fee40bc37660685a129b7d939d65 Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Mon, 27 May 2019 21:30:48 -0700
Subject: [PATCH 03/10] Add functions for incremental `Graph` construction

---
 src/Data/Graph.purs | 36 ++++++++++++++++++++++++++++++++++++
 test/Main.purs      | 14 ++++++++++++++
 2 files changed, 50 insertions(+)

diff --git a/src/Data/Graph.purs b/src/Data/Graph.purs
index af2ad96..3f2d4d3 100644
--- a/src/Data/Graph.purs
+++ b/src/Data/Graph.purs
@@ -4,6 +4,11 @@ module Data.Graph
   ( Graph
   , unfoldGraph
   , fromMap
+  , toMap
+  , empty
+  , insertEdge
+  , insertVertex
+  , insertEdgeWithVertices
   , vertices
   , lookup
   , outEdges
@@ -45,6 +50,32 @@ newtype Graph k v = Graph (Map k (Tuple v (List k)))
 instance functorGraph :: Functor (Graph k) where
   map f (Graph m) = Graph (map (lmap f) m)
 
+-- | An empty graph.
+empty :: forall k v. Graph k v
+empty = Graph M.empty
+
+-- | Insert an edge from the start key to the end key.
+insertEdge :: forall k v. Ord k => k -> k -> Graph k v -> Graph k v
+insertEdge from to (Graph g) =
+  Graph $ M.alter (map (rmap (insert to))) from g
+  where
+    insert k l =
+      if k `Foldable.elem` l
+      then l
+      else k `Cons` l
+
+-- | Insert a vertex into the graph.
+-- |
+-- | If the key already exists, replaces the existing value and
+-- |preserves existing edges.
+insertVertex :: forall k v. Ord k => k -> v -> Graph k v -> Graph k v
+insertVertex k v (Graph g) = Graph $ M.insertWith (\(Tuple _ ks) _ -> Tuple v ks) k (Tuple v mempty) g
+
+-- | Insert two vertices and connect them.
+insertEdgeWithVertices :: forall k v. Ord k => Tuple k v -> Tuple k v -> Graph k v -> Graph k v
+insertEdgeWithVertices from@(Tuple fromKey _) to@(Tuple toKey _) =
+  insertEdge fromKey toKey <<< uncurry insertVertex from <<< uncurry insertVertex to
+
 -- | Unfold a `Graph` from a collection of keys and functions which label keys
 -- | and specify out-edges.
 unfoldGraph
@@ -66,6 +97,11 @@ unfoldGraph ks label edges =
 fromMap :: forall k v. Map k (Tuple v (List k)) -> Graph k v
 fromMap = Graph
 
+-- | Turn a `Graph` into a `Map` which maps vertices to their labels and
+-- | outgoing edges.
+toMap :: forall k v. Graph k v -> Map k (Tuple v (List k))
+toMap (Graph g) = g
+
 -- | Check if the first key is adjacent to the second.
 isAdjacent :: forall k v. Ord k => k -> k -> Graph k v -> Boolean
 isAdjacent k1 k2 g = k1 `Set.member` adjacent k2 g
diff --git a/test/Main.purs b/test/Main.purs
index fcbca79..04a3b96 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -54,6 +54,20 @@ main = do
               , Tuple 4 (Tuple 4 (l [ ]))
               , Tuple 5 (Tuple 5 (l [ 1 ]))
               ])
+    describe "insertEdgeWithVertices" do
+      it "works for examples" do
+        let t n = Tuple n n
+            graph =
+              Graph.insertEdgeWithVertices (t 1) (t 2) $
+              Graph.insertEdgeWithVertices (t 2) (t 4) $
+              Graph.insertEdgeWithVertices (t 4) (t 8) $
+              Graph.insertEdgeWithVertices (t 8) (t 5) $
+              Graph.insertEdgeWithVertices (t 5) (t 7) $
+              Graph.insertEdgeWithVertices (t 2) (t 3) $
+              Graph.insertEdgeWithVertices (t 3) (t 5) $
+              Graph.insertEdgeWithVertices (t 3) (t 6) $
+              Graph.empty
+        Graph.toMap graph `shouldEqual` Graph.toMap acyclicGraph
     describe "descendants" do
       it "works for examples" do
         Graph.descendants 1 acyclicGraph `shouldEqual` Set.fromFoldable [ 2, 3, 4, 5, 6, 7, 8 ]

From 9e8155f849ceeb9c1a008a3b0d2a1790b905ba64 Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Mon, 27 May 2019 21:44:46 -0700
Subject: [PATCH 04/10] Switch from `List` of keys to `Set` of keys

---
 src/Data/Graph.purs | 28 +++++++++++++---------------
 test/Main.purs      | 36 ++++++++++++++++++++++--------------
 2 files changed, 35 insertions(+), 29 deletions(-)

diff --git a/src/Data/Graph.purs b/src/Data/Graph.purs
index 3f2d4d3..103c9ba 100644
--- a/src/Data/Graph.purs
+++ b/src/Data/Graph.purs
@@ -39,13 +39,14 @@ import Data.Map (Map)
 import Data.Map as M
 import Data.Maybe (Maybe(..), isJust, maybe)
 import Data.Set (Set)
+import Data.Set as S
 import Data.Set as Set
 import Data.Tuple (Tuple(..), fst, snd, uncurry)
 
 -- | A graph with vertices of type `v`.
 -- |
 -- | Edges refer to vertices using keys of type `k`.
-newtype Graph k v = Graph (Map k (Tuple v (List k)))
+newtype Graph k v = Graph (Map k (Tuple v (Set k)))
 
 instance functorGraph :: Functor (Graph k) where
   map f (Graph m) = Graph (map (lmap f) m)
@@ -57,12 +58,7 @@ empty = Graph M.empty
 -- | Insert an edge from the start key to the end key.
 insertEdge :: forall k v. Ord k => k -> k -> Graph k v -> Graph k v
 insertEdge from to (Graph g) =
-  Graph $ M.alter (map (rmap (insert to))) from g
-  where
-    insert k l =
-      if k `Foldable.elem` l
-      then l
-      else k `Cons` l
+  Graph $ M.alter (map (rmap (S.insert to))) from g
 
 -- | Insert a vertex into the graph.
 -- |
@@ -90,16 +86,16 @@ unfoldGraph
   -> Graph k v
 unfoldGraph ks label edges =
   Graph (M.fromFoldable (map (\k ->
-            Tuple k (Tuple (label k) (L.fromFoldable (edges k)))) ks))
+            Tuple k (Tuple (label k) (S.fromFoldable (edges k)))) ks))
 
 -- | Create a `Graph` from a `Map` which maps vertices to their labels and
 -- | outgoing edges.
-fromMap :: forall k v. Map k (Tuple v (List k)) -> Graph k v
+fromMap :: forall k v. Map k (Tuple v (Set k)) -> Graph k v
 fromMap = Graph
 
 -- | Turn a `Graph` into a `Map` which maps vertices to their labels and
 -- | outgoing edges.
-toMap :: forall k v. Graph k v -> Map k (Tuple v (List k))
+toMap :: forall k v. Graph k v -> Map k (Tuple v (Set k))
 toMap (Graph g) = g
 
 -- | Check if the first key is adjacent to the second.
@@ -123,7 +119,7 @@ path start end (Graph g) = L.reverse <$> go mempty start
         case M.lookup k g of
           Nothing -> Nothing
           Just (Tuple _ ks) ->
-            L.head <<< L.catMaybes $ go hist' <$> ks
+            S.findMin <<< S.mapMaybe identity $ Set.map (go hist') ks
       where
         hist' = k `Cons` hist
 
@@ -140,7 +136,7 @@ lookup :: forall k v. Ord k => k -> Graph k v -> Maybe v
 lookup k (Graph g) = map fst (M.lookup k g)
 
 -- | Get the keys which are directly accessible from the given key.
-outEdges :: forall k v. Ord k => k -> Graph k v -> Maybe (List k)
+outEdges :: forall k v. Ord k => k -> Graph k v -> Maybe (Set k)
 outEdges k (Graph g) = map snd (M.lookup k g)
 
 -- | Returns immediate ancestors of given key.
@@ -195,7 +191,7 @@ acyclic :: forall k v. Ord k => Graph k v -> Boolean
 acyclic = not <<< cyclic
 
 type SortState k v =
-  { unvisited :: Map k (Tuple v (List k))
+  { unvisited :: Map k (Tuple v (Set k))
   , result :: List k
   }
 
@@ -203,6 +199,8 @@ type SortState k v =
 -- we introduce this data type which captures what we intend to do at each stage
 -- of the recursion.
 data SortStep a = Emit a | Visit a
+derive instance eqSortStep :: Eq a => Eq (SortStep a)
+derive instance ordSortStep :: Ord a => Ord (SortStep a)
 
 -- | Topologically sort the vertices of a graph.
 -- |
@@ -234,9 +232,9 @@ topologicalSort (Graph g) =
                   , unvisited: M.delete k state.unvisited
                   }
 
-                next :: List k
+                next :: Set k
                 next = maybe mempty snd (M.lookup k g)
-            in visit start (CL.fromFoldable (map Visit next) <> CL.cons (Emit k) ks)
+            in visit start (CL.fromFoldable (Set.map Visit next) <> CL.cons (Emit k) ks)
           | otherwise -> visit state ks
 
     initialState :: SortState k v
diff --git a/test/Main.purs b/test/Main.purs
index 04a3b96..281b0b6 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -24,7 +24,7 @@ main = do
       graph = unfoldGraph (range 1 100000) identity double
   foreachE (toUnfoldable (topologicalSort graph)) logShow
   run [consoleReporter] do
-    let l = List.fromFoldable
+    let s = Set.fromFoldable
         --       4 - 8
         --      /     \
         -- 1 - 2 - 3 - 5 - 7
@@ -33,14 +33,14 @@ main = do
         acyclicGraph =
           Graph.fromMap (
             Map.fromFoldable
-              [ Tuple 1 (Tuple 1 (l [ 2 ]))
-              , Tuple 2 (Tuple 2 (l [ 3, 4 ]))
-              , Tuple 3 (Tuple 3 (l [ 5, 6 ]))
-              , Tuple 4 (Tuple 4 (l [ 8 ]))
-              , Tuple 5 (Tuple 5 (l [ 7 ]))
-              , Tuple 6 (Tuple 6 (l [ ]))
-              , Tuple 7 (Tuple 7 (l [ ]))
-              , Tuple 8 (Tuple 8 (l [ 5 ]))
+              [ Tuple 1 (Tuple 1 (s [ 2 ]))
+              , Tuple 2 (Tuple 2 (s [ 3, 4 ]))
+              , Tuple 3 (Tuple 3 (s [ 5, 6 ]))
+              , Tuple 4 (Tuple 4 (s [ 8 ]))
+              , Tuple 5 (Tuple 5 (s [ 7 ]))
+              , Tuple 6 (Tuple 6 (s [ ]))
+              , Tuple 7 (Tuple 7 (s [ ]))
+              , Tuple 8 (Tuple 8 (s [ 5 ]))
               ])
         --       2 - 4
         --      / \
@@ -48,11 +48,11 @@ main = do
         cyclicGraph =
           Graph.fromMap (
             Map.fromFoldable
-              [ Tuple 1 (Tuple 1 (l [ 2 ]))
-              , Tuple 2 (Tuple 2 (l [ 3, 4 ]))
-              , Tuple 3 (Tuple 3 (l [ 1 ]))
-              , Tuple 4 (Tuple 4 (l [ ]))
-              , Tuple 5 (Tuple 5 (l [ 1 ]))
+              [ Tuple 1 (Tuple 1 (s [ 2 ]))
+              , Tuple 2 (Tuple 2 (s [ 3, 4 ]))
+              , Tuple 3 (Tuple 3 (s [ 1 ]))
+              , Tuple 4 (Tuple 4 (s [ ]))
+              , Tuple 5 (Tuple 5 (s [ 1 ]))
               ])
     describe "insertEdgeWithVertices" do
       it "works for examples" do
@@ -68,6 +68,14 @@ main = do
               Graph.insertEdgeWithVertices (t 3) (t 6) $
               Graph.empty
         Graph.toMap graph `shouldEqual` Graph.toMap acyclicGraph
+        let graph' =
+               Graph.insertEdgeWithVertices (t 5) (t 1) $
+               Graph.insertEdgeWithVertices (t 1) (t 2) $
+               Graph.insertEdgeWithVertices (t 2) (t 4) $
+               Graph.insertEdgeWithVertices (t 2) (t 3) $
+               Graph.insertEdgeWithVertices (t 3) (t 1) $
+               Graph.empty
+        Graph.toMap graph' `shouldEqual` Graph.toMap cyclicGraph
     describe "descendants" do
       it "works for examples" do
         Graph.descendants 1 acyclicGraph `shouldEqual` Set.fromFoldable [ 2, 3, 4, 5, 6, 7, 8 ]

From 290d13423867d764110784e1b298582a4d5068c1 Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Mon, 27 May 2019 21:50:38 -0700
Subject: [PATCH 05/10] Switch to spec for `topologicalSort`

---
 test/Main.purs | 12 ++++--------
 1 file changed, 4 insertions(+), 8 deletions(-)

diff --git a/test/Main.purs b/test/Main.purs
index 281b0b6..84c8ddd 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -2,16 +2,13 @@ module Test.Main where
 
 import Prelude
 
-import Data.Graph (topologicalSort, unfoldGraph)
 import Data.Graph as Graph
-import Data.List (toUnfoldable, range)
 import Data.List as List
 import Data.Map as Map
 import Data.Maybe (Maybe(..))
 import Data.Set as Set
 import Data.Tuple (Tuple(..))
-import Effect (Effect, foreachE)
-import Effect.Console (logShow)
+import Effect (Effect)
 import Test.Spec (describe, it)
 import Test.Spec.Assertions (shouldEqual)
 import Test.Spec.Reporter.Console (consoleReporter)
@@ -19,10 +16,6 @@ import Test.Spec.Runner (run)
 
 main :: Effect Unit
 main = do
-  let double x | x * 2 < 100000 = [x * 2]
-               | otherwise      = []
-      graph = unfoldGraph (range 1 100000) identity double
-  foreachE (toUnfoldable (topologicalSort graph)) logShow
   run [consoleReporter] do
     let s = Set.fromFoldable
         --       4 - 8
@@ -54,6 +47,9 @@ main = do
               , Tuple 4 (Tuple 4 (s [ ]))
               , Tuple 5 (Tuple 5 (s [ 1 ]))
               ])
+    describe "topologicalSort" do
+      it "works for an example" do
+        Graph.topologicalSort acyclicGraph `shouldEqual` List.fromFoldable [ 1, 2, 4, 8, 3, 6, 5, 7 ]
     describe "insertEdgeWithVertices" do
       it "works for examples" do
         let t n = Tuple n n

From cc6d84fa6fbe4a3e2e15bde4b77963f14fb04e0c Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Fri, 31 May 2019 09:57:14 -0700
Subject: [PATCH 06/10] Standardize names of predicates

---
 src/Data/Graph.purs | 24 ++++++++++++------------
 test/Main.purs      | 18 +++++++++---------
 2 files changed, 21 insertions(+), 21 deletions(-)

diff --git a/src/Data/Graph.purs b/src/Data/Graph.purs
index 103c9ba..004c94b 100644
--- a/src/Data/Graph.purs
+++ b/src/Data/Graph.purs
@@ -17,12 +17,12 @@ module Data.Graph
   , parents
   , ancestors
   , topologicalSort
-  , inCycle
-  , cyclic
-  , acyclic
+  , isInCycle
+  , isCyclic
+  , isAcyclic
   , adjacent
   , isAdjacent
-  , connected
+  , areConnected
   , path
   ) where
 
@@ -124,8 +124,8 @@ path start end (Graph g) = L.reverse <$> go mempty start
         hist' = k `Cons` hist
 
 -- | Checks if there's a directed path between the start and end key.
-connected :: forall k v. Ord k => k -> k -> Graph k v -> Boolean
-connected start end g = isJust $ path start end g
+areConnected :: forall k v. Ord k => k -> k -> Graph k v -> Boolean
+areConnected start end g = isJust $ path start end g
 
 -- | List all vertices in a graph.
 vertices :: forall k v. Graph k v -> List v
@@ -168,8 +168,8 @@ descendants k' g = go k'
        dd = children k g
 
 -- | Checks if given key is part of a cycle.
-inCycle :: forall k v. Ord k => k -> Graph k v -> Boolean
-inCycle k' g = go mempty k'
+isInCycle :: forall k v. Ord k => k -> Graph k v -> Boolean
+isInCycle k' g = go mempty k'
   where
     go seen k =
       case Tuple (dd == mempty) (k `Set.member` seen) of
@@ -181,14 +181,14 @@ inCycle k' g = go mempty k'
 
 -- | Checks if there any cycles in graph.
 -- There's presumably a faster implementation but this is very easy to implement
-cyclic :: forall k v. Ord k => Graph k v -> Boolean
-cyclic g = Foldable.any (flip inCycle g) <<< keys $ g
+isCyclic :: forall k v. Ord k => Graph k v -> Boolean
+isCyclic g = Foldable.any (flip isInCycle g) <<< keys $ g
   where
     keys (Graph g') = M.keys g'
 
 -- | Checks if there are not any cycles in the graph.
-acyclic :: forall k v. Ord k => Graph k v -> Boolean
-acyclic = not <<< cyclic
+isAcyclic :: forall k v. Ord k => Graph k v -> Boolean
+isAcyclic = not <<< isCyclic
 
 type SortState k v =
   { unvisited :: Map k (Tuple v (Set k))
diff --git a/test/Main.purs b/test/Main.purs
index 84c8ddd..6a08925 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -94,17 +94,17 @@ main = do
         Graph.ancestors 8 acyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2, 4 ]
     describe "inCycle" do
       it "works for examples" do
-        Graph.inCycle 1 cyclicGraph `shouldEqual` true
-        Graph.inCycle 2 cyclicGraph `shouldEqual` true
-        Graph.inCycle 3 cyclicGraph `shouldEqual` true
-        Graph.inCycle 4 cyclicGraph `shouldEqual` false
-        Graph.inCycle 5 cyclicGraph `shouldEqual` false
+        Graph.isInCycle 1 cyclicGraph `shouldEqual` true
+        Graph.isInCycle 2 cyclicGraph `shouldEqual` true
+        Graph.isInCycle 3 cyclicGraph `shouldEqual` true
+        Graph.isInCycle 4 cyclicGraph `shouldEqual` false
+        Graph.isInCycle 5 cyclicGraph `shouldEqual` false
     describe "cyclic" do
       it "works for examples" do
-        Graph.cyclic cyclicGraph `shouldEqual` true
-        Graph.cyclic acyclicGraph `shouldEqual` false
-        Graph.acyclic cyclicGraph `shouldEqual` false
-        Graph.acyclic acyclicGraph `shouldEqual` true
+        Graph.isCyclic cyclicGraph `shouldEqual` true
+        Graph.isCyclic acyclicGraph `shouldEqual` false
+        Graph.isAcyclic cyclicGraph `shouldEqual` false
+        Graph.isAcyclic acyclicGraph `shouldEqual` true
     describe "adjacent" do
       it "works for examples" do
         Graph.adjacent 1 acyclicGraph `shouldEqual` Set.fromFoldable [ 2 ]

From 95b8772495ef5bbcc42add4712967a0e30f87183 Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Fri, 31 May 2019 10:13:28 -0700
Subject: [PATCH 07/10] Switch to `allPaths` and `shortestPath` rather than
 `path`

Also, the implementation is less buggy
---
 src/Data/Graph.purs | 30 ++++++++++++++++++++----------
 test/Main.purs      | 19 ++++++++++---------
 2 files changed, 30 insertions(+), 19 deletions(-)

diff --git a/src/Data/Graph.purs b/src/Data/Graph.purs
index 004c94b..05e8651 100644
--- a/src/Data/Graph.purs
+++ b/src/Data/Graph.purs
@@ -23,11 +23,13 @@ module Data.Graph
   , adjacent
   , isAdjacent
   , areConnected
-  , path
+  , shortestPath
+  , allPaths
   ) where
 
 import Prelude
 
+import Data.Array as Array
 import Data.Bifunctor (lmap, rmap)
 import Data.CatList (CatList)
 import Data.CatList as CL
@@ -35,6 +37,7 @@ import Data.Foldable (class Foldable)
 import Data.Foldable as Foldable
 import Data.List (List(..))
 import Data.List as L
+import Data.List as List
 import Data.Map (Map)
 import Data.Map as M
 import Data.Maybe (Maybe(..), isJust, maybe)
@@ -108,24 +111,31 @@ adjacent k g = children k g `Set.union` parents k g
 
 -- | Returns shortest path between start and end key if it exists.
 -- |
--- | Will return bottom if the path includes but doesn't end on a cycle.
-path :: forall k v. Ord k => k -> k -> Graph k v -> Maybe (List k)
-path start end (Graph g) = L.reverse <$> go mempty start
+-- | Cyclic graphs may return bottom.
+shortestPath :: forall k v. Ord k => k -> k -> Graph k v -> Maybe (List k)
+shortestPath start end g =
+  Array.head <<< Array.sortWith List.length <<< S.toUnfoldable $ allPaths start end g
+
+-- | Returns shortest path between start and end key if it exists.
+-- |
+-- | Cyclic graphs may return bottom.
+allPaths :: forall k v. Ord k => k -> k -> Graph k v -> Set (List k)
+allPaths start end g = Set.map L.reverse $ go mempty start
   where
     go hist k =
       if end == k
-      then Just hist'
+      then Set.singleton hist'
       else
-        case M.lookup k g of
-          Nothing -> Nothing
-          Just (Tuple _ ks) ->
-            S.findMin <<< S.mapMaybe identity $ Set.map (go hist') ks
+        if children' == Set.empty
+        then Set.empty
+        else Foldable.foldMap (go hist') children'
       where
+        children' = children k g
         hist' = k `Cons` hist
 
 -- | Checks if there's a directed path between the start and end key.
 areConnected :: forall k v. Ord k => k -> k -> Graph k v -> Boolean
-areConnected start end g = isJust $ path start end g
+areConnected start end g = isJust $ shortestPath start end g
 
 -- | List all vertices in a graph.
 vertices :: forall k v. Graph k v -> List v
diff --git a/test/Main.purs b/test/Main.purs
index 6a08925..dc7be3d 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -120,13 +120,14 @@ main = do
         Graph.adjacent 3 cyclicGraph `shouldEqual` Set.fromFoldable [ 1, 2 ]
         Graph.adjacent 4 cyclicGraph `shouldEqual` Set.fromFoldable [ 2 ]
         Graph.adjacent 5 cyclicGraph `shouldEqual` Set.fromFoldable [ 1 ]
-    describe "path" do
+    describe "allPaths" do
       it "works for examples" do
-        Graph.path 2 1 acyclicGraph `shouldEqual` Nothing
-        Graph.path 1 9 acyclicGraph `shouldEqual` Nothing
-        Graph.path 1 1 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 1 ])
-        Graph.path 1 2 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 1, 2 ])
-        Graph.path 1 7 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 1, 2, 3, 5, 7 ])
-        Graph.path 1 8 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 1, 2, 4, 8 ])
-        Graph.path 2 6 acyclicGraph `shouldEqual` Just (List.fromFoldable [ 2, 3, 6 ])
-        Graph.path 5 3 cyclicGraph `shouldEqual` Just (List.fromFoldable [ 5, 1, 2, 3 ])
+        Graph.allPaths 2 1 acyclicGraph `shouldEqual` Set.empty
+        Graph.allPaths 1 9 acyclicGraph `shouldEqual` Set.empty
+        Graph.allPaths 1 1 acyclicGraph `shouldEqual` Set.singleton (List.fromFoldable [ 1 ])
+        Graph.allPaths 1 2 acyclicGraph `shouldEqual` Set.singleton (List.fromFoldable [ 1, 2 ])
+        Graph.allPaths 1 7 acyclicGraph `shouldEqual`
+          Set.fromFoldable [ List.fromFoldable [ 1, 2, 4, 8, 5, 7 ], List.fromFoldable [ 1, 2, 3, 5, 7 ] ]
+        Graph.allPaths 1 8 acyclicGraph `shouldEqual` Set.singleton (List.fromFoldable [ 1, 2, 4, 8 ])
+        Graph.allPaths 2 6 acyclicGraph `shouldEqual` Set.singleton (List.fromFoldable [ 2, 3, 6 ])
+        Graph.allPaths 5 3 cyclicGraph `shouldEqual` Set.singleton (List.fromFoldable [ 5, 1, 2, 3 ])

From 4d60aa96448e6db109c48a5dfe2e72615c1f7723 Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Fri, 31 May 2019 10:38:31 -0700
Subject: [PATCH 08/10] Improve graph declaration readability in tests

---
 test/Main.purs | 31 +++++++++++++++----------------
 1 file changed, 15 insertions(+), 16 deletions(-)

diff --git a/test/Main.purs b/test/Main.purs
index dc7be3d..9416037 100644
--- a/test/Main.purs
+++ b/test/Main.purs
@@ -5,7 +5,6 @@ import Prelude
 import Data.Graph as Graph
 import Data.List as List
 import Data.Map as Map
-import Data.Maybe (Maybe(..))
 import Data.Set as Set
 import Data.Tuple (Tuple(..))
 import Effect (Effect)
@@ -17,7 +16,7 @@ import Test.Spec.Runner (run)
 main :: Effect Unit
 main = do
   run [consoleReporter] do
-    let s = Set.fromFoldable
+    let n k v = Tuple k (Tuple k (Set.fromFoldable v ))
         --       4 - 8
         --      /     \
         -- 1 - 2 - 3 - 5 - 7
@@ -26,14 +25,14 @@ main = do
         acyclicGraph =
           Graph.fromMap (
             Map.fromFoldable
-              [ Tuple 1 (Tuple 1 (s [ 2 ]))
-              , Tuple 2 (Tuple 2 (s [ 3, 4 ]))
-              , Tuple 3 (Tuple 3 (s [ 5, 6 ]))
-              , Tuple 4 (Tuple 4 (s [ 8 ]))
-              , Tuple 5 (Tuple 5 (s [ 7 ]))
-              , Tuple 6 (Tuple 6 (s [ ]))
-              , Tuple 7 (Tuple 7 (s [ ]))
-              , Tuple 8 (Tuple 8 (s [ 5 ]))
+              [ n 1 [ 2 ]
+              , n 2 [ 3, 4 ]
+              , n 3 [ 5, 6 ]
+              , n 4 [ 8 ]
+              , n 5 [ 7 ]
+              , n 6 [ ]
+              , n 7 [ ]
+              , n 8 [ 5 ]
               ])
         --       2 - 4
         --      / \
@@ -41,18 +40,18 @@ main = do
         cyclicGraph =
           Graph.fromMap (
             Map.fromFoldable
-              [ Tuple 1 (Tuple 1 (s [ 2 ]))
-              , Tuple 2 (Tuple 2 (s [ 3, 4 ]))
-              , Tuple 3 (Tuple 3 (s [ 1 ]))
-              , Tuple 4 (Tuple 4 (s [ ]))
-              , Tuple 5 (Tuple 5 (s [ 1 ]))
+              [ n 1 [ 2 ]
+              , n 2 [ 3, 4 ]
+              , n 3 [ 1 ]
+              , n 4 [ ]
+              , n 5 [ 1 ]
               ])
     describe "topologicalSort" do
       it "works for an example" do
         Graph.topologicalSort acyclicGraph `shouldEqual` List.fromFoldable [ 1, 2, 4, 8, 3, 6, 5, 7 ]
     describe "insertEdgeWithVertices" do
       it "works for examples" do
-        let t n = Tuple n n
+        let t x = Tuple x x
             graph =
               Graph.insertEdgeWithVertices (t 1) (t 2) $
               Graph.insertEdgeWithVertices (t 2) (t 4) $

From 24f2e5613c71390df886fcdb9b2a72ad515fae85 Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Fri, 7 Jun 2019 12:03:17 -0700
Subject: [PATCH 09/10] Add graph editing functions

---
 src/Data/Graph.purs | 20 ++++++++++++++++++++
 1 file changed, 20 insertions(+)

diff --git a/src/Data/Graph.purs b/src/Data/Graph.purs
index 05e8651..0d030ea 100644
--- a/src/Data/Graph.purs
+++ b/src/Data/Graph.purs
@@ -20,6 +20,8 @@ module Data.Graph
   , isInCycle
   , isCyclic
   , isAcyclic
+  , alterVertex
+  , alterEdges
   , adjacent
   , isAdjacent
   , areConnected
@@ -200,6 +202,24 @@ isCyclic g = Foldable.any (flip isInCycle g) <<< keys $ g
 isAcyclic :: forall k v. Ord k => Graph k v -> Boolean
 isAcyclic = not <<< isCyclic
 
+alterVertex ::
+  forall v k.
+  Ord k =>
+  (Maybe v -> Maybe v) ->
+  k -> Graph k v -> Graph k v
+alterVertex f k (Graph g) = Graph $ M.alter (applyF =<< _) k g
+  where
+    applyF (Tuple v es) = flip Tuple es <$> f (Just v)
+
+alterEdges ::
+  forall v k.
+  Ord k =>
+  (Maybe (Set k) -> Maybe (Set k)) ->
+  k -> Graph k v -> Graph k v
+alterEdges f k (Graph g) = Graph $ M.alter (applyF =<< _) k g
+  where
+    applyF (Tuple v es) = Tuple v <$> f (Just es)
+
 type SortState k v =
   { unvisited :: Map k (Tuple v (Set k))
   , result :: List k

From c4a3189e39579102b8be3cff9bcde63a9d4ef322 Mon Sep 17 00:00:00 2001
From: Cole Haus <colehaus@cryptolab.net>
Date: Fri, 7 Jun 2019 12:14:06 -0700
Subject: [PATCH 10/10] v5.0.0