//// Billiard Search: 
//// Find the mimimal glides and translations 
// define functions

Factor := function(g,glist);
 h := g;  
 fs := [ ];
 while #h gt 0 do
   for x in glist do
      y := x^(-1)*h; 
      if #y lt #h then Append(~fs,x); h := y; end if;
      end for;
   end while;
 return fs;
 end function;   
 
 CyclicConjugates := function(g,glist);
    L := Factor(g,glist);
    CCL := [ g ];
    if #g eq 0 then return CCL; end if; 
    h := g;
    for j := 1 to #L-1 do
       h := h^L[j];
       Append(~CCL,h);      
       end for;
    return CCL;
    end function;    
    
  IsProperPurePower := function(g,glist);
    w := #g;
    D := Divisors(w);
    Exclude(~D,1);
    Exclude(~D,w);
    if #D eq 0 then return false; end if;
    L := Factor(g,glist);
    for d in D do
       h := L[1];
       for j := 2 to d do h := h*L[j]; end for;
       e := w div d;
       if g eq  h^e then return true; end if;
       end for;
    return false;   
    end function;      
    
// define group
FG<p,q,r> := FreeGroup(3);
Lams := quo< FG | p^(-1)= p, q^(-1) = q, r^(-1)= r, q*p=p*q, r*q*r=q*r*q, r*p*r*p*r*p*r=p*r*p*r*p*r*p>;
G<p,q,r> := RWSGroup(Lams : MaxRelations := 100, MaxStates := 200);
gens := [ p,q,r ];    
    

//set parameters
top := 40;
e := 2*3*7;

// start recording
logname := "billiards"*IntegerToString(top)*".log";
rezname := "billiards"*IntegerToString(top)*".rez";
FW := Open(rezname,"w");
SetLogFile(logname: Overwrite := true);

/// generate some elements
print "looking at words of length "*IntegerToString(top)*" or less";
W0 := Seq(G,0,top: Search := "BFS");
print "number of elements of length <= "*IntegerToString(top)*" : ", #W0;

/// find the translations
tgW := [ ]; 
tgcount := 0;
W := W0; 
for x in W do 
  nxe := #(x^e);
  enx := (e*#x);
  Exclude(~W,x); 
  if nxe eq enx then Append(~tgW,x); end if;
  if #tgW ge tgcount+100 
     then print #tgW, "glides/translations found, ", #W, "words left to examine"; 
     tgcount := #tgW; end if;
  end for; 

print "number of glides and translations  = ", #tgW;
print "pruning list for primitive conjugacy class representatives";

/// eliminate  cylic conjugates
Exclude(~tgW,Id(G));
cccount :=0;
cctgW := [ ]; 
 while #tgW gt 0 do
     x := tgW[1];
     CCL := CyclicConjugates(x,gens);
     found  := false;
     for z in cctgW do
     for w in CCL do
        if z eq w then found := true; end if;
        end for;
        end for;
     ispower := false;   
     if not (IsPrime(#x) or found)
        then for w in CCL do
             ispower := ispower or IsProperPurePower(w,gens); 
             end for;
        end if;     
     if not (found  or ispower)
        then Append(~cctgW,x); 
        printf "%3o %o \n", #x, x; 
        end if;     
     if #x eq 0 
        then e  := 1; 
        else e := top div #x;
        end if; 
     CCLP := CCL;
     for j := 2 to e do
         CCLP := CCLP cat [ y^j : y in CCL ];
         end for; 
     for z in CCLP do Exclude(~tgW,z); end for;
     if #cctgW ge cccount+10 
     then print #cctgW, "conjugacy class representatives found, ", #tgW, "words left to examine"; 
     cccount := #cctgW; end if;
     end while;

mult := [#g : g in cctgW];
print "number of conjugacy class representatives found = ", #cctgW;  
print mult; 

for x in cctgW do
   fprintf FW, "%3o %o \n", #x, x; 
   end for; 

// stop recording
UnsetLogFile();
delete FW;