-- Copyright (c) David Amos, 2009. All rights reserved.


module Math.Projects.Rubik where

import Math.Algebra.Group.PermutationGroup hiding (_D)
import Math.Algebra.Group.SchreierSims as SS
import Math.Algebra.Group.RandomSchreierSims as RSS
import Math.Algebra.Group.Subquotients


-- Rubik's cube


--           11 12 13

--           14  U 16

--           17 18 19

-- 21 22 23   1  2  3  41 42 43  51 52 53

-- 24  L 26   4  F  6  44  R 46  54  B 56

-- 27 28 29   7  8  9  47 48 49  57 58 59

--           31 32 33

--           34  D 36

--           37 38 39


f :: Permutation Integer
f = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[ 1, 3, 9, 7],[ 2, 6, 8, 4],[17,41,33,29],[18,44,32,26],[19,47,31,23]]
b :: Permutation Integer
b = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[51,53,59,57],[52,56,58,54],[11,27,39,43],[12,24,38,46],[13,21,37,49]]
l :: Permutation Integer
l = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[21,23,29,27],[22,26,28,24],[ 1,31,59,11],[ 4,34,56,14],[ 7,37,53,17]]
r :: Permutation Integer
r = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[41,43,49,47],[42,46,48,44],[ 3,13,57,33],[ 6,16,54,36],[ 9,19,51,39]]
u :: Permutation Integer
u = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[11,13,19,17],[12,16,18,14],[ 1,21,51,41],[ 2,22,52,42],[ 3,23,53,43]]
d :: Permutation Integer
d = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[31,33,39,37],[32,36,38,34],[ 7,47,57,27],[ 8,48,58,28],[ 9,49,59,29]]

rubikCube :: [Permutation Integer]
rubikCube = [Permutation Integer
f,Permutation Integer
b,Permutation Integer
l,Permutation Integer
r,Permutation Integer
u,Permutation Integer
d]
-- In Singmaster notation these would be capital letters.


[cornerFaces :: [Integer]
cornerFaces,edgeFaces :: [Integer]
edgeFaces] = [Permutation Integer] -> [[Integer]]
forall a. Ord a => [Permutation a] -> [[a]]
orbits [Permutation Integer]
rubikCube

(kerCornerFaces :: [Permutation Integer]
kerCornerFaces,imCornerFaces :: [Permutation Integer]
imCornerFaces) = [Permutation Integer]
-> [Integer] -> ([Permutation Integer], [Permutation Integer])
forall a.
(Ord a, Show a) =>
[Permutation a] -> [a] -> ([Permutation a], [Permutation a])
transitiveConstituentHomomorphism [Permutation Integer]
rubikCube [Integer]
cornerFaces
-- kernel is the elts which fix all corner faces

-- image is the action restricted to the corner faces


(kerEdgeFaces :: [Permutation Integer]
kerEdgeFaces,imEdgeFaces :: [Permutation Integer]
imEdgeFaces) = [Permutation Integer]
-> [Integer] -> ([Permutation Integer], [Permutation Integer])
forall a.
(Ord a, Show a) =>
[Permutation a] -> [a] -> ([Permutation a], [Permutation a])
transitiveConstituentHomomorphism [Permutation Integer]
rubikCube [Integer]
edgeFaces
-- kernel is the elts which fix all edge faces

-- image is the action restricted to the edge faces


[cornerBlocks :: [[Integer]]
cornerBlocks] = [Permutation Integer] -> [[[Integer]]]
forall t. Ord t => [Permutation t] -> [[[t]]]
blockSystems [Permutation Integer]
imCornerFaces
[edgeBlocks :: [[Integer]]
edgeBlocks] = [Permutation Integer] -> [[[Integer]]]
forall t. Ord t => [Permutation t] -> [[[t]]]
blockSystems [Permutation Integer]
imEdgeFaces

(kerCornerBlocks :: [Permutation Integer]
kerCornerBlocks,imCornerBlocks :: [Permutation [Integer]]
imCornerBlocks) = [Permutation Integer]
-> [[Integer]] -> ([Permutation Integer], [Permutation [Integer]])
forall t.
(Ord t, Show t) =>
[Permutation t] -> [[t]] -> ([Permutation t], [Permutation [t]])
blockHomomorphism [Permutation Integer]
imCornerFaces [[Integer]]
cornerBlocks
-- kernel is elts which fix all the corners as blocks, with order 3^7

-- (Whenever you twist one corner you must untwist another

-- - so the action on 7 corners determines the 8th)

-- image is the action on the corners as blocks, which is S8 of order 20160


(kerEdgeBlocks :: [Permutation Integer]
kerEdgeBlocks,imEdgeBlocks :: [Permutation [Integer]]
imEdgeBlocks) = [Permutation Integer]
-> [[Integer]] -> ([Permutation Integer], [Permutation [Integer]])
forall t.
(Ord t, Show t) =>
[Permutation t] -> [[t]] -> ([Permutation t], [Permutation [t]])
blockHomomorphism [Permutation Integer]
imEdgeFaces [[Integer]]
edgeBlocks
-- kernel is elts which fix all the edges as blocks, with order 2^11

