{- |
Description: Supporting definitions for graph problems
Copyright: Copyright (C) 2023 Yoo Chung
License: GPL-3.0-or-later
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),
  Adjacency (Adjacency),
  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
  adjacent Vertex
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])]
-- Adjacency ...
newtype Adjacency = Adjacency [(Vertex, [Vertex])]
  deriving (Vertex -> Adjacency -> ShowS
[Adjacency] -> ShowS
Adjacency -> String
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Adjacency] -> ShowS
$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

instance Graph Adjacency where
  vertexes :: Adjacency -> Set Vertex
vertexes (Adjacency [(Vertex, [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
v (Adjacency [(Vertex, [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
adjacent Vertex
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