(*this notebook is used to construct a faithful representation of e27s4 where s4 acts on e27 by the standard permutation representation and e27 is realized as the group of all 4-tuples in Z3 whose sum is 0;  here are some definitions;*)
ClearAll["Global`*"];

(*here permutations are representated by a list of lists, so for example sig={{1,2},{3,4}} is the permutation taking {1,2,3,4} --> {2,1,4,3};*)

(*makes sure the range of a permutation lies between {a,a+1,...,b-1,b}*)
checkrange[sig_,{a_,b_}]:=If[(Min[Flatten[sig]]<a)||(Max[Flatten[sig]]>b)||Length[Flatten[sig]]>1+(b-a),False,True];
(*e27s4[{v1_,perm1_}]:=If[
(Mod[Total[v1],3]!=0)||(Length[v1]!=4)||(checkrange[perm1,{1,4}]==False),Return[ErrorBox["Please choose an appropriate pair (v1,perm1)."]],{Mod[v1,3],perm1}];*)

(*(Mod[Total[v1],2]!=0)||(checkrange[perm2,{1,3}]==False),Return[ErrorBox["Please choose an appropriate pair (perm1,perm2) in K4,S3"]],*)

(*permcomp eats up two permutations sigma and rho and applies the permutation from RIGHT to LEFT.  Note the order is different than the Mathematic convention here!;
So for example permcomp[{{1,3}},{{1,2}}]={{1,2,3}} __NOT__ permcomp[{{1,3}},{{1,2}}]={{1,3,2}};
*)
permcomp[sig_,rho_]:=PermutationProduct[
Cycles[rho],Cycles[sig]
][[1]];
(*does the same thing but with a bunch of permutations > 2*)
permcomp[listofperms_]:=Fold[permcomp,{{}},listofperms];

(*permpower takes a permutation and applies the corresponding power to it*)
permpower[sig_,0]:=Cycles[{{}}][[1]];
permpower[sig_,1]:=sig;
permpower[sig_,-1]:=InversePermutation[Cycles[sig]][[1]];
permpower[sig_,n_]:=If[n>1,permcomp[sig,permpower[sig,n-1]],If[n<-1,permcomp[permpower[sig,-1],permpower[sig,n+1]],permpower[sig,n]]];

(*permutation inverse*)
perminv[sig_]:=permpower[sig,-1];

(*conjugates rho by sigma*)
permconj[sig_,rho_]:=permcomp[{sig,rho,perminv[sig]}];

(*takes up a permutation sigma and applies it to a list v1 by moving the i-th spot to the sigma(i)-th spot;*) 
act[sigma_,v1_]:=Permute[v1,Cycles[sigma]];

(*adds two vectors and takes their answer mod m*)
add[{v1_,v2_},m_]:=Mod[(v1+v2),m];

