-- permutationgroupexamples.hs

module Math.PermutationGroupExamples where

import Math.RedBlackTree
import Math.PermutationGroups
import Math.PermutationOrbits
import Math.SchreierSims


-- AUTOMORPHISM GROUPS OF SOME GRAPHS AND SET SYSTEMS

-- Automorphism group of (graph of) cube
cubeGraph = toGraph [(1,2),(1,3),(2,4),(3,4),(1,5),(2,6),(3,7),(4,8),(5,6),(5,7),(6,8),(7,8)]

cubeFaces = toSetSystem [ [1,2,3,4], [5,6,7,8], [1,3,5,7], [1,2,5,6], [2,4,6,8], [3,4,7,8] ]

alphaCube = fromCycles [[1,2,4,8,7,5],[3,6]] -- 60 degree rotation about the line 3-6, followed by reflection in the midplane between 3-6
betaCube = fromCycles [[1,2,4,3],[5,6,8,7]]  -- 90 degree rotation about the line joining the centres of the front and back faces

schreierSimsCube = schreierSimsTransversals 8 [alphaCube, betaCube]

cubeRotations = schreierSimsTransversals 8 [alphaCube^2, betaCube]


-- Cameron, Combinatorics: Topics, Techniques, Algorithms, p240, 243
petersenGraph = toGraph [(1,2),(2,3),(3,4),(4,5),(5,1),(6,8),(7,9),(8,10),(9,6),(10,7),(1,6),(2,7),(3,8),(4,9),(5,10)]

alphaPetersen = fromCycles [[1,2,3,4,5],[6,7,8,9,10]]
betaPetersen = fromCycles [[1,2,3,4,9,6],[5,7,8],[10]]

petersenSS = schreierSimsTransversals 10 [alphaPetersen, betaPetersen]

-- the generated group has order 120 - it is S5


-- Cameron, Combinatorics, p239, 242
sts7 = toSetSystem [[1,2,4],[2,3,5],[3,4,6],[4,5,7],[5,6,1],[6,7,2],[7,1,3]]
-- this is the Fano plane, viewed as a Steiner Triple System on 7 points

alphaSTS7 = fromCycles [[1,2,3,4,5,6,7]]
betaSTS7 = fromCycles [[1],[2],[3,7],[4],[5,6]]

schreierSimsSTS7 = schreierSimsTransversals 7 [alphaSTS7, betaSTS7]

-- The generated group has order 168 - it is GL(3,2) - see Cameron for justification

-- should rewrite the above to count from zero, and then functions to adjust


-- THE MATHIEU GROUPS

-- L2(23)
-- Linear transformations of the projective line over F23

-- we represent the points of the projective line over Fp as [-1..p-1], where -1 represents the point at infinity
fromProjectiveLine x = x+2  -- because our permutations act on [1..n]
toProjectiveLine x = x-2


alphaL2_23 = fromCycles (map (map (+2)) [[-1],[0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22]])                      -- t -> t+1
betaL2_23 = fromCycles (map (map (+2)) [[-1],[15,7,14,5,10,20,17,11,22,21,19],[0],[3,6,12,1,2,4,8,16,9,18,13]])                   -- t -> 2*t
gammaL2_23 = fromCycles (map (map (+2)) [[-1,0],[15,3],[7,13],[14,18],[5,9],[10,16],[20,8],[17,4],[11,2],[22,1],[21,12],[19,6]])  -- t -> -1/t

schreierSimsL2_23 = schreierSimsTransversals 24 [alphaL2_23, betaL2_23, gammaL2_23]


-- Mathieu group M24
-- Conway and Sloane p274ff
-- This is the automorphism group of the extended binary Golay code G24
-- or alternatively of the unique Steiner system S(5,8,24) (which consists of the weight 8 codewords of the above)

deltaM24 = fromCycles (map (map (+2)) [[-1],[14,17,11,19,22],[15],[20,10,7,5,21],[0],[18,4,2,6,1],[3],[8,16,13,9,12]])
-- this is t -> t^3 / 9 (for t a quadratic residue), t -> 9 t^3 (t a non-residue)

generatorsM24 = [alphaL2_23, betaL2_23, gammaL2_23, deltaM24]
-- schreierSimsM24 = schreierSimsTransversals 24 generatorsM24
schreierSimsM24 = randomSchreierSimsTransversals 24 generatorsM24 929847293
orderM24 = 244823040
-- we declare this as a variable so that once it's calculated, it stays calculated (it won't be calculated before because of lazy evaluation)


-- Steiner system S(5,8,24)

octad = toBlock (map (+2) [0,1,2,3,4,7,10,12])
-- Conway&Sloane p276 - this is a weight 8 codeword from Golay code G24

s_5_8_24 = orbit [alphaL2_23, betaL2_23, gammaL2_23] octad
-- S(5,8,24) constructed as the image of a single octad under the action of PSL(2,23)
-- it has 759 blocks ( (24 `choose` 5) `div` (8 `choose` 5) )
-- The automorphism group of S(5,8,24) is in fact the full Mathieu group M24
-- (You can check that deltaM24 is also an automorphism)


