{- |
Description: Supporting definitions for graph problems
Maintainer: dev@chungyc.org

Supporting definitions for graph problems.
-}
module Problems.Graphs (
Graph (vertexes, edges, sets, neighbors, adjacent, toGraph, isValidGraph),
Vertex,
Edge (Edge),
Var (Var),
Lists (Lists),
Paths (Paths),
G (G),
areValidGraphSets,
) where

import           Control.DeepSeq
import           Data.List       (group, permutations, sort)
import           Data.Map.Lazy   (Map)
import qualified Data.Map.Lazy   as Map
import           Data.Maybe      (fromJust)
import           Data.Set        (Set)
import qualified Data.Set        as Set
import           GHC.Generics    (Generic)

-- $setup -- >>> import qualified Data.Map as Map -- >>> import qualified Data.Set as Set -- | A graph is mathematically defined as a set of vertexes and a set of edges, -- where an edge is a set of two elements from the set of vertexes. -- I.e., if $$G = (V, E)$$, where $$E \subseteq \{ \{v_1, v_2\} \,|\, v_1 \in V, v_2 \in V\}$$, -- then $$G$$ is a graph. -- -- The following is an example of a graph, with vertexes represented as circles and edges represented as lines. -- -- ![Graph with vertexes 1, 2, 3, 4, 5, and edges {1, 2}, {1, 4}, {2, 3}, {2, 4}, {3, 4}, {4, 5}](images/Graphs/Example.svg) -- -- === __Notes__ -- -- This introduction to graphs is substantially different from the one in -- the original list of [Ninety-Nine Haskell Problems](https://wiki.haskell.org/H-99:_Ninety-Nine_Haskell_Problems). -- The original introduction would serve as an introduction to graphs in the context of Prolog, -- but apparently was not updated to be more appropriate for other languages as the problems -- were ported for Lisp and then Haskell. -- -- This is a rewrite targeted to be more useful towards practicing Haskell. -- Most of the graph problems themselves remain substantially the same. class Graph g where -- | The set of vertexes. vertexes :: g -> Set Vertex -- | The set of edges. edges :: g -> Set Edge -- | The sets of vertexes and edges for a graph. I.e., @('vertexes' g, 'edges' g)@. sets :: g -> (Set Vertex, Set Edge) sets g g = (forall g. Graph g => g -> Set Vertex vertexes g g, forall g. Graph g => g -> Set Edge edges g g) -- | The neighbors of a vertex in a graph. -- I.e., the set of vertexes adjacent to the given vertex. neighbors :: Vertex -> g -> Set Vertex neighbors Vertex v g g = forall a b. (a -> b -> a) -> a -> Set b -> a Set.foldl Set Vertex -> Edge -> Set Vertex extract forall a. Set a Set.empty forall a b. (a -> b) -> a -> b$ forall g. Graph g => g -> Set Edge
edges g
g
where extract :: Set Vertex -> Edge -> Set Vertex
extract Set Vertex
vs (Edge (Vertex
u', Vertex
v'))
| Vertex
v forall a. Eq a => a -> a -> Bool
== Vertex
u'   = forall a. Ord a => a -> Set a -> Set a
Set.insert Vertex
v' Set Vertex
vs
| Vertex
v forall a. Eq a => a -> a -> Bool
== Vertex
v'   = forall a. Ord a => a -> Set a -> Set a
Set.insert Vertex
u' Set Vertex
vs
| Bool
otherwise = Set Vertex
vs

-- | Whether the given vertexes are adjacent in the graph.
adjacent :: Vertex -> Vertex -> g -> Bool
u Vertex
v g
g = forall a. Ord a => a -> Set a -> Bool
Set.member ((Vertex, Vertex) -> Edge
Edge (Vertex
u, Vertex
v)) (forall g. Graph g => g -> Set Edge
edges g
g)

-- | Build a graph of type @g@, given a set of vertexes and a set of edges.
--
-- If the sets are not consistent with a valid graph, return 'Nothing'.
toGraph :: (Set Vertex, Set Edge) -> Maybe g

-- | Whether the graph representation is valid.
--
-- If graph representations can only be built using 'toGraph',
-- it should be impossible to build an invalid graph representation.
-- However, we allow graph representations to be built directly,
-- so for some representations of graphs, it is possible to build an invalid one.
isValidGraph :: g -> Bool

-- | Checks whether the given set of vertexes and edges can form a graph.
--
-- I.e., the vertexes in edges must be in the set of vertexes.
areValidGraphSets :: (Set Vertex, Set Edge) -> Bool
areValidGraphSets :: (Set Vertex, Set Edge) -> Bool
areValidGraphSets (Set Vertex
vs, Set Edge
es) = forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set Vertex
vs' Set Vertex
vs
where vs' :: Set Vertex
vs' = forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl (\Set Vertex
s (Edge (Vertex
u, Vertex
v)) -> forall a. Ord a => a -> Set a -> Set a
Set.insert Vertex
u forall a b. (a -> b) -> a -> b
$forall a. Ord a => a -> Set a -> Set a Set.insert Vertex v Set Vertex s) forall a. Set a Set.empty Set Edge es -- | A vertex in a graph. -- -- In general, vertexes can be anything. For these problems, vertexes will be integers. type Vertex = Int -- | An edge in a graph. -- -- We will only deal with /undirected/ graphs. I.e., -- -- prop> Edge (u, v) == Edge (v, u) newtype Edge = Edge (Vertex, Vertex) deriving (Vertex -> Edge -> ShowS [Edge] -> ShowS Edge -> String forall a. (Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Edge] -> ShowS$cshowList :: [Edge] -> ShowS
show :: Edge -> String
$cshow :: Edge -> String showsPrec :: Vertex -> Edge -> ShowS$cshowsPrec :: Vertex -> Edge -> ShowS
Show)

-- Edges in undirected graphs have no direction, so the order of the vertexes do not matter.
instance Eq Edge where
== :: Edge -> Edge -> Bool
(==) (Edge (Vertex, Vertex)
e) (Edge (Vertex, Vertex)
e') = (Vertex, Vertex) -> (Vertex, Vertex)
normalize (Vertex, Vertex)
e forall a. Eq a => a -> a -> Bool
== (Vertex, Vertex) -> (Vertex, Vertex)
normalize (Vertex, Vertex)
e'

-- We define an order for the sole purpose of making output reproducible.
-- The ordering has no meaning otherwise.
instance Ord Edge where
compare :: Edge -> Edge -> Ordering
compare (Edge (Vertex, Vertex)
e) (Edge (Vertex, Vertex)
e') = forall a. Ord a => a -> a -> Ordering
compare ((Vertex, Vertex) -> (Vertex, Vertex)
normalize (Vertex, Vertex)
e) ((Vertex, Vertex) -> (Vertex, Vertex)
normalize (Vertex, Vertex)
e')

-- | Normalizes the representation of an edge to a single representation.
--
-- I.e., @normalize (u, v) == normalize (v, u)@.
normalize :: (Vertex, Vertex) -> (Vertex, Vertex)
normalize :: (Vertex, Vertex) -> (Vertex, Vertex)
normalize e :: (Vertex, Vertex)
e@(Vertex
u, Vertex
v)
| Vertex
u forall a. Ord a => a -> a -> Bool
<= Vertex
v    = (Vertex, Vertex)
e
| Bool
otherwise = (Vertex
v, Vertex
u)

-- | A default implementation for comparing graph equality.
equals :: Graph g => g -> g -> Bool
equals :: forall g. Graph g => g -> g -> Bool
equals g
g g
g' = Set Vertex
vs forall a. Eq a => a -> a -> Bool
== Set Vertex
vs' Bool -> Bool -> Bool
&& Set Edge
es forall a. Eq a => a -> a -> Bool
== Set Edge
es'
where (Set Vertex
vs, Set Vertex
vs') = (forall g. Graph g => g -> Set Vertex
vertexes g
g, forall g. Graph g => g -> Set Vertex
vertexes g
g')
(Set Edge
es, Set Edge
es') = (forall g. Graph g => g -> Set Edge
edges g
g, forall g. Graph g => g -> Set Edge
edges g
g')

-- | There are many ways to represent graphs in Haskell.
-- For example, the example graph can be represented by variables including their adjacent vertexes as values:
--
-- >>> :{
-- let v1 = Var () [v2, v4]
--     v2 = Var () [v1, v3, v4]
--     v3 = Var () [v2, v4]
--     v4 = Var () [v1, v2, v3, v5]
--     v5 = Var () [v4]
-- :}
--
-- We will not be using this representation of graphs further.
--
-- === __Tying the knot__
--
-- While many languages can repesent cycles in graphs with objects pointing or referencing each other,
-- most of them cannot do so by /value/ if there are any cycles.
-- This is possible in Haskell thanks to lazy evaluation,
-- and this technique is called ["tying the knot"](https://wiki.haskell.org/Tying_the_Knot).
--
-- However, tying the knot to represent graphs with cycles can be problematic.
-- It is equivalent to and indistinguishable from an infinite multiway tree.
-- This can be resolved by assuming that values with the same label are the same vertex.
-- Unfortunately, this allows for an inconsistent graph representation,
-- and there is no general way to confirm that a graph representation is consistent.
--
-- For example, there are no graphs consistent with the following representation:
--
-- >>> :{
-- let v1  = Var 1 [v2]
--     v2  = Var 2 [v3]
--     v3  = Var 3 [v1']
--     v1' = Var 1 [v3]
-- :}
--
-- On the other hand, the following is a consistent representation of a graph.
-- Unfortunately, it cannot be proven that it is consistent using just the values.
--
-- >>> :{
-- let v1 = Var 1 [v2]
--     v2 = Var 2 [v1]
-- :}
--
-- If there are no cycles in the graph, there is no need to tie the knot, so this is not an issue.
-- In fact, trees are graphs which are often represented this way.
data Var a = Var a [Var a]
deriving Vertex -> Var a -> ShowS
forall a. Show a => Vertex -> Var a -> ShowS
forall a. Show a => [Var a] -> ShowS
forall a. Show a => Var a -> String
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Var a] -> ShowS
$cshowList :: forall a. Show a => [Var a] -> ShowS show :: Var a -> String$cshow :: forall a. Show a => Var a -> String
showsPrec :: Vertex -> Var a -> ShowS
$cshowsPrec :: forall a. Show a => Vertex -> Var a -> ShowS Show instance Eq a => Eq (Var a) where == :: Var a -> Var a -> Bool (==) (Var a v [Var a] vs) (Var a v' [Var a] vs') | a v forall a. Eq a => a -> a -> Bool /= a v' = Bool False | Bool otherwise = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool elem [Var a] vs forall a b. (a -> b) -> a -> b$ forall a. [a] -> [[a]]
permutations [Var a]
vs'

-- | Graphs can also be represented by the lists of its vertexes and edges.
-- This is close to the standard mathematical definition of a graph.
--
-- For example, the example graph can be represented as:
--
-- >>> Lists ([1, 2, 3, 4, 5], [(1, 2), (1, 4), (2, 3), (2, 4), (3, 4), (4, 5)])
-- Lists ...
newtype Lists = Lists ([Vertex], [(Vertex, Vertex)])
deriving (Vertex -> Lists -> ShowS
[Lists] -> ShowS
Lists -> String
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Lists] -> ShowS
$cshowList :: [Lists] -> ShowS show :: Lists -> String$cshow :: Lists -> String
showsPrec :: Vertex -> Lists -> ShowS
$cshowsPrec :: Vertex -> Lists -> ShowS Show, forall x. Rep Lists x -> Lists forall x. Lists -> Rep Lists x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a$cto :: forall x. Rep Lists x -> Lists
$cfrom :: forall x. Lists -> Rep Lists x Generic) deriving anyclass Lists -> () forall a. (a -> ()) -> NFData a rnf :: Lists -> ()$crnf :: Lists -> ()
NFData

instance Graph Lists where
vertexes :: Lists -> Set Vertex
vertexes (Lists ([Vertex]
vs, [(Vertex, Vertex)]
_)) = forall a. Ord a => [a] -> Set a
Set.fromList [Vertex]
vs

edges :: Lists -> Set Edge
edges (Lists ([Vertex]
_, [(Vertex, Vertex)]
es)) = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$forall a b. (a -> b) -> [a] -> [b] map (Vertex, Vertex) -> Edge Edge [(Vertex, Vertex)] es toGraph :: (Set Vertex, Set Edge) -> Maybe Lists toGraph (Set Vertex vs, Set Edge es) | (Set Vertex, Set Edge) -> Bool areValidGraphSets (Set Vertex vs, Set Edge es) = forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b$ ([Vertex], [(Vertex, Vertex)]) -> Lists
Lists (forall a. Set a -> [a]
Set.toList Set Vertex
vs, forall a b. (a -> b) -> [a] -> [b]
map (\(Edge (Vertex, Vertex)
e) -> (Vertex, Vertex)
e) forall a b. (a -> b) -> a -> b
$forall a. Set a -> [a] Set.toList Set Edge es) | Bool otherwise = forall a. Maybe a Nothing isValidGraph :: Lists -> Bool isValidGraph (Lists ([Vertex] vs, [(Vertex, Vertex)] es)) = (Set Vertex, Set Edge) -> Bool areValidGraphSets (forall a. Ord a => [a] -> Set a Set.fromList [Vertex] vs, forall a. Ord a => [a] -> Set a Set.fromList forall a b. (a -> b) -> a -> b$ forall a b. (a -> b) -> [a] -> [b]
map (Vertex, Vertex) -> Edge
Edge [(Vertex, Vertex)]
es)

instance Eq Lists where
== :: Lists -> Lists -> Bool
(==) = forall g. Graph g => g -> g -> Bool
equals

-- | A common approach to representing graphs are with /adjacency lists/.
-- As the name implies, for each vertex it lists its adjacent vertexes
--
-- For example, the example graph can be represented as:
--
-- >>> Adjacency [(1, [2, 4]), (2, [1, 3, 4]), (3, [2, 4]), (4, [1, 2, 3, 5]), (5, [4])]
deriving (Vertex -> Adjacency -> ShowS
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowList :: [Adjacency] -> ShowS show :: Adjacency -> String$cshow :: Adjacency -> String
showsPrec :: Vertex -> Adjacency -> ShowS
$cshowsPrec :: Vertex -> Adjacency -> ShowS Show, forall x. Rep Adjacency x -> Adjacency forall x. Adjacency -> Rep Adjacency x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a$cto :: forall x. Rep Adjacency x -> Adjacency
$cfrom :: forall x. Adjacency -> Rep Adjacency x Generic) deriving anyclass Adjacency -> () forall a. (a -> ()) -> NFData a rnf :: Adjacency -> ()$crnf :: Adjacency -> ()
NFData

vertexes :: Adjacency -> Set Vertex
vs) = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$forall a b. (a -> b) -> [a] -> [b] map forall a b. (a, b) -> a fst [(Vertex, [Vertex])] vs edges :: Adjacency -> Set Edge edges (Adjacency [(Vertex, [Vertex])] vs) = forall a. Ord a => [a] -> Set a Set.fromList forall a b. (a -> b) -> a -> b$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(Vertex
v, [Vertex]
es) -> [(Vertex, Vertex) -> Edge
Edge (Vertex
v, Vertex
e) | Vertex
e <- [Vertex]
es]) [(Vertex, [Vertex])]
vs

neighbors :: Vertex -> Adjacency -> Set Vertex
neighbors Vertex
vs) = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$forall a b. (a, b) -> b snd forall a b. (a -> b) -> a -> b$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$forall a. (a -> Bool) -> [a] -> [a] filter (forall a. Eq a => a -> a -> Bool (==) Vertex v forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a, b) -> a fst) [(Vertex, [Vertex])] vs adjacent :: Vertex -> Vertex -> Adjacency -> Bool adjacent Vertex u Vertex v (Adjacency [(Vertex, [Vertex])] vs) | forall (t :: * -> *) a. Foldable t => t a -> Bool null [(Vertex, [Vertex])] ls = Bool False | Bool otherwise = forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool elem Vertex v forall a b. (a -> b) -> a -> b$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$forall a. [a] -> a head [(Vertex, [Vertex])] ls where ls :: [(Vertex, [Vertex])] ls = forall a. (a -> Bool) -> [a] -> [a] filter (forall a. Eq a => a -> a -> Bool (==) Vertex u forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a, b) -> a fst) [(Vertex, [Vertex])] vs toGraph :: (Set Vertex, Set Edge) -> Maybe Adjacency toGraph (Set Vertex, Set Edge) g | (Set Vertex, Set Edge) -> Bool areValidGraphSets (Set Vertex, Set Edge) g = forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b$ [(Vertex, [Vertex])] -> Adjacency
Adjacency forall a b. (a -> b) -> a -> b
$forall k a. Map k a -> [(k, a)] Map.toList forall a b. (a -> b) -> a -> b$ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Set a -> [a]
Set.toList Map Vertex (Set Vertex)
m
| Bool
otherwise           = forall a. Maybe a
Nothing
where (G Map Vertex (Set Vertex)
m) = forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$forall g. Graph g => (Set Vertex, Set Edge) -> Maybe g toGraph (Set Vertex, Set Edge) g :: G isValidGraph :: Adjacency -> Bool isValidGraph (Adjacency [(Vertex, [Vertex])] ls) = Bool unique Bool -> Bool -> Bool && Bool symmetric where -- There should not be more than one adjacency list for the same vertex. unique :: Bool unique = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all (forall a. Eq a => a -> a -> Bool (==) Vertex 1 forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (t :: * -> *) a. Foldable t => t a -> Vertex length) forall a b. (a -> b) -> a -> b$ forall a. Eq a => [a] -> [[a]]
group forall a b. (a -> b) -> a -> b
$forall a. Ord a => [a] -> [a] sort forall a b. (a -> b) -> a -> b$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(Vertex, [Vertex])]
ls
-- The validity condition is basically the same as that of 'G', which is more efficient to check.
symmetric :: Bool
symmetric = forall g. Graph g => g -> Bool
isValidGraph forall a b. (a -> b) -> a -> b
$Map Vertex (Set Vertex) -> G G forall a b. (a -> b) -> a -> b$ forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList forall a b. (a -> b) -> a -> b
$forall a b. (a -> b) -> [a] -> [b] map (\(Vertex v, [Vertex] vs) -> (Vertex v, forall a. Ord a => [a] -> Set a Set.fromList [Vertex] vs)) [(Vertex, [Vertex])] ls instance Eq Adjacency where == :: Adjacency -> Adjacency -> Bool (==) = forall g. Graph g => g -> g -> Bool equals -- | The previous approaches can be verbose and error-prone for humans to use. -- -- An easier way for humans is to use paths of vertexes to represent both the vertexes and edges. -- Within a path is implicitly an edge between consecutive vertexes. -- E.g., a path @[a, b, c, ...]@ means there are vertexes @a@, @b@, @c@, ... and edges @(a, b)@, @(b, c)@, ... -- There will be as many paths as required to represent all edges in the graph. -- -- For example, the example graph can be represented as: -- -- >>> Paths [[1, 2, 3, 4, 5], [1, 4], [2, 4]] -- Paths ... -- -- === __DOT graphs__ -- -- This is similar to the approach used by DOT graphs, -- which are commonly used to generate [visualizations of graphs](https://graphviz.org/). -- E.g., the example graph can be written in DOT as: -- -- > graph { -- > 1 -- 2 -- 3 -- 4 -- 5 -- > 1 -- 4 -- > 2 -- 4 -- > } newtype Paths = Paths [[Vertex]] deriving (Vertex -> Paths -> ShowS [Paths] -> ShowS Paths -> String forall a. (Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Paths] -> ShowS$cshowList :: [Paths] -> ShowS
show :: Paths -> String
$cshow :: Paths -> String showsPrec :: Vertex -> Paths -> ShowS$cshowsPrec :: Vertex -> Paths -> ShowS
Show, forall x. Rep Paths x -> Paths
forall x. Paths -> Rep Paths x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Paths x -> Paths$cfrom :: forall x. Paths -> Rep Paths x
Generic)
deriving anyclass Paths -> ()
forall a. (a -> ()) -> NFData a
rnf :: Paths -> ()
$crnf :: Paths -> () NFData instance Graph Paths where vertexes :: Paths -> Set Vertex vertexes (Paths [[Vertex]] ps) = forall a. Ord a => [a] -> Set a Set.fromList forall a b. (a -> b) -> a -> b$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Vertex]]
ps

