Fix #24

Verites · May 10, 2017 · 747fa63 · 747fa63
2 parents f4027e9 + ad5b9db
commit 747fa63
Show file tree

Hide file tree

Showing 2 changed files with 9 additions and 1 deletion.
diff --git a/src/library/Abstract/Relation.hs b/src/library/Abstract/Relation.hs
@@ -58,7 +58,11 @@ image = nub . concat . Map.elems . mapping
 
 -- | An empty relation, with domain and codomain specified.
 empty :: Ord a => [a] -> [a] -> Relation a
-empty dom cod = Relation (sort $ nub dom) (sort $ nub cod) Map.empty
+empty dom cod = Relation  orderedDomain orderedCodomain emptyMap
+  where
+    orderedDomain = sort $ nub dom
+    orderedCodomain = sort $ nub cod
+    emptyMap = foldr (\x -> Map.insert x []) Map.empty orderedDomain
 
 -- | The identity relation on @dom@.
 id :: Ord a => [a] -> Relation a

diff --git a/tests/Graph/GraphMorphismSpec.hs b/tests/Graph/GraphMorphismSpec.hs
@@ -30,6 +30,10 @@ spec = describe "Graph Morphism API" $ do
       removeNodeFromCodomain 1 g1 `shouldBe` g1
       removeNodeFromCodomain 2 g1 `shouldBe` g1
 
+    it "Should remove node without incident edges" $ do
+      removeNodeFromCodomain 3 g1 `shouldBe` g4
+      removeNodeFromCodomain 4 g1 `shouldBe` g5
+
 g1' :: Graph (Maybe a) (Maybe b)
 g1' = build [1,2,3,4] [(1,1,2)]