-- Extended binary Golay code G24

qr23 = [1,2,3,4,6,8,9,12,13,16,18] :: [Int] -- quadratic residues mod 23

dodecad = toBlock (map (+2) (0:qr23))

weight12codewordsG24 = orbit [alphaL2_23, betaL2_23, gammaL2_23, deltaM24] dodecad
-- this has 2576 elts
-- we do need the full Mathieu group to generate this - the orbit under PSL(2,23) has only 552 elts

-- we can now list G24 if desired
-- it is the zero codeword, and its complement, the weight 8 codewords and their complements, and the weight 12 codewords


-- schreierSimsM23 = onePointStabilizer schreierSimsM24
-- order 10200960

s_4_7_23 = map (\(B (1:xs)) -> B xs) (filter (\(B (x:xs)) -> x == 1) s_5_8_24)
-- 253 blocks ( (23 `choose` 4) `div` (7 `choose` 4) )


-- schreierSimsM22 = onePointStabilizer schreierSimsM23
-- order 443520


-- L2(11)
-- Linear transformations of the projective line over F11
-- Conway&Sloane 268-271

alphaL2_11 = fromCycles (map (map (+2)) [[-1],[0,1,2,3,4,5,6,7,8,9,10]])          -- t -> t+1
betaL2_11 = fromCycles (map (map (+2)) [[-1],[0],[1,3,9,5,4],[2,6,7,10,8]])       -- t -> 3t
gammaL2_11 = fromCycles (map (map (+2)) [[-1,0],[1,10],[2,5],[3,7],[4,8],[6,9]])  -- t -> - 1/t

schreierSimsL2_11 = schreierSimsTransversals 12 [alphaL2_11, betaL2_11, gammaL2_11]

-- Mathieu group M12
-- Conway and Sloane p327
-- M12 is the automorphism group of the extended ternary Golay code G12
-- or alternatively of the unique Steiner system S(5,6,12)
-- (with perhaps a cyclic group of order 2 thrown in)

deltaM12 = fromCycles (map (map (+2)) [[-1],[0],[1],[2,10],[3,4],[5,9],[6,7],[8]])

schreierSimsM12 = schreierSimsTransversals 12 [alphaL2_11, betaL2_11, gammaL2_11, deltaM12]
-- order 95040


qr11 = [1,3,4,5,9] :: [Int]

hexad = toBlock (map (+2) (0:qr11))

s_5_6_12 = orbit [alphaL2_11, betaL2_11, gammaL2_11] hexad
-- This has 132 blocks ( (12 `choose` 5) `div` (6 `choose` 5) )

-- schreierSimsM11 = onePointStabilizer schreierSimsM12
-- order 7920



-- We can also generate G24 using linear algebra in F2(24)
-- it is the code spanned by the images of the dodecad under the action of PSL(2,23)


-- RUBIK'S 3-CUBE

--             10    11    12
--             13    14    15
--             16    17    18
--  37 38 39  1(48) 2(47) 3(46)  19 20 21  (46 47 48)
--  40 41 42  4(51) 5(50) 6(49)  22 23 24  (49 50 51)
--  43 44 45  7(54) 8(53) 9(52)  25 26 27  (52 53 54)
--             28    29    30
--             31    32    33
--             34    35    36

f = fromCycles' 54 [[1,3,9,7],[2,6,8,4],[16,19,30,45],[17,22,29,42],[18,25,28,39]]           -- rotate front face
b = fromCycles' 54 [[46,48,54,52],[47,51,53,49],[10,43,36,21],[11,40,35,24],[12,37,34,27]]   -- rotate back face
l = fromCycles' 54 [[1,28,54,10],[4,31,51,13],[7,34,48,16],[37,39,45,43],[38,42,44,40]]      -- rotate left face
r = fromCycles' 54 [[3,12,52,30],[6,15,49,33],[9,18,46,36],[19,21,27,25],[20,24,26,22]]      -- rotate right face
u = fromCycles' 54 [[1,37,46,19],[2,38,47,20],[3,39,48,21],[10,12,18,16],[11,15,17,13]]      -- rotate up (top) face
d = fromCycles' 54 [[7,25,52,43],[8,26,53,44],[9,27,54,45],[28,30,36,34],[29,33,35,31]]      -- rotate down (bottom) face

f' = inverse f
b' = inverse b
l' = inverse l
r' = inverse r
u' = inverse u
d' = inverse d

generatorsRubikCube =  [f,b,l,r,u,d]
-- we keep the face centres fixed. The "supergroup" is the direct product of this group with the rotation group of the cube (of order 24)

rubikCube = randomSchreierSimsTransversals 54 generatorsRubikCube 876423876
orderRubikCube = 43252003274489856000