edges :: Paths -> Set Edge
edges (Paths [[Vertex]]
ps) = forall a. Ord a => [a] -> Set a
Set.fromList forall a b. (a -> b) -> a -> b
$forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap [Vertex] -> [Edge] toEdges [[Vertex]] ps where toEdges :: [Vertex] -> [Edge] toEdges [] = [] toEdges [Vertex _] = [] toEdges (Vertex u : vs :: [Vertex] vs@(Vertex v:[Vertex] _)) = (Vertex, Vertex) -> Edge Edge (Vertex u, Vertex v) forall a. a -> [a] -> [a] : [Vertex] -> [Edge] toEdges [Vertex] vs toGraph :: (Set Vertex, Set Edge) -> Maybe Paths toGraph (Set Vertex, Set Edge) g | (Set Vertex, Set Edge) -> Bool areValidGraphSets (Set Vertex, Set Edge) g = forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b$ [[Vertex]] -> Paths
Paths forall a b. (a -> b) -> a -> b
$forall a b. (a, b) -> b snd forall a b. (a -> b) -> a -> b$ (G, [[Vertex]]) -> (G, [[Vertex]])
extractPaths (forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$forall g. Graph g => (Set Vertex, Set Edge) -> Maybe g toGraph (Set Vertex, Set Edge) g, []) | Bool otherwise = forall a. Maybe a Nothing isValidGraph :: Paths -> Bool isValidGraph = forall a b. a -> b -> a const Bool True extractPaths :: (G, [[Vertex]]) -> (G, [[Vertex]]) extractPaths :: (G, [[Vertex]]) -> (G, [[Vertex]]) extractPaths e :: (G, [[Vertex]]) e@(g :: G g@(G Map Vertex (Set Vertex) m), [[Vertex]] ps) | forall k a. Map k a -> Bool Map.null Map Vertex (Set Vertex) m = (G, [[Vertex]]) e | Bool otherwise = (G, [[Vertex]]) -> (G, [[Vertex]]) extractPaths (G g', [Vertex] p' forall a. a -> [a] -> [a] : [[Vertex]] ps) where (G g', [Vertex] p') = Vertex -> G -> (G, [Vertex]) extractPathFrom (G -> Vertex pathStart G g) G g pathStart :: G -> Vertex pathStart :: G -> Vertex pathStart (G Map Vertex (Set Vertex) m) = forall a b. (a, b) -> a fst forall a b. (a -> b) -> a -> b$ forall a. [a] -> a
head forall a b. (a -> b) -> a -> b
$[(Vertex, Set Vertex)] -> [(Vertex, Set Vertex)] candidates forall a b. (a -> b) -> a -> b$ forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex (Set Vertex)
roots
-- Try to choose a vertex in zero or one edge.
-- Make it more likely to get paths such as [[1,2,3]] instead of [[2,3],[1,2]].
where roots :: Map Vertex (Set Vertex)
roots = forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (forall a. Ord a => a -> a -> Bool
(>=) Vertex
1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> Vertex
Set.size) Map Vertex (Set Vertex)
m
candidates :: [(Vertex, Set Vertex)] -> [(Vertex, Set Vertex)]
candidates [] = forall k a. Map k a -> [(k, a)]
Map.toList Map Vertex (Set Vertex)
m
candidates [(Vertex, Set Vertex)]
vs = [(Vertex, Set Vertex)]
vs

