|
#
# walrus: Computational Methods for Finitely Generated Monoids and Groups
#
## Presentations
InstallGlobalFunction(NewPregroupPresentation,
function(pg, rels)
local res;
res := rec( pg := pg );
res.rels := List([1..Length(rels)], x -> NewPregroupRelator(res, rels[x], x));
# Orgh. Make sure Locations and Places are all computed for the moment
Objectify(PregroupPresentationType, res);
Locations(res);
Places(res);
SetVertexTripleCache(res, HashMap());
return res;
end);
InstallGlobalFunction(PregroupPresentationFromFp,
function(F, rred, rgreen)
local inv, pg, rgreens, inv_test;
inv_test := function(x)
local lr;
if Length(x) = 2 then
lr := LetterRepAssocWord(x);
return lr[1] = lr[2];
fi;
return false;
end;
# Get the involutions
inv := Filtered(rgreen, inv_test);
rgreens := Filtered(rgreen, x -> not inv_test(x));
pg := PregroupByRedRelators(F, rred, List(inv, x -> LetterRepAssocWord(x)[1]));
rgreens := List(rgreens, pg!.convert_word);
return NewPregroupPresentation(pg, rgreens);
end);
InstallMethod(ViewString
, "for a pregroup presentation"
, [IsPregroupPresentationRep],
function(pgp)
# Note that we do not really regard 1 as a generator
local res;
return STRINGIFY("<pregroup presentation with "
, Size(pgp!.pg)-1, " generators and "
, Length(pgp!.rels), " relators>");
end);
InstallMethod(Pregroup
, "for a pregroup presentation"
, [IsPregroupPresentation],
pgp -> pgp!.pg);
InstallMethod(Generators
, "for a pregroup presentation"
, [IsPregroupPresentation],
function(pres)
local gens;
gens := List(Pregroup(pres), x->x);
Remove(gens, 1);
return gens;
end);
InstallMethod(Relators
, "for a pregroup presentation"
, [IsPregroupPresentation],
pgp -> pgp!.rels);
InstallMethod(RelatorsAndInverses
, "for a pregroup presentation"
, [IsPregroupPresentation],
function(pgp)
local r;
r := Relators(pgp);
return Concatenation(r, List(r, Inverse));
end);
InstallMethod(Powers
, "for a pregroup presentation"
, [IsPregroupPresentation],
x -> x!.powers);
InstallMethod(RLetters
, "for a pregroup presentation"
, [IsPregroupPresentation],
function(pres)
local rels, gens, x, r, rlett;
rels := RelatorsAndInverses(pres);
gens := Generators(pres);
rlett := Set([]);
for r in rels do
for x in gens do
if x in r then AddSet(rlett, x); fi;
od;
od;
return rlett;
end);
# An R-letter is a letter that occurs in any (interleave) of
# a relation (Definition 7.4)
# XXX: Note that the code below does not do interleaves yet!
InstallGlobalFunction(IsRLetter,
function(pres, x)
# determine whether x occurs in I(R)
return x in RLetters(pres);
end);
InstallMethod(Locations, "for a pregroup presentation",
[IsPregroupPresentation and IsPregroupPresentationRep],
function(pres)
local rel, locs, w, i, index;
locs := [];
for rel in RelatorsAndInverses(pres) do
Append(locs, Locations(rel));
od;
# Hack
# In particular this ID is ID within presentation
index := HashMap(x -> HashBasic([__ID(x[1]), __ID(x[2])]));
for i in [1..Length(locs)] do
locs[i]![6] := i;
if IsBound( index[ [ InLetter(locs[i]), OutLetter(locs[i]) ] ] ) then
Add( index[ [ InLetter(locs[i]), OutLetter(locs[i]) ] ], locs[i] );
else
index[ [ InLetter(locs[i]), OutLetter(locs[i]) ] ] := [ locs[i] ];
fi;
od;
SetLocationIndex(pres, index);
return locs;
end);
# For a location R(i,a,b) find a matching location
# R'(j,b^(-1),c) such that a reduced diagram only
# containing R and R' exists
FindMatchingLocation := function(loc, c)
local locs, b, binv, loc2;
b := OutLetter(loc);
binv := PregroupInverse(b);
locs := LocationIndex(PregroupPresentationOf(loc));
locs := locs[ [binv, c] ];
if locs <> fail then
for loc2 in locs do
if CheckReducedDiagram(loc, loc2) then
return loc2;
fi;
od;
fi;
return fail;
end;
# Given a pregroup presentation as the input, find all places
# B is true if a place will always occur on the boundary
InstallMethod(Places, "for a pregroup presentation",
[IsPregroupPresentation and IsPregroupPresentationRep],
function(pres)
local loc, loc2,
places, a, b, c,
rels,
locs, i;
# rels := RelatorsAndInverses(pres);
rels := Relators(pres);
locs := Locations(pres);
places := [];
for loc in locs do
a := InLetter(loc);
b := OutLetter(loc);
for c in Generators(pres) do
# Colour is "red"
if IsIntermultPair(PregroupInverse(b), c) then
Add(places, NewPlace(loc, c, "red"));
fi;
# Colour is "green"
# find location R'(j,b^(-1),c) and check that a diagram that
# meets at the edge b doesn't collapse.
if FindMatchingLocation(loc, c) <> fail then
Add(places, NewPlace(loc, c, "green"));
fi;
od;
od;
# Hack
for i in [1..Length(places)] do
places[i]![5] := i;
od;
return places;
end);
InstallMethod(LengthLongestRelator, "for a pregroup presentation",
[IsPregroupPresentation and IsPregroupPresentationRep],
function(pres)
return Maximum(List(Relators(pres), Length));
end);
# Definition 3.3: A diagram is semi-reduced, if no distinct adjacent faces
# are labelled by ww_1 and w_1^{-1}w for a relator ww_1 and have a common
# consolidated edge labelled by w and w^-1
# it is reduced if this also holds for a face incident with itself.
#
# test whether label on Relator(l2) beginning at b^(-1) is equal to inverse
# of label on Relator(l1) ending at b
InstallGlobalFunction(CheckReducedDiagram,
function(l1, l2)
local i, j, r1, r2, iend, jend;
r1 := Relator(l1);
i := Position(l1);
iend := i + 1;
if iend > Length(r1) then iend := iend - Length(r1); fi;
r2 := Relator(l2);
j := Position(l2) - 1;
jend := j - 1;
if jend < 0 then jend := jend + Length(r2); fi;
# Here inverses should match, or otherwise the passed
# locations are already incompatible
if r1[i] <> PregroupInverse(r2[j]) then
Error("loc1 and loc2 are not compatible");
return fail;
fi;
repeat
i := i - 1;
if i = 0 then i := Length(r1); fi;
j := j + 1;
if j > Length(r2) then j := 1; fi;
# # Print("r1[", i, "] = ", r1[i], " r2[", j, "] = ", r2[j], "\n");
if r1[i] <> PregroupInverse(r2[j]) then
return true;
fi;
until (i = iend) or (j = jend);
return false;
end);
InstallGlobalFunction(PregroupPresentationToFpGroup,
function(pres)
local d, F, rels, gens, pg, p, i, j;
# By Definition 2.2 of the paper
d := Size(Pregroup(pres)) - 1;
F := FreeGroup(d);
pg := Pregroup(pres);
rels := [];
# rels := List([1..d], x -> [ F.(x) * F.(pg!.inv(x+1)-1), One(F) ]);
for i in [2..d+1] do
for j in [2..d+1] do
p := pg[i] * pg[j];
if p <> fail then
if p = One(pg) then
Add(rels, [F.(i-1) * F.(j-1), One(F)]);
else
Add(rels, [F.(i-1) * F.(j-1) * F.(__ID(PregroupInverse(p))-1), One(F)]);
fi;
fi;
od;
od;
Append(rels, List(Relators(pres), x -> [Product(List(List(x), y -> F.(__ID(y)-1))), One(F)]));
return F / rels;
end);
#T Put pregroup relations in (if pregroup is not the pregroup of the free group)
#T Choose sensible generator names and print them (maybe just use x1,x2,... or a,b,c))
if WALRUS_kbmag_available then
InstallGlobalFunction(PregroupPresentationToKBMAG,
pres -> KBMAGRewritingSystem(PregroupPresentationToFpGroup(pres)));
fi;
# Writes out pregroup as a multiplication table
# and then the relators, intended as a simple exchange
# format
InstallGlobalFunction(PregroupPresentationToSimpleStream,
function(stream, pres)
local row, col, table, n, i, rel;
table := MultiplicationTableIDs(Pregroup(pres));
n := Length(table);
AppendTo(stream, "pregroup:\n" );
for row in [1..n] do
AppendTo(stream, " ");
for col in [1..n-1] do
AppendTo(stream, String(table[row][col]));
AppendTo(stream, " ");
od;
AppendTo(stream, String(table[row][n]));
AppendTo(stream, "\n");
od;
AppendTo(stream, "relators:\n");
for rel in Relators(pres) do
AppendTo(stream, " ");
for i in [1..Length(rel)-1] do
AppendTo(stream, String(__ID(rel[i])));
AppendTo(stream, " ");
od;
AppendTo(stream, String(__ID(rel[Length(rel)])));
AppendTo(stream, "\n");
od;
end);
# Serialises a pregroup presentation as a GAP record
# that GAP can read back easily
InstallGlobalFunction(PregroupPresentationToStream,
function(stream, pres)
local res, rel, rels;
res := rec( table := MultiplicationTableIDs(Pregroup(pres)),
rels := List(Relators(pres), r -> List(r, x -> __ID(x))));
PrintTo(stream, res, ";\n");
end);
InstallGlobalFunction(PregroupPresentationFromStream,
function(stream)
local res, r, pg, rels;
res := READ_ALL_COMMANDS(stream, false, false, IdFunc);
if Length(res) = 1
and res[1][1] = true
and IsBound(res[1][2])
and IsRecord(res[1][2]) then
# FIXME: Store element names, at least don't put arbitarary
# restriction o nnumber of pregroup elts here
r := res[1][2];
pg := PregroupByTable("1abcdefghijklmnopqrstuvwxyz"{[1..Length(r.table)]}, r.table);
return NewPregroupPresentation(pg, List(r.rels, x -> pg_word(pg, x)));
else
Error("Could not read pregroup presentation from stream");
fi;
end);
InstallGlobalFunction(PregroupPresentationToFile,
function(filename, pres)
local outs;
outs := OutputTextFile(filename, false);
SetPrintFormattingStatus(outs, false);
PregroupPresentationToStream(outs, pres);
CloseStream(outs);
end);
InstallGlobalFunction(PregroupPresentationToSimpleFile,
function(filename, pres)
local outs;
outs := OutputTextFile(filename, false);
SetPrintFormattingStatus(outs, false);
PregroupPresentationToSimpleStream(outs, pres);
CloseStream(outs);
end);
[ Dauer der Verarbeitung: 0.28 Sekunden
(vorverarbeitet)
]
|
