{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module: DiGraph
-- Copyright: Copyright © 2018-2020 Kadena LLC.
-- License: MIT
-- Maintainer: Lars Kuhtz <lars@kadena.io>
-- Stability: experimental
--
-- Directed graphs in adjacency set representation. The implementation is based
-- on "Data.HashMap.Strict" and "Data.HashSet" from the [unordered-containers
-- package](https://hackage.haskell.org/package/unordered-containers)
--
-- Undirected graphs are represented as symmetric, irreflexive directed graphs.
--
module Data.DiGraph
( DiGraph
, DiEdge
, adjacencySets
, vertices
, edges
, adjacents
, incidents

-- * Construction and Modification of Graphs
, insertEdge
, fromEdges
, insertVertex
, mapVertices
, union
, transpose
, symmetric
, fromList
, unsafeFromList

-- * Predicates
, isDiGraph
, isAdjacent
, isRegular
, isSymmetric
, isIrreflexive
, isEdge
, isVertex

-- * Properties
, order
, size
, diSize
, symSize
, outDegree
, inDegree
, maxOutDegree
, maxInDegree
, minOutDegree
, minInDegree

-- * Distances, Shortest Paths, and Diameter
, ShortestPathCache
, shortestPathCache
, shortestPath
, shortestPath_
, distance
, distance_
, diameter
, diameter_

-- * Graphs
, emptyGraph
, singleton
, clique
, pair
, triangle
, cycle
, diCycle
, line
, diLine
, petersonGraph
, twentyChainGraph
, hoffmanSingleton
, pentagon
, ascendingCube

) where

import Control.Arrow
import Control.DeepSeq
import Control.Monad

import Data.Foldable
import Data.Hashable (Hashable)
import qualified Data.HashMap.Strict as HM
import qualified Data.HashSet as HS
import qualified Data.List as L
import Data.Maybe
import Data.Semigroup
import Data.Traversable
import Data.Tuple

import GHC.Generics

import Numeric.Natural

import Prelude hiding (cycle)

-- internal modules

import qualified Data.DiGraph.FloydWarshall as FW

-- -------------------------------------------------------------------------- --
-- Utils

int :: Integral a => Num b => a -> b
int :: forall a b. (Integral a, Num b) => a -> b
int = forall a b. (Integral a, Num b) => a -> b
fromIntegral
{-# INLINE int #-}

-- -------------------------------------------------------------------------- --
-- Graph

-- | Directed Edge.
--
type DiEdge a = (a, a)

-- | Adjacency set representation of directed graphs.
--
-- It is assumed that each target of an edge is also explicitly a vertex in the
-- graph.
--
-- It is not generally required that graphs are irreflexive, but all concrete
-- graphs that are defined in this module are irreflexive.
--
-- Undirected graphs are represented as symmetric directed graphs.
--
newtype DiGraph a = DiGraph { forall a. DiGraph a -> HashMap a (HashSet a)
unGraph :: HM.HashMap a (HS.HashSet a) }
    deriving (Int -> DiGraph a -> ShowS
forall a. Show a => Int -> DiGraph a -> ShowS
forall a. Show a => [DiGraph a] -> ShowS
forall a. Show a => DiGraph a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DiGraph a] -> ShowS
$cshowList :: forall a. Show a => [DiGraph a] -> ShowS
show :: DiGraph a -> String
$cshow :: forall a. Show a => DiGraph a -> String
showsPrec :: Int -> DiGraph a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> DiGraph a -> ShowS
Show, DiGraph a -> DiGraph a -> Bool
forall a. Eq a => DiGraph a -> DiGraph a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DiGraph a -> DiGraph a -> Bool
$c/= :: forall a. Eq a => DiGraph a -> DiGraph a -> Bool
== :: DiGraph a -> DiGraph a -> Bool
$c== :: forall a. Eq a => DiGraph a -> DiGraph a -> Bool
Eq, DiGraph a -> DiGraph a -> Bool
DiGraph a -> DiGraph a -> Ordering
DiGraph a -> DiGraph a -> DiGraph a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (DiGraph a)
forall a. Ord a => DiGraph a -> DiGraph a -> Bool
forall a. Ord a => DiGraph a -> DiGraph a -> Ordering
forall a. Ord a => DiGraph a -> DiGraph a -> DiGraph a
min :: DiGraph a -> DiGraph a -> DiGraph a
$cmin :: forall a. Ord a => DiGraph a -> DiGraph a -> DiGraph a
max :: DiGraph a -> DiGraph a -> DiGraph a
$cmax :: forall a. Ord a => DiGraph a -> DiGraph a -> DiGraph a
>= :: DiGraph a -> DiGraph a -> Bool
$c>= :: forall a. Ord a => DiGraph a -> DiGraph a -> Bool
> :: DiGraph a -> DiGraph a -> Bool
$c> :: forall a. Ord a => DiGraph a -> DiGraph a -> Bool
<= :: DiGraph a -> DiGraph a -> Bool
$c<= :: forall a. Ord a => DiGraph a -> DiGraph a -> Bool
< :: DiGraph a -> DiGraph a -> Bool
$c< :: forall a. Ord a => DiGraph a -> DiGraph a -> Bool
compare :: DiGraph a -> DiGraph a -> Ordering
$ccompare :: forall a. Ord a => DiGraph a -> DiGraph a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (DiGraph a) x -> DiGraph a
forall a x. DiGraph a -> Rep (DiGraph a) x
$cto :: forall a x. Rep (DiGraph a) x -> DiGraph a
$cfrom :: forall a x. DiGraph a -> Rep (DiGraph a) x
Generic)
    deriving anyclass (forall a. NFData a => DiGraph a -> ()
forall a. (a -> ()) -> NFData a
rnf :: DiGraph a -> ()
$crnf :: forall a. NFData a => DiGraph a -> ()
NFData, forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall {a}. Hashable a => Eq (DiGraph a)
forall a. Hashable a => Int -> DiGraph a -> Int
forall a. Hashable a => DiGraph a -> Int
hash :: DiGraph a -> Int
$chash :: forall a. Hashable a => DiGraph a -> Int
hashWithSalt :: Int -> DiGraph a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> DiGraph a -> Int
Hashable)

instance (Hashable a, Eq a) => Semigroup (DiGraph a) where
    (DiGraph HashMap a (HashSet a)
a) <> :: DiGraph a -> DiGraph a -> DiGraph a
<> (DiGraph HashMap a (HashSet a)
b) = forall a. HashMap a (HashSet a) -> DiGraph a
DiGraph (forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith forall a. Semigroup a => a -> a -> a
(<>) HashMap a (HashSet a)
a HashMap a (HashSet a)
b)
    {-# INLINE (<>) #-}

instance (Hashable a, Eq a) => Monoid (DiGraph a) where
    mempty :: DiGraph a
mempty = forall a. HashMap a (HashSet a) -> DiGraph a
DiGraph forall a. Monoid a => a
mempty
    mappend :: DiGraph a -> DiGraph a -> DiGraph a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
    {-# INLINE mempty #-}
    {-# INLINE mappend #-}

-- | A predicate that asserts that every target of an edge is also a vertex in
-- the graph. Any graph that is constructed without using unsafe methods is
-- guaranteed to satisfy this predicate.
--
isDiGraph :: Eq a => Hashable a => DiGraph a -> Bool
isDiGraph :: forall a. (Eq a, Hashable a) => DiGraph a -> Bool
isDiGraph g :: DiGraph a
g@(DiGraph HashMap a (HashSet a)
m) = forall a. HashSet a -> Bool
HS.null (forall a. (Eq a, Hashable a) => [HashSet a] -> HashSet a
HS.unions (forall k v. HashMap k v -> [v]
HM.elems HashMap a (HashSet a)
m) forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
`HS.difference` forall a. DiGraph a -> HashSet a
vertices DiGraph a
g)
{-# INLINE isDiGraph #-}

-- | The adjacency sets of a graph.
--
adjacencySets :: DiGraph a -> HM.HashMap a (HS.HashSet a)
adjacencySets :: forall a. DiGraph a -> HashMap a (HashSet a)
adjacencySets = forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE adjacencySets #-}

-- | The set of vertices of the graph.
--
vertices :: DiGraph a -> HS.HashSet a
vertices :: forall a. DiGraph a -> HashSet a
vertices = forall a. HashMap a () -> HashSet a
HS.fromMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map (forall a b. a -> b -> a
const ()) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE vertices #-}

-- | The set edges of the graph.
--
edges :: Eq a => Hashable a => DiGraph a -> HS.HashSet (DiEdge a)
edges :: forall a. (Eq a, Hashable a) => DiGraph a -> HashSet (DiEdge a)
edges = forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. HashSet a -> [a]
HS.toList) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HM.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE edges #-}

-- | The set of adjacent pairs of a graph.
--
adjacents :: Eq a => Hashable a => a -> DiGraph a -> HS.HashSet a
adjacents :: forall a. (Eq a, Hashable a) => a -> DiGraph a -> HashSet a
adjacents a
a (DiGraph HashMap a (HashSet a)
g) = HashMap a (HashSet a)
g forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! a
a
{-# INLINE adjacents #-}

-- | The set of incident edges of a graph.
--
incidents :: Eq a => Hashable a => a -> DiGraph a -> [(a, a)]
incidents :: forall a. (Eq a, Hashable a) => a -> DiGraph a -> [(a, a)]
incidents a
a DiGraph a
g = [ (a
a, a
b) | a
b <- forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (forall a. (Eq a, Hashable a) => a -> DiGraph a -> HashSet a
adjacents a
a DiGraph a
g) ]
{-# INLINE incidents #-}

-- -------------------------------------------------------------------------- --
-- Constructing and Modifying Graphs

-- | Construct a graph from adjacency lists.
--
fromList :: Eq a => Hashable a => [(a,[a])] -> DiGraph a
fromList :: forall a. (Eq a, Hashable a) => [(a, [a])] -> DiGraph a
fromList [(a, [a])]
l = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. (Eq a, Hashable a) => a -> DiGraph a -> DiGraph a
insertVertex DiGraph a
es (forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(a, [a])]
l)
  where
    es :: DiGraph a
es = forall a (f :: * -> *).
(Eq a, Hashable a, Foldable f) =>
f (a, a) -> DiGraph a
fromEdges [ (a
a,a
b) | (a
a, [a]
bs) <- [(a, [a])]
l, a
b <- [a]
bs ]
{-# INLINE fromList #-}

-- | Unsafely construct a graph from adjacency lists.
--
-- This function assumes that the input includes a adjacency list of each vertex
-- that appears in a adjacency list of another vertex. Generally, 'fromList'
-- should be preferred.
--
unsafeFromList :: Eq a => Hashable a => [(a,[a])] -> DiGraph a
unsafeFromList :: forall a. (Eq a, Hashable a) => [(a, [a])] -> DiGraph a
unsafeFromList = forall a. HashMap a (HashSet a) -> DiGraph a
DiGraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
HM.map forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList
{-# INLINE unsafeFromList #-}

-- | Construct a graph from a foldable structure of edges.
--
fromEdges :: Eq a => Hashable a => Foldable f => f (a, a) -> DiGraph a
fromEdges :: forall a (f :: * -> *).
(Eq a, Hashable a, Foldable f) =>
f (a, a) -> DiGraph a
fromEdges = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. (Eq a, Hashable a) => DiEdge a -> DiGraph a -> DiGraph a
insertEdge forall a. Monoid a => a
mempty
{-# INLINE fromEdges #-}

-- | The union of two graphs.
--
union :: Eq a => Hashable a => DiGraph a -> DiGraph a -> DiGraph a
union :: forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a -> DiGraph a
union = forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE union #-}

-- | Map a function over all vertices of a graph.
--
mapVertices :: Eq b => Hashable b => (a -> b) -> DiGraph a -> DiGraph b
mapVertices :: forall b a.
(Eq b, Hashable b) =>
(a -> b) -> DiGraph a -> DiGraph b
mapVertices a -> b
f = forall a. HashMap a (HashSet a) -> DiGraph a
DiGraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (a -> b
f forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HM.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE mapVertices #-}

-- | Transpose a graph, i.e. reverse all edges of the graph.
--
transpose :: Eq a => Hashable a => DiGraph a -> DiGraph a
transpose :: forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a
transpose DiGraph a
g = (forall a. HashMap a (HashSet a) -> DiGraph a
DiGraph forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall a. DiGraph a -> HashMap a (HashSet a)
unGraph DiGraph a
g)
    forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a -> DiGraph a
`union` (forall a (f :: * -> *).
(Eq a, Hashable a, Foldable f) =>
f (a, a) -> DiGraph a
fromEdges forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map forall a b. (a, b) -> (b, a)
swap forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => DiGraph a -> HashSet (DiEdge a)
edges DiGraph a
g)

-- | Symmetric closure of a graph.
--
symmetric :: Eq a => Hashable a => DiGraph a -> DiGraph a
symmetric :: forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a
symmetric DiGraph a
g = DiGraph a
g forall a. Semigroup a => a -> a -> a
<> forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a
transpose DiGraph a
g
{-# INLINE symmetric #-}

-- | Insert an edge. Returns the graph unmodified if the edge is already in the
-- graph. Non-existing vertices are added.
--
insertEdge :: Eq a => Hashable a => DiEdge a -> DiGraph a -> DiGraph a
insertEdge :: forall a. (Eq a, Hashable a) => DiEdge a -> DiGraph a -> DiGraph a
insertEdge (a
a,a
b) = forall a. HashMap a (HashSet a) -> DiGraph a
DiGraph
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith forall a. Semigroup a => a -> a -> a
(<>) a
a [a
b]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith forall a. Semigroup a => a -> a -> a
(<>) a
b []
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE insertEdge #-}

-- | Insert a vertex. Returns the graph unmodified if the vertex is already in
-- the graph.
--
insertVertex :: Eq a => Hashable a => a -> DiGraph a -> DiGraph a
insertVertex :: forall a. (Eq a, Hashable a) => a -> DiGraph a -> DiGraph a
insertVertex a
a = forall a. HashMap a (HashSet a) -> DiGraph a
DiGraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith forall a. Semigroup a => a -> a -> a
(<>) a
a [] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE insertVertex #-}

-- -------------------------------------------------------------------------- --
-- Properties

-- | The order of a graph is the number of vertices.
--
order :: DiGraph a -> Natural
order :: forall a. DiGraph a -> Natural
order = forall a b. (Integral a, Num b) => a -> b
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> Int
HS.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashSet a
vertices
{-# INLINE order #-}

-- | Directed Size. This the number of edges of the graph.
--
diSize :: Eq a => Hashable a => DiGraph a -> Natural
diSize :: forall a. (Eq a, Hashable a) => DiGraph a -> Natural
diSize = forall a b. (Integral a, Num b) => a -> b
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> Int
HS.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => DiGraph a -> HashSet (DiEdge a)
edges
{-# INLINE diSize #-}

-- | Directed Size. This the number of edges of the graph.
--
size :: Eq a => Hashable a => DiGraph a -> Natural
size :: forall a. (Eq a, Hashable a) => DiGraph a -> Natural
size = forall a b. (Integral a, Num b) => a -> b
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> Int
HS.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => DiGraph a -> HashSet (DiEdge a)
edges
{-# INLINE size #-}

-- | Undirected Size of a graph. This is the number of edges of the symmetric
-- closure of the graph.
--
symSize :: Eq a => Hashable a => DiGraph a -> Natural
symSize :: forall a. (Eq a, Hashable a) => DiGraph a -> Natural
symSize DiGraph a
g = forall a. (Eq a, Hashable a) => DiGraph a -> Natural
diSize (forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a
symmetric DiGraph a
g) forall a. Integral a => a -> a -> a
`div` Natural
2
{-# INLINE symSize #-}

-- | The number of outgoing edges of vertex in a graph.
--
outDegree :: Eq a => Hashable a => DiGraph a -> a -> Natural
outDegree :: forall a. (Eq a, Hashable a) => DiGraph a -> a -> Natural
outDegree (DiGraph HashMap a (HashSet a)
g) a
a = forall a b. (Integral a, Num b) => a -> b
int forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. HashSet a -> Int
HS.size forall a b. (a -> b) -> a -> b
$ HashMap a (HashSet a)
g forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! a
a
{-# INLINE outDegree #-}

-- | The maximum out-degree of the vertices of a graph.
--
maxOutDegree :: Eq a => Hashable a => DiGraph a -> Natural
maxOutDegree :: forall a. (Eq a, Hashable a) => DiGraph a -> Natural
maxOutDegree DiGraph a
g = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall a b. (a -> b) -> a -> b
$ forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map (forall a. (Eq a, Hashable a) => DiGraph a -> a -> Natural
outDegree DiGraph a
g) (forall a. DiGraph a -> HashSet a
vertices DiGraph a
g)
{-# INLINE maxOutDegree #-}

-- | The minimum out-degree of the vertices of a graph.
--
minOutDegree :: Eq a => Hashable a => DiGraph a -> Natural
minOutDegree :: forall a. (Eq a, Hashable a) => DiGraph a -> Natural
minOutDegree DiGraph a
g = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum forall a b. (a -> b) -> a -> b
$ forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map (forall a. (Eq a, Hashable a) => DiGraph a -> a -> Natural
outDegree DiGraph a
g) (forall a. DiGraph a -> HashSet a
vertices DiGraph a
g)
{-# INLINE minOutDegree #-}

-- | The number of incoming edges of vertex in a graph.
--
inDegree :: Eq a => Hashable a => DiGraph a -> a -> Natural
inDegree :: forall a. (Eq a, Hashable a) => DiGraph a -> a -> Natural
inDegree DiGraph a
g = forall a. (Eq a, Hashable a) => DiGraph a -> a -> Natural
outDegree (forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a
transpose DiGraph a
g)
{-# INLINE inDegree #-}

-- | The maximum in-degree of the vertices of a graph.
--
maxInDegree :: Eq a => Hashable a => DiGraph a -> Natural
maxInDegree :: forall a. (Eq a, Hashable a) => DiGraph a -> Natural
maxInDegree = forall a. (Eq a, Hashable a) => DiGraph a -> Natural
maxOutDegree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a
transpose
{-# INLINE maxInDegree #-}

-- | The minimum in-degree of the vertices of a graph.
--
minInDegree :: Eq a => Hashable a => DiGraph a -> Natural
minInDegree :: forall a. (Eq a, Hashable a) => DiGraph a -> Natural
minInDegree = forall a. (Eq a, Hashable a) => DiGraph a -> Natural
minOutDegree forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a
transpose
{-# INLINE minInDegree #-}

-- -------------------------------------------------------------------------- --
-- Predicates

-- | Return whether a graph is regular, i.e. whether all vertices have the same
-- out-degree. Note that the latter implies that all vertices also have the same
-- in-degree.
--
isRegular :: DiGraph a -> Bool
isRegular :: forall a. DiGraph a -> Bool
isRegular = (forall a. Eq a => a -> a -> Bool
== Int
1)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Int
length
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [[a]]
L.group
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. HashSet a -> Int
HS.size forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HM.toList
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE isRegular #-}

-- | Return whether a graph is symmetric, i.e. whether for each edge \((a,b)\)
-- there is also the edge \((b,a)\) in the graph.
--
isSymmetric :: Hashable a => Eq a => DiGraph a -> Bool
isSymmetric :: forall a. (Hashable a, Eq a) => DiGraph a -> Bool
isSymmetric DiGraph a
g = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all forall {t :: * -> *}. Foldable t => (a, t a) -> Bool
checkVertex forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [(k, v)]
HM.toList forall a b. (a -> b) -> a -> b
$ forall a. DiGraph a -> HashMap a (HashSet a)
unGraph DiGraph a
g
  where
    checkVertex :: (a, t a) -> Bool
checkVertex (a
a, t a
e) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\a
x -> forall a. (Eq a, Hashable a) => a -> a -> DiGraph a -> Bool
isAdjacent a
x a
a DiGraph a
g) t a
e
{-# INLINE isSymmetric #-}

-- | Return whether a graph is irreflexive. A graph is irreflexive if for each
-- edge \((a,b)\) it holds that \(a \neq b\), i.e there are no self-loops in the
-- graph.
--
isIrreflexive :: Eq a => Hashable a => DiGraph a -> Bool
isIrreflexive :: forall a. (Eq a, Hashable a) => DiGraph a -> Bool
isIrreflexive = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. HashMap k v -> [(k, v)]
HM.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE isIrreflexive #-}

-- | Return whether a vertex is contained in a graph.
--
isVertex :: Eq a => Hashable a => a -> DiGraph a -> Bool
isVertex :: forall a. (Eq a, Hashable a) => a -> DiGraph a -> Bool
isVertex a
a = forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HM.member a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE isVertex #-}

-- | Return whether an edge is contained in a graph.
--
isEdge :: Eq a => Hashable a => DiEdge a -> DiGraph a -> Bool
isEdge :: forall a. (Eq a, Hashable a) => DiEdge a -> DiGraph a -> Bool
isEdge (a
a, a
b) = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
HS.member a
b) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup a
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. DiGraph a -> HashMap a (HashSet a)
unGraph
{-# INLINE isEdge #-}

-- | Return whether two vertices are adjacent in a graph.
--
isAdjacent :: Eq a => Hashable a => a -> a -> DiGraph a -> Bool
isAdjacent :: forall a. (Eq a, Hashable a) => a -> a -> DiGraph a -> Bool
isAdjacent = forall a b c. ((a, b) -> c) -> a -> b -> c
curry forall a. (Eq a, Hashable a) => DiEdge a -> DiGraph a -> Bool
isEdge
{-# INLINE isAdjacent #-}

-- -------------------------------------------------------------------------- --
-- Distances, Shortest Paths, and Diameter

-- | The shortest path matrix of a graph.
--
-- The shortest path matrix of a graph can be used to efficiently query the
-- distance and shortest path between any two vertices of the graph. It can also
-- be used to efficiently compute the diameter of the graph.
--
-- Computing the shortest path matrix is expensive for larger graphs. The matrix
-- is computed using the Floyd-Warshall algorithm. The space and time complexity
-- is quadratic in the /order/ of the graph. For sparse graphs there are more
-- efficient algorithms for computing distances and shortest paths between the
-- nodes of the graph.
--
data ShortestPathCache a = ShortestPathCache
    { forall a. ShortestPathCache a -> ShortestPathMatrix
_spcMatrix :: {-# UNPACK #-} !FW.ShortestPathMatrix
        -- ^ The shortest path matrix of a graph.
    , forall a. ShortestPathCache a -> HashMap a Int
_spcIndices :: !(HM.HashMap a Int)
        -- ^ mapping from vertices of the graph to indices in the shortest path
        -- matrix.
    , forall a. ShortestPathCache a -> HashMap Int a
_spcVertices :: !(HM.HashMap Int a)
        -- ^ mapping from indices in the shortest path matrix to vertices in the
        -- graph.
    }
    deriving (Int -> ShortestPathCache a -> ShowS
forall a. Show a => Int -> ShortestPathCache a -> ShowS
forall a. Show a => [ShortestPathCache a] -> ShowS
forall a. Show a => ShortestPathCache a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShortestPathCache a] -> ShowS
$cshowList :: forall a. Show a => [ShortestPathCache a] -> ShowS
show :: ShortestPathCache a -> String
$cshow :: forall a. Show a => ShortestPathCache a -> String
showsPrec :: Int -> ShortestPathCache a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> ShortestPathCache a -> ShowS
Show, ShortestPathCache a -> ShortestPathCache a -> Bool
forall a.
Eq a =>
ShortestPathCache a -> ShortestPathCache a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShortestPathCache a -> ShortestPathCache a -> Bool
$c/= :: forall a.
Eq a =>
ShortestPathCache a -> ShortestPathCache a -> Bool
== :: ShortestPathCache a -> ShortestPathCache a -> Bool
$c== :: forall a.
Eq a =>
ShortestPathCache a -> ShortestPathCache a -> Bool
Eq, ShortestPathCache a -> ShortestPathCache a -> Bool
ShortestPathCache a -> ShortestPathCache a -> Ordering
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (ShortestPathCache a)
forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> Bool
forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> Ordering
forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> ShortestPathCache a
min :: ShortestPathCache a -> ShortestPathCache a -> ShortestPathCache a
$cmin :: forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> ShortestPathCache a
max :: ShortestPathCache a -> ShortestPathCache a -> ShortestPathCache a
$cmax :: forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> ShortestPathCache a
>= :: ShortestPathCache a -> ShortestPathCache a -> Bool
$c>= :: forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> Bool
> :: ShortestPathCache a -> ShortestPathCache a -> Bool
$c> :: forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> Bool
<= :: ShortestPathCache a -> ShortestPathCache a -> Bool
$c<= :: forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> Bool
< :: ShortestPathCache a -> ShortestPathCache a -> Bool
$c< :: forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> Bool
compare :: ShortestPathCache a -> ShortestPathCache a -> Ordering
$ccompare :: forall a.
Ord a =>
ShortestPathCache a -> ShortestPathCache a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ShortestPathCache a) x -> ShortestPathCache a
forall a x. ShortestPathCache a -> Rep (ShortestPathCache a) x
$cto :: forall a x. Rep (ShortestPathCache a) x -> ShortestPathCache a
$cfrom :: forall a x. ShortestPathCache a -> Rep (ShortestPathCache a) x
Generic)
    deriving anyclass (forall a. NFData a => ShortestPathCache a -> ()
forall a. (a -> ()) -> NFData a
rnf :: ShortestPathCache a -> ()
$crnf :: forall a. NFData a => ShortestPathCache a -> ()
NFData)

-- | Compute the shortest path matrix for a graph. The result can be used to
-- efficiently query the distance and shortest path between any two vertices of
-- the graph. It can also be used to efficiently compute the diameter of the
-- graph.
--
shortestPathCache :: Eq a => Hashable a => DiGraph a -> ShortestPathCache a
shortestPathCache :: forall a. (Eq a, Hashable a) => DiGraph a -> ShortestPathCache a
shortestPathCache DiGraph a
g = forall a.
ShortestPathMatrix
-> HashMap a Int -> HashMap Int a -> ShortestPathCache a
ShortestPathCache ShortestPathMatrix
m HashMap a Int
vmap HashMap Int a
rvmap
  where
    m :: ShortestPathMatrix
m = forall a. (Unbox a, Real a) => Array U Ix2 a -> ShortestPathMatrix
FW.floydWarshall forall a b. (a -> b) -> a -> b
$ HashMap Int (HashSet Int) -> DenseAdjMatrix
FW.fromAdjacencySets (forall a. DiGraph a -> HashMap a (HashSet a)
unGraph DiGraph Int
ig)
    ig :: DiGraph Int
ig = forall b a.
(Eq b, Hashable b) =>
(a -> b) -> DiGraph a -> DiGraph b
mapVertices (HashMap a Int
vmap forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.!) DiGraph a
g
    vmap :: HashMap a Int
vmap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. HashSet a -> [a]
HS.toList forall a b. (a -> b) -> a -> b
$ forall a. DiGraph a -> HashSet a
vertices DiGraph a
g) [Int
0..]
    rvmap :: HashMap Int a
rvmap = forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (forall a. HashSet a -> [a]
HS.toList forall a b. (a -> b) -> a -> b
$ forall a. DiGraph a -> HashSet a
vertices DiGraph a
g)

-- | Compute the Diameter of a graph, i.e. the maximum length of a shortest path
-- between two vertices in the graph.
--
-- This is expensive to compute for larger graphs. If also the shortest paths or
-- distances are needed, one should use 'shortestPathCache' to cache the result
-- of the search and use the 'diameter_', 'shortestPath_', and 'distance_' to
-- query the respective results from the cache.
--
-- The algorithm is optimized for dense graphs. For large sparse graphs a more
-- efficient algorithm should be used.
--
diameter :: Eq a => Hashable a => DiGraph a -> Maybe Natural
diameter :: forall a. (Eq a, Hashable a) => DiGraph a -> Maybe Natural
diameter = forall a. ShortestPathCache a -> Maybe Natural
diameter_ forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => DiGraph a -> ShortestPathCache a
shortestPathCache
{-# INLINE diameter #-}

-- | Compute the Diameter of a graph from a shortest path matrix. The diameter
-- of a graph is the maximum length of a shortest path between two vertices in
-- the graph.
--
diameter_ :: ShortestPathCache a -> Maybe Natural
diameter_ :: forall a. ShortestPathCache a -> Maybe Natural
diameter_ (ShortestPathCache ShortestPathMatrix
m HashMap a Int
_ HashMap Int a
_) = forall a b. (RealFrac a, Integral b) => a -> b
round forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShortestPathMatrix -> Maybe Double
FW.diameter ShortestPathMatrix
m
{-# INLINE diameter_ #-}

-- | Compute the shortest path between two vertices of a graph.
--
-- | This is expensive for larger graphs. If more than one path is needed one
-- should use 'shortestPathCache' to cache the result of the search and use
-- 'shortestPath_' to query paths from the cache.
--
-- The algorithm is optimized for dense graphs. For large sparse graphs a more
-- efficient algorithm should be used.
--
shortestPath :: Eq a => Hashable a => a -> a -> DiGraph a -> Maybe [a]
shortestPath :: forall a. (Eq a, Hashable a) => a -> a -> DiGraph a -> Maybe [a]
shortestPath a
src a
trg = forall a.
(Eq a, Hashable a) =>
a -> a -> ShortestPathCache a -> Maybe [a]
shortestPath_ a
src a
trg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => DiGraph a -> ShortestPathCache a
shortestPathCache
{-# INLINE shortestPath #-}

-- | Compute the shortest path between two vertices from the shortest path
-- matrix of a graph.
--
-- The algorithm is optimized for dense graphs. For large sparse graphs a more
-- efficient algorithm should be used.
--
shortestPath_ :: Eq a => Hashable a => a -> a -> ShortestPathCache a -> Maybe [a]
shortestPath_ :: forall a.
(Eq a, Hashable a) =>
a -> a -> ShortestPathCache a -> Maybe [a]
shortestPath_ a
src a
trg (ShortestPathCache ShortestPathMatrix
c HashMap a Int
m HashMap Int a
r)
    = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
(HM.!) HashMap Int a
r) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShortestPathMatrix -> Int -> Int -> Maybe [Int]
FW.shortestPath ShortestPathMatrix
c (HashMap a Int
m forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! a
src) (HashMap a Int
m forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! a
trg)
{-# INLINE shortestPath_ #-}

-- | Compute the distance between two vertices of a graph.
--
-- | This is expensive for larger graphs. If more than one distance is needed
-- one should use 'shortestPathCache' to cache the result of the search and use
-- 'distance_' to query paths from the cache.
--
-- The algorithm is optimized for dense graphs. For large sparse graphs a more
-- efficient algorithm should be used.
--
distance :: Eq a => Hashable a => a -> a -> DiGraph a -> Maybe Natural
distance :: forall a.
(Eq a, Hashable a) =>
a -> a -> DiGraph a -> Maybe Natural
distance a
src a
trg = forall a.
(Eq a, Hashable a) =>
a -> a -> ShortestPathCache a -> Maybe Natural
distance_ a
src a
trg forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Eq a, Hashable a) => DiGraph a -> ShortestPathCache a
shortestPathCache
{-# INLINE distance #-}

-- | Compute the distance between two vertices from the shortest path matrix of
-- a graph.
--
-- The algorithm is optimized for dense graphs. For large sparse graphs a more
-- efficient algorithm should be used.
--
distance_ :: Eq a => Hashable a => a -> a -> ShortestPathCache a -> Maybe Natural
distance_ :: forall a.
(Eq a, Hashable a) =>
a -> a -> ShortestPathCache a -> Maybe Natural
distance_ a
src a
trg (ShortestPathCache ShortestPathMatrix
c HashMap a Int
m HashMap Int a
_)
    = forall a b. (RealFrac a, Integral b) => a -> b
round forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ShortestPathMatrix -> Int -> Int -> Maybe Double
FW.distance ShortestPathMatrix
c (HashMap a Int
m forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! a
src) (HashMap a Int
m forall k v.
(Eq k, Hashable k, HasCallStack) =>
HashMap k v -> k -> v
HM.! a
trg)
{-# INLINE distance_ #-}

-- -------------------------------------------------------------------------- --
-- Concrete Graph

-- | The empty graph on @n@ nodes. This is the graph of 'order' @n@ and 'size'
-- @0@.
--
emptyGraph :: Natural -> DiGraph Int
emptyGraph :: Natural -> DiGraph Int
emptyGraph Natural
n = forall a. (Eq a, Hashable a) => [(a, [a])] -> DiGraph a
unsafeFromList [ (Int
i, []) | Int
i <- [Int
0 .. forall a b. (Integral a, Num b) => a -> b
int Natural
n forall a. Num a => a -> a -> a
- Int
1] ]

-- | Undirected clique.
--
clique :: Natural -> DiGraph Int
clique :: Natural -> DiGraph Int
clique Natural
i = forall a. (Eq a, Hashable a) => [(a, [a])] -> DiGraph a
unsafeFromList
    [ (Int
a, [Int]
b)
    | Int
a <- [Int
0 .. forall a b. (Integral a, Num b) => a -> b
int Natural
i forall a. Num a => a -> a -> a
- Int
1]
    , let b :: [Int]
b = [ Int
x | Int
x <- [Int
0 .. forall a b. (Integral a, Num b) => a -> b
int Natural
i forall a. Num a => a -> a -> a
- Int
1] , Int
x forall a. Eq a => a -> a -> Bool
/= Int
a ]
    ]

-- | The (irreflexive) singleton graph.
--
singleton :: DiGraph Int
singleton :: DiGraph Int
singleton = Natural -> DiGraph Int
clique Natural
1

-- | Undirected pair.
--
pair :: DiGraph Int
pair :: DiGraph Int
pair = Natural -> DiGraph Int
clique Natural
2

-- | Undirected triangle.
--
triangle :: DiGraph Int
triangle :: DiGraph Int
triangle = Natural -> DiGraph Int
clique Natural
3

-- | Directed cycle.
--
diCycle :: Natural -> DiGraph Int
diCycle :: Natural -> DiGraph Int
diCycle Natural
n = forall a. (Eq a, Hashable a) => [(a, [a])] -> DiGraph a
unsafeFromList [ (Int
a, [(Int
a forall a. Num a => a -> a -> a
+ Int
1) forall a. Integral a => a -> a -> a
`mod` forall a b. (Integral a, Num b) => a -> b
int Natural
n]) | Int
a <- [Int
0 .. forall a b. (Integral a, Num b) => a -> b
int Natural
n forall a. Num a => a -> a -> a
- Int
1] ]

-- | Undirected cycle.
--
cycle :: Natural -> DiGraph Int
cycle :: Natural -> DiGraph Int
cycle = forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a
symmetric forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> DiGraph Int
diCycle

-- | Directed line.
--
diLine :: Natural -> DiGraph Int
diLine :: Natural -> DiGraph Int
diLine Natural
n = forall a. (Eq a, Hashable a) => [(a, [a])] -> DiGraph a
unsafeFromList [ (Int
a, [ Int
a forall a. Num a => a -> a -> a
+ Int
1 | Int
a forall a. Eq a => a -> a -> Bool
/= forall a b. (Integral a, Num b) => a -> b
int Natural
n forall a. Num a => a -> a -> a
- Int
1]) | Int
a <- [Int
0 .. forall a b. (Integral a, Num b) => a -> b
int Natural
n forall a. Num a => a -> a -> a
- Int
1] ]

-- | Undirected line.
--
line :: Natural -> DiGraph Int
line :: Natural -> DiGraph Int
line = forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a
symmetric forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> DiGraph Int
diLine

-- | The Peterson graph.
--
-- * order: 10
-- * size: 30
-- * degree: 3
-- * diameter: 2
--
petersonGraph :: DiGraph Int
petersonGraph :: DiGraph Int
petersonGraph = forall a. HashMap a (HashSet a) -> DiGraph a
DiGraph
    [ (Int
0, [Int
2,Int
3,Int
5])
    , (Int
1, [Int
3,Int
4,Int
6])
    , (Int
2, [Int
4,Int
0,Int
7])
    , (Int
3, [Int
0,Int
1,Int
8])
    , (Int
4, [Int
1,Int
2,Int
9])
    , (Int
5, [Int
0,Int
6,Int
9])
    , (Int
6, [Int
1,Int
5,Int
7])
    , (Int
7, [Int
2,Int
6,Int
8])
    , (Int
8, [Int
3,Int
7,Int
9])
    , (Int
9, [Int
4,Int
8,Int
5])
    ]

-- | The "twenty chain" graph.
--
-- * order: 20
-- * size: 60
-- * degree: 3
-- * diameter: 3
--
twentyChainGraph :: DiGraph Int
twentyChainGraph :: DiGraph Int
twentyChainGraph = DiGraph Int
pentagram forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a -> DiGraph a
`union` DiGraph Int
decagon forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a -> DiGraph a
`union` DiGraph Int
connections
  where
    pentagram :: DiGraph Int
pentagram = forall b a.
(Eq b, Hashable b) =>
(a -> b) -> DiGraph a -> DiGraph b
mapVertices (forall a. Num a => a -> a -> a
+ Int
5) forall a b. (a -> b) -> a -> b
$ DiGraph Int -> DiGraph Int
pentagon2pentagram forall a b. (a -> b) -> a -> b
$ Natural -> DiGraph Int
cycle Natural
5
    decagon :: DiGraph Int
decagon =  forall b a.
(Eq b, Hashable b) =>
(a -> b) -> DiGraph a -> DiGraph b
mapVertices (forall a. Num a => a -> a -> a
+ Int
10) forall a b. (a -> b) -> a -> b
$ Natural -> DiGraph Int
cycle Natural
10
    connections :: DiGraph Int
connections = forall a (f :: * -> *).
(Eq a, Hashable a, Foldable f) =>
f (a, a) -> DiGraph a
fromEdges forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ [(Int
i, Int
x), (Int
x, Int
i)]
        | Int
i <- [Int
0..Int
4]
        , Int
x <- [Int
i forall a. Num a => a -> a -> a
+ Int
5, Int
i forall a. Num a => a -> a -> a
+ Int
10, Int
i forall a. Num a => a -> a -> a
+ Int
15]
        ]
    pentagon2pentagram :: DiGraph Int -> DiGraph Int
pentagon2pentagram = forall b a.
(Eq b, Hashable b) =>
(a -> b) -> DiGraph a -> DiGraph b
mapVertices forall a b. (a -> b) -> a -> b
$ \case
        Int
0 -> Int
0
        Int
1 -> Int
3
        Int
2 -> Int
1
        Int
3 -> Int
4
        Int
4 -> Int
2
        Int
_ -> forall a. HasCallStack => String -> a
error String
"invalid vertex"

-- | Hoffman-Singleton Graph.
--
-- The Hoffman-Singleton graph is a 7-regular graph with 50 vertices and 175
-- edges. It's the largest graph of max-degree 7 and diameter 2. Cf.
-- [https://en.wikipedia.org/wiki/Hoffman–Singleton_graph]()
--
hoffmanSingleton :: DiGraph Int
hoffmanSingleton :: DiGraph Int
hoffmanSingleton = DiGraph Int
pentagons forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a -> DiGraph a
`union` DiGraph Int
pentagrams forall a. (Eq a, Hashable a) => DiGraph a -> DiGraph a -> DiGraph a
`union` DiGraph Int
connections
  where
    pentagons :: DiGraph Int
pentagons = forall a. Monoid a => [a] -> a
mconcat
        [ forall b a.
(Eq b, Hashable b) =>
(a -> b) -> DiGraph a -> DiGraph b
mapVertices (forall a. Num a => a -> a -> a
p_off Int
i) forall a b. (a -> b) -> a -> b
$ Natural -> DiGraph Int
cycle Natural
5 | Int
i <- [Int
0 .. Int
4] ]
    pentagrams :: DiGraph Int
pentagrams = forall a. Monoid a => [a] -> a
mconcat
        [ forall b a.
(Eq b, Hashable b) =>
(a -> b) -> DiGraph a -> DiGraph b
mapVertices (forall a. Num a => a -> a -> a
q_off Int
i) forall a b. (a -> b) -> a -> b
$ DiGraph Int -> DiGraph Int
pentagon2pentagram forall a b. (a -> b) -> a -> b
$ Natural -> DiGraph Int
cycle Natural
5 | Int
i <- [Int
0 .. Int
4] ]

    p_off :: a -> a -> a
p_off a
h = forall a. Num a => a -> a -> a
(+) (a
25 forall a. Num a => a -> a -> a
+ a
5 forall a. Num a => a -> a -> a
* a
h)
    q_off :: a -> a -> a
q_off a
i = forall a. Num a => a -> a -> a
(+) (a
5 forall a. Num a => a -> a -> a
* a
i)

    pentagon2pentagram :: DiGraph Int -> DiGraph Int
pentagon2pentagram = forall b a.
(Eq b, Hashable b) =>
(a -> b) -> DiGraph a -> DiGraph b
mapVertices forall a b. (a -> b) -> a -> b
$ \case
        Int
0 -> Int
0
        Int
1 -> Int
3
        Int
2 -> Int
1
        Int
3 -> Int
4
        Int
4 -> Int
2
        Int
_ -> forall a. HasCallStack => String -> a
error String
"invalid vertex"

    connections :: DiGraph Int
connections = forall a (f :: * -> *).
(Eq a, Hashable a, Foldable f) =>
f (a, a) -> DiGraph a
fromEdges forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
        [ [(Int
a, Int
b), (Int
b, Int
a)]
        | Int
h <- [Int
0 .. Int
4]
        , Int
j <- [Int
0 .. Int
4]
        , let a :: Int
a = forall a. Num a => a -> a -> a
p_off Int
h Int
j
        , Int
i <- [Int
0 .. Int
4]
        , let b :: Int
b = forall a. Num a => a -> a -> a
q_off Int
i ((Int
h forall a. Num a => a -> a -> a
* Int
i forall a. Num a => a -> a -> a
+ Int
j) forall a. Integral a => a -> a -> a
`mod` Int
5)
        ]

pentagon :: DiGraph Int
pentagon :: DiGraph Int
pentagon = forall a (f :: * -> *).
(Eq a, Hashable a, Foldable f) =>
f (a, a) -> DiGraph a
fromEdges forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList [(Int
i,(Int
iforall a. Num a => a -> a -> a
+Int
1) forall a. Integral a => a -> a -> a
`mod` Int
5) | Int
i <- [Int
0..Int
4] ]

ascendingCube :: DiGraph (Int,Int,Int)
ascendingCube :: DiGraph (Int, Int, Int)
ascendingCube = forall a (f :: * -> *).
(Eq a, Hashable a, Foldable f) =>
f (a, a) -> DiGraph a
fromEdges forall a b. (a -> b) -> a -> b
$ forall a. (Eq a, Hashable a) => [a] -> HashSet a
HS.fromList forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat
  [ [ ((Int
0,Int
a,Int
b),(Int
1,Int
a,Int
b))
    , ((Int
a,Int
0,Int
b),(Int
a,Int
1,Int
b))
    , ((Int
a,Int
b,Int
0),(Int
a,Int
b,Int
1))
    ]
  | Int
a <- [Int
0,Int
1]
  , Int
b <- [Int
0,Int
1]
  ]