{-# OPTIONS_GHC -Wno-x-partial -Wno-unrecognised-warning-flags #-}

{- |
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 = (g -> Set Vertex forall g. Graph g => g -> Set Vertex vertexes g g, g -> Set Edge 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 = (Set Vertex -> Edge -> Set Vertex) -> Set Vertex -> Set Edge -> Set Vertex forall a b. (a -> b -> a) -> a -> Set b -> a Set.foldl Set Vertex -> Edge -> Set Vertex extract Set Vertex forall a. Set a Set.empty (Set Edge -> Set Vertex) -> Set Edge -> Set Vertex forall a b. (a -> b) -> a -> b$ g -> Set Edge
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 Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
u'   = Vertex -> Set Vertex -> Set Vertex
forall a. Ord a => a -> Set a -> Set a
Set.insert Vertex
v' Set Vertex
vs
| Vertex
v Vertex -> Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Vertex
v'   = Vertex -> Set Vertex -> Set Vertex
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 = Edge -> Set Edge -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member ((Vertex, Vertex) -> Edge
Edge (Vertex
u, Vertex
v)) (g -> Set Edge
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) = Set Vertex -> Set Vertex -> Bool
forall a. Ord a => Set a -> Set a -> Bool
Set.isSubsetOf Set Vertex
vs' Set Vertex
vs
where vs' :: Set Vertex
vs' = (Set Vertex -> Edge -> Set Vertex)
-> Set Vertex -> Set Edge -> Set Vertex
forall a b. (a -> b -> a) -> a -> Set b -> a
Set.foldl (\Set Vertex
s (Edge (Vertex
u, Vertex
v)) -> Vertex -> Set Vertex -> Set Vertex
forall a. Ord a => a -> Set a -> Set a
Set.insert Vertex
u (Set Vertex -> Set Vertex) -> Set Vertex -> Set Vertex
forall a b. (a -> b) -> a -> b
$Vertex -> Set Vertex -> Set Vertex forall a. Ord a => a -> Set a -> Set a Set.insert Vertex v Set Vertex s) Set Vertex 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 (Vertex -> Edge -> ShowS) -> (Edge -> String) -> ([Edge] -> ShowS) -> Show Edge forall a. (Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a$cshowsPrec :: Vertex -> Edge -> ShowS
showsPrec :: Vertex -> Edge -> ShowS
$cshow :: Edge -> String show :: Edge -> String$cshowList :: [Edge] -> ShowS
showList :: [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 (Vertex, Vertex) -> (Vertex, Vertex) -> Bool
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') = (Vertex, Vertex) -> (Vertex, Vertex) -> Ordering
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 Vertex -> Vertex -> Bool
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 Set Vertex -> Set Vertex -> Bool
forall a. Eq a => a -> a -> Bool
== Set Vertex
vs' Bool -> Bool -> Bool
&& Set Edge
es Set Edge -> Set Edge -> Bool
forall a. Eq a => a -> a -> Bool
== Set Edge
es'
where (Set Vertex
vs, Set Vertex
vs') = (g -> Set Vertex
forall g. Graph g => g -> Set Vertex
vertexes g
g, g -> Set Vertex
forall g. Graph g => g -> Set Vertex
vertexes g
g')
(Set Edge
es, Set Edge
es') = (g -> Set Edge
forall g. Graph g => g -> Set Edge
edges g
g, g -> Set Edge
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
[Var a] -> ShowS
Var a -> String
(Vertex -> Var a -> ShowS)
-> (Var a -> String) -> ([Var a] -> ShowS) -> Show (Var a)
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
$cshowsPrec :: forall a. Show a => Vertex -> Var a -> ShowS showsPrec :: Vertex -> Var a -> ShowS$cshow :: forall a. Show a => Var a -> String
show :: Var a -> String
$cshowList :: forall a. Show a => [Var a] -> ShowS showList :: [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 a -> a -> Bool forall a. Eq a => a -> a -> Bool /= a v' = Bool False | Bool otherwise = [Var a] -> [[Var a]] -> Bool forall a. Eq a => a -> [a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool elem [Var a] vs ([[Var a]] -> Bool) -> [[Var a]] -> Bool forall a b. (a -> b) -> a -> b$ [Var a] -> [[Var a]]
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
(Vertex -> Lists -> ShowS)
-> (Lists -> String) -> ([Lists] -> ShowS) -> Show Lists
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> Lists -> ShowS showsPrec :: Vertex -> Lists -> ShowS$cshow :: Lists -> String
show :: Lists -> String
$cshowList :: [Lists] -> ShowS showList :: [Lists] -> ShowS Show, (forall x. Lists -> Rep Lists x) -> (forall x. Rep Lists x -> Lists) -> Generic Lists 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$cfrom :: forall x. Lists -> Rep Lists x
from :: forall x. Lists -> Rep Lists x
$cto :: forall x. Rep Lists x -> Lists to :: forall x. Rep Lists x -> Lists Generic) deriving anyclass Lists -> () (Lists -> ()) -> NFData Lists forall a. (a -> ()) -> NFData a$crnf :: Lists -> ()
rnf :: Lists -> ()
NFData

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

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

instance Eq Lists where
== :: Lists -> Lists -> Bool
(==) = 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
$cshowsPrec :: Vertex -> Adjacency -> ShowS showsPrec :: Vertex -> Adjacency -> ShowS$cshow :: Adjacency -> String
$cshowList :: [Adjacency] -> ShowS showList :: [Adjacency] -> ShowS Show, (forall x. Adjacency -> Rep Adjacency x) -> (forall x. Rep Adjacency x -> Adjacency) -> Generic Adjacency 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$cfrom :: forall x. Adjacency -> Rep Adjacency x
$cto :: forall x. Rep Adjacency x -> Adjacency to :: forall x. Rep Adjacency x -> Adjacency Generic) deriving anyclass Adjacency -> () (Adjacency -> ()) -> NFData Adjacency forall a. (a -> ()) -> NFData a$crnf :: Adjacency -> ()
NFData

vertexes :: Adjacency -> Set Vertex
vs) = [Vertex] -> Set Vertex
forall a. Ord a => [a] -> Set a
Set.fromList ([Vertex] -> Set Vertex) -> [Vertex] -> Set Vertex
forall a b. (a -> b) -> a -> b
$((Vertex, [Vertex]) -> Vertex) -> [(Vertex, [Vertex])] -> [Vertex] forall a b. (a -> b) -> [a] -> [b] map (Vertex, [Vertex]) -> Vertex forall a b. (a, b) -> a fst [(Vertex, [Vertex])] vs edges :: Adjacency -> Set Edge edges (Adjacency [(Vertex, [Vertex])] vs) = [Edge] -> Set Edge forall a. Ord a => [a] -> Set a Set.fromList ([Edge] -> Set Edge) -> [Edge] -> Set Edge forall a b. (a -> b) -> a -> b$ ((Vertex, [Vertex]) -> [Edge]) -> [(Vertex, [Vertex])] -> [Edge]
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) = [Vertex] -> Set Vertex
forall a. Ord a => [a] -> Set a
Set.fromList ([Vertex] -> Set Vertex) -> [Vertex] -> Set Vertex
forall a b. (a -> b) -> a -> b
$(Vertex, [Vertex]) -> [Vertex] forall a b. (a, b) -> b snd ((Vertex, [Vertex]) -> [Vertex]) -> (Vertex, [Vertex]) -> [Vertex] forall a b. (a -> b) -> a -> b$ [(Vertex, [Vertex])] -> (Vertex, [Vertex])
forall a. HasCallStack => [a] -> a
head ([(Vertex, [Vertex])] -> (Vertex, [Vertex]))
-> [(Vertex, [Vertex])] -> (Vertex, [Vertex])
forall a b. (a -> b) -> a -> b
$((Vertex, [Vertex]) -> Bool) -> [(Vertex, [Vertex])] -> [(Vertex, [Vertex])] forall a. (a -> Bool) -> [a] -> [a] filter (Vertex -> Vertex -> Bool forall a. Eq a => a -> a -> Bool (==) Vertex v (Vertex -> Bool) -> ((Vertex, [Vertex]) -> Vertex) -> (Vertex, [Vertex]) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (Vertex, [Vertex]) -> Vertex forall a b. (a, b) -> a fst) [(Vertex, [Vertex])] vs adjacent :: Vertex -> Vertex -> Adjacency -> Bool adjacent Vertex u Vertex v (Adjacency [(Vertex, [Vertex])] vs) | [(Vertex, [Vertex])] -> Bool forall a. [a] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [(Vertex, [Vertex])] ls = Bool False | Bool otherwise = Vertex -> [Vertex] -> Bool forall a. Eq a => a -> [a] -> Bool forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool elem Vertex v ([Vertex] -> Bool) -> [Vertex] -> Bool forall a b. (a -> b) -> a -> b$ (Vertex, [Vertex]) -> [Vertex]
forall a b. (a, b) -> b
snd ((Vertex, [Vertex]) -> [Vertex]) -> (Vertex, [Vertex]) -> [Vertex]
forall a b. (a -> b) -> a -> b
$[(Vertex, [Vertex])] -> (Vertex, [Vertex]) forall a. HasCallStack => [a] -> a head [(Vertex, [Vertex])] ls where ls :: [(Vertex, [Vertex])] ls = ((Vertex, [Vertex]) -> Bool) -> [(Vertex, [Vertex])] -> [(Vertex, [Vertex])] forall a. (a -> Bool) -> [a] -> [a] filter (Vertex -> Vertex -> Bool forall a. Eq a => a -> a -> Bool (==) Vertex u (Vertex -> Bool) -> ((Vertex, [Vertex]) -> Vertex) -> (Vertex, [Vertex]) -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . (Vertex, [Vertex]) -> Vertex 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 = Adjacency -> Maybe Adjacency forall a. a -> Maybe a Just (Adjacency -> Maybe Adjacency) -> Adjacency -> Maybe Adjacency forall a b. (a -> b) -> a -> b$ [(Vertex, [Vertex])] -> Adjacency
forall a b. (a -> b) -> a -> b
$Map Vertex [Vertex] -> [(Vertex, [Vertex])] forall k a. Map k a -> [(k, a)] Map.toList (Map Vertex [Vertex] -> [(Vertex, [Vertex])]) -> Map Vertex [Vertex] -> [(Vertex, [Vertex])] forall a b. (a -> b) -> a -> b$ (Set Vertex -> [Vertex])
-> Map Vertex (Set Vertex) -> Map Vertex [Vertex]
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map Set Vertex -> [Vertex]
forall a. Set a -> [a]
Set.toList Map Vertex (Set Vertex)
m
| Bool
forall a. Maybe a
Nothing
where (G Map Vertex (Set Vertex)
m) = Maybe G -> G
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe G -> G) -> Maybe G -> G
forall a b. (a -> b) -> a -> b
$(Set Vertex, Set Edge) -> Maybe G 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 = ([Vertex] -> Bool) -> [[Vertex]] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all (Vertex -> Vertex -> Bool forall a. Eq a => a -> a -> Bool (==) Vertex 1 (Vertex -> Bool) -> ([Vertex] -> Vertex) -> [Vertex] -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . [Vertex] -> Vertex forall a. [a] -> Vertex forall (t :: * -> *) a. Foldable t => t a -> Vertex length) ([[Vertex]] -> Bool) -> [[Vertex]] -> Bool forall a b. (a -> b) -> a -> b$ [Vertex] -> [[Vertex]]
forall a. Eq a => [a] -> [[a]]
group ([Vertex] -> [[Vertex]]) -> [Vertex] -> [[Vertex]]
forall a b. (a -> b) -> a -> b
$[Vertex] -> [Vertex] forall a. Ord a => [a] -> [a] sort ([Vertex] -> [Vertex]) -> [Vertex] -> [Vertex] forall a b. (a -> b) -> a -> b$ ((Vertex, [Vertex]) -> Vertex) -> [(Vertex, [Vertex])] -> [Vertex]
forall a b. (a -> b) -> [a] -> [b]
map (Vertex, [Vertex]) -> Vertex
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 = G -> Bool
forall g. Graph g => g -> Bool
isValidGraph (G -> Bool) -> G -> Bool
forall a b. (a -> b) -> a -> b
$Map Vertex (Set Vertex) -> G G (Map Vertex (Set Vertex) -> G) -> Map Vertex (Set Vertex) -> G forall a b. (a -> b) -> a -> b$ [(Vertex, Set Vertex)] -> Map Vertex (Set Vertex)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Vertex, Set Vertex)] -> Map Vertex (Set Vertex))
-> [(Vertex, Set Vertex)] -> Map Vertex (Set Vertex)
forall a b. (a -> b) -> a -> b
$((Vertex, [Vertex]) -> (Vertex, Set Vertex)) -> [(Vertex, [Vertex])] -> [(Vertex, Set Vertex)] forall a b. (a -> b) -> [a] -> [b] map (\(Vertex v, [Vertex] vs) -> (Vertex v, [Vertex] -> Set Vertex forall a. Ord a => [a] -> Set a Set.fromList [Vertex] vs)) [(Vertex, [Vertex])] ls instance Eq Adjacency where == :: Adjacency -> Adjacency -> Bool (==) = 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 (Vertex -> Paths -> ShowS) -> (Paths -> String) -> ([Paths] -> ShowS) -> Show Paths forall a. (Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a$cshowsPrec :: Vertex -> Paths -> ShowS
showsPrec :: Vertex -> Paths -> ShowS
$cshow :: Paths -> String show :: Paths -> String$cshowList :: [Paths] -> ShowS
showList :: [Paths] -> ShowS
Show, (forall x. Paths -> Rep Paths x)
-> (forall x. Rep Paths x -> Paths) -> Generic Paths
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
$cfrom :: forall x. Paths -> Rep Paths x from :: forall x. Paths -> Rep Paths x$cto :: forall x. Rep Paths x -> Paths
to :: forall x. Rep Paths x -> Paths
Generic)
deriving anyclass Paths -> ()
(Paths -> ()) -> NFData Paths
forall a. (a -> ()) -> NFData a
$crnf :: Paths -> () rnf :: Paths -> () NFData instance Graph Paths where vertexes :: Paths -> Set Vertex vertexes (Paths [[Vertex]] ps) = [Vertex] -> Set Vertex forall a. Ord a => [a] -> Set a Set.fromList ([Vertex] -> Set Vertex) -> [Vertex] -> Set Vertex forall a b. (a -> b) -> a -> b$ [[Vertex]] -> [Vertex]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Vertex]]
ps

