|
# Takes two groups, and builds the pregroup underlying the free product of
# these two groups
#
# don't try using this on large groups.
#
InstallMethod(PregroupOfFreeProduct, "for two finite groups",
[IsGroup and IsFinite, IsGroup and IsFinite],
function(G, H)
local i, j, size, table, eltn;
size := Size(G) + Size(H) - 1;
table := NullMat(size,size);
table{[2..Size(G)]}{[2..Size(G)]} := MultiplicationTable(G){[2..Size(G)]}{[2..Size(G)]};
table{[Size(G)+1..size]}{[Size(G)+1..size]} := Size(G) - 1 + MultiplicationTable(H){[2..Size(H)]}{[2..Size(H)]};
for i in [Size(G) + 1 .. size ] do
for j in [Size(G) + 1 .. size ] do
if table[i][j] = Size(G) then
table[i][j] := 1;
fi;
od;
od;
for i in [1..size] do
table[1][i] := i;
table[i][1] := i;
od;
eltn := List([1..size], String);
return PregroupByTable(eltn, table);
end);
# Pregroup of free product of entered groups
InstallGlobalFunction(PregroupOfFreeProductList,
function(l)
local r;
r.groups := l;
return Objectify(PregroupOfFreeProductType, r);
end);
InstallMethod(PregroupByRedRelators,
"for a free group, and a list of words of length 3",
[ IsFreeGroup, IsList, IsList ],
function(F, rred, inv)
local rkF, n, enams, table, i, j, r, pg, convert, ic;
rkF := Length(GeneratorsOfGroup(F));
if ForAny(rred, x -> not ( (x in F) and ( Length(x) = 3 ) ) ) then
Error("rred has to be a list of words of length 3 over F");
fi;
ic := Length(inv);
n := 1 + 2 * rkF;
enams := Concatenation(["1"]
, Concatenation( List([1..rkF],
x -> [ Concatenation("x", String(x))
, Concatenation("X", String(x)) ] )));
table := NullMat(n, n);
# Multiplication by 1
for i in [1..n] do
table[1,i] := i;
table[i,1] := i;
od;
# Multiplication of mutual inverse generators in
# Free group
for i in [2, 4..2 * rkF] do
table[i, i+1] := 1;
table[i+1, i] := 1;
od;
for i in inv do
table[ 2*i, 2*i] := 1;
table[ 2*i, 2*i + 1] := 0;
table[ 2*i + 1, 2*i] := 0;
table[ 2*i+1 , 2*i+1] := 1;
od;
convert := function(x)
if x > 0 then
return 2 * x;
else
# involution
if -x in inv then
return 2 * (-x);
else
return 2 * (-x) + 1;
fi;
fi;
end;
# Enter red relators
# for r = x * y * z we get
# - x * y = z^-1
# - x = z^-1 * y^-1
# - y * z = x ^ -1
# - z = y^-1 * x^-1
# - y = x^-1 * z^-1
# - y^-1 = z * x
for r in List(rred, LetterRepAssocWord) do
table[ convert(r[1]), convert(r[2]) ] := convert(-r[3]);
table[ convert(-r[3]), convert(-r[2]) ] := convert(r[1]);
table[ convert(r[2]), convert(r[3]) ] := convert(-r[1]);
table[ convert(-r[2]), convert(-r[1]) ] := convert(r[3]);
table[ convert(-r[1]), convert(-r[3]) ] := convert(r[2]);
table[ convert(r[3]), convert(r[1]) ] := convert(-r[2]);
od;
pg := PregroupByTable(enams, table);
pg!.freegroup := F;
pg!.convert_word := w -> List(LetterRepAssocWord(w), l -> pg[convert(l)]);
return pg;
end);
[ Dauer der Verarbeitung: 0.24 Sekunden
(vorverarbeitet)
]
|
