Revise documentation and tests for induceJust (#211)

CHANGES.md

@@ -2,6 +2,7 @@
 
 ## 0.5
 
+* #202, #209, #211: Add `induceJust` and `induceJust1`.
 * #208: Add `fromNonEmpty` to `NonEmpty.AdjacencyMap`.
 * #208: Add `fromAdjacencyMap` to `AdjacencyIntMap`.
 * #208: Drop `Internal` modules for `AdjacencyIntMap`, `AdjacencyMap`,

src/Algebra/Graph.hs

@@ -990,6 +990,7 @@ transpose :: Graph a -> Graph a
 transpose = foldg Empty Vertex Overlay (flip Connect)
 {-# INLINE transpose #-}
 
+-- TODO: Implement via 'induceJust' to reduce code duplication.
 -- | Construct the /induced subgraph/ of a given graph by removing the
 -- vertices that do not satisfy a given predicate.
 -- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes
@@ -1010,13 +1011,15 @@ induce p = foldg Empty (\x -> if p x then Vertex x else Empty) (k Overlay) (k Co
     k f x     y     = f x y
 {-# INLINE [1] induce #-}
 
--- | Construct the /induced subgraph/ of a given graph by removing the 
--- vertices that are 'Nothing'.
+-- | Construct the /induced subgraph/ of a given graph by removing the vertices
+-- that are 'Nothing'.
 -- Complexity: /O(s)/ time, memory and size.
+--
 -- @
--- induceJust ('vertex' 'Nothing')                            == 'empty'
--- induceJust (gmap Just x)                                   == x
--- induceJust ('connect' (gmap Just x) ('vertex' 'Nothing'))  == x
+-- induceJust ('vertex' 'Nothing')                               == 'empty'
+-- induceJust ('edge' ('Just' x) 'Nothing')                        == 'vertex' x
+-- induceJust . 'fmap' 'Just'                                    == 'id'
+-- induceJust . 'fmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce' p
 -- @
 induceJust :: Graph (Maybe a) -> Graph a
 induceJust = foldg Empty (maybe Empty Vertex) (k Overlay) (k Connect)

src/Algebra/Graph/AdjacencyMap.hs

@@ -755,18 +755,20 @@ gmap f = AM . Map.map (Set.map f) . Map.mapKeysWith Set.union f . adjacencyMap
 induce :: (a -> Bool) -> AdjacencyMap a -> AdjacencyMap a
 induce p = AM . Map.map (Set.filter p) . Map.filterWithKey (\k _ -> p k) . adjacencyMap
 
--- | Construct the /induced subgraph/ of a given graph by removing the 
--- vertices that are 'Nothing'.
--- Complexity: /O(n)/ time.
+-- | Construct the /induced subgraph/ of a given graph by removing the vertices
+-- that are 'Nothing'.
+-- Complexity: /O(n + m)/ time.
+--
 -- @
--- induceJust ('vertex' 'Nothing')                            == 'empty'
--- induceJust (gmap Just x)                                   == x
--- induceJust ('connect' (gmap Just x) ('vertex' 'Nothing'))  == x
+-- induceJust ('vertex' 'Nothing')                               == 'empty'
+-- induceJust ('edge' ('Just' x) 'Nothing')                        == 'vertex' x
+-- induceJust . 'gmap' 'Just'                                    == 'id'
+-- induceJust . 'gmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce' p
 -- @
 induceJust :: Ord a => AdjacencyMap (Maybe a) -> AdjacencyMap a
 induceJust = AM . Map.map catMaybesSet . catMaybesMap . adjacencyMap
-    where 
-      catMaybesSet = Set.mapMonotonic Maybe.fromJust . Set.delete Nothing
+    where
+      catMaybesSet = Set.mapMonotonic     Maybe.fromJust . Set.delete Nothing
       catMaybesMap = Map.mapKeysMonotonic Maybe.fromJust . Map.delete Nothing
 
 -- | Left-to-right /relational composition/ of graphs: vertices @x@ and @z@ are

src/Algebra/Graph/Labelled.hs

@@ -492,6 +492,7 @@ transpose = foldg empty vertex (fmap flip connect)
 emap :: (e -> f) -> Graph e a -> Graph f a
 emap f = foldg Empty Vertex (Connect . f)
 
+-- TODO: Implement via 'induceJust' to reduce code duplication.
 -- | Construct the /induced subgraph/ of a given graph by removing the
 -- vertices that do not satisfy a given predicate.
 -- Complexity: /O(s)/ time, memory and size, assuming that the predicate takes
@@ -511,13 +512,15 @@ induce p = foldg Empty (\x -> if p x then Vertex x else Empty) c
     c _ Empty y     = y
     c e x     y     = Connect e x y
 
--- | Construct the /induced subgraph/ of a given graph by removing the 
--- vertices that are 'Nothing'.
+-- | Construct the /induced subgraph/ of a given graph by removing the vertices
+-- that are 'Nothing'.
 -- Complexity: /O(s)/ time, memory and size.
+--
 -- @
--- induceJust ('vertex' 'Nothing')                            == 'empty'
--- induceJust (gmap Just x)                                   == x
--- induceJust ('connect' (gmap Just x) ('vertex' 'Nothing'))  == x
+-- induceJust ('vertex' 'Nothing')                               == 'empty'
+-- induceJust ('edge' ('Just' x) 'Nothing')                        == 'vertex' x
+-- induceJust . 'fmap' 'Just'                                    == 'id'
+-- induceJust . 'fmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce' p
 -- @
 induceJust :: Graph e (Maybe a) -> Graph e a
 induceJust = foldg Empty (maybe Empty Vertex) c

src/Algebra/Graph/Labelled/AdjacencyMap.hs

@@ -599,13 +599,15 @@ induce :: (a -> Bool) -> AdjacencyMap e a -> AdjacencyMap e a
 induce p = AM . Map.map (Map.filterWithKey (\k _ -> p k)) .
     Map.filterWithKey (\k _ -> p k) . adjacencyMap
 
--- | Construct the /induced subgraph/ of a given graph by removing the 
--- vertices that are 'Nothing'.
--- Complexity: /O(n)/ time.
+-- | Construct the /induced subgraph/ of a given graph by removing the vertices
+-- that are 'Nothing'.
+-- Complexity: /O(n + m)/ time.
+--
 -- @
--- induceJust ('vertex' 'Nothing')                            == 'empty'
--- induceJust (gmap Just x)                                   == x
--- induceJust ('connect' (gmap Just x) ('vertex' 'Nothing'))  == x
+-- induceJust ('vertex' 'Nothing')                               == 'empty'
+-- induceJust ('edge' ('Just' x) 'Nothing')                        == 'vertex' x
+-- induceJust . 'gmap' 'Just'                                    == 'id'
+-- induceJust . 'gmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce' p
 -- @
 induceJust :: Ord a => AdjacencyMap e (Maybe a) -> AdjacencyMap e a
 induceJust = AM . Map.map catMaybesMap . catMaybesMap . adjacencyMap

src/Algebra/Graph/NonEmpty.hs

@@ -825,6 +825,7 @@ transpose = foldg1 vertex overlay (flip connect)
 "transpose/clique1"   forall xs. transpose (clique1 xs) = clique1 (NonEmpty.reverse xs)
  #-}
 
+-- TODO: Implement via 'induceJust1' to reduce code duplication.
 -- | Construct the /induced subgraph/ of a given graph by removing the
 -- vertices that do not satisfy a given predicate. Returns @Nothing@ if the
 -- resulting graph is empty.
@@ -839,30 +840,28 @@ transpose = foldg1 vertex overlay (flip connect)
 -- @
 induce1 :: (a -> Bool) -> Graph a -> Maybe (Graph a)
 induce1 p = foldg1
-  (\x -> if p x then Just (Vertex x) else Nothing)
-  (k Overlay)
-  (k Connect)
+    (\x -> if p x then Just (Vertex x) else Nothing) (k Overlay) (k Connect)
   where
-    k _ Nothing a = a
-    k _ a Nothing = a
-    k f (Just a) (Just b) = Just $ f a b
+    k _ Nothing  a        = a
+    k _ a        Nothing  = a
+    k f (Just a) (Just b) = Just (f a b)
 
-
--- | Construct the /induced subgraph/ of a given graph by removing the 
--- vertices that are 'Nothing'. Returns 'Nothing' if the 
--- resulting graph is empty.
+-- | Construct the /induced subgraph/ of a given graph by removing the vertices
+-- that are 'Nothing'. Returns 'Nothing' if the resulting graph is empty.
 -- Complexity: /O(s)/ time, memory and size.
+--
 -- @
--- induceJust1 ('vertex' 'Nothing')                            == `Nothing`
--- induceJust1 (fmap Just x)                                   == Just x
--- induceJust1 ('connect' (fmap Just x) ('vertex' 'Nothing'))  == Just x
+-- induceJust1 ('vertex' 'Nothing')                               == 'Nothing'
+-- induceJust1 ('edge' ('Just' x) 'Nothing')                        == 'Just' ('vertex' x)
+-- induceJust1 . 'fmap' 'Just'                                    == 'Just'
+-- induceJust1 . 'fmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce1' p
 -- @
 induceJust1 :: Graph (Maybe a) -> Maybe (Graph a)
 induceJust1 = foldg1 (fmap Vertex) (k Overlay) (k Connect)
   where
-    k _ Nothing a = a
-    k _ a Nothing = a
-    k f (Just a) (Just b) = Just $ f a b
+    k _ Nothing  a        = a
+    k _ a        Nothing  = a
+    k f (Just a) (Just b) = Just (f a b)
 
 -- | Simplify a graph expression. Semantically, this is the identity function,
 -- but it simplifies a given expression according to the laws of the algebra.

src/Algebra/Graph/NonEmpty/AdjacencyMap.hs

@@ -629,14 +629,15 @@ gmap = coerce AM.gmap
 induce1 :: (a -> Bool) -> AdjacencyMap a -> Maybe (AdjacencyMap a)
 induce1 = fmap toNonEmpty . coerce AM.induce
 
--- | Construct the /induced subgraph/ of a given graph by removing the 
--- vertices that are 'Nothing'. Returns 'Nothing' if the 
--- resulting graph is empty.
--- Complexity: /O(n)/ time.
+-- | Construct the /induced subgraph/ of a given graph by removing the vertices
+-- that are 'Nothing'. Returns 'Nothing' if the resulting graph is empty.
+-- Complexity: /O(n + m)/ time.
+--
 -- @
--- induceJust1 ('vertex' 'Nothing')                            == 'Nothing'
--- induceJust1 (gmap Just x)                                   == Just x
--- induceJust1 ('connect' (gmap Just x) ('vertex' 'Nothing'))  == Just x
+-- induceJust1 ('vertex' 'Nothing')                               == 'Nothing'
+-- induceJust1 ('edge' ('Just' x) 'Nothing')                        == 'Just' ('vertex' x)
+-- induceJust1 . 'gmap' 'Just'                                    == 'Just'
+-- induceJust1 . 'gmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce1' p
 -- @
 induceJust1 :: Ord a => AdjacencyMap (Maybe a) -> Maybe (AdjacencyMap a)
 induceJust1 m = toNonEmpty (AM.induceJust (coerce m))

src/Algebra/Graph/Relation.hs

@@ -32,7 +32,7 @@ module Algebra.Graph.Relation (
     path, circuit, clique, biclique, star, stars, tree, forest,
 
     -- * Graph transformation
-    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap, 
+    removeVertex, removeEdge, replaceVertex, mergeVertices, transpose, gmap,
     induce, induceJust,
 
     -- * Relational operations
@@ -693,7 +693,7 @@ gmap f (Relation d r) = Relation (Set.map f d) (Set.map (\(x, y) -> (f x, f y))
 
 -- | Construct the /induced subgraph/ of a given graph by removing the
 -- vertices that do not satisfy a given predicate.
--- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to
+-- Complexity: /O(n + m)/ time, assuming that the predicate takes /O(1)/ to
 -- be evaluated.
 --
 -- @
@@ -708,19 +708,22 @@ induce p (Relation d r) = Relation (Set.filter p d) (Set.filter pp r)
   where
     pp (x, y) = p x && p y
 
--- | Construct the /induced subgraph/ of a given graph by removing the 
--- vertices that are 'Nothing'.
--- Complexity: /O(n)/ time.
+-- | Construct the /induced subgraph/ of a given graph by removing the vertices
+-- that are 'Nothing'.
+-- Complexity: /O(n + m)/ time.
+--
 -- @
--- induceJust ('vertex' 'Nothing')                            == 'empty'
--- induceJust (gmap Just x)                                   == x
--- induceJust ('connect' (gmap Just x) ('vertex' 'Nothing'))  == x
+-- induceJust ('vertex' 'Nothing')                               == 'empty'
+-- induceJust ('edge' ('Just' x) 'Nothing')                        == 'vertex' x
+-- induceJust . 'gmap' 'Just'                                    == 'id'
+-- induceJust . 'gmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce' p
 -- @
 induceJust :: Ord a => Relation (Maybe a) -> Relation a
-induceJust (Relation d r) = Relation (catMaybesSet d) (catMaybesSet' r)
-  where 
+induceJust (Relation d r) = Relation (catMaybesSet d) (catMaybesSet2 r)
+  where
     catMaybesSet         = Set.mapMonotonic Maybe.fromJust . Set.delete Nothing
-    catMaybesSet'        = Set.mapMonotonic (\(x, y) -> (Maybe.fromJust x, Maybe.fromJust y)) . Set.filter p
+    catMaybesSet2        = Set.mapMonotonic (\(x, y) -> (Maybe.fromJust x, Maybe.fromJust y))
+                         . Set.filter p
     p (Nothing, _)       = False
     p (_,       Nothing) = False
     p (_,       _)       = True

src/Algebra/Graph/Relation/Symmetric.hs

@@ -38,7 +38,7 @@ module Algebra.Graph.Relation.Symmetric (
 
     -- * Miscellaneous
     consistent
-    
+
     ) where
 
 import Control.DeepSeq
@@ -595,7 +595,7 @@ gmap = coerce R.gmap
 
 -- | Construct the /induced subgraph/ of a given graph by removing the
 -- vertices that do not satisfy a given predicate.
--- Complexity: /O(m)/ time, assuming that the predicate takes /O(1)/ to
+-- Complexity: /O(n + m)/ time, assuming that the predicate takes /O(1)/ to
 -- be evaluated.
 --
 -- @
@@ -608,13 +608,15 @@ gmap = coerce R.gmap
 induce :: (a -> Bool) -> Relation a -> Relation a
 induce = coerce R.induce
 
--- | Construct the /induced subgraph/ of a given graph by removing the 
--- vertices that are 'Nothing'.
--- Complexity: /O(n)/ time.
+-- | Construct the /induced subgraph/ of a given graph by removing the vertices
+-- that are 'Nothing'.
+-- Complexity: /O(n + m)/ time.
+--
 -- @
--- induceJust ('vertex' 'Nothing')                            == 'empty'
--- induceJust (gmap Just x)                                   == x
--- induceJust ('connect' (gmap Just x) ('vertex' 'Nothing'))  == x
+-- induceJust ('vertex' 'Nothing')                               == 'empty'
+-- induceJust ('edge' ('Just' x) 'Nothing')                        == 'vertex' x
+-- induceJust . 'gmap' 'Just'                                    == 'id'
+-- induceJust . 'gmap' (\\x -> if p x then 'Just' x else 'Nothing') == 'induce' p
 -- @
 induceJust :: Ord a => Relation (Maybe a) -> Relation a
 induceJust = coerce R.induceJust

test/Algebra/Graph/Test/Generic.hs

@@ -1518,12 +1518,14 @@ testInduce (prefix, API{..}) = do
 testInduceJust :: Testsuite g Ord -> IO ()
 testInduceJust (prefix, API{..}) = do
     putStrLn $ "\n============ " ++ prefix ++ "induceJust ============"
-    test "induceJust (vertex Nothing)                          == empty" $
-          induceJust (vertex (Nothing :: Maybe Int))           == empty
-    test "induceJust (gmap Just x)                             == x" $ \(x :: g Int) ->
-          induceJust (gmap Just x)                             == x
-    test "induceJust (gmap Just x)                             == x" $ \(x :: g Int) ->
-          induceJust (connect (gmap Just x) (vertex Nothing))  == x
+    test "induceJust (vertex Nothing)                               == empty" $
+          induceJust (vertex (Nothing :: Maybe Int))                == empty
+    test "induceJust (edge (Just x) Nothing)                        == vertex x" $ \x ->
+          induceJust (edge (Just x) (Nothing :: Maybe Int))         == vertex x
+    test "induceJust . gmap Just                                    == id" $ \(x :: g Int) ->
+         (induceJust . gmap Just) x                                 == id x
+    test "induceJust . gmap (\\x -> if p x then Just x else Nothing) == induce p" $ \(x :: g Int) (apply -> p) ->
+         (induceJust . gmap (\x -> if p x then Just x else Nothing)) x == induce p x
 
 testCompose :: TestsuiteInt g -> IO ()
 testCompose (prefix, API{..}) = do

test/Algebra/Graph/Test/NonEmpty/AdjacencyMap.hs

@@ -548,12 +548,17 @@ testNonEmptyAdjacencyMap = do
          (induce1 p >=> induce1 q) y == induce1 (\x -> p x && q x) y
 
     putStrLn $ "\n============ NonEmpty.AdjacencyMap.induceJust1 ============"
-    test "induceJust1 (vertex Nothing)                         == Nothing" $
-          induceJust1 (vertex (Nothing :: Maybe Int))          == Nothing
-    test "induceJust1 (gmap Just x)                            == Just x" $ \(x :: G) ->
-          induceJust1 (gmap Just x)                            == Just x
-    test "induceJust1 (gmap Just x)                            == Just x" $ \(x :: G) ->
-          induceJust1 (connect (gmap Just x) (vertex Nothing)) == Just x
+    test "induceJust1 (vertex Nothing)                               == Nothing" $
+          induceJust1 (vertex (Nothing :: Maybe Int))                == Nothing
+
+    test "induceJust1 (edge (Just x) Nothing)                        == Just (vertex x)" $ \(x :: G) ->
+          induceJust1 (edge (Just x) Nothing)                        == Just (vertex x)
+
+    test "induceJust1 . gmap Just                                    == Just" $ \(x :: G) ->
+         (induceJust1 . gmap Just) x                                 == Just x
+
+    test "induceJust1 . gmap (\\x -> if p x then Just x else Nothing) == induce1 p" $ \(x :: G) (apply -> p) ->
+         (induceJust1 . gmap (\x -> if p x then Just x else Nothing)) x == induce1 p x
 
     putStrLn $ "\n============ NonEmpty.AdjacencyMap.closure ============"
     test "closure (vertex x)      == edge x x" $ \(x :: Int) ->

test/Algebra/Graph/Test/NonEmpty/Graph.hs

@@ -625,12 +625,17 @@ testNonEmptyGraph = do
          (induce1 p >=> induce1 q) y == induce1 (\x -> p x && q x) y
 
     putStrLn $ "\n============ NonEmpty.Graph.induceJust1 ============"
-    test "induceJust1 (vertex Nothing)                         == Nothing" $
-          induceJust1 (vertex (Nothing :: Maybe Int))          == Nothing
-    test "induceJust1 (fmap Just x)                            == Just x" $ \(x :: G) ->
-          induceJust1 (fmap Just x)                            == Just x
-    test "induceJust1 (fmap Just x)                            == Just x" $ \(x :: G) ->
-          induceJust1 (connect (fmap Just x) (vertex Nothing)) == Just x
+    test "induceJust1 (vertex Nothing)                               == Nothing" $
+          induceJust1 (vertex (Nothing :: Maybe Int))                == Nothing
+
+    test "induceJust1 (edge (Just x) Nothing)                        == Just (vertex x)" $ \(x :: G) ->
+          induceJust1 (edge (Just x) Nothing)                        == Just (vertex x)
+
+    test "induceJust1 . fmap Just                                    == Just" $ \(x :: G) ->
+         (induceJust1 . fmap Just) x                                 == Just x
+
+    test "induceJust1 . fmap (\\x -> if p x then Just x else Nothing) == induce1 p" $ \(x :: G) (apply -> p) ->
+         (induceJust1 . fmap (\x -> if p x then Just x else Nothing)) x == induce1 p x
 
     putStrLn $ "\n============ NonEmpty.Graph.simplify ============"
     test "simplify             ==  id" $ \(x :: G) ->