-- (Whenever you flip one edge, you must flip another edge

-- - so the action on 11 edges determines the 12th)

-- image is the action on the edges as blocks, which is S12 of order 479001600


-- Note that orderSGS imCornerFaces * orderSGS imEdgeFaces == 2 * orderSGS (sgs rubikCube)

-- This is because you can't operate on corners and edges totally independently

-- If you swap two corners, you must also swap two edges


-- See also

-- http://www.gap-system.org/Doc/Examples/rubik.html


-- (Note that the kernel of the corner constituent homomorphism /= image of edge constituent homomorphism

-- For example, [[36,38],[48,58]] is in the latter, but not the former because it's not in the Rubik group

-- ie there is an elt in the Rubik group which does just that to the edges, but may do some things to the corners)



-- Rubik's revenge (4*4*4 cube)


--                    1   2   3   4

--                    5   6   7   8

--                    9  10  11  12

--                   13  14  15  16

-- 101 102 103 104  201 202 203 204  301 302 303 304  401 402 403 404

-- 105 106 107 108  205 206 207 208  305 306 307 308  405 406 407 408

-- 109 110 111 112  209 210 211 212  309 310 311 312  409 410 411 412

-- 113 114 115 116  213 214 215 216  313 314 315 316  413 414 415 416

--                  501 502 503 504

--                  505 506 507 508

--                  509 510 511 512

--                  513 514 515 516


_U :: Permutation Integer
_U = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[1,13,16,4],[2,9,15,8],[3,5,14,12],[6,10,11,7],
        [101,201,301,401],[102,202,302,402],[103,203,303,403],[104,204,304,404]]
_u :: Permutation Integer
_u = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[105,205,305,405],[106,206,306,406],[107,207,307,407],[108,208,308,408]]
_d :: Permutation Integer
_d = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[109,209,309,409],[110,210,310,410],[111,211,311,411],[112,212,312,412]]
_D :: Permutation Integer
_D = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[113,213,313,413],[114,214,314,414],[115,215,315,415],[116,216,316,416],
        [501,504,516,513],[502,508,515,509],[503,512,514,505],[506,507,511,510]]

bf :: Permutation Integer
bf = [[Integer]] -> Permutation Integer
forall a. Ord a => [[a]] -> Permutation a
p [[1,304,516,113],[2,308,515,109],[3,312,514,105],[4,316,513,101],
        [5,303,512,114],[6,307,511,110],[7,311,510,106],[8,315,509,102],
        [9,302,508,115],[10,306,507,111],[11,310,506,107],[12,314,505,103],
        [13,301,504,116],[14,305,503,112],[15,309,502,108],[16,313,501,104],
        [201,204,216,213],[202,208,215,209],[203,212,214,205],[206,207,211,210],
        [401,413,416,404],[402,409,415,408],[403,405,414,412],[406,410,411,407]]

_R :: Permutation Integer
_R = Permutation Integer
_U Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Ord a => Permutation a -> Permutation a -> Permutation a
~^ Permutation Integer
bf
_r :: Permutation Integer
_r = Permutation Integer
_u Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Ord a => Permutation a -> Permutation a -> Permutation a
~^ Permutation Integer
bf
_l :: Permutation Integer
_l = Permutation Integer
_d Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Ord a => Permutation a -> Permutation a -> Permutation a
~^ Permutation Integer
bf
_L :: Permutation Integer
_L = Permutation Integer
_D Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Ord a => Permutation a -> Permutation a -> Permutation a
~^ Permutation Integer
bf

ud :: Permutation Integer
ud = Permutation Integer
_U Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Num a => a -> a -> a
* Permutation Integer
_u Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Num a => a -> a -> a
* Permutation Integer
_d Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Num a => a -> a -> a
* Permutation Integer
_D

_B :: Permutation Integer
_B = Permutation Integer
_R Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Ord a => Permutation a -> Permutation a -> Permutation a
~^ Permutation Integer
ud
_b :: Permutation Integer
_b = Permutation Integer
_r Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Ord a => Permutation a -> Permutation a -> Permutation a
~^ Permutation Integer
ud
_f :: Permutation Integer
_f = Permutation Integer
_l Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Ord a => Permutation a -> Permutation a -> Permutation a
~^ Permutation Integer
ud
_F :: Permutation Integer
_F = Permutation Integer
_L Permutation Integer -> Permutation Integer -> Permutation Integer
forall a. Ord a => Permutation a -> Permutation a -> Permutation a
~^ Permutation Integer
ud

-- Note that orderSGS $ sgs [_U,_u,_d,_D,bf] comes out much too large,

-- because it includes rotations of the whole cube (24)

-- and exchanges of indistinguishable centre faces (24 for each of 6 colours)

-- So we have to divide by 24^7 / 2. 

-- (The /2 is because we can only have even permutations when exchanging indistinguishable centres)