module Math.Combinatorics.Design where
import Data.Maybe (fromJust, isJust)
import qualified Data.List as L
import qualified Data.Map as M
import qualified Data.Set as S
import Math.Common.ListSet (intersect, symDiff)
import Math.Core.Utils (combinationsOf)
import Math.Algebra.Field.Base
import Math.Algebra.Field.Extension
import Math.Algebra.Group.PermutationGroup hiding (elts, order, isMember)
import Math.Algebra.Group.SchreierSims as SS
import Math.Combinatorics.Graph as G hiding (to1n, incidenceMatrix)
import Math.Combinatorics.GraphAuts (graphAuts, incidenceAuts)
import Math.Combinatorics.FiniteGeometry
isSubset :: t a -> t a -> Bool
isSubset xs :: t a
xs ys :: t a
ys = (a -> Bool) -> t a -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
ys) t a
xs
data Design a = D [a] [[a]] deriving (Design a -> Design a -> Bool
(Design a -> Design a -> Bool)
-> (Design a -> Design a -> Bool) -> Eq (Design a)
forall a. Eq a => Design a -> Design a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Design a -> Design a -> Bool
$c/= :: forall a. Eq a => Design a -> Design a -> Bool
== :: Design a -> Design a -> Bool
$c== :: forall a. Eq a => Design a -> Design a -> Bool
Eq,Eq (Design a)
Eq (Design a) =>
(Design a -> Design a -> Ordering)
-> (Design a -> Design a -> Bool)
-> (Design a -> Design a -> Bool)
-> (Design a -> Design a -> Bool)
-> (Design a -> Design a -> Bool)
-> (Design a -> Design a -> Design a)
-> (Design a -> Design a -> Design a)
-> Ord (Design a)
Design a -> Design a -> Bool
Design a -> Design a -> Ordering
Design a -> Design a -> Design 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 (Design a)
forall a. Ord a => Design a -> Design a -> Bool
forall a. Ord a => Design a -> Design a -> Ordering
forall a. Ord a => Design a -> Design a -> Design a
min :: Design a -> Design a -> Design a
$cmin :: forall a. Ord a => Design a -> Design a -> Design a
max :: Design a -> Design a -> Design a
$cmax :: forall a. Ord a => Design a -> Design a -> Design a
>= :: Design a -> Design a -> Bool
$c>= :: forall a. Ord a => Design a -> Design a -> Bool
> :: Design a -> Design a -> Bool
$c> :: forall a. Ord a => Design a -> Design a -> Bool
<= :: Design a -> Design a -> Bool
$c<= :: forall a. Ord a => Design a -> Design a -> Bool
< :: Design a -> Design a -> Bool
$c< :: forall a. Ord a => Design a -> Design a -> Bool
compare :: Design a -> Design a -> Ordering
$ccompare :: forall a. Ord a => Design a -> Design a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Design a)
Ord,Int -> Design a -> ShowS
[Design a] -> ShowS
Design a -> String
(Int -> Design a -> ShowS)
-> (Design a -> String) -> ([Design a] -> ShowS) -> Show (Design a)
forall a. Show a => Int -> Design a -> ShowS
forall a. Show a => [Design a] -> ShowS
forall a. Show a => Design a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Design a] -> ShowS
$cshowList :: forall a. Show a => [Design a] -> ShowS
show :: Design a -> String
$cshow :: forall a. Show a => Design a -> String
showsPrec :: Int -> Design a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Design a -> ShowS
Show)
design :: ([a], [[a]]) -> Design a
design (xs :: [a]
xs,bs :: [[a]]
bs) | Design a -> Bool
forall a. Ord a => Design a -> Bool
isValid Design a
d = Design a
d where d :: Design a
d = [a] -> [[a]] -> Design a
forall a. [a] -> [[a]] -> Design a
D [a]
xs [[a]]
bs
toDesign :: ([a], [[a]]) -> Design a
toDesign (xs :: [a]
xs,bs :: [[a]]
bs) = [a] -> [[a]] -> Design a
forall a. [a] -> [[a]] -> Design a
D [a]
xs' [[a]]
bs' where
xs' :: [a]
xs' = [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a]
xs
bs' :: [[a]]
bs' = [[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]]
bs
isValid :: Design a -> Bool
isValid (D xs :: [a]
xs bs :: [[a]]
bs) = ([a]
xs [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a]
xs Bool -> Bool -> Bool
|| String -> Bool
forall a. HasCallStack => String -> a
error "design: points are not in order")
Bool -> Bool -> Bool
&& (([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\b :: [a]
b -> [a]
b [a] -> [a] -> Bool
forall a. Eq a => a -> a -> Bool
== [a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort [a]
b) [[a]]
bs Bool -> Bool -> Bool
|| String -> Bool
forall a. HasCallStack => String -> a
error "design: blocks do not have points in order")
points :: Design a -> [a]
points (D xs :: [a]
xs bs :: [[a]]
bs) = [a]
xs
blocks :: Design a -> [[a]]
blocks (D xs :: [a]
xs bs :: [[a]]
bs) = [[a]]
bs
noRepeatedBlocks :: Design a -> Bool
noRepeatedBlocks (D xs :: [a]
xs bs :: [[a]]
bs) = ([[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
==1) (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]]] -> Bool) -> [[[a]]] -> Bool
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[[a]]]
forall a. Eq a => [a] -> [[a]]
L.group ([[a]] -> [[[a]]]) -> [[a]] -> [[[a]]]
forall a b. (a -> b) -> a -> b
$ [[a]] -> [[a]]
forall a. Ord a => [a] -> [a]
L.sort [[a]]
bs
tDesignParams :: Int -> Design a -> Maybe (Int, Int, Int)
tDesignParams t :: Int
t d :: Design a
d =
case Design a -> Maybe (Int, Int)
forall a. Design a -> Maybe (Int, Int)
findvk Design a
d of
Nothing -> Maybe (Int, Int, Int)
forall a. Maybe a
Nothing
Just (v :: Int
v,k :: Int
k) ->
case Int -> Design a -> Maybe Int
forall a. Eq a => Int -> Design a -> Maybe Int
findlambda Int
t Design a
d of
Nothing -> Maybe (Int, Int, Int)
forall a. Maybe a
Nothing
Just lambda :: Int
lambda -> (Int, Int, Int) -> Maybe (Int, Int, Int)
forall a. a -> Maybe a
Just (Int
v,Int
k,Int
lambda)
findvk :: Design a -> Maybe (Int, Int)
findvk (D xs :: [a]
xs bs :: [[a]]
bs) =
let k :: Int
k:ls :: [Int]
ls = ([a] -> Int) -> [[a]] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
bs
in if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
k) [Int]
ls then (Int, Int) -> Maybe (Int, Int)
forall a. a -> Maybe a
Just (Int
v,Int
k) else Maybe (Int, Int)
forall a. Maybe a
Nothing
where v :: Int
v = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs
findlambda :: Int -> Design a -> Maybe Int
findlambda t :: Int
t (D xs :: [a]
xs bs :: [[a]]
bs) =
let lambda :: Int
lambda:ls :: [Int]
ls = [[[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]
b | [a]
b <- [[a]]
bs, [a]
ts [a] -> [a] -> Bool
forall (t :: * -> *) (t :: * -> *) a.
(Foldable t, Foldable t, Eq a) =>
t a -> t a -> Bool
`isSubset` [a]
b] | [a]
ts <- Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
t [a]
xs]
in if (Int -> Bool) -> [Int] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
==Int
lambda) [Int]
ls then Int -> Maybe Int
forall a. a -> Maybe a
Just Int
lambda else Maybe Int
forall a. Maybe a
Nothing
designParams :: Design a -> Maybe (Int, (Int, Int, Int))
designParams d :: Design a
d =
case Design a -> Maybe (Int, Int)
forall a. Design a -> Maybe (Int, Int)
findvk Design a
d of
Nothing -> Maybe (Int, (Int, Int, Int))
forall a. Maybe a
Nothing
Just (v :: Int
v,k :: Int
k) ->
case [(Int, Maybe Int)] -> [(Int, Maybe Int)]
forall a. [a] -> [a]
reverse (((Int, Maybe Int) -> Bool)
-> [(Int, Maybe Int)] -> [(Int, Maybe Int)]
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool)
-> ((Int, Maybe Int) -> Maybe Int) -> (Int, Maybe Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Maybe Int) -> Maybe Int
forall a b. (a, b) -> b
snd) [(Int
t, Int -> Design a -> Maybe Int
forall a. Eq a => Int -> Design a -> Maybe Int
findlambda Int
t Design a
d) | Int
t <- [0..Int
k] ]) of
[] -> Maybe (Int, (Int, Int, Int))
forall a. Maybe a
Nothing
(t :: Int
t,Just lambda :: Int
lambda):_ -> (Int, (Int, Int, Int)) -> Maybe (Int, (Int, Int, Int))
forall a. a -> Maybe a
Just (Int
t,(Int
v,Int
k,Int
lambda))
isStructure :: Int -> Design a -> Bool
isStructure t :: Int
t d :: Design a
d = Maybe (Int, Int, Int) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (Int, Int, Int) -> Bool) -> Maybe (Int, Int, Int) -> Bool
forall a b. (a -> b) -> a -> b
$ Int -> Design a -> Maybe (Int, Int, Int)
forall a. Eq a => Int -> Design a -> Maybe (Int, Int, Int)
tDesignParams Int
t Design a
d
isDesign :: Int -> Design a -> Bool
isDesign t :: Int
t d :: Design a
d = Design a -> Bool
forall a. Ord a => Design a -> Bool
noRepeatedBlocks Design a
d Bool -> Bool -> Bool
&& Int -> Design a -> Bool
forall a. Eq a => Int -> Design a -> Bool
isStructure Int
t Design a
d
is2Design :: Design a -> Bool
is2Design d :: Design a
d = Int -> Design a -> Bool
forall a. Ord a => Int -> Design a -> Bool
isDesign 2 Design a
d
isSquare :: Design a -> Bool
isSquare d :: Design a
d@(D xs :: [a]
xs bs :: [[a]]
bs) = Design a -> Bool
forall a. Ord a => Design a -> Bool
is2Design Design a
d Bool -> Bool -> Bool
&& [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== [[a]] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [[a]]
bs
incidenceMatrix :: (Eq t) => Design t -> [[Int]]
incidenceMatrix :: Design t -> [[Int]]
incidenceMatrix (D xs :: [t]
xs bs :: [[t]]
bs) = [ [if t
x t -> [t] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [t]
b then 1 else 0 | t
x <- [t]
xs] | [t]
b <- [[t]]
bs]
subsetDesign :: a -> Int -> Design a
subsetDesign v :: a
v k :: Int
k = ([a], [[a]]) -> Design a
forall a. Ord a => ([a], [[a]]) -> Design a
design ([a]
xs,[[a]]
bs) where
xs :: [a]
xs = [1..a
v]
bs :: [[a]]
bs = Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
combinationsOf Int
k [a]
xs
pairDesign :: a -> Design a
pairDesign n :: a
n = [a] -> [[a]] -> Design a
forall a. [a] -> [[a]] -> Design a
D [a]
vs [[a]]
es where
graph :: Graph a
graph = a -> Graph a
forall t. Integral t => t -> Graph t
G.k a
n
vs :: [a]
vs = Graph a -> [a]
forall a. Graph a -> [a]
vertices Graph a
graph
es :: [[a]]
es = Graph a -> [[a]]
forall a. Graph a -> [[a]]
edges Graph a
graph
ag2 :: (FiniteField k, Ord k) => [k] -> Design [k]
ag2 :: [k] -> Design [k]
ag2 fq :: [k]
fq = ([[k]], [[[k]]]) -> Design [k]
forall a. Ord a => ([a], [[a]]) -> Design a
design ([[k]]
points, [[[k]]]
lines) where
points :: [[k]]
points = Int -> [k] -> [[k]]
forall a. Int -> [a] -> [[a]]
ptsAG 2 [k]
fq
lines :: [[[k]]]
lines = ([k] -> [[k]]) -> [[k]] -> [[[k]]]
forall a b. (a -> b) -> [a] -> [b]
map [k] -> [[k]]
line ([[k]] -> [[[k]]]) -> [[k]] -> [[[k]]]
forall a b. (a -> b) -> a -> b
$ [[k]] -> [[k]]
forall a. [a] -> [a]
tail ([[k]] -> [[k]]) -> [[k]] -> [[k]]
forall a b. (a -> b) -> a -> b
$ Int -> [k] -> [[k]]
forall a. Num a => Int -> [a] -> [[a]]
ptsPG 2 [k]
fq
line :: [k] -> [[k]]
line [a :: k
a,b :: k
b,c :: k
c] = [ [k
x,k
y] | [x :: k
x,y :: k
y] <- [[k]]
points, k
ak -> k -> k
forall a. Num a => a -> a -> a
*k
xk -> k -> k
forall a. Num a => a -> a -> a
+k
bk -> k -> k
forall a. Num a => a -> a -> a
*k
yk -> k -> k
forall a. Num a => a -> a -> a
+k
ck -> k -> Bool
forall a. Eq a => a -> a -> Bool
==0 ]
pg2 :: (FiniteField k, Ord k) => [k] -> Design [k]
pg2 :: [k] -> Design [k]
pg2 fq :: [k]
fq = ([[k]], [[[k]]]) -> Design [k]
forall a. Ord a => ([a], [[a]]) -> Design a
design ([[k]]
points, [[[k]]]
lines) where
points :: [[k]]
points = Int -> [k] -> [[k]]
forall a. Num a => Int -> [a] -> [[a]]
ptsPG 2 [k]
fq
lines :: [[[k]]]
lines = [[[k]]] -> [[[k]]]
forall a. Ord a => [a] -> [a]
L.sort ([[[k]]] -> [[[k]]]) -> [[[k]]] -> [[[k]]]
forall a b. (a -> b) -> a -> b
$ ([k] -> [[k]]) -> [[k]] -> [[[k]]]
forall a b. (a -> b) -> [a] -> [b]
map [k] -> [[k]]
line [[k]]
points
line :: [k] -> [[k]]
line u :: [k]
u = [[k]
v | [k]
v <- [[k]]
points, [k]
u [k] -> [k] -> k
forall a. Num a => [a] -> [a] -> a
<.> [k]
v k -> k -> Bool
forall a. Eq a => a -> a -> Bool
== 0]
u :: [a]
u <.> :: [a] -> [a] -> a
<.> v :: [a]
v = [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((a -> a -> a) -> [a] -> [a] -> [a]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith a -> a -> a
forall a. Num a => a -> a -> a
(*) [a]
u [a]
v)
flatsDesignPG :: Int -> [a] -> Int -> Design [a]
flatsDesignPG n :: Int
n fq :: [a]
fq k :: Int
k = ([[a]], [[[a]]]) -> Design [a]
forall a. Ord a => ([a], [[a]]) -> Design a
design ([[a]]
points, [[[a]]]
blocks) where
points :: [[a]]
points = Int -> [a] -> [[a]]
forall a. Num a => Int -> [a] -> [[a]]
ptsPG Int
n [a]
fq
blocks :: [[[a]]]
blocks = ([[a]] -> [[a]]) -> [[[a]]] -> [[[a]]]
forall a b. (a -> b) -> [a] -> [b]
map [[a]] -> [[a]]
forall a. (Num a, Ord a, FinSet a) => [[a]] -> [[a]]
closurePG ([[[a]]] -> [[[a]]]) -> [[[a]]] -> [[[a]]]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> Int -> [[[a]]]
forall a. (Eq a, Num a) => Int -> [a] -> Int -> [[[a]]]
flatsPG Int
n [a]
fq Int
k
pg :: Int -> [a] -> Design [a]
pg n :: Int
n fq :: [a]
fq = Int -> [a] -> Int -> Design [a]
forall a.
(Ord a, FinSet a, Num a) =>
Int -> [a] -> Int -> Design [a]
flatsDesignPG Int
n [a]
fq (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
flatsDesignAG :: Int -> [a] -> Int -> Design [a]
flatsDesignAG n :: Int
n fq :: [a]
fq k :: Int
k = ([[a]], [[[a]]]) -> Design [a]
forall a. Ord a => ([a], [[a]]) -> Design a
design ([[a]]
points, [[[a]]]
blocks) where
points :: [[a]]
points = Int -> [a] -> [[a]]
forall a. Int -> [a] -> [[a]]
ptsAG Int
n [a]
fq
blocks :: [[[a]]]
blocks = ([[a]] -> [[a]]) -> [[[a]]] -> [[[a]]]
forall a b. (a -> b) -> [a] -> [b]
map [[a]] -> [[a]]
forall a. (Num a, Ord a, FinSet a) => [[a]] -> [[a]]
closureAG ([[[a]]] -> [[[a]]]) -> [[[a]]] -> [[[a]]]
forall a b. (a -> b) -> a -> b
$ Int -> [a] -> Int -> [[[a]]]
forall a. (Eq a, Num a) => Int -> [a] -> Int -> [[[a]]]
flatsAG Int
n [a]
fq Int
k
ag :: Int -> [a] -> Design [a]
ag n :: Int
n fq :: [a]
fq = Int -> [a] -> Int -> Design [a]
forall a.
(Num a, Ord a, FinSet a) =>
Int -> [a] -> Int -> Design [a]
flatsDesignAG Int
n [a]
fq (Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-1)
to1n :: Design a -> Design a
to1n (D xs :: [a]
xs bs :: [[a]]
bs) = ([a] -> [[a]] -> Design a
forall a. [a] -> [[a]] -> Design a
D [a]
xs' [[a]]
bs') where
mapping :: Map a a
mapping = [(a, a)] -> Map a a
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(a, a)] -> Map a a) -> [(a, a)] -> Map a a
forall a b. (a -> b) -> a -> b
$ [a] -> [a] -> [(a, a)]
forall a b. [a] -> [b] -> [(a, b)]
zip [a]
xs [1..]
xs' :: [a]
xs' = Map a a -> [a]
forall k a. Map k a -> [a]
M.elems Map a a
mapping
bs' :: [[a]]
bs' = [(a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Map a a
mapping Map a a -> a -> a
forall k a. Ord k => Map k a -> k -> a
M.!) [a]
b | [a]
b <- [[a]]
bs]
paleyDesign :: [a] -> Design a
paleyDesign fq :: [a]
fq | [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
fq Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` 4 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 3 = ([a], [[a]]) -> Design a
forall a. Ord a => ([a], [[a]]) -> Design a
design ([a]
xs,[[a]]
bs) where
xs :: [a]
xs = [a]
fq
qs :: [a]
qs = [a] -> [a]
forall a. Ord a => [a] -> [a]
set [a
xa -> Integer -> a
forall a b. (Num a, Integral b) => a -> b -> a
^2 | a
x <- [a]
xs] [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [0]
bs :: [[a]]
bs = [[a] -> [a]
forall a. Ord a => [a] -> [a]
L.sort ((a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (a
xa -> a -> a
forall a. Num a => a -> a -> a
+) [a]
qs) | a
x <- [a]
xs]
fanoPlane :: Design F7
fanoPlane = [F7] -> Design F7
forall a. (Ord a, Num a) => [a] -> Design a
paleyDesign [F7]
f7
dual :: (Ord t) => Design t -> Design [t]
dual :: Design t -> Design [t]
dual (D xs :: [t]
xs bs :: [[t]]
bs) = ([[t]], [[[t]]]) -> Design [t]
forall a. Ord a => ([a], [[a]]) -> Design a
design ([[t]]
bs, (t -> [[t]]) -> [t] -> [[[t]]]
forall a b. (a -> b) -> [a] -> [b]
map t -> [[t]]
beta [t]
xs) where
beta :: t -> [[t]]
beta x :: t
x = ([t] -> Bool) -> [[t]] -> [[t]]
forall a. (a -> Bool) -> [a] -> [a]
filter (t
x t -> [t] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem`) [[t]]
bs
derivedDesign :: (Ord t) => Design t -> t -> Design t
derivedDesign :: Design t -> t -> Design t
derivedDesign (D xs :: [t]
xs bs :: [[t]]
bs) p :: t
p = ([t], [[t]]) -> Design t
forall a. Ord a => ([a], [[a]]) -> Design a
design ([t]
xs [t] -> [t] -> [t]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [t
p], [[t]
b [t] -> [t] -> [t]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [t
p] | [t]
b <- [[t]]
bs, t
p t -> [t] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [t]
b])
pointResidual :: (Ord t) => Design t -> t -> Design t
pointResidual :: Design t -> t -> Design t
pointResidual (D xs :: [t]
xs bs :: [[t]]
bs) p :: t
p = ([t], [[t]]) -> Design t
forall a. Ord a => ([a], [[a]]) -> Design a
design ([t]
xs [t] -> [t] -> [t]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [t
p], [[t]
b | [t]
b <- [[t]]
bs, t
p t -> [t] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [t]
b])
complementaryDesign :: Design a -> Design a
complementaryDesign (D xs :: [a]
xs bs :: [[a]]
bs) = ([a], [[a]]) -> Design a
forall a. Ord a => ([a], [[a]]) -> Design a
design ([a]
xs, [[a]
xs [a] -> [a] -> [a]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [a]
b | [a]
b <- [[a]]
bs])
blockResidual :: (Ord t) => Design t -> [t] -> Design t
blockResidual :: Design t -> [t] -> Design t
blockResidual d :: Design t
d@(D xs :: [t]
xs bs :: [[t]]
bs) b :: [t]
b | Design t -> Bool
forall a. Ord a => Design a -> Bool
isSquare Design t
d = ([t], [[t]]) -> Design t
forall a. Ord a => ([a], [[a]]) -> Design a
design ([t]
xs [t] -> [t] -> [t]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [t]
b, [[t]
b' [t] -> [t] -> [t]
forall a. Eq a => [a] -> [a] -> [a]
L.\\ [t]
b | [t]
b' <- [[t]]
bs, [t]
b' [t] -> [t] -> Bool
forall a. Eq a => a -> a -> Bool
/= [t]
b])
isDesignAut :: Design a -> Permutation a -> Bool
isDesignAut (D xs :: [a]
xs bs :: [[a]]
bs) g :: Permutation a
g | Permutation a -> [a]
forall a. Permutation a -> [a]
supp Permutation a
g [a] -> [a] -> Bool
forall (t :: * -> *) (t :: * -> *) a.
(Foldable t, Foldable t, Eq a) =>
t a -> t a -> Bool
`isSubset` [a]
xs = ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ([a] -> Set [a] -> Bool
forall a. Ord a => a -> Set a -> Bool
`S.member` Set [a]
bs') [[a]
b [a] -> Permutation a -> [a]
forall a. Ord a => [a] -> Permutation a -> [a]
-^ Permutation a
g | [a]
b <- [[a]]
bs]
where bs' :: Set [a]
bs' = [[a]] -> Set [a]
forall a. Ord a => [a] -> Set a
S.fromList [[a]]
bs
incidenceGraph :: (Ord a) => Design a -> Graph (Either a [a])
incidenceGraph :: Design a -> Graph (Either a [a])
incidenceGraph (D xs :: [a]
xs bs :: [[a]]
bs) = [Either a [a]] -> [[Either a [a]]] -> Graph (Either a [a])
forall a. [a] -> [[a]] -> Graph a
G [Either a [a]]
vs [[Either a [a]]]
es where
vs :: [Either a [a]]
vs = [Either a [a]] -> [Either a [a]]
forall a. Ord a => [a] -> [a]
L.sort ([Either a [a]] -> [Either a [a]])
-> [Either a [a]] -> [Either a [a]]
forall a b. (a -> b) -> a -> b
$ (a -> Either a [a]) -> [a] -> [Either a [a]]
forall a b. (a -> b) -> [a] -> [b]
map a -> Either a [a]
forall a b. a -> Either a b
Left [a]
xs [Either a [a]] -> [Either a [a]] -> [Either a [a]]
forall a. [a] -> [a] -> [a]
++ ([a] -> Either a [a]) -> [[a]] -> [Either a [a]]
forall a b. (a -> b) -> [a] -> [b]
map [a] -> Either a [a]
forall a b. b -> Either a b
Right [[a]]
bs
es :: [[Either a [a]]]
es = [[Either a [a]]] -> [[Either a [a]]]
forall a. Ord a => [a] -> [a]
L.sort [ [a -> Either a [a]
forall a b. a -> Either a b
Left a
x, [a] -> Either a [a]
forall a b. b -> Either a b
Right [a]
b] | a
x <- [a]
xs, [a]
b <- [[a]]
bs, a
x a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [a]
b ]
designAuts :: (Ord t) => Design t -> [Permutation t]
designAuts :: Design t -> [Permutation t]
designAuts d :: Design t
d = Graph (Either t [t]) -> [Permutation t]
forall p b. (Ord p, Ord b) => Graph (Either p b) -> [Permutation p]
incidenceAuts (Graph (Either t [t]) -> [Permutation t])
-> Graph (Either t [t]) -> [Permutation t]
forall a b. (a -> b) -> a -> b
$ Design t -> Graph (Either t [t])
forall a. Ord a => Design a -> Graph (Either a [a])
incidenceGraph Design t
d
designAuts1 :: Design a -> [Permutation a]
designAuts1 d :: Design a
d = (Permutation a -> Bool) -> [Permutation a] -> [Permutation a]
forall a. (a -> Bool) -> [a] -> [a]
filter (Permutation a -> Permutation a -> Bool
forall a. Eq a => a -> a -> Bool
/=1) ([Permutation a] -> [Permutation a])
-> [Permutation a] -> [Permutation a]
forall a b. (a -> b) -> a -> b
$ (Permutation (Either a [a]) -> Permutation a)
-> [Permutation (Either a [a])] -> [Permutation a]
forall a b. (a -> b) -> [a] -> [b]
map Permutation (Either a [a]) -> Permutation a
forall a b. Ord a => Permutation (Either a b) -> Permutation a
points ([Permutation (Either a [a])] -> [Permutation a])
-> [Permutation (Either a [a])] -> [Permutation a]
forall a b. (a -> b) -> a -> b
$ Graph (Either a [a]) -> [Permutation (Either a [a])]
forall a. Ord a => Graph a -> [Permutation a]
graphAuts (Graph (Either a [a]) -> [Permutation (Either a [a])])
-> Graph (Either a [a]) -> [Permutation (Either a [a])]
forall a b. (a -> b) -> a -> b
$ Design a -> Graph (Either a [a])
forall a. Ord a => Design a -> Graph (Either a [a])
incidenceGraph Design a
d where
points :: Permutation (Either a b) -> Permutation a
points h :: Permutation (Either a b)
h = [(a, a)] -> Permutation a
forall a. Ord a => [(a, a)] -> Permutation a
fromPairs [(a
x,a
y) | (Left x :: a
x, Left y :: a
y) <- Permutation (Either a b) -> [(Either a b, Either a b)]
forall a. Permutation a -> [(a, a)]
toPairs Permutation (Either a b)
h]
alphaL2_23 :: Permutation Integer
alphaL2_23 = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[-1],[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22]]
betaL2_23 :: Permutation Integer
betaL2_23 = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[-1],[0],[1,2,4,8,16,9,18,13,3,6,12],[5,10,20,17,11,22,21,19,15,7,14]]
gammaL2_23 :: Permutation Integer
gammaL2_23 = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[-1,0],[1,22],[2,11],[3,15],[4,17],[5,9],[6,19],[7,13],[8,20],[10,16],[12,21],[14,18]]
l2_23 :: [Permutation Integer]
l2_23 = [Permutation Integer
alphaL2_23, Permutation Integer
betaL2_23, Permutation Integer
gammaL2_23]
deltaM24 :: Permutation Integer
deltaM24 = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[-1],[0],[1,18,4,2,6],[3],[5,21,20,10,7],[8,16,13,9,12],[11,19,22,14,17],[15]]
m24 :: [Permutation Integer]
m24 :: [Permutation Integer]
m24 = [Permutation Integer
alphaL2_23, Permutation Integer
betaL2_23, Permutation Integer
gammaL2_23, Permutation Integer
deltaM24]
m24sgs :: [Permutation Integer]
m24sgs :: [Permutation Integer]
m24sgs = [Permutation Integer] -> [Permutation Integer]
forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
sgs [Permutation Integer]
m24
m23sgs :: [Permutation Integer]
m23sgs :: [Permutation Integer]
m23sgs = (Permutation Integer -> Bool)
-> [Permutation Integer] -> [Permutation Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (\g :: Permutation Integer
g -> (-1)Integer -> Permutation Integer -> Integer
forall a. Ord a => a -> Permutation a -> a
.^Permutation Integer
g Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -1) [Permutation Integer]
m24sgs
m22sgs :: [Permutation Integer]
m22sgs :: [Permutation Integer]
m22sgs = (Permutation Integer -> Bool)
-> [Permutation Integer] -> [Permutation Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (\g :: Permutation Integer
g -> 0Integer -> Permutation Integer -> Integer
forall a. Ord a => a -> Permutation a -> a
.^Permutation Integer
g Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== 0) [Permutation Integer]
m23sgs
octad :: [Integer]
octad = [0,1,2,3,4,7,10,12]
s_5_8_24 :: Design Integer
s_5_8_24 :: Design Integer
s_5_8_24 = ([Integer], [[Integer]]) -> Design Integer
forall a. Ord a => ([a], [[a]]) -> Design a
design ([-1..22], [Integer]
octad [Integer] -> [Permutation Integer] -> [[Integer]]
forall a. Ord a => [a] -> [Permutation a] -> [[a]]
-^^ [Permutation Integer]
l2_23)
s_4_7_23 :: Design Integer
s_4_7_23 :: Design Integer
s_4_7_23 = Design Integer -> Integer -> Design Integer
forall t. Ord t => Design t -> t -> Design t
derivedDesign Design Integer
s_5_8_24 (-1)
s_3_6_22 :: Design Integer
s_3_6_22 :: Design Integer
s_3_6_22 = Design Integer -> Integer -> Design Integer
forall t. Ord t => Design t -> t -> Design t
derivedDesign Design Integer
s_4_7_23 0
s_5_8_24' :: Design Integer
s_5_8_24' = [Integer] -> [[Integer]] -> Design Integer
forall a. [a] -> [[a]] -> Design a
D [Integer]
xs [[Integer]]
bs where
xs :: [Integer]
xs = [1..24]
bs :: [[Integer]]
bs = [[Integer]] -> [[Integer]] -> [[Integer]]
forall a. Ord a => [[a]] -> [[a]] -> [[a]]
sift [] (Int -> [Integer] -> [[Integer]]
forall a. Int -> [a] -> [[a]]
combinationsOf 8 [Integer]
xs)
sift :: [[a]] -> [[a]] -> [[a]]
sift ls :: [[a]]
ls (r :: [a]
r:rs :: [[a]]
rs) = if ([a] -> Bool) -> [[a]] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<=4) (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]
r [a] -> [a] -> [a]
forall a. Ord a => [a] -> [a] -> [a]
`intersect` [a]
l | [a]
l <- [[a]]
ls]
then [a]
r [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]] -> [[a]]
sift ([a]
r[a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
:[[a]]
ls) [[a]]
rs
else [[a]] -> [[a]] -> [[a]]
sift [[a]]
ls [[a]]
rs
sift ls :: [[a]]
ls [] = []
alphaL2_11 :: Permutation Integer
alphaL2_11 = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[-1],[0,1,2,3,4,5,6,7,8,9,10]]
betaL2_11 :: Permutation Integer
betaL2_11 = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[-1],[0],[1,3,9,5,4],[2,6,7,10,8]]
gammaL2_11 :: Permutation Integer
gammaL2_11 = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[-1,0],[1,10],[2,5],[3,7],[4,8],[6,9]]
l2_11 :: [Permutation Integer]
l2_11 = [Permutation Integer
alphaL2_11, Permutation Integer
betaL2_11, Permutation Integer
gammaL2_11]
deltaM12 :: Permutation Integer
deltaM12 = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[-1],[0],[1],[2,10],[3,4],[5,9],[6,7],[8]]
hexad :: [Integer]
hexad = [0,1,3,4,5,9]
s_5_6_12 :: Design Integer
s_5_6_12 :: Design Integer
s_5_6_12 = ([Integer], [[Integer]]) -> Design Integer
forall a. Ord a => ([a], [[a]]) -> Design a
design ([-1..10], [Integer]
hexad [Integer] -> [Permutation Integer] -> [[Integer]]
forall a. Ord a => [a] -> [Permutation a] -> [[a]]
-^^ [Permutation Integer]
l2_11)
s_4_5_11 :: Design Integer
s_4_5_11 :: Design Integer
s_4_5_11 = Design Integer -> Integer -> Design Integer
forall t. Ord t => Design t -> t -> Design t
derivedDesign Design Integer
s_5_6_12 (-1)
m12 :: [Permutation Integer]
m12 :: [Permutation Integer]
m12 = [Permutation Integer
alphaL2_11, Permutation Integer
betaL2_11, Permutation Integer
gammaL2_11, Permutation Integer
deltaM12]
m12sgs :: [Permutation Integer]
m12sgs :: [Permutation Integer]
m12sgs = [Permutation Integer] -> [Permutation Integer]
forall a. (Ord a, Show a) => [Permutation a] -> [Permutation a]
sgs [Permutation Integer]
m12
m11sgs :: [Permutation Integer]
m11sgs :: [Permutation Integer]
m11sgs = (Permutation Integer -> Bool)
-> [Permutation Integer] -> [Permutation Integer]
forall a. (a -> Bool) -> [a] -> [a]
filter (\g :: Permutation Integer
g -> (-1)Integer -> Permutation Integer -> Integer
forall a. Ord a => a -> Permutation a -> a
.^Permutation Integer
g Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
== -1) [Permutation Integer]
m12sgs