{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.DiGraph
( DiGraph
, DiEdge
, adjacencySets
, vertices
, edges
, adjacents
, incidents
, insertEdge
, fromEdges
, insertVertex
, mapVertices
, union
, transpose
, symmetric
, fromList
, unsafeFromList
, isDiGraph
, isAdjacent
, isRegular
, isSymmetric
, isIrreflexive
, isEdge
, isVertex
, order
, size
, diSize
, symSize
, outDegree
, inDegree
, maxOutDegree
, maxInDegree
, minOutDegree
, minInDegree
, ShortestPathCache
, shortestPathCache
, shortestPath
, shortestPath_
, distance
, distance_
, diameter
, diameter_
, 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)
import qualified Data.DiGraph.FloydWarshall as FW
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 #-}
type DiEdge a = (a, a)
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 :: 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 :: 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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
data ShortestPathCache a = ShortestPathCache
{ forall a. ShortestPathCache a -> ShortestPathMatrix
_spcMatrix :: {-# UNPACK #-} !FW.ShortestPathMatrix
, forall a. ShortestPathCache a -> HashMap a Int
_spcIndices :: !(HM.HashMap a Int)
, forall a. ShortestPathCache a -> HashMap Int a
_spcVertices :: !(HM.HashMap Int a)
}
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)
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)
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 #-}
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_ #-}
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 #-}
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_ #-}
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 #-}
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_ #-}
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] ]
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 ]
]
singleton :: DiGraph Int
singleton :: DiGraph Int
singleton = Natural -> DiGraph Int
clique Natural
1
pair :: DiGraph Int
pair :: DiGraph Int
pair = Natural -> DiGraph Int
clique Natural
2
triangle :: DiGraph Int
triangle :: DiGraph Int
triangle = Natural -> DiGraph Int
clique Natural
3
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] ]
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
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] ]
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
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])
]
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"
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]
]