(*represents an element in the group e27s4;  here we require v1 to be length 4, have sum of entries be 0 mod 3, and have permutation between 1 and 4*)
(*elements in e27 as 4-tuples with entries in Z3 whose sum is 0;*)
e27=Select[Tuples[{0,1,2},4],(Mod[Total[#],3]==0)&];
(*s4 as a permutation group;*)
s4={
{{}},{{1,2}},{{1,3}},{{2,3}},
{{1,2,3}},{{1,3,2}},
{{1,4}},{{2,4}},{{3,4}},{{1,2,4}},{{1,3,4}},{{1,4,2}},{{1,4,3}},{{2,3,4}},{{2,4,3}},{{1,2},{3,4}},{{1,3},{2,4}},{{1,4},{2,3}},{{1,2,3,4}},{{1,2,4,3}},{{1,3,2,4}},{{1,3,4,2}},{{1,4,2,3}},{{1,4,3,2}}
};

(*performs multiplication of two group elements in the semi-direct product e27s4;*)
e27s4=Tuples[{e27,s4}];
(*multiplaction of two elements in e27s4 where s4 acts on e27 by permutations in the typical way;*)
e27s4mult[g1_,g2_]:={add[{g1[[1]],act[g1[[2]],g2[[1]]]},3],permcomp[g1[[2]],g2[[2]]]};

(*the following is dedicated to writing an isomorphism between s4 and k4s3 ;*)
(*s3 as a permutation group in s4;*)
s3=s4[[1;;6]];
(*k4 as 3-tuples in Z2 whose sum is 0;*)
k4=Select[Tuples[{0,1},3],(Mod[Total[#],2]==0)&];
(*s3k4 represented as tuples of elements*)
k4s3=Tuples[{k4,s3}];
(*multiplication in k4s3 where s3 acts on k4 via permutation of entries of the 3-tuples with entries Z2;*)
k4s3mult[{g1_,g2_}]:={add[{g1[[1]],act[g1[[2]],g2[[1]]]},2],permcomp[g1[[2]],g2[[2]]]};

(*isomorphism between k4s3 and s4.  here we identify {0,1,1} with {{2,3}{1,4}} and {{1,1,0}} with {{1,2},{3,4}}.  under this identification the permutation action of s3 on the group generated by these transpositions is isomorphic to the action of s3 on k4 as tuples via permutation;*)
k4s3tos4[g1_]:=permcomp[
{permpower[{{2,3},{1,4}},Mod[(g1[[1]])[[3]],2]],
permpower[{{1,2},{3,4}},Mod[(g1[[1]])[[1]],2]],(g1[[2]])
}];

(*Makes a list of booleans checking to see if the homomorphism property holds for every pair.  If it works, it should just be a list of True.;*)
k4s3tos4checks=Flatten[Table[
(permcomp[k4s3tos4[g1],k4s3tos4[g2]])==k4s3tos4[k4s3mult[{g1,g2}]],{g1,k4s3},{g2,k4s3}
]];

(*Checks to see if False is anywhere in our list, and then returns the negative.  So if False is in the list, this output will return False.  If it returns True, then the equality holds everywhere;  Finally, checks the image of k4s3tos4 has number of distinct elements equal to |s4| = 24;*) 
Print["checks to see if homomorphism property is satisfied by making sure the equality is true for every possible pair in k4s3:  ",Style[Not[MemberQ[k4s3tos4checks,False]],FontColor->Blue,Bold]
];
Print["checks whether k4s3tos4: k4s3 --> s4 has full image:  ", Style[(CountDistinct[Table[k4s3tos4[g1],{g1,k4s3}]]==24),FontColor->Blue,Bold]
];

(*Because of the isomorphism between k4s3 and s4, a representation of e27s4 is the same as a representation of e27(k4s3) where (k4s3) acts on e27 by the permutations induced via the isomorphism to s4; *)

(*below we introduce matrices to functions that will help construct our representation of e27(k4s3) --> SO(6,R)*) 
(*here we construct an isomorphism between e27*)
(*3rd root of unity and a 2x2 real matrix rep of it via rot[angle]*)
omega=2Pi/3;
rot[theta_]:={{Cos[theta],-Sin[theta]},{Sin[theta],Cos[theta]}};
Momega=rot[omega];
(*a reflection element matrix*)
ref={{0,1},{1,0}};
(*2x2 identity matrix and 2x2 zero matrix*)
id2=IdentityMatrix[2];
zero2=ConstantArray[0,{2,2}];

(*function that eats up a permutation in s3 and spits out the permutation on the blocks R2+R2+R2 where it acts by sending oriented bases to oriented bases; so for example {{1,2,3}} will get sent to the permutation that {{1,3,5},{2,4,6}};*)
blockcycle[listofcycles_]:=Join[
Table[
2*(listofcycles[[i]])-(ConstantArray[1,Length[listofcycles[[i]]]]),{i,1,Length[listofcycles]}
],
Table[
2*(listofcycles[[i]]),{i,1,Length[listofcycles]}
]
];

(*Matrix representation of k4, here, upto isomorphism, the first blockdiagonal matrix is k1 and the second one is k3; *)
Mk4[v1_]:=MatrixPower[BlockDiagonalMatrix[{id2,ref,ref}],Mod[v1[[3]],2]].MatrixPower[BlockDiagonalMatrix[{ref,ref,id2}],Mod[v1[[1]],2]];
(*Matrix representation of s3*)
Ms3[perm_]:=Normal[Transpose[PermutationMatrix[Cycles[blockcycle[perm]],6]]];
(*Matrix representation of e27*)
Me27[{m1_,m2_,m3_}]:=BlockDiagonalMatrix[{MatrixPower[Momega,Mod[m1,3]],MatrixPower[Momega,Mod[m2,3]],MatrixPower[Momega,Mod[m3,3]]}];

(*defining the group e27k4s3 by tuples in factor e27, and k4s3*)
e27k4s3=Tuples[{e27,Tuples[{k4,s3}]}];
(*defines the group multiplication by elements of *)
e27k4s3mult[{g1_,g2_}]:=Join[{
add[{g1[[1]],act[k4s3tos4[g1[[2]]],g2[[1]]]},3],k4s3mult[{g1[[2]],g2[[2]]}]
}];

(*Constructing the actual representation from e27(k4s3)~e27s4*)
(*Solves for an element {a,b,c,d} in e27 to Z3^3 relative to a basis adapted to the s4-action on it;  Specifically, the basis is v1={2,1,1,2}, v2={1,2,1,2}, v3={1,1,2,2};*)
e27toz33[v1_]:={2(v1[[2]]+v1[[3]]),2(v1[[1]]+v1[[3]]),2(v1[[1]]+v1[[2]])};
Me27k4s3rep[g1_]:=Simplify[Me27[e27toz33[g1[[1]]]].Mk4[(g1[[2]])[[1]]].Ms3[(g1[[2]])[[2]]]];

(*checks every possible pair from {g1,g2} of elements in e27k4s3 and ensures the representation satisfies the homomorphism property;*)

(*warning takes like 45 minutes to run!*)
Me27k4s3repchecks=Flatten[Table[
Me27k4s3rep[e27k4s3mult[{g1,g2}]]==Me27k4s3rep[g1].Me27k4s3rep[g2],{g1,e27k4s3},{g2,e27k4s3}
]];

(*Checks to see if False is anywhere in our list, and then returns the negative.  So if False is in the list, this output will return False.  If it returns True, then the equality holds everywhere;  Finally, checks the image of Me27k4s3repchecks has number of distinct elements equal to |e27s4| = (3^3)(4!) = 648;*)  
Print["checks to see if homomorphism property is satisfied by making sure the equality is true for every possible pair in e27k4s3:  ",Style[Not[MemberQ[Me27k4s3repchecks,False]],FontColor->Blue,Bold]
];
Print[
"checks whether e27k4s3: k4s3 --> O(6,R) has full image:  ", Style[(CountDistinct[Table[Me27k4s3rep[g1],{g1,e27k4s3}]]==(3^3)(4!)),FontColor->Blue,Bold]
];

(*we see that Me27k4s3rep is a faithful 6-dimensional representation of e27k4s3.  Because e27k4s3 contains a Z3^3, by Theorem 4.2, a faithful representation of e27k4s3 must be at least 3*2 = 6 real-dimensional as it must faithfully represent e27.  Hence mdimR(G) = 6.  By Corollary 4.5, and faithful complex dimensional representation of G must be at least u(S4) = 4 dimensional.  It is routine to construct these, and their character tables all have non-zero
*)