Quelle  balanced.in

F := FreeGroup("x","y");;
#x := F.1;; y := F.2;;
p := 5;
nexpts := p-1;
expts := Concatenation([1 .. Int(p/2)], 
[-Int(p/2) .. -1]);
sylls := List(expts, i -> x*y^i);
cLength := 6;
c := ListWithIdenticalEntries(cLength, expts[1]);
word := vec -> Product(vec, veci -> x*y^expts[veci], One(x));
word(c);
getNext := function(vec)
local i;
   i := 1;
   while i <= cLength and vec[i] mod p = p-1 do
      vec[i] := 1;
      i := i + 1;
   od;
   if i <= cLength then
      vec[i] := vec[i] + 1;
   else
      vec := fail;
   fi;
end;
printVecWord := function(vec, num)
local i;
   Print(vec, "  ", word(vec), "\n");
   i := 1;;
   while i < num and vec <> fail do
   i := i + 1;
   getNext(vec);
   Print(vec, "  ", word(vec), "\n");
   od;
end;
printVecWord( [1,1,1,1,1,1], 20);
LoadPackage("ace");
SetInfoLevel(InfoACE,0);
ReadPackage("ace","res-examples/pgrelfind.g");
SetInfoLevel(InfoACE,1);
f:= FreeGroup("x","y");;
#x:= f.1;; y:= f.2;;
rels:=[ x^2, y^3,
y^(-1)*x*y^(-1)*x*y^(-1)*x*y^(-1)*x*y^(-1)*x*y^(-1)*x*y^(-1)*x,
x*y^(-1)*x*y*x*y^(-1)*x*y*x*y^(-1)*x*y*x*y^(-1)*x*y*x*y*x*
y^(-1)*x*y*x*y^(-1)*x*y*x*y^(-1)*x*y*x*y^(-1)*x*y*x*y ];;
G:=f/rels;
Size(G);
l:=LowIndexSubgroupsFpGroup( G, TrivialSubgroup( G),10);
sgens:=GeneratorsOfGroup(l[2]);
sgens:=List(sgens,UnderlyingElement);
fgens := [ x, y ];
PGRelFind(fgens, rels, sgens );
newrels := [ x^2, y^3, x*y*x*y*x*y^(-1)*x*y^(-1)*x*y^(-1)*x*y*x*
y*x*y^(-1)*x*y^(-1)*x*y*x*y^(-1)*x*y^(-1)*x*y*x*y^(-1)*x*y ];
ge:=f/newrels;
Size(ge);
ExponentSumWord(newrels[3],x);
ExponentSumWord(newrels[3],y);
balancedrels := [x^2*y^3, newrels[3]*x^-16];
gb := f/balancedrels;
Size(gb);
quit;