edges :: Paths -> Set Edge
edges (Paths [[Vertex]]
ps) = [Edge] -> Set Edge
forall a. Ord a => [a] -> Set a
Set.fromList ([Edge] -> Set Edge) -> [Edge] -> Set Edge
forall a b. (a -> b) -> a -> b
$([Vertex] -> [Edge]) -> [[Vertex]] -> [Edge] 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) Edge -> [Edge] -> [Edge] 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 = Paths -> Maybe Paths forall a. a -> Maybe a Just (Paths -> Maybe Paths) -> Paths -> Maybe Paths forall a b. (a -> b) -> a -> b$ [[Vertex]] -> Paths
Paths ([[Vertex]] -> Paths) -> [[Vertex]] -> Paths
forall a b. (a -> b) -> a -> b
$(G, [[Vertex]]) -> [[Vertex]] forall a b. (a, b) -> b snd ((G, [[Vertex]]) -> [[Vertex]]) -> (G, [[Vertex]]) -> [[Vertex]] forall a b. (a -> b) -> a -> b$ (G, [[Vertex]]) -> (G, [[Vertex]])
extractPaths (Maybe G -> G
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe G -> G) -> Maybe G -> G
forall a b. (a -> b) -> a -> b
$(Set Vertex, Set Edge) -> Maybe G forall g. Graph g => (Set Vertex, Set Edge) -> Maybe g toGraph (Set Vertex, Set Edge) g, []) | Bool otherwise = Maybe Paths forall a. Maybe a Nothing isValidGraph :: Paths -> Bool isValidGraph = Bool -> Paths -> Bool 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) | Map Vertex (Set Vertex) -> Bool 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' [Vertex] -> [[Vertex]] -> [[Vertex]] 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) = (Vertex, Set Vertex) -> Vertex forall a b. (a, b) -> a fst ((Vertex, Set Vertex) -> Vertex) -> (Vertex, Set Vertex) -> Vertex forall a b. (a -> b) -> a -> b$ [(Vertex, Set Vertex)] -> (Vertex, Set Vertex)
forall a. HasCallStack => [a] -> a
head ([(Vertex, Set Vertex)] -> (Vertex, Set Vertex))
-> [(Vertex, Set Vertex)] -> (Vertex, Set Vertex)
forall a b. (a -> b) -> a -> b
$[(Vertex, Set Vertex)] -> [(Vertex, Set Vertex)] candidates ([(Vertex, Set Vertex)] -> [(Vertex, Set Vertex)]) -> [(Vertex, Set Vertex)] -> [(Vertex, Set Vertex)] forall a b. (a -> b) -> a -> b$ Map Vertex (Set Vertex) -> [(Vertex, Set Vertex)]
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 = (Set Vertex -> Bool)
-> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex)
forall a k. (a -> Bool) -> Map k a -> Map k a
Map.filter (Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
(>=) Vertex
1 (Vertex -> Bool) -> (Set Vertex -> Vertex) -> Set Vertex -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Vertex -> Vertex
forall a. Set a -> Vertex
Set.size) Map Vertex (Set Vertex)
m
candidates :: [(Vertex, Set Vertex)] -> [(Vertex, Set Vertex)]
candidates [] = Map Vertex (Set Vertex) -> [(Vertex, Set Vertex)]
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)
| Set Vertex -> Bool
forall a. Set a -> Bool
Set.null Set Vertex
vs = (Map Vertex (Set Vertex) -> G
G (Map Vertex (Set Vertex) -> G) -> Map Vertex (Set Vertex) -> G
forall a b. (a -> b) -> a -> b
$Vertex -> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex) forall k a. Ord k => k -> Map k a -> Map k a Map.delete Vertex v Map Vertex (Set Vertex) m, Vertex v Vertex -> [Vertex] -> [Vertex] 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 Vertex -> [Vertex] -> [Vertex] forall a. a -> [a] -> [a] : [Vertex] p) where vs :: Set Vertex vs = Vertex -> G -> Set Vertex forall g. Graph g => Vertex -> g -> Set Vertex neighbors Vertex v G g v' :: Vertex v' = Set Vertex -> Vertex 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 (Map Vertex (Set Vertex) -> G) -> Map Vertex (Set Vertex) -> G forall a b. (a -> b) -> a -> b$ Vertex
-> Vertex -> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex)
forall {k} {a}.
(Ord k, Ord a) =>
k -> a -> Map k (Set a) -> Map k (Set a)
delete Vertex
u Vertex
v (Map Vertex (Set Vertex) -> Map Vertex (Set Vertex))
-> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex)
forall a b. (a -> b) -> a -> b
$Vertex -> Vertex -> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex) 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' = (Set a -> Maybe (Set a)) -> k -> Map k (Set a) -> Map k (Set a) forall k a. Ord k => (a -> Maybe a) -> k -> Map k a -> Map k a Map.update (Set a -> Maybe (Set a) forall {a}. Set a -> Maybe (Set a) toMaybe (Set a -> Maybe (Set a)) -> (Set a -> Set a) -> Set a -> Maybe (Set a) forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> Set a -> Set a 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 | Set a -> Bool forall a. Set a -> Bool Set.null Set a vs = Maybe (Set a) forall a. Maybe a Nothing | Bool otherwise = Set a -> Maybe (Set a) forall a. a -> Maybe a Just Set a vs instance Eq Paths where == :: Paths -> Paths -> Bool (==) = 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 (G -> G -> Bool) -> (G -> G -> Bool) -> Eq G forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a$c== :: G -> G -> Bool
== :: G -> G -> Bool
$c/= :: G -> G -> Bool /= :: G -> G -> Bool Eq, Vertex -> G -> ShowS [G] -> ShowS G -> String (Vertex -> G -> ShowS) -> (G -> String) -> ([G] -> ShowS) -> Show G forall a. (Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a$cshowsPrec :: Vertex -> G -> ShowS
showsPrec :: Vertex -> G -> ShowS
$cshow :: G -> String show :: G -> String$cshowList :: [G] -> ShowS
showList :: [G] -> ShowS
Show, (forall x. G -> Rep G x) -> (forall x. Rep G x -> G) -> Generic G
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
$cfrom :: forall x. G -> Rep G x from :: forall x. G -> Rep G x$cto :: forall x. Rep G x -> G
to :: forall x. Rep G x -> G
Generic)
deriving anyclass G -> ()
(G -> ()) -> NFData G
forall a. (a -> ()) -> NFData a
$crnf :: G -> () rnf :: G -> () NFData instance Graph G where vertexes :: G -> Set Vertex vertexes (G Map Vertex (Set Vertex) m) = Map Vertex (Set Vertex) -> Set Vertex 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) = (Set Edge -> Vertex -> Set Vertex -> Set Edge) -> Set Edge -> Map Vertex (Set Vertex) -> Set Edge forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a Map.foldlWithKey Set Edge -> Vertex -> Set Vertex -> Set Edge addVertex Set Edge 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 = Set Edge -> Set Edge -> Set Edge forall a. Ord a => Set a -> Set a -> Set a Set.union Set Edge s (Set Edge -> Set Edge) -> Set Edge -> Set Edge 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 = (Vertex -> Edge) -> Set Vertex -> Set Edge
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) = Set Vertex -> Vertex -> Map Vertex (Set Vertex) -> Set Vertex
forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault Set Vertex
forall a. Set a
Set.empty Vertex
v Map Vertex (Set Vertex)
m

