module Math.Combinatorics.Graph where
import qualified Data.List as L
import Data.Maybe (isJust)
import qualified Data.Map as M
import qualified Data.Set as S
import Control.Arrow ( (&&&) )
import Math.Common.ListSet as LS
import Math.Core.Utils
import Math.Algebra.Group.PermutationGroup hiding (fromDigits, fromBinary)
import qualified Math.Algebra.Group.SchreierSims as SS
set :: [b] -> [b]
set xs :: [b]
xs = ([b] -> b) -> [[b]] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map [b] -> b
forall a. [a] -> a
head ([[b]] -> [b]) -> [[b]] -> [b]
forall a b. (a -> b) -> a -> b
$ [b] -> [[b]]
forall a. Eq a => [a] -> [[a]]
L.group ([b] -> [[b]]) -> [b] -> [[b]]
forall a b. (a -> b) -> a -> b
$ [b] -> [b]
forall a. Ord a => [a] -> [a]
L.sort [b]
xs
powerset :: [a] -> [[a]]
powerset [] = [[]]
powerset (x :: a
x:xs :: [a]
xs) = let p :: [[a]]
p = [a] -> [[a]]
powerset [a]
xs in [[a]]
p [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) [[a]]
p
data Graph a = G [a] [[a]] deriving (Graph a -> Graph a -> Bool
(Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Bool) -> Eq (Graph a)
forall a. Eq a => Graph a -> Graph a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Graph a -> Graph a -> Bool
$c/= :: forall a. Eq a => Graph a -> Graph a -> Bool
== :: Graph a -> Graph a -> Bool
$c== :: forall a. Eq a => Graph a -> Graph a -> Bool
Eq,Eq (Graph a)
Eq (Graph a) =>
(Graph a -> Graph a -> Ordering)
-> (Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Bool)
-> (Graph a -> Graph a -> Graph a)
-> (Graph a -> Graph a -> Graph a)
-> Ord (Graph a)
Graph a -> Graph a -> Bool
Graph a -> Graph a -> Ordering
Graph a -> Graph a -> Graph 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 (Graph a)
forall a. Ord a => Graph a -> Graph a -> Bool
forall a. Ord a => Graph a -> Graph a -> Ordering
forall a. Ord a => Graph a -> Graph a -> Graph a
min :: Graph a -> Graph a -> Graph a
$cmin :: forall a. Ord a => Graph a -> Graph a -> Graph a
max :: Graph a -> Graph a -> Graph a
$cmax :: forall a. Ord a => Graph a -> Graph a -> Graph a
>= :: Graph a -> Graph a -> Bool
$c>= :: forall a. Ord a => Graph a -> Graph a -> Bool
> :: Graph a -> Graph a -> Bool
$c> :: forall a. Ord a => Graph a -> Graph a -> Bool
<= :: Graph a -> Graph a -> Bool
$c<= :: forall a. Ord a => Graph a -> Graph a -> Bool
< :: Graph a -> Graph a -> Bool
$c< :: forall a. Ord a => Graph a -> Graph a -> Bool
compare :: Graph a -> Graph a -> Ordering
$ccompare :: forall a. Ord a => Graph a -> Graph a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Graph a)
Ord,Int -> Graph a -> ShowS
[Graph a] -> ShowS
Graph a -> String
(Int -> Graph a -> ShowS)
-> (Graph a -> String) -> ([Graph a] -> ShowS) -> Show (Graph a)
forall a. Show a => Int -> Graph a -> ShowS
forall a. Show a => [Graph a] -> ShowS
forall a. Show a => Graph a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Graph a] -> ShowS
$cshowList :: forall a. Show a => [Graph a] -> ShowS
show :: Graph a -> String
$cshow :: forall a. Show a => Graph a -> String
showsPrec :: Int -> Graph a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Graph a -> ShowS
Show)
instance Functor Graph where
fmap :: (a -> b) -> Graph a -> Graph b
fmap f :: a -> b
f (G vs :: [a]
vs es :: [[a]]
es) = [b] -> [[b]] -> Graph b
forall a. [a] -> [[a]] -> Graph a
G ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f [a]
vs) (([a] -> [b]) -> [[a]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> [a] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map a -> b
f) [[a]]
es)
nf :: Ord a => Graph a -> Graph a
nf :: Graph a -> Graph a
nf (G vs :: [a]
vs es :: [[a]]
es) = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [a]
vs' [[a]]
es' where
vs' :: [a]
vs' = [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a]
vs
es' :: [[a]]
es' = [[a]] -> [[a]]
forall a. Ord a => [a] -> [a]
L.sort (([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [[a]]
es)
isSetSystem :: [a] -> [[a]] -> Bool
isSetSystem xs :: [a]
xs bs :: [[a]]
bs = [a] -> Bool
forall a. Ord a => [a] -> Bool
isListSet [a]
xs Bool -> Bool -> Bool
&& [[a]] -> Bool
forall a. Ord a => [a] -> Bool
isListSet [[a]]
bs Bool -> Bool -> Bool
&& ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all [a] -> Bool
forall a. Ord a => [a] -> Bool
isListSet [[a]]
bs Bool -> Bool -> Bool
&& ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([a] -> [a] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`isSubset` [a]
xs) [[a]]
bs
isGraph :: [a] -> [[a]] -> Bool
isGraph vs :: [a]
vs es :: [[a]]
es = [a] -> [[a]] -> Bool
forall a. Ord a => [a] -> [[a]] -> Bool
isSetSystem [a]
vs [[a]]
es Bool -> Bool -> Bool
&& ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ( (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==2) (Int -> Bool) -> ([a] -> Int) -> [a] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) [[a]]
es
graph :: (Ord t) => ([t], [[t]]) -> Graph t
graph :: ([t], [[t]]) -> Graph t
graph (vs :: [t]
vs,es :: [[t]]
es) | [t] -> [[t]] -> Bool
forall a. Ord a => [a] -> [[a]] -> Bool
isGraph [t]
vs [[t]]
es = [t] -> [[t]] -> Graph t
forall a. [a] -> [[a]] -> Graph a
G [t]
vs [[t]]
es
toGraph :: ([a], [[a]]) -> Graph a
toGraph (vs :: [a]
vs,es :: [[a]]
es) | [a] -> [[a]] -> Bool
forall a. Ord a => [a] -> [[a]] -> Bool
isGraph [a]
vs' [[a]]
es' = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [a]
vs' [[a]]
es' where
vs' :: [a]
vs' = [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a]
vs
es' :: [[a]]
es' = [[a]] -> [[a]]
forall a. Ord a => [a] -> [a]
L.sort ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [[a]]
es
vertices :: Graph a -> [a]
vertices (G vs :: [a]
vs _) = [a]
vs
edges :: Graph a -> [[a]]
edges (G _ es :: [[a]]
es) = [[a]]
es
incidenceMatrix :: Graph a -> [[a]]
incidenceMatrix (G vs :: [a]
vs es :: [[a]]
es) = [ [if a
v a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
e then 1 else 0 | a
v <- [a]
vs] | [a]
e <- [[a]]
es]
fromIncidenceMatrix :: [[a]] -> Graph t
fromIncidenceMatrix m :: [[a]]
m = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs,[[t]]
es) where
n :: t
n = [a] -> t
forall i a. Num i => [a] -> i
L.genericLength ([a] -> t) -> [a] -> t
forall a b. (a -> b) -> a -> b
$ [[a]] -> [a]
forall a. [a] -> a
head [[a]]
m
vs :: [t]
vs = [1..t
n]
es :: [[t]]
es = [[t]] -> [[t]]
forall a. Ord a => [a] -> [a]
L.sort ([[t]] -> [[t]]) -> [[t]] -> [[t]]
forall a b. (a -> b) -> a -> b
$ ([a] -> [t]) -> [[a]] -> [[t]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [t]
forall a. (Eq a, Num a) => [a] -> [t]
edge [[a]]
m
edge :: [a] -> [t]
edge row :: [a]
row = [t
v | (1,v :: t
v) <- [a] -> [t] -> [(a, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
row [t]
vs]
adjacencyMatrix :: Graph a -> [[a]]
adjacencyMatrix (G vs :: [a]
vs es :: [[a]]
es) =
[ [if [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
i,a
j] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
es' then 1 else 0 | a
j <- [a]
vs] | a
i <- [a]
vs]
where es' :: Set [a]
es' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
fromAdjacencyMatrix :: [[a]] -> Graph Int
fromAdjacencyMatrix m :: [[a]]
m = ([Int], [[Int]]) -> Graph Int
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([Int]
vs,[[Int]]
es) where
n :: Int
n = [[a]] -> Int
forall i a. Num i => [a] -> i
L.genericLength [[a]]
m
vs :: [Int]
vs = [1..Int
n]
es :: [[Int]]
es = Int -> [[a]] -> [[Int]]
forall a. (Eq a, Num a) => Int -> [[a]] -> [[Int]]
es' 1 [[a]]
m
es' :: Int -> [[a]] -> [[Int]]
es' i :: Int
i (r :: [a]
r:rs :: [[a]]
rs) = [ [Int
i,Int
j] | (j :: Int
j,1) <- Int -> [(Int, a)] -> [(Int, a)]
forall a. Int -> [a] -> [a]
drop Int
i ([Int] -> [a] -> [(Int, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int]
vs [a]
r)] [[Int]] -> [[Int]] -> [[Int]]
forall a. [a] -> [a] -> [a]
++ Int -> [[a]] -> [[Int]]
es' (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+1) [[a]]
rs
es' _ [] = []
nullGraph :: (Integral t) => t -> Graph t
nullGraph :: t -> Graph t
nullGraph n :: t
n = [t] -> [[t]] -> Graph t
forall a. [a] -> [[a]] -> Graph a
G [1..t
n] []
nullGraph' :: Graph Int
nullGraph' :: Graph Int
nullGraph' = [Int] -> [[Int]] -> Graph Int
forall a. [a] -> [[a]] -> Graph a
G [] []
c :: (Integral t) => t -> Graph t
c :: t -> Graph t
c n :: t
n | t
n t -> t -> Bool
forall a. Ord a => a -> a -> Bool
>= 3 = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs,[[t]]
es) where
vs :: [t]
vs = [1..t
n]
es :: [[t]]
es = [t] -> [[t]] -> [[t]]
forall a. Ord a => a -> [a] -> [a]
L.insert [1,t
n] [[t
i,t
it -> t -> t
forall a. Num a => a -> a -> a
+1] | t
i <- [1..t
nt -> t -> t
forall a. Num a => a -> a -> a
-1]]
k :: (Integral t) => t -> Graph t
k :: t -> Graph t
k n :: t
n = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs,[[t]]
es) where
vs :: [t]
vs = [1..t
n]
es :: [[t]]
es = [[t
i,t
j] | t
i <- [1..t
nt -> t -> t
forall a. Num a => a -> a -> a
-1], t
j <- [t
it -> t -> t
forall a. Num a => a -> a -> a
+1..t
n]]
kb :: (Integral t) => t -> t -> Graph t
kb :: t -> t -> Graph t
kb m :: t
m n :: t
n = Graph (Either t t) -> Graph t
forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
to1n (Graph (Either t t) -> Graph t) -> Graph (Either t t) -> Graph t
forall a b. (a -> b) -> a -> b
$ t -> t -> Graph (Either t t)
forall t. Integral t => t -> t -> Graph (Either t t)
kb' t
m t
n
kb' :: (Integral t) => t -> t -> Graph (Either t t)
kb' :: t -> t -> Graph (Either t t)
kb' m :: t
m n :: t
n = ([Either t t], [[Either t t]]) -> Graph (Either t t)
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([Either t t]
vs,[[Either t t]]
es) where
vs :: [Either t t]
vs = (t -> Either t t) -> [t] -> [Either t t]
forall a b. (a -> b) -> [a] -> [b]
map t -> Either t t
forall a b. a -> Either a b
Left [1..t
m] [Either t t] -> [Either t t] -> [Either t t]
forall a. [a] -> [a] -> [a]
++ (t -> Either t t) -> [t] -> [Either t t]
forall a b. (a -> b) -> [a] -> [b]
map t -> Either t t
forall a b. b -> Either a b
Right [1..t
n]
es :: [[Either t t]]
es = [ [t -> Either t t
forall a b. a -> Either a b
Left t
i, t -> Either t t
forall a b. b -> Either a b
Right t
j] | t
i <- [1..t
m], t
j <- [1..t
n] ]
q :: (Integral t) => Int -> Graph t
q :: Int -> Graph t
q k :: Int
k = Graph [t] -> Graph t
forall a. Integral a => Graph [a] -> Graph a
fromBinary (Graph [t] -> Graph t) -> Graph [t] -> Graph t
forall a b. (a -> b) -> a -> b
$ Int -> Graph [t]
forall t. Integral t => Int -> Graph [t]
q' Int
k
q' :: (Integral t) => Int -> Graph [t]
q' :: Int -> Graph [t]
q' k :: Int
k = ([[t]], [[[t]]]) -> Graph [t]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[t]]
vs,[[[t]]]
es) where
vs :: [[t]]
vs = [[t]] -> [[t]]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
sequence ([[t]] -> [[t]]) -> [[t]] -> [[t]]
forall a b. (a -> b) -> a -> b
$ Int -> [t] -> [[t]]
forall a. Int -> a -> [a]
replicate Int
k [0,1]
es :: [[[t]]]
es = [ [[t]
u,[t]
v] | [u :: [t]
u,v :: [t]
v] <- Int -> [[t]] -> [[[t]]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [[t]]
vs, [t] -> [t] -> Int
forall a. Eq a => [a] -> [a] -> Int
hammingDistance [t]
u [t]
v Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 ]
hammingDistance :: [a] -> [a] -> Int
hammingDistance as :: [a]
as bs :: [a]
bs = [Bool] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Bool] -> Int) -> [Bool] -> Int
forall a b. (a -> b) -> a -> b
$ (Bool -> Bool) -> [Bool] -> [Bool]
forall a. (a -> Bool) -> [a] -> [a]
filter Bool -> Bool
forall a. a -> a
id ([Bool] -> [Bool]) -> [Bool] -> [Bool]
forall a b. (a -> b) -> a -> b
$ (a -> a -> Bool) -> [a] -> [a] -> [Bool]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(/=) [a]
as [a]
bs
tetrahedron :: Graph Integer
tetrahedron = Integer -> Graph Integer
forall t. Integral t => t -> Graph t
k 4
cube :: Graph Integer
cube = Int -> Graph Integer
forall t. Integral t => Int -> Graph t
q 3
octahedron :: Graph Integer
octahedron = ([Integer], [[Integer]]) -> Graph Integer
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([Integer]
vs,[[Integer]]
es) where
vs :: [Integer]
vs = [1..6]
es :: [[Integer]]
es = Int -> [Integer] -> [[Integer]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [Integer]
vs [[Integer]] -> [[Integer]] -> [[Integer]]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [[1,6],[2,5],[3,4]]
dodecahedron :: Graph Integer
dodecahedron = ([Integer], [[Integer]]) -> Graph Integer
forall t. Ord t => ([t], [[t]]) -> Graph t
toGraph ([Integer]
vs,[[Integer]]
es) where
vs :: [Integer]
vs = [1..20]
es :: [[Integer]]
es = [ [1,2],[2,3],[3,4],[4,5],[5,1],
[6,7],[7,8],[8,9],[9,10],[10,11],[11,12],[12,13],[13,14],[14,15],[15,6],
[16,17],[17,18],[18,19],[19,20],[20,16],
[1,6],[2,8],[3,10],[4,12],[5,14],
[7,16],[9,17],[11,18],[13,19],[15,20] ]
icosahedron :: Graph Integer
icosahedron = ([Integer], [[Integer]]) -> Graph Integer
forall t. Ord t => ([t], [[t]]) -> Graph t
toGraph ([Integer]
vs,[[Integer]]
es) where
vs :: [Integer]
vs = [1..12]
es :: [[Integer]]
es = [ [1,2],[1,3],[1,4],[1,5],[1,6],
[2,3],[3,4],[4,5],[5,6],[6,2],
[7,12],[8,12],[9,12],[10,12],[11,12],
[7,8],[8,9],[9,10],[10,11],[11,7],
[2,7],[7,3],[3,8],[8,4],[4,9],[9,5],[5,10],[10,6],[6,11],[11,2] ]
prism :: Int -> Graph (Int,Int)
prism :: Int -> Graph (Int, Int)
prism n :: Int
n = Int -> Graph Int
forall t. Integral t => t -> Graph t
k 2 Graph Int -> Graph Int -> Graph (Int, Int)
forall a a. (Ord a, Ord a) => Graph a -> Graph a -> Graph (a, a)
`cartProd` Int -> Graph Int
forall t. Integral t => t -> Graph t
c Int
n
to1n :: Graph a -> Graph t
to1n (G vs :: [a]
vs es :: [[a]]
es) = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs',[[t]]
es') where
mapping :: Map a t
mapping = [(a, t)] -> Map a t
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, t)] -> Map a t) -> [(a, t)] -> Map a t
forall a b. (a -> b) -> a -> b
$ [a] -> [t] -> [(a, t)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
vs [1..]
vs' :: [t]
vs' = Map a t -> [t]
forall k a. Map k a -> [a]
M.elems Map a t
mapping
es' :: [[t]]
es' = [(a -> t) -> [a] -> [t]
forall a b. (a -> b) -> [a] -> [b]
map (Map a t
mapping Map a t -> a -> t
forall k a. Ord k => Map k a -> k -> a
M.!) [a]
e | [a]
e <- [[a]]
es]
fromDigits :: Integral a => Graph [a] -> Graph a
fromDigits :: Graph [a] -> Graph a
fromDigits = ([a] -> a) -> Graph [a] -> Graph a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall p. Num p => [p] -> p
fromDigits'
fromBinary :: Integral a => Graph [a] -> Graph a
fromBinary :: Graph [a] -> Graph a
fromBinary = ([a] -> a) -> Graph [a] -> Graph a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [a] -> a
forall p. Num p => [p] -> p
fromBinary'
petersen :: Graph [Integer]
petersen :: Graph [Integer]
petersen = ([[Integer]], [[[Integer]]]) -> Graph [Integer]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[Integer]]
vs,[[[Integer]]]
es) where
vs :: [[Integer]]
vs = Int -> [Integer] -> [[Integer]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [1..5]
es :: [[[Integer]]]
es = [ [[Integer]
v1,[Integer]
v2] | [v1 :: [Integer]
v1,v2 :: [Integer]
v2] <- Int -> [[Integer]] -> [[[Integer]]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [[Integer]]
vs, [Integer] -> [Integer] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
disjoint [Integer]
v1 [Integer]
v2]
complement :: (Ord t) => Graph t -> Graph t
complement :: Graph t -> Graph t
complement (G vs :: [t]
vs es :: [[t]]
es) = ([t], [[t]]) -> Graph t
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([t]
vs,[[t]]
es') where es' :: [[t]]
es' = Int -> [t] -> [[t]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [t]
vs [[t]] -> [[t]] -> [[t]]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [[t]]
es
restriction :: (Eq a) => Graph a -> [a] -> Graph a
restriction :: Graph a -> [a] -> Graph a
restriction g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) us :: [a]
us = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [a]
us ([[a]]
es [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a. (Foldable t, Eq a) => [[a]] -> t a -> [[a]]
`restrict` [a]
us)
where es :: [[a]]
es restrict :: [[a]] -> t a -> [[a]]
`restrict` us :: t a
us = [[a]
e | e :: [a]
e@[i :: a
i,j :: a
j] <- [[a]]
es, a
i a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
us, a
j a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
us]
inducedSubgraph :: (Eq a) => Graph a -> [a] -> Graph a
inducedSubgraph :: Graph a -> [a] -> Graph a
inducedSubgraph g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) us :: [a]
us = [a] -> [[a]] -> Graph a
forall a. [a] -> [[a]] -> Graph a
G [a]
us ([[a]]
es [[a]] -> [a] -> [[a]]
forall (t :: * -> *) a. (Foldable t, Eq a) => [[a]] -> t a -> [[a]]
`restrict` [a]
us)
where es :: [[a]]
es restrict :: [[a]] -> t a -> [[a]]
`restrict` us :: t a
us = [[a]
e | e :: [a]
e@[i :: a
i,j :: a
j] <- [[a]]
es, a
i a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
us, a
j a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
us]
lineGraph :: Graph a -> Graph t
lineGraph g :: Graph a
g = Graph [a] -> Graph t
forall t a. (Ord t, Num t, Enum t, Ord a) => Graph a -> Graph t
to1n (Graph [a] -> Graph t) -> Graph [a] -> Graph t
forall a b. (a -> b) -> a -> b
$ Graph a -> Graph [a]
forall a. Ord a => Graph a -> Graph [a]
lineGraph' Graph a
g
lineGraph' :: Graph a -> Graph [a]
lineGraph' (G vs :: [a]
vs es :: [[a]]
es) = ([[a]], [[[a]]]) -> Graph [a]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[a]]
es, [ [[a]
ei,[a]
ej] | [a]
ei <- [[a]]
es, [a]
ej <- ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile ([a] -> [a] -> Bool
forall a. Ord a => a -> a -> Bool
<= [a]
ei) [[a]]
es, [a]
ei [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`intersect` [a]
ej [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] ])
cartProd :: Graph a -> Graph a -> Graph (a, a)
cartProd (G vs :: [a]
vs es :: [[a]]
es) (G vs' :: [a]
vs' es' :: [[a]]
es') = [(a, a)] -> [[(a, a)]] -> Graph (a, a)
forall a. [a] -> [[a]] -> Graph a
G [(a, a)]
us [[(a, a)]
e | e :: [(a, a)]
e@[u :: (a, a)
u,u' :: (a, a)
u'] <- Int -> [(a, a)] -> [[(a, a)]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [(a, a)]
us, (a, a)
u (a, a) -> (a, a) -> Bool
`adj` (a, a)
u' ]
where us :: [(a, a)]
us = [(a
v,a
v') | a
v <- [a]
vs, a
v' <- [a]
vs']
eset :: Set [a]
eset = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es
eset' :: Set [a]
eset' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es'
adj :: (a, a) -> (a, a) -> Bool
adj (x1 :: a
x1,y1 :: a
y1) (x2 :: a
x2,y2 :: a
y2) = a
x1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
x2 Bool -> Bool -> Bool
&& [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
y1,a
y2] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
eset'
Bool -> Bool -> Bool
|| a
y1 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y2 Bool -> Bool -> Bool
&& [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
x1,a
x2] [a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
eset
order :: Graph a -> Int
order = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([a] -> Int) -> (Graph a -> [a]) -> Graph a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> [a]
forall a. Graph a -> [a]
vertices
size :: Graph a -> Int
size = [[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[a]] -> Int) -> (Graph a -> [[a]]) -> Graph a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Graph a -> [[a]]
forall a. Graph a -> [[a]]
edges
valency :: Graph a -> a -> Int
valency (G vs :: [a]
vs es :: [[a]]
es) v :: a
v = [[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([[a]] -> Int) -> [[a]] -> Int
forall a b. (a -> b) -> a -> b
$ ([a] -> Bool) -> [[a]] -> [[a]]
forall a. (a -> Bool) -> [a] -> [a]
filter (a
v a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [[a]]
es
valencies :: Graph a -> [(Int, Int)]
valencies g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) = ([Int] -> (Int, Int)) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ([Int] -> Int
forall a. [a] -> a
head ([Int] -> Int) -> ([Int] -> Int) -> [Int] -> (Int, Int)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) ([[Int]] -> [(Int, Int)]) -> [[Int]] -> [(Int, Int)]
forall a b. (a -> b) -> a -> b
$ [Int] -> [[Int]]
forall a. Eq a => [a] -> [[a]]
L.group ([Int] -> [[Int]]) -> [Int] -> [[Int]]
forall a b. (a -> b) -> a -> b
$ [Int] -> [Int]
forall a. Ord a => [a] -> [a]
L.sort ([Int] -> [Int]) -> [Int] -> [Int]
forall a b. (a -> b) -> a -> b
$ (a -> Int) -> [a] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Graph a -> a -> Int
forall a. Eq a => Graph a -> a -> Int
valency Graph a
g) [a]
vs
valencyPartition :: Graph b -> [[b]]
valencyPartition g :: Graph b
g@(G vs :: [b]
vs es :: [[b]]
es) = ([(Int, b)] -> [b]) -> [[(Int, b)]] -> [[b]]
forall a b. (a -> b) -> [a] -> [b]
map (((Int, b) -> b) -> [(Int, b)] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map (Int, b) -> b
forall a b. (a, b) -> b
snd) ([[(Int, b)]] -> [[b]]) -> [[(Int, b)]] -> [[b]]
forall a b. (a -> b) -> a -> b
$ ((Int, b) -> (Int, b) -> Bool) -> [(Int, b)] -> [[(Int, b)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
L.groupBy (\x :: (Int, b)
x y :: (Int, b)
y -> (Int, b) -> Int
forall a b. (a, b) -> a
fst (Int, b)
x Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== (Int, b) -> Int
forall a b. (a, b) -> a
fst (Int, b)
y) [(Graph b -> b -> Int
forall a. Eq a => Graph a -> a -> Int
valency Graph b
g b
v, b
v) | b
v <- [b]
vs]
regularParam :: Graph a -> Maybe Int
regularParam g :: Graph a
g =
case Graph a -> [(Int, Int)]
forall a. Eq a => Graph a -> [(Int, Int)]
valencies Graph a
g of
[(v :: Int
v,_)] -> Int -> Maybe Int
forall a. a -> Maybe a
Just Int
v
_ -> Maybe Int
forall a. Maybe a
Nothing
isRegular :: (Eq t) => Graph t -> Bool
isRegular :: Graph t -> Bool
isRegular g :: Graph t
g = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ Graph t -> Maybe Int
forall a. Eq a => Graph a -> Maybe Int
regularParam Graph t
g
isCubic :: (Eq t) => Graph t -> Bool
isCubic :: Graph t -> Bool
isCubic g :: Graph t
g = Graph t -> Maybe Int
forall a. Eq a => Graph a -> Maybe Int
regularParam Graph t
g Maybe Int -> Maybe Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Maybe Int
forall a. a -> Maybe a
Just 3
nbrs :: Graph a -> a -> [a]
nbrs (G vs :: [a]
vs es :: [[a]]
es) v :: a
v = [a
u | [u :: a
u,v' :: a
v'] <- [[a]]
es, a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v']
[a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a
w | [v' :: a
v',w :: a
w] <- [[a]]
es, a
v a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
v']
findPaths :: Graph a -> a -> a -> [[a]]
findPaths g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) x :: a
x y :: a
y = ([a] -> [a]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> [a]
forall a. [a] -> [a]
reverse ([[a]] -> [[a]]) -> [[a]] -> [[a]]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
bfs [ [a
x] ] where
bfs :: [[a]] -> [[a]]
bfs ((z :: a
z:zs :: [a]
zs) : nodes :: [[a]]
nodes)
| a
z a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y = (a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
bfs [[a]]
nodes
| Bool
otherwise = [[a]] -> [[a]]
bfs ([[a]]
nodes [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [(a
wa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) | a
w <- Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
z, a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
zs])
bfs [] = []
distance :: (Eq a) => Graph a -> a -> a -> Int
distance :: Graph a -> a -> a -> Int
distance g :: Graph a
g x :: a
x y :: a
y =
case Graph a -> a -> a -> [[a]]
forall a. Eq a => Graph a -> a -> a -> [[a]]
findPaths Graph a
g a
x a
y of
[] -> -1
p :: [a]
p:ps :: [[a]]
ps -> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
p Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
diameter :: (Ord t) => Graph t -> Int
diameter :: Graph t -> Int
diameter g :: Graph t
g@(G vs :: [t]
vs es :: [[t]]
es)
| Graph t -> Bool
forall t. Ord t => Graph t -> Bool
isConnected Graph t
g = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (t -> Int) -> [t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map t -> Int
maxDistance [t]
vs
| Bool
otherwise = -1
where maxDistance :: t -> Int
maxDistance v :: t
v = [[t]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Graph t -> t -> [[t]]
forall a. Ord a => Graph a -> a -> [[a]]
distancePartition Graph t
g t
v) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
findCycles :: Graph a -> a -> [[a]]
findCycles g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) x :: a
x = [[a] -> [a]
forall a. [a] -> [a]
reverse (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) | z :: a
z:zs :: [a]
zs <- [[a]] -> [[a]]
bfs [ [a
x] ], a
z a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
nbrsx, [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
zs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1] where
nbrsx :: [a]
nbrsx = Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
x
bfs :: [[a]] -> [[a]]
bfs ((z :: a
z:zs :: [a]
zs) : nodes :: [[a]]
nodes) = (a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
bfs ([[a]]
nodes [[a]] -> [[a]] -> [[a]]
forall a. [a] -> [a] -> [a]
++ [ a
wa -> [a] -> [a]
forall a. a -> [a] -> [a]
:a
za -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
zs | a
w <- Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
z, a
w a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [a]
zs])
bfs [] = []
girth :: (Eq t) => Graph t -> Int
girth :: Graph t -> Int
girth g :: Graph t
g@(G vs :: [t]
vs es :: [[t]]
es) = [Int] -> Int
forall p. (Ord p, Num p) => [p] -> p
minimum' ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ (t -> Int) -> [t] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map t -> Int
minCycle [t]
vs where
minimum' :: [p] -> p
minimum' xs :: [p]
xs = let (zs :: [p]
zs,nzs :: [p]
nzs) = (p -> Bool) -> [p] -> ([p], [p])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (p -> p -> Bool
forall a. Eq a => a -> a -> Bool
==0) [p]
xs in if [p] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [p]
nzs then -1 else [p] -> p
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [p]
nzs
minCycle :: t -> Int
minCycle v :: t
v = case Graph t -> t -> [[t]]
forall a. Eq a => Graph a -> a -> [[a]]
findCycles Graph t
g t
v of
[] -> 0
c :: [t]
c:cs :: [[t]]
cs -> [t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [t]
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
distancePartition :: Graph a -> a -> [[a]]
distancePartition g :: Graph a
g@(G vs :: [a]
vs es :: [[a]]
es) v :: a
v = [a] -> Set [a] -> a -> [[a]]
forall a. Ord a => [a] -> Set [a] -> a -> [[a]]
distancePartitionS [a]
vs ([[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
es) a
v
distancePartitionS :: [a] -> Set [a] -> a -> [[a]]
distancePartitionS vs :: [a]
vs eset :: Set [a]
eset v :: a
v = Set a -> Set a -> [[a]]
distancePartition' (a -> Set a
forall a. a -> Set a
S.singleton a
v) (a -> Set a -> Set a
forall a. Ord a => a -> Set a -> Set a
S.delete a
v ([a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList [a]
vs)) where
distancePartition' :: Set a -> Set a -> [[a]]
distancePartition' boundary :: Set a
boundary exterior :: Set a
exterior
| Set a -> Bool
forall a. Set a -> Bool
S.null Set a
boundary = if Set a -> Bool
forall a. Set a -> Bool
S.null Set a
exterior then [] else [Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
exterior]
| Bool
otherwise = let (boundary' :: Set a
boundary', exterior' :: Set a
exterior') = (a -> Bool) -> Set a -> (Set a, Set a)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
S.partition (\v :: a
v -> ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ([a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
eset) [[a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a
u,a
v] | a
u <- Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
boundary]) Set a
exterior
in Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
boundary [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: Set a -> Set a -> [[a]]
distancePartition' Set a
boundary' Set a
exterior'
component :: Graph a -> a -> [a]
component g :: Graph a
g v :: a
v = Set a -> Set a -> [a]
component' Set a
forall a. Set a
S.empty (a -> Set a
forall a. a -> Set a
S.singleton a
v) where
component' :: Set a -> Set a -> [a]
component' interior :: Set a
interior boundary :: Set a
boundary
| Set a -> Bool
forall a. Set a -> Bool
S.null Set a
boundary = Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
interior
| Bool
otherwise = let interior' :: Set a
interior' = Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
interior Set a
boundary
boundary' :: Set a
boundary' = (Set a -> Set a -> Set a) -> Set a -> [Set a] -> Set a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.union Set a
forall a. Set a
S.empty [[a] -> Set a
forall a. Ord a => [a] -> Set a
S.fromList (Graph a -> a -> [a]
forall a. Eq a => Graph a -> a -> [a]
nbrs Graph a
g a
x) | a
x <- Set a -> [a]
forall a. Set a -> [a]
S.toList Set a
boundary] Set a -> Set a -> Set a
forall a. Ord a => Set a -> Set a -> Set a
S.\\ Set a
interior'
in Set a -> Set a -> [a]
component' Set a
interior' Set a
boundary'
isConnected :: (Ord t) => Graph t -> Bool
isConnected :: Graph t -> Bool
isConnected g :: Graph t
g@(G (v :: t
v:vs :: [t]
vs) es :: [[t]]
es) = [t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Graph t -> t -> [t]
forall a. Ord a => Graph a -> a -> [a]
component Graph t
g t
v) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [t] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (t
vt -> [t] -> [t]
forall a. a -> [a] -> [a]
:[t]
vs)
isConnected (G [] []) = Bool
True
components :: Graph a -> [[a]]
components g :: Graph a
g = [a] -> [[a]]
components' (Graph a -> [a]
forall a. Graph a -> [a]
vertices Graph a
g)
where components' :: [a] -> [[a]]
components' [] = []
components' (v :: a
v:vs :: [a]
vs) = let c :: [a]
c = Graph a -> a -> [a]
forall a. Ord a => Graph a -> a -> [a]
component Graph a
g a
v in [a]
c [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a] -> [[a]]
components' ([a]
vs [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
LS.\\ [a]
c)
j :: Int -> Int -> Int -> Graph [Int]
j v :: Int
v k :: Int
k i :: Int
i | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
k Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
i
= ([[Int]], [[[Int]]]) -> Graph [Int]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[Int]]
vs,[[[Int]]]
es) where
vs :: [[Int]]
vs = Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [1..Int
v]
es :: [[[Int]]]
es = [ [[Int]
v1,[Int]
v2] | [v1 :: [Int]
v1,v2 :: [Int]
v2] <- Int -> [[Int]] -> [[[Int]]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [[Int]]
vs, [Int] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Int]
v1 [Int] -> [Int] -> [Int]
forall a. Ord a => [a] -> [a] -> [a]
`intersect` [Int]
v2) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
i ]
kneser :: Int -> Int -> Graph [Int]
kneser :: Int -> Int -> Graph [Int]
kneser n :: Int
n k :: Int
k | 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
n = ([[Int]], [[[Int]]]) -> Graph [Int]
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([[Int]]
vs,[[[Int]]]
es) where
vs :: [[Int]]
vs = Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [1..Int
n]
es :: [[[Int]]]
es = [ [[Int]
v1,[Int]
v2] | [v1 :: [Int]
v1,v2 :: [Int]
v2] <- Int -> [[Int]] -> [[[Int]]]
forall a. Int -> [a] -> [[a]]
combinationsOf 2 [[Int]]
vs, [Int] -> [Int] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
disjoint [Int]
v1 [Int]
v2]
johnson :: Int -> Int -> Graph [Int]
johnson v :: Int
v k :: Int
k | Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k = Int -> Int -> Int -> Graph [Int]
j Int
v Int
k (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
bipartiteKneser :: Int -> Int -> Graph (Either [Int] [Int])
bipartiteKneser n :: Int
n k :: Int
k | 2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n = ([Either [Int] [Int]], [[Either [Int] [Int]]])
-> Graph (Either [Int] [Int])
forall t. Ord t => ([t], [[t]]) -> Graph t
graph ([Either [Int] [Int]]
vs,[[Either [Int] [Int]]]
es) where
vs :: [Either [Int] [Int]]
vs = ([Int] -> Either [Int] [Int]) -> [[Int]] -> [Either [Int] [Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Either [Int] [Int]
forall a b. a -> Either a b
Left (Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [1..Int
n])
[Either [Int] [Int]]
-> [Either [Int] [Int]] -> [Either [Int] [Int]]
forall a. [a] -> [a] -> [a]
++ ([Int] -> Either [Int] [Int]) -> [[Int]] -> [Either [Int] [Int]]
forall a b. (a -> b) -> [a] -> [b]
map [Int] -> Either [Int] [Int]
forall a b. b -> Either a b
Right (Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) [1..Int
n])
es :: [[Either [Int] [Int]]]
es = [ [[Int] -> Either [Int] [Int]
forall a b. a -> Either a b
Left [Int]
u, [Int] -> Either [Int] [Int]
forall a b. b -> Either a b
Right [Int]
v] | [Int]
u <- Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [1..Int
n], [Int]
v <- Int -> [Int] -> [[Int]]
forall a. Int -> [a] -> [[a]]
combinationsOf (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
k) [1..Int
n], [Int]
u [Int] -> [Int] -> Bool
forall a. Ord a => [a] -> [a] -> Bool
`isSubset` [Int]
v]
desargues1 :: Graph (Either [Int] [Int])
desargues1 = Int -> Int -> Graph (Either [Int] [Int])
bipartiteKneser 5 2
gp :: b -> b -> Graph (Either b b)
gp n :: b
n k :: b
k | 2b -> b -> b
forall a. Num a => a -> a -> a
*b
k b -> b -> Bool
forall a. Ord a => a -> a -> Bool
< b
n = ([Either b b], [[Either b b]]) -> Graph (Either b b)
forall t. Ord t => ([t], [[t]]) -> Graph t
toGraph ([Either b b]
vs,[[Either b b]]
es) where
vs :: [Either b b]
vs = (b -> Either b b) -> [b] -> [Either b b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Either b b
forall a b. a -> Either a b
Left [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1] [Either b b] -> [Either b b] -> [Either b b]
forall a. [a] -> [a] -> [a]
++ (b -> Either b b) -> [b] -> [Either b b]
forall a b. (a -> b) -> [a] -> [b]
map b -> Either b b
forall a b. b -> Either a b
Right [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1]
es :: [[Either b b]]
es = (([b] -> [Either b b]) -> [[b]] -> [[Either b b]]
forall a b. (a -> b) -> [a] -> [b]
map (([b] -> [Either b b]) -> [[b]] -> [[Either b b]])
-> ((b -> Either b b) -> [b] -> [Either b b])
-> (b -> Either b b)
-> [[b]]
-> [[Either b b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Either b b) -> [b] -> [Either b b]
forall a b. (a -> b) -> [a] -> [b]
map) b -> Either b b
forall a b. a -> Either a b
Left [ [b
i, (b
ib -> b -> b
forall a. Num a => a -> a -> a
+1) b -> b -> b
forall a. Integral a => a -> a -> a
`mod` b
n] | b
i <- [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1] ]
[[Either b b]] -> [[Either b b]] -> [[Either b b]]
forall a. [a] -> [a] -> [a]
++ [ [b -> Either b b
forall a b. a -> Either a b
Left b
i, b -> Either b b
forall a b. b -> Either a b
Right b
i] | b
i <- [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1] ]
[[Either b b]] -> [[Either b b]] -> [[Either b b]]
forall a. [a] -> [a] -> [a]
++ (([b] -> [Either b b]) -> [[b]] -> [[Either b b]]
forall a b. (a -> b) -> [a] -> [b]
map (([b] -> [Either b b]) -> [[b]] -> [[Either b b]])
-> ((b -> Either b b) -> [b] -> [Either b b])
-> (b -> Either b b)
-> [[b]]
-> [[Either b b]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> Either b b) -> [b] -> [Either b b]
forall a b. (a -> b) -> [a] -> [b]
map) b -> Either b b
forall a b. b -> Either a b
Right [ [b
i, (b
ib -> b -> b
forall a. Num a => a -> a -> a
+b
k) b -> b -> b
forall a. Integral a => a -> a -> a
`mod` b
n] | b
i <- [0..b
nb -> b -> b
forall a. Num a => a -> a -> a
-1] ]
petersen2 :: Graph (Either Integer Integer)
petersen2 = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 5 2
prism' :: b -> Graph (Either b b)
prism' n :: b
n = b -> b -> Graph (Either b b)
forall t. Integral t => t -> t -> Graph (Either t t)
gp b
n 1
durer :: Graph (Either Integer Integer)
durer = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 6 2
mobiusKantor :: Graph (Either Integer Integer)
mobiusKantor = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 8 3
dodecahedron2 :: Graph (Either Integer Integer)
dodecahedron2 = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 10 2
desargues2 :: Graph (Either Integer Integer)
desargues2 = Integer -> Integer -> Graph (Either Integer Integer)
forall t. Integral t => t -> t -> Graph (Either t t)
gp 10 3