{- |
Description: Regular graphs
Copyright: Copyright (C) 2023 Yoo Chung
License: GPL-3.0-or-later
Maintainer: dev@chungyc.org

Some solutions to "Problems.P94" of Ninety-Nine Haskell "Problems".
-}
module Solutions.P94 (regularGraphs) where

import           Data.List       (nubBy)
import qualified Data.Map.Lazy   as Map
import           Data.Maybe      (fromJust)
import qualified Data.Set        as Set
import           Problems.Graphs
import           Problems.P26
import           Solutions.P85   (isomorphic)

-- | Generate \(k\)-regular graphs with \(n\) vertexes.
regularGraphs :: Int  -- ^ \(n\)
              -> Int  -- ^ \(k\)
              -> [G]  -- ^ non-isomorphic \(k\)-regular graphs with \(n\) vertexes
regularGraphs :: Vertex -> Vertex -> [G]
regularGraphs Vertex
n Vertex
k = (G -> G -> Bool) -> [G] -> [G]
forall a. (a -> a -> Bool) -> [a] -> [a]
nubBy G -> G -> Bool
isomorphic ([G] -> [G]) -> [G] -> [G]
forall a b. (a -> b) -> a -> b
$ Vertex -> [Vertex] -> G -> [G]
buildGraphs Vertex
k [Vertex
1..Vertex
n] G
emptyGraph
  where emptyGraph :: G
emptyGraph = 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 ([Vertex] -> Set Vertex
forall a. Ord a => [a] -> Set a
Set.fromList [Vertex
1..Vertex
n], Set Edge
forall a. Set a
Set.empty)

-- | Build up the regular graph by adding edges for each vertex one by one.
-- An earlier vertex would attempt all possibilities that add an edge
-- to a later vertex, so there is no need to add edges to earlier vertexes,
-- and neither is there a need to try different orders of vertexes.
buildGraphs :: Int -> [Vertex] -> G -> [G]
buildGraphs :: Vertex -> [Vertex] -> G -> [G]
buildGraphs Vertex
_ [] G
g = [G
g]
buildGraphs Vertex
k (Vertex
v:[Vertex]
vs) G
g = (G -> [G]) -> [G] -> [G]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Vertex -> [Vertex] -> G -> [G]
buildGraphs Vertex
k [Vertex]
vs) [G]
gs
  where gs :: [G]
gs = Vertex -> G -> Vertex -> [Vertex] -> [G]
expand Vertex
k G
g Vertex
v [Vertex]
vs

-- | Expand the graph to all possible graphs that have edges added
-- from the given vertex to a combination of the remaining vertexes.
expand :: Int -> G -> Vertex -> [Vertex] -> [G]
expand :: Vertex -> G -> Vertex -> [Vertex] -> [G]
expand Vertex
k G
g Vertex
v [Vertex]
vs = ([Vertex] -> G) -> [[Vertex]] -> [G]
forall a b. (a -> b) -> [a] -> [b]
map (G -> Vertex -> [Vertex] -> G
addEdges G
g Vertex
v) [[Vertex]]
candidates
  where k' :: Vertex
k' = Vertex
k Vertex -> Vertex -> Vertex
forall a. Num a => a -> a -> a
- Set Vertex -> Vertex
forall a. Set a -> Vertex
Set.size (Vertex -> G -> Set Vertex
forall g. Graph g => Vertex -> g -> Set Vertex
neighbors Vertex
v G
g)
        candidates :: [[Vertex]]
candidates = ([Vertex] -> Bool) -> [[Vertex]] -> [[Vertex]]
forall a. (a -> Bool) -> [a] -> [a]
filter ((Vertex -> Bool) -> [Vertex] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Vertex -> Bool) -> [Vertex] -> Bool)
-> (Vertex -> Bool) -> [Vertex] -> Bool
forall a b. (a -> b) -> a -> b
$ \Vertex
v' -> Set Vertex -> Vertex
forall a. Set a -> Vertex
Set.size (Vertex -> G -> Set Vertex
forall g. Graph g => Vertex -> g -> Set Vertex
neighbors Vertex
v' G
g) Vertex -> Vertex -> Bool
forall a. Ord a => a -> a -> Bool
< Vertex
k) ([[Vertex]] -> [[Vertex]]) -> [[Vertex]] -> [[Vertex]]
forall a b. (a -> b) -> a -> b
$ Vertex -> [Vertex] -> [[Vertex]]
forall a. Vertex -> [a] -> [[a]]
combinations Vertex
k' [Vertex]
vs

addEdges :: G -> Vertex -> [Vertex] -> G
addEdges :: G -> Vertex -> [Vertex] -> G
addEdges G
g Vertex
v = (G -> Vertex -> G) -> G -> [Vertex] -> G
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (Vertex -> G -> Vertex -> G
addEdge Vertex
v) G
g

addEdge :: Vertex -> G -> Vertex -> G
addEdge :: Vertex -> G -> Vertex -> G
addEdge Vertex
v (G Map Vertex (Set Vertex)
g) Vertex
v' = Map Vertex (Set Vertex) -> G
G (Map Vertex (Set Vertex) -> G) -> Map Vertex (Set Vertex) -> G
forall a b. (a -> b) -> a -> b
$ (Set Vertex -> Set Vertex)
-> Vertex -> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Vertex -> Set Vertex -> Set Vertex
forall a. Ord a => a -> Set a -> Set a
Set.insert Vertex
v) 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
$ (Set Vertex -> Set Vertex)
-> Vertex -> Map Vertex (Set Vertex) -> Map Vertex (Set Vertex)
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust (Vertex -> Set Vertex -> Set Vertex
forall a. Ord a => a -> Set a -> Set a
Set.insert Vertex
v') Vertex
v Map Vertex (Set Vertex)
g