adjacent :: Vertex -> Vertex -> G -> Bool
u Vertex
v G
g = Vertex -> Set Vertex -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Vertex
u (Set Vertex -> Bool) -> Set Vertex -> Bool
forall a b. (a -> b) -> a -> b
$Vertex -> G -> Set Vertex 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) = G -> Maybe G forall a. a -> Maybe a Just (G -> Maybe G) -> G -> Maybe G forall a b. (a -> b) -> a -> b$ Map Vertex (Set Vertex) -> G
G (Map Vertex (Set Vertex) -> G) -> Map Vertex (Set Vertex) -> G
forall a b. (a -> b) -> a -> b
$(Map Vertex (Set Vertex) -> Edge -> Map Vertex (Set Vertex)) -> Map Vertex (Set Vertex) -> Set Edge -> Map Vertex (Set Vertex) forall a b. (a -> b -> a) -> a -> Set b -> a Set.foldl Map Vertex (Set Vertex) -> Edge -> Map Vertex (Set Vertex) insertEdge Map Vertex (Set Vertex) forall {a}. Map Vertex (Set a) fromVertexes Set Edge es | Bool otherwise = Maybe G forall a. Maybe a Nothing where fromVertexes :: Map Vertex (Set a) fromVertexes = (Vertex -> Set a) -> Set Vertex -> Map Vertex (Set a) forall k a. (k -> a) -> Set k -> Map k a Map.fromSet (Set a -> Vertex -> Set a forall a b. a -> b -> a const Set a 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)) = Vertex -> Vertex -> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex) forall {k} {a}. (Ord k, Ord a) => k -> a -> Map k (Set a) -> Map k (Set a) insertNeighbor Vertex u Vertex v (Map Vertex (Set Vertex) -> Map Vertex (Set Vertex)) -> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex) forall a b. (a -> b) -> a -> b$ Vertex
-> Vertex -> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex)
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 = (Set a -> Set a -> Set a)
-> k -> Set a -> Map k (Set a) -> Map k (Set a)
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
Set.union k
u (a -> Set a
forall a. a -> Set a
Set.singleton a
v)

isValidGraph :: G -> Bool
isValidGraph (G Map Vertex (Set Vertex)
m) = (Bool -> Vertex -> Set Vertex -> Bool)
-> Bool -> Map Vertex (Set Vertex) -> Bool
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 = (Bool -> Vertex -> Bool) -> Bool -> Set Vertex -> Bool
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 Vertex -> Maybe (Set Vertex) -> Bool
forall {a}. Ord a => a -> Maybe (Set a) -> Bool
inside Vertex -> Map Vertex (Set Vertex) -> Maybe (Set Vertex)
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) = a -> Set a -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member a
v Set a
vs