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

{- |
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 = (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
  adjacent Vertex
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])]
-- Adjacency ...
newtype Adjacency = Adjacency [(Vertex, [Vertex])]
  deriving (Vertex -> Adjacency -> ShowS
[Adjacency] -> ShowS
Adjacency -> String
(Vertex -> Adjacency -> ShowS)
-> (Adjacency -> String)
-> ([Adjacency] -> ShowS)
-> Show Adjacency
forall a.
(Vertex -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Vertex -> Adjacency -> ShowS
showsPrec :: Vertex -> Adjacency -> ShowS
$cshow :: Adjacency -> String
show :: 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
from :: 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 -> ()
rnf :: Adjacency -> ()
NFData

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