Navigation Menu

Skip to content

Instantly share code, notes, and snippets.

@Gro-Tsen
Last active February 7, 2023 17:10
Show Gist options
  • Star 2 You must be signed in to star a gist
  • Fork 2 You must be signed in to fork a gist
  • Save Gro-Tsen/ff0a76dca0aa9b547698f3203f147744 to your computer and use it in GitHub Desktop.
Save Gro-Tsen/ff0a76dca0aa9b547698f3203f147744 to your computer and use it in GitHub Desktop.
#### Start gap with enough memory (e.g., "gap -o 8g" for 8GB) to run this.
## The MOG cells are labeled top to bottom and left to right:
## so the leftmost column is 1,2,3,4 and the rightmost is 21,22,23,24,
## whereas the top line is 1,5,9,13,17,21.
## Generators of the Mathieu group M_24:
rotate_blocks := (1,9,17)(2,10,18)(3,11,19)(4,12,20)(5,13,21)(6,14,22)(7,15,23)(8,16,24);
flip_blocks12 := (1,5)(2,6)(3,7)(4,8)(9,13)(10,14)(11,15)(12,16);
omega_cols := (2,3,4)(6,7,8)(10,11,12)(14,15,16)(18,19,20)(22,23,24);
myflip := (1,8)(2,4)(3,5)(6,7)(9,17)(10,18)(13,21)(14,22);
m24_group := Group([rotate_blocks, flip_blocks12, omega_cols, myflip]);
## The same permutations as matrices:
rotate_blocks_mat := PermutationMat(rotate_blocks, 24);
flip_blocks12_mat := PermutationMat(flip_blocks12, 24);
omega_cols_mat := PermutationMat(omega_cols, 24);
myflip_mat := PermutationMat(myflip, 24);
## Conway's xi generator first subtracts from each column half the sum
## of all its cells (this is eta), then takes the negative of one block:
conway_eta := List([1..24], i->List([1..24], function(j) if QuoInt(i-1,4)=QuoInt(j-1,4) then if i=j then return 1/2; else return -1/2; fi; else return 0; fi; end));;
conway_xi := conway_eta * List([1..24], i->List([1..24], function(j) if i=j then if i>=1 and i<=4 then return -1; else return 1; fi; else return 0; fi; end));
## Conway's group Co_0 as a group of matrices (too unwieldly for GAP):
co0_mat := Group([rotate_blocks_mat, flip_blocks12_mat, omega_cols_mat, myflip_mat, conway_xi]);
## The orbit of an element of the Leech lattice (this should have size 196560):
orb := Orbit(co0_mat, List([1..24], function(i) if i=1 or i=5 then return 4; else return 0; fi; end));;
Size(orb); ## Should return 196560
## The action homomorphism (makes elements of Co_0 into permutations):
phi := ActionHomomorphism(co0_mat, orb);
## The five generators, this time as permutations on orb (of size 196560):
rotate_blocks_l := Image(phi, rotate_blocks_mat);;
flip_blocks12_l := Image(phi, flip_blocks12_mat);;
omega_cols_l := Image(phi, omega_cols_mat);;
myflip_l := Image(phi, myflip_mat);;
conway_xi_l := Image(phi, conway_xi);;
## Now Co_0 as a permutation group:
co0 := Group([rotate_blocks_l, flip_blocks12_l, omega_cols_l, myflip_l, conway_xi_l]);
## Check its order and compute its conjugacy classes (this is fairly long):
Order(co0); ## Should return 8315553613086720000
lst_cl := ConjugacyClasses(co0);; ## Takes about 35* longer than previous command
lst := List(lst_cl, cl->Representative(cl));;
## Compute centralizer orders (this is again a bit long):
lst_centralizers := List(lst, x->Order(Centralizer(co0, x)));;
lst_orders := List(lst, Order);;
## Convenience function for cycle structure of permutations:
cycle_struct := function(p) local str, t, i; t := []; if NrMovedPoints(p)<Size(orb) then Append(t,[[1, Size(orb)-NrMovedPoints(p)]]); fi; str := CycleStructurePerm(p); for i in [1..Length(str)] do if IsBound(str[i]) then Append(t,[[i+1, str[i]]]); fi; od; return t; end;
lst_cycles := List(lst, cycle_struct);;
## Morphisms from a free group to our two descriptions of Co_0:
frhom := EpimorphismFromFreeGroup(co0 : names := ["rot","fbl","omg","flp","cxi"]);;
frhom_mat := GroupHomomorphismByImages(Source(frhom), co0_mat, GeneratorsOfGroup(co0_mat));;
## Convert the computed conjugacy classes into representative matrices:
lst_mat := List(lst, x->Image(frhom_mat, PreImagesRepresentative(frhom, x)));;
## Convenience function for cyclotomic factors:
factor_struct := function(pol, d) local fl, t, i, u, k; fl := Factors(pol); t := []; for i in [1..d] do u := CyclotomicPolynomial(Rationals, i); k := Length(Positions(fl, u)); if k>0 then Append(t, [[i, k]]); fi; od; if Sum(List(t, p->p[2]*Phi(p[1]))) <> 24 then Error("This shouldn't happen!"); fi; return t; end;
lst_factors := List([1..Length(lst_cl)], i -> factor_struct(CharacteristicPolynomial(lst_mat[i]), lst_orders[i]));;
## Now we try to identify the ATLAS labeling of these classes...
## Identify each class by its order, the traces of the first few powers,
## and the order of the centralizer:
keylist1 := List([1..Length(lst_cl)], i->Concatenation([lst_orders[i]], List([1..7], k->Trace(lst_mat[i]^k)), [lst_centralizers[i]]));;
## Get the ATLAS character table from the library:
tbl := CharacterTable("2.Co1");
# ConnectGroupAndCharacterTable(co0, tbl); ## <- This doesn't work, of course
## Identify the 24-dimensional character
tbl_stdchar := Filtered(Irr(tbl), l->l[1]=24)[1];
## Identify the classes by the same numbers, in the order given by tbl:
keylist2 := List([1..Length(lst_cl)], i->Concatenation([OrdersClassRepresentatives(tbl)[i]], List([1..7], k->tbl_stdchar[PowerMap(tbl,k)[i]]), [SizesCentralizers(tbl)[i]]));;
## Now recover the labeling, insofar as it can be identified:
labeling := [];; revorder := [];; for i in [1..Length(lst_cl)] do tmp := Filtered([1..Length(lst_cl)], j->keylist2[j]=keylist1[i]); if Length(tmp)=1 then labeling[i] := AtlasClassNames(tbl)[tmp[1]]; elif Length(tmp)=2 then labeling[i] := Concatenation(AtlasClassNames(tbl)[tmp[1]],"|",AtlasClassNames(tbl)[tmp[2]]); else Error("Ambigous class"); fi; if IsBound(revorder[tmp[1]]) then revorder[tmp[2]] := i; else revorder[tmp[1]] := i; fi; od;
## Finally, dump it all out il a file called "co0-representative-matrices.dat":
output := OutputTextFile("co0-representative-matrices.dat", false);
PrintTo(output, "lst_mat := [\n\n");
for j in [1..Length(lst_cl)] do i := revorder[j]; WriteAll(output, Concatenation("#### ", String(j), "\n## Label: ", labeling[i], "\n## Order: ", String(lst_orders[i]), "\n## Centralizer: ", String(lst_centralizers[i]), "\n## Cycles: ", String(lst_cycles[i]), "\n## Trace: ", String(keylist1[i][2]), "\n## Factors: ", String(lst_factors[i]), "\n")); PrintTo(output, lst_mat[i], "\n,\n\n"); od;
PrintTo(output, "];\n\n");
PrintTo(output, "########\n\n");
PrintTo(output, "lst_labels := ", List(revorder, i->labeling[i]), ";\n\n");
PrintTo(output, "lst_orders := ", List(revorder, i->lst_orders[i]), ";\n\n");
PrintTo(output, "lst_centralizers := ", List(revorder, i->lst_centralizers[i]), ";\n\n");
PrintTo(output, "lst_cycles := ", List(revorder, i->lst_cycles[i]), ";\n\n");
PrintTo(output, "lst_traces := ", List(revorder, i->keylist1[i][2]), ";\n\n");
PrintTo(output, "lst_factors := ", List(revorder, i->lst_factors[i]), ";\n\n");
CloseStream(output);
## The eight simple roots of E_8 in Bourbaki labeling:
alpha1 := [1,-1,-1,-1,-1,-1,-1,1]/2;
alpha2 := [1,1,0,0,0,0,0,0];
alpha3 := [-1,1,0,0,0,0,0,0];
alpha4 := [0,-1,1,0,0,0,0,0];
alpha5 := [0,0,-1,1,0,0,0,0];
alpha6 := [0,0,0,-1,1,0,0,0];
alpha7 := [0,0,0,0,-1,1,0,0];
alpha8 := [0,0,0,0,0,-1,1,0];
alphas := [alpha1,alpha2,alpha3,alpha4,alpha5,alpha6,alpha7,alpha8];
refls := List(alphas, x -> -TransposedMat([x]) * [x] + IdentityMat(8));
## Weyl group of E_8 as a group of matrices (too unwieldly for GAP):
we8_mat := Group(refls);
## The orbit of an element of the Leech lattice (this should have size 196560):
orb := Orbit(we8_mat, List([1..8], function(i) if i=1 or i=2 then return 2; else return 0; fi; end));;
Size(orb); ## Should return 240
## The action homomorphism (makes elements of W(E_8) into permutations):
phi := ActionHomomorphism(we8_mat, orb);
## The five generators, this time as permutations on orb (of size 196560):
refls_l := List(refls, x->Image(phi, x));;
## Now W(E_8) as a permutation group:
we8 := Group(refls_l);
## Check its order and compute its conjugacy classes (this is fairly long):
Order(we8); ## Should return 696729600
lst_cl := ConjugacyClasses(we8);;
lst := List(lst_cl, cl->Representative(cl));;
## Compute centralizer orders (this is again a bit long):
lst_centralizers := List(lst, x->Order(Centralizer(we8, x)));;
lst_orders := List(lst, Order);;
## Convenience function for cycle structure of permutations:
cycle_struct := function(p) local str, t, i; t := []; if NrMovedPoints(p)<Size(orb) then Append(t,[[1, Size(orb)-NrMovedPoints(p)]]); fi; str := CycleStructurePerm(p); for i in [1..Length(str)] do if IsBound(str[i]) then Append(t,[[i+1, str[i]]]); fi; od; return t; end;
lst_cycles := List(lst, cycle_struct);;
## Morphisms from a free group to our two descriptions of Co_0:
frhom := EpimorphismFromFreeGroup(we8 : names := ["r1","r2","r3","r4","r5","r6","r7","r8"]);;
frhom_mat := GroupHomomorphismByImages(Source(frhom), we8_mat, GeneratorsOfGroup(we8_mat));;
## Convert the computed conjugacy classes into representative matrices:
lst_mat := List(lst, x->Image(frhom_mat, PreImagesRepresentative(frhom, x)));;
## Convenience function for cyclotomic factors:
factor_struct := function(pol, d) local fl, t, i, u, k; fl := Factors(pol); t := []; for i in [1..d] do u := CyclotomicPolynomial(Rationals, i); k := Length(Positions(fl, u)); if k>0 then Append(t, [[i, k]]); fi; od; if Sum(List(t, p->p[2]*Phi(p[1]))) <> 8 then Error("This shouldn't happen!"); fi; return t; end;
lst_factors := List([1..Length(lst_cl)], i -> factor_struct(CharacteristicPolynomial(lst_mat[i]), lst_orders[i]));;
## Now we try to identify the ATLAS labeling of these classes...
## Identify each class by its order, the traces of the first few powers,
## and the order of the centralizer:
keylist1 := List([1..Length(lst_cl)], i->Concatenation([lst_orders[i]], List([1..7], k->Trace(lst_mat[i]^k)), [lst_centralizers[i]]));;
## Get the ATLAS character table from the library:
tbl := CharacterTable("W(E8)");
# ConnectGroupAndCharacterTable(we8, tbl); ## <- This doesn't work, of course
## Identify the determinant and the 8-dimensional character
tbl_detchar := Filtered(Irr(tbl), l->l[1]=1)[2];
tbl_stdchar := Filtered(Irr(tbl), l->l[1]=8)[1];
## Identify the classes by the same numbers, in the order given by tbl:
keylist2 := List([1..Length(lst_cl)], i->Concatenation([OrdersClassRepresentatives(tbl)[i]], List([1..7], k->tbl_stdchar[PowerMap(tbl,k)[i]]), [SizesCentralizers(tbl)[i]]));;
## Now recover the labeling, insofar as it can be identified:
labeling := [];; revorder := [];; for i in [1..Length(lst_cl)] do tmp := Filtered([1..Length(lst_cl)], j->keylist2[j]=keylist1[i]); if Length(tmp)=1 then labeling[i] := AtlasClassNames(tbl)[tmp[1]]; else Error("Ambigous class"); fi; revorder[tmp[1]] := i; od;
## Finally, dump it all out il a file called "we8-representative-matrices.dat":
output := OutputTextFile("we8-representative-matrices.dat", false);
PrintTo(output, "lst_mat := [\n\n");
for j in [1..Length(lst_cl)] do i := revorder[j]; WriteAll(output, Concatenation("#### ", String(j), "\n## Label: ", labeling[i], "\n## Order: ", String(lst_orders[i]), "\n## Centralizer: ", String(lst_centralizers[i]), "\n## Cycles: ", String(lst_cycles[i]), "\n## Trace: ", String(keylist1[i][2]), "\n## Factors: ", String(lst_factors[i]), "\n")); PrintTo(output, lst_mat[i], "\n,\n\n"); od;
PrintTo(output, "];\n\n");
PrintTo(output, "########\n\n");
PrintTo(output, "lst_labels := ", List(revorder, i->labeling[i]), ";\n\n");
PrintTo(output, "lst_orders := ", List(revorder, i->lst_orders[i]), ";\n\n");
PrintTo(output, "lst_centralizers := ", List(revorder, i->lst_centralizers[i]), ";\n\n");
PrintTo(output, "lst_cycles := ", List(revorder, i->lst_cycles[i]), ";\n\n");
PrintTo(output, "lst_traces := ", List(revorder, i->keylist1[i][2]), ";\n\n");
PrintTo(output, "lst_factors := ", List(revorder, i->lst_factors[i]), ";\n\n");
CloseStream(output);
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment