
/*
  Compute representatives for the conjugacy classes of
  the reflection subgroups of Shephard and Todd group G_k
*/

ReflectionSubgroupClasses := function(k)
  G := ShephardTodd(k);
  N := #G;
  refs := [];
  for g in Generators(G) do
    if g notin refs then
      Append(~refs,g);
    end if;
  end for;
  R := &join[ Class(G,r) : r in refs];
  L := SetToSequence({sub<G|r> : r in refs});
  layers := [L];
  mflag := AssociativeArray();
  for A in L do mflag[A] := false; end for;
  while true do
    nextlayer := [];
    n := #layers;
    for H in layers[n] do
//      print "#H:",#H;
      X := {sub<G|H,s> : s in R | s notin H};
      mflag[H] := not IsNull(X) and forall{ Q : Q in X | #Q eq N };
      for A in X do
        if not exists(B){B : B in L | IsConjugate(G,A,B)} then
          Append(~nextlayer,A);
          Append(~L,A);
          mflag[A] := false;
        end if;
      end for;
    end for;
    if IsEmpty(nextlayer) then break; end if;
    Append(~layers,nextlayer);
    print "";
    print n+1,"generators";
    m := #nextlayer;
    suffix := m eq 1 select "" else "s";
    print m, "group"*suffix;
    [#A : A in nextlayer];
  end while;
  return G, R, layers, [ A : A in L | mflag[A] ];
end function;

braid := function(x,y,n)
  b := Parent(x)!1;
  toggle := true;
  while n gt 0 do
    if toggle then
      b := b*x;
    else 
      b := b*y;
    end if;
    toggle := not toggle;
    n -:= 1;
  end while;
  return b;
end function;

Shephard := [<4,3>,<5,4>,<6,6>,<8,3>,<9,6>,<10,4>,<14,8>,<16,3>,<17,6>,<18,4>,<20,5>,<21,10>];

for p in Shephard do
  G := ShephardTodd(p[1]);
  q := p[2];
  assert braid(G.1,G.2,q) eq braid(G.2,G.1,q);
  for k := 2 to q-1 do
    assert braid(G.1,G.2,k) ne braid(G.2,G.1,k);
  end for;
end for;

/*
braidmat := function(G)
  N := Ngens(G);
  M := ZeroMatrix(Integers(),N,N);
  for i := 1 to N do
    M[i,i] := Order(G.i);
    x := G.i;
    for j := i+1 to N do
      y := G.j;
      m := Order(x*y);
      q := m;
      for q := 2 to m do
        if braid(x,y,q) eq braid(y,x,q) then
          M[i,j] := q;
          M[j,i] := q;
          break;
        end if;
      end for;
    end for;
  end for;
  return M;
end function;
*/


G,R,L,M := ReflectionSubgroupClasses(26);
assert Sort([Order(Q) : Q in M]) eq [48,162,648];

/* 
 *  Check that the generators of the complex reflection groups
 *  ShephardTodd(n) for n in [23..37] satisfy the Broue-Malle-Rouquier
 *  relations.
**/


// The braid relation of length m
braidRel := function(x,y,m)
  if IsEven(m) then
    lh := y*x;
    rh := x*y;
  else
    lh := x;
    rh := y;
  end if;
  for i := 1 to (m-1) div 2 do
    lh *:= y;
    lh *:= x;
    rh *:= x;
    rh *:= y;
  end for;
  return lh = rh;
end function;

wd := func< S,J | &*[S.j : j in J] >;
comm := func< x,y | x*y = y*x >;

bmrPres := function(n)
  case n:
  when 23, 24, 25, 26, 27:
    k := 3;
  when 28, 29, 30, 32:
    k := 4;
  when 31, 33:
    k := 5;
  when 34, 35:
    k := 6;
  when 36:
    k := 7;
  when 37:
    k := 8;
  end case;
  S := SLPGroup(k);
  if n in [25,32] then
    rels := [S.i^3 = S!1 : i in [1..k]];
  else
    rels := [S.i^2 = S!1 : i in [1..k]];
  end if;

  case n:
  when 23:
    rels cat:= [braidRel(S.1,S.2,5), braidRel(S.2,S.3,3),comm(S.1,S.3)];
  when 24:
    rels cat:= [braidRel(S.1,S.2,3), braidRel(S.2,S.3,4), braidRel(S.1,S.3,4)];
    rels cat:= [wd(S,[2,3,2,1,2,3]) = wd(S,[1,2,3,2,1,2])];
  when 25:
    rels cat:= [braidRel(S.1,S.2,3), braidRel(S.2,S.3,3), comm(S.1,S.3)];
  when 26:
    rels := [S.1^3 = S!1, S.2^3 = S!1, S.3^2 = S!1];
    rels cat:= [braidRel(S.1,S.2,3),braidRel(S.2,S.3,4),comm(S.1,S.3)];
  when 27:
    rels cat:= [braidRel(S.1,S.2,3),braidRel(S.2,S.3,4),braidRel(S.1,S.3,5)];
    rels cat:= [wd(S,[1,3,1,2,1,3]) = wd(S,[2,1,3,1,2,1])];
  when 28:
    rels cat:= [braidRel(S.1,S.2,3),comm(S.1,S.3),comm(S.1,S.4), braidRel(S.2,S.3,4),
      comm(S.2,S.4),braidRel(S.3,S.4,3)];
  when 29:
    rels cat:= [braidRel(S.1,S.2,3),braidRel(S.1,S.3,3),comm(S.1,S.4),braidRel(S.2,S.3,4),
      comm(S.2,S.4),braidRel(S.3,S.4,3)];
    rels cat:= [wd(S,[1,3,2,1,3,2]) = wd(S,[3,2,1,3,2,1])];
  when 30:
    rels cat:= [braidRel(S.1,S.2,5),comm(S.1,S.3),comm(S.1,S.4), braidRel(S.2,S.3,3),
      comm(S.2,S.4),braidRel(S.3,S.4,3)];
  when 31:
    rels cat:= [ braidRel(S.1,S.2,3),comm(S.1,S.4),braidRel(S.2,S.3,3),comm(S.2,S.4),
      comm(S.2,S.5), braidRel(S.3,S.4,3),braidRel(S.4,S.5,3) ];
    rels cat:= [wd(S,[1,5,3]) = wd(S,[5,3,1]), wd(S,[5,3,1]) = wd(S,[3,1,5])];
  when 32:
    rels cat:= [braidRel(S.1,S.2,3), comm(S.1,S.3),comm(S.1,S.4), braidRel(S.2,S.3,3),
     comm(S.2,S.4),braidRel(S.3,S.4,3)];
  when 33:
    rels cat:= [comm(S.1,S.3),comm(S.1,S.4),comm(S.1,S.5),comm(S.2,S.5),comm(S.3,S.5)];
    rels cat:= [braidRel(S.1,S.2,3),braidRel(S.2,S.3,3),braidRel(S.2,S.4,3),
      braidRel(S.3,S.4,3),braidRel(S.4,S.5,3)];
    rels cat:= [wd(S,[3,4,3,2,3,4]) = wd(S,[2,3,4,3,2,3])];
  when 34:
    rels cat:= [comm(S.1,S.3),comm(S.1,S.4),comm(S.1,S.5),comm(S.1,S.6),comm(S.2,S.5),
      comm(S.2,S.6),comm(S.3,S.5),comm(S.3,S.6),comm(S.4,S.6)];
    rels cat:= [braidRel(S.1,S.2,3),braidRel(S.2,S.3,3),braidRel(S.2,S.4,3),braidRel(S.3,S.4,3),
      braidRel(S.4,S.5,3),braidRel(S.5,S.6,3)];
    rels cat:= [wd(S,[3,4,3,2,3,4]) = wd(S,[2,3,4,3,2,3])];
  when 35:
    C := CartanMatrix("E6");
    for i := 1 to 5 do
      for j := i+1 to 6 do
        Append(~rels, C[i,j] eq 0 select comm(S.i,S.j) else braidRel(S.i,S.j,3));
      end for;
    end for;
  when 36:
    C := CartanMatrix("E7");
    for i := 1 to 6 do
      for j := i+1 to 7 do
        Append(~rels, C[i,j] eq 0 select comm(S.i,S.j) else braidRel(S.i,S.j,3));
      end for;
    end for;
  when 37:
    C := CartanMatrix("E8");
    for i := 1 to 7 do
      for j := i+1 to 8 do
        Append(~rels, C[i,j] eq 0 select comm(S.i,S.j) else braidRel(S.i,S.j,3));
      end for;
    end for;
  else
    error "Out of range";
  end case;
  return S, [LHS(g)^-1*RHS(g) : g in rels];
end function;

test_rel := procedure()
  print "Broue-Malle-Rouquier relations";
  for n := 23 to 37 do
    n;
    S, rels := bmrPres(n);
    W := ShephardTodd(n : NumFld);
    assert Set(Evaluate(rels,W)) eq {W!1};
  end for;
end procedure;

test_pres := procedure()
  print "Broue-Malle-Rouquier presentations";
  for n := 23 to 37 do
    n;
    S, rels := bmrPres(n);
    W := ShephardTodd(n : NumFld);
    m := Ngens(W);
    F := FreeGroup(m);
    R := Evaluate(rels,F);
    Q := quo<F|R>;
    if n in [34,37] then
    // these groups are too large to test the order directly
      Q := quo<F|R>;
      H := sub<Q| [Q.i : i in [1..m-1]] >;
      K := sub<W| [W.i : i in [1..m-1]] >;
      assert Index(Q,H) eq Index(W,K);
    else
      assert #Q eq #W;
    end if;
  end for;
end procedure;

test_rel();
test_pres();