extractPathFrom :: Vertex -> G -> (G, [Vertex])
extractPathFrom :: Vertex -> G -> (G, [Vertex])
extractPathFrom Vertex
v G
g = Vertex -> (G, [Vertex]) -> (G, [Vertex])
extractPath Vertex
v (G
g, [])

extractPath :: Vertex -> (G, [Vertex]) -> (G, [Vertex])
extractPath :: Vertex -> (G, [Vertex]) -> (G, [Vertex])
extractPath Vertex
v (g :: G
g@(G Map Vertex (Set Vertex)
m), [Vertex]
p)
| forall a. Set a -> Bool
Set.null Set Vertex
vs = (Map Vertex (Set Vertex) -> G
G forall a b. (a -> b) -> a -> b
$forall k a. Ord k => k -> Map k a -> Map k a Map.delete Vertex v Map Vertex (Set Vertex) m, Vertex v forall a. a -> [a] -> [a] : [Vertex] p) | Bool otherwise = Vertex -> (G, [Vertex]) -> (G, [Vertex]) extractPath Vertex v' (Vertex -> Vertex -> G -> G deleteEdge Vertex v Vertex v' G g, Vertex v forall a. a -> [a] -> [a] : [Vertex] p) where vs :: Set Vertex vs = forall g. Graph g => Vertex -> g -> Set Vertex neighbors Vertex v G g v' :: Vertex v' = forall a. Set a -> a Set.findMin Set Vertex vs deleteEdge :: Vertex -> Vertex -> G -> G deleteEdge :: Vertex -> Vertex -> G -> G deleteEdge Vertex u Vertex v (G Map Vertex (Set Vertex) m) = Map Vertex (Set Vertex) -> G G forall a b. (a -> b) -> a -> b$ forall {k} {a}.
(Ord k, Ord a) =>
k -> a -> Map k (Set a) -> Map k (Set a)
delete Vertex
u Vertex
v forall a b. (a -> b) -> a -> b
$forall {k} {a}. (Ord k, Ord a) => k -> a -> Map k (Set a) -> Map k (Set a) delete Vertex v Vertex u Map Vertex (Set Vertex) m where delete :: k -> a -> Map k (Set a) -> Map k (Set a) delete k u' a v' = forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a Map.update (forall {a}. Set a -> Maybe (Set a) toMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Ord a => a -> Set a -> Set a Set.delete a v') k u' toMaybe :: Set a -> Maybe (Set a) toMaybe Set a vs | forall a. Set a -> Bool Set.null Set a vs = forall a. Maybe a Nothing | Bool otherwise = forall a. a -> Maybe a Just Set a vs instance Eq Paths where == :: Paths -> Paths -> Bool (==) = forall g. Graph g => g -> g -> Bool equals -- | Represents a graph with a map where a vertex is a key and the set of its neighbors is the value. -- -- This is basically an indexed version of adjacency lists. -- This representation may be the easiest for graph functions to use, -- and we will use it as the default representation of graphs. -- -- For example, the example graph can be represented as: -- -- >>> :{ -- G$ Map.map Set.fromList $Map.fromList -- [ (1, [2, 4]) -- , (2, [1, 3, 4]) -- , (3, [2, 4]) -- , (4, [1, 2, 3, 5]) -- , (5, [4]) -- ] -- :} -- G ... newtype G = G (Map Vertex (Set Vertex)) deriving (G -> G -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: G -> G -> Bool$c/= :: G -> G -> Bool
== :: G -> G -> Bool
$c== :: G -> G -> Bool Eq, Vertex -> G -> ShowS [G] -> ShowS G -> String forall a. (Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [G] -> ShowS$cshowList :: [G] -> ShowS
show :: G -> String
$cshow :: G -> String showsPrec :: Vertex -> G -> ShowS$cshowsPrec :: Vertex -> G -> ShowS
Show, forall x. Rep G x -> G
forall x. G -> Rep G x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep G x -> G$cfrom :: forall x. G -> Rep G x
Generic)
deriving anyclass G -> ()
forall a. (a -> ()) -> NFData a
rnf :: G -> ()
$crnf :: G -> () NFData instance Graph G where vertexes :: G -> Set Vertex vertexes (G Map Vertex (Set Vertex) m) = forall k a. Map k a -> Set k Map.keysSet Map Vertex (Set Vertex) m edges :: G -> Set Edge edges (G Map Vertex (Set Vertex) m) = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a Map.foldlWithKey Set Edge -> Vertex -> Set Vertex -> Set Edge addVertex forall a. Set a Set.empty Map Vertex (Set Vertex) m where addVertex :: Set Edge -> Vertex -> Set Vertex -> Set Edge addVertex Set Edge s Vertex v Set Vertex vs = forall a. Ord a => Set a -> Set a -> Set a Set.union Set Edge s forall a b. (a -> b) -> a -> b$ Vertex -> Set Vertex -> Set Edge
toEdges Vertex
v Set Vertex
vs
toEdges :: Vertex -> Set Vertex -> Set Edge
toEdges Vertex
v = forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (\Vertex
u -> (Vertex, Vertex) -> Edge
Edge (Vertex
v, Vertex
u))

neighbors :: Vertex -> G -> Set Vertex
neighbors Vertex
v (G Map Vertex (Set Vertex)
m) = forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault forall a. Set a
Set.empty Vertex
v Map Vertex (Set Vertex)
m

adjacent :: Vertex -> Vertex -> G -> Bool
u Vertex
v G
g = forall a. Ord a => a -> Set a -> Bool
Set.member Vertex
u forall a b. (a -> b) -> a -> b
$forall g. Graph g => Vertex -> g -> Set Vertex neighbors Vertex v G g toGraph :: (Set Vertex, Set Edge) -> Maybe G toGraph (Set Vertex vs, Set Edge es) | (Set Vertex, Set Edge) -> Bool areValidGraphSets (Set Vertex vs, Set Edge es) = forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b$ Map Vertex (Set Vertex) -> G
G forall a b. (a -> b) -> a -> b
$forall a b. (a -> b -> a) -> a -> Set b -> a Set.foldl Map Vertex (Set Vertex) -> Edge -> Map Vertex (Set Vertex) insertEdge forall {a}. Map Vertex (Set a) fromVertexes Set Edge es | Bool otherwise = forall a. Maybe a Nothing where fromVertexes :: Map Vertex (Set a) fromVertexes = forall k a. (k -> a) -> Set k -> Map k a Map.fromSet (forall a b. a -> b -> a const forall a. Set a Set.empty) Set Vertex vs insertEdge :: Map Vertex (Set Vertex) -> Edge -> Map Vertex (Set Vertex) insertEdge Map Vertex (Set Vertex) m (Edge (Vertex u, Vertex v)) = forall {k} {a}. (Ord k, Ord a) => k -> a -> Map k (Set a) -> Map k (Set a) insertNeighbor Vertex u Vertex v forall a b. (a -> b) -> a -> b$ forall {k} {a}.
(Ord k, Ord a) =>
k -> a -> Map k (Set a) -> Map k (Set a)
insertNeighbor Vertex
v Vertex
u Map Vertex (Set Vertex)
m
insertNeighbor :: k -> a -> Map k (Set a) -> Map k (Set a)
insertNeighbor k
u a
v = forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Ord a => Set a -> Set a -> Set a
Set.union k
u (forall a. a -> Set a
Set.singleton a
v)

isValidGraph :: G -> Bool
isValidGraph (G Map Vertex (Set Vertex)
m) = forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey (\Bool
r Vertex
v Set Vertex
vs -> Bool
r Bool -> Bool -> Bool
&& Vertex -> Set Vertex -> Bool
symmetric Vertex
v Set Vertex
vs) Bool
True Map Vertex (Set Vertex)
m
where symmetric :: Vertex -> Set Vertex -> Bool
symmetric Vertex
v = forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl (\Bool
r' Vertex
v' -> Bool
r' Bool -> Bool -> Bool
&& Vertex -> Vertex -> Bool
converse Vertex
v Vertex
v') Bool
True
converse :: Vertex -> Vertex -> Bool
converse Vertex
v Vertex
v' = Vertex
v forall {a}. Ord a => a -> Maybe (Set a) -> Bool
inside forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Vertex
v' Map Vertex (Set Vertex)
m
inside :: a -> Maybe (Set a) -> Bool
inside a
_ Maybe (Set a)
Nothing   = Bool
False  -- edge has vertex not in set of vertexes
inside a
v (Just Set a
vs) = forall a. Ord a => a -> Set a -> Bool
Set.member a
v Set a
vs