|
#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Thomas Breuer, Frank Celler, Alexander Hulpke.
##
## Copyright of GAP belongs to its developers, whose names are too numerous
## to list here. Please refer to the COPYRIGHT file for details.
##
## SPDX-License-Identifier: GPL-2.0-or-later
##
##
## This file contains generic methods for associative words.
##
#############################################################################
##
#F AssignGeneratorVariables(<G>)
##
BindGlobal("DoAssignGenVars",function(gens)
local g,s;
# test whether the variable name would be a proper identifier
for g in gens do
s := String(g);
# remove < > enclosures
s:=Filtered(s,x->x<>'<' and x<>'>');
if not IsValidIdentifier(s) then
Error("Variable `", s, "' would not be a proper identifier");
fi;
if IS_READ_ONLY_GLOBAL(s) then
Error("Variable `", s, "' is write protected.");
fi;
od;
for g in gens do
s := String(g);
s:=Filtered(s,x->x<>'<' and x<>'>');
if ISBOUND_GLOBAL(s) then
Info(InfoWarning + InfoGlobal, 1, "Global variable `", s,
"' is already defined and will be overwritten");
fi;
UNBIND_GLOBAL(s);
ASS_GVAR(s, g);
od;
Info(InfoWarning + InfoGlobal, 1, "Assigned the global variables ", gens);
end);
InstallMethod(AssignGeneratorVariables, "default method for a group",
[IsGroup],
function(G)
local gens;
gens := GeneratorsOfGroup(G);
DoAssignGenVars(gens);
end);
#############################################################################
##
#F AssignGeneratorVariables(<R>)
##
InstallMethod(AssignGeneratorVariables, "default method for a ring",
[IsRing and HasGeneratorsOfRing],
function(G)
local gens;
gens := GeneratorsOfRing(G);
DoAssignGenVars(gens);
end);
#############################################################################
##
#F AssignGeneratorVariables(<A>)
##
InstallMethod(AssignGeneratorVariables, "default method for a LOR",
[IsLeftOperatorRing],
function(G)
local gens;
if IsLeftOperatorRingWithOne(G) then
gens := GeneratorsOfLeftOperatorRingWithOne(G);
else
gens := GeneratorsOfLeftOperatorRing(G);
fi;
DoAssignGenVars(gens);
end);
# functions for syllable representation
InstallGlobalFunction(ERepAssWorProd,function(x,y)
local l,p,len,e;
if IsEmpty(y) then
return x;
elif IsEmpty(x) then
return y;
fi;
len:=Length(y);
l:=Length(x)-1;
p:=1;
while 0<l and p<len
and x[l]=y[p] and x[l+1]=-y[p+1] do
l:=l-2;
p:=p+2;
od;
if l<0 then
# first argument is gone
return y{[p..len]};
elif len<p then
# the second is gone
return x{[1..l+1]};
else
if x[l]=y[p] then
e:=x[l+1]+y[p+1];
if e=0 then
return Concatenation(x{[1..l-1]},y{[p+2..len]});
else
return Concatenation(x{[1..l-1]},[x[l],e],y{[p+2..len]});
fi;
else
return Concatenation(x{[1..l+1]},y{[p..len]});
fi;
fi;
end);
InstallGlobalFunction(ERepAssWorInv,function(w)
local i,e;
e:=[];
# invert
for i in [Length(w),Length(w)-2..2] do
Add(e,w[i-1]);
Add(e,-w[i]);
od;
return e;
end);
#############################################################################
##
#M \<( <w1>, <w2> ) . . . . . . . . . . . . . . . . . . . . . . . for words
##
## Associative words are ordered by the shortlex order of their external
## representation.
##
InstallMethod(\<,"assoc words",IsIdenticalObj,[IsAssocWord,IsAssocWord],0,
function( x, y )
local n,m;
x:= ExtRepOfObj( x );
y:= ExtRepOfObj( y );
n:=Sum([2,4..Length(x)],i->AbsInt(x[i]));
m:=Sum([2,4..Length(y)],i->AbsInt(y[i]));
# first length
if n<m then
return true;
elif n>m then
return false;
fi;
# then lex
m:= Minimum( Length( x ), Length( y ) );
n:=1;
while n<=m and x[n]=y[n] do # common prefix
n:=n+1;
od;
if n>Length(x) then
return x<y; # x is a prefix of y. They could be same
elif n>Length(y) then
return false; # y is a prefix of x
elif not IsInt(n/2) then
# discrepancy at generator
return x[n]<y[n];
fi;
# so the exponents disagree.
if SignInt(x[n])<>SignInt(y[n]) then
#they have different sign: The smaller wins
return x[n]<y[n];
fi;
# but have the same sign. We need to compare the generators with the next
# one
if AbsInt(x[n])<AbsInt(y[n]) then
# x runs out first
if Length(x)<=n then
return true;
else
return x[n+1]<y[n-1];
fi;
else
# y runs out first
if Length(y)<=n then
return false;
else
return x[n-1]<y[n+1];
fi;
fi;
end );
#############################################################################
##
#M \*( <w1>, <w2> )
##
## Multiplication of associative words is done by concatenating the words
## and removing adjacent pairs of an abstract generator and its inverse.
##
BindGlobal( "AssocWord_Product", function( x, y )
local xx, # external representation of 'x'
l, # current length of 'xx', minus 1
yy, # external representation of 'y'
p, # current first valid position in 'yy'
len; # total length of 'yy' minus 1
# Treat the special cases that one argument is trivial.
xx:= ExtRepOfObj( x );
l:= Length( xx ) - 1;
if l < 0 then
return y;
fi;
yy:= ExtRepOfObj( y );
if IsEmpty( yy ) then
return x;
fi;
# Treat the case of cancellation.
p:= 1;
len:= Length( yy ) - 1;
while 0 < l and p <= len
and xx[l] = yy[p] and xx[ l+1 ] = - yy[ p+1 ] do
l:= l-2;
p:= p+2;
od;
if l < 0 then
# The first argument has been eaten up,
# so the product can be formed as object of the same type as 'y'.
return AssocWord( TypeObj( y )![ AWP_PURE_TYPE ],
yy{ [ p .. len+1 ] } );
elif len < p then
# The second argument has been eaten up,
# so the product can be formed as object of the same type as 'x'.
return AssocWord( TypeObj( x )![ AWP_PURE_TYPE ],
xx{ [ 1 .. l+1 ] } );
else
if 1 < p then
yy:= yy{ [ p .. len+1 ] };
xx:= xx{ [ 1 .. l+1 ] };
fi;
xx:= ShallowCopy( xx );
if xx[l] = yy[1] then
# We have the same generator at the gluing position.
yy:= ShallowCopy( yy );
yy[2]:= xx[ l+1 ] + yy[2];
Unbind( xx[l] );
Unbind( xx[ l+1 ] );
Append( xx, yy );
# This is the only case where the subtypes of 'x' and 'y'
# may be too small.
# So let 'ObjByExtRep' choose the appropriate subtype.
if TypeObj( x )![ AWP_NR_BITS_EXP ]
<= TypeObj( y )![ AWP_NR_BITS_EXP ] then
return ObjByExtRep( FamilyObj( x ), TypeObj( y )![ AWP_NR_BITS_EXP ],
yy[2], xx );
else
return ObjByExtRep( FamilyObj( x ), TypeObj( x )![ AWP_NR_BITS_EXP ],
yy[2], xx );
fi;
else
# The exponents of the result do not exceed the exponents
# of 'x' and 'y'.
# So the bigger of the two types will be sufficient.
Append( xx, yy );
if TypeObj( x )![ AWP_NR_BITS_EXP ] <= TypeObj( y )![ AWP_NR_BITS_EXP ] then
return AssocWord( TypeObj( y )![ AWP_PURE_TYPE ], xx );
else
return AssocWord( TypeObj( x )![ AWP_PURE_TYPE ], xx );
fi;
fi;
fi;
end );
InstallMethod( \*, "for two assoc. words in syllable rep", IsIdenticalObj,
[ IsAssocWord and IsSyllableAssocWordRep,
IsAssocWord and IsSyllableAssocWordRep], 0, AssocWord_Product );
InstallMethod( \*, "for two assoc. words: force syllable rep", IsIdenticalObj,
[ IsAssocWord, IsAssocWord], 0,
function(a,b)
return SyllableRepAssocWord(a)*SyllableRepAssocWord(b);
end);
#############################################################################
##
#M \^( <w>, <n> )
##
## Note that in a family of associative words without inverses no
## cancellation can occur, and that the algorithm may use this fact.
## So we must guarantee that words with inverses get the method that handles
## the case of cancellation.
##
InstallMethod( \^,
"for an assoc. word in syllable rep, and a positive integer",
true,
[ IsAssocWord and IsSyllableAssocWordRep, IsPosInt ], 0,
function( x, n )
local xx, # external representation of 'x'
result, # external representation of the result
l, # actual length of 'xx'
exp, # store one exponent value
tail; # trailing part in 'xx' (cancels with 'head')
if 1 < n then
xx:= ExtRepOfObj( x );
if IsEmpty( xx ) then
return x;
fi;
l:= Length( xx );
if l = 2 then
n:= n * xx[2];
return ObjByExtRep( FamilyObj( x ), 1, n, [ xx[1], n ] );
fi;
xx:= ShallowCopy( xx );
if xx[1] = xx[ l-1 ] then
# Treat the case of gluing.
tail:= [ xx[1], xx[l] ];
exp:= xx[2];
xx[2]:= xx[2] + xx[l];
Unbind( xx[ l ] );
Unbind( xx[ l-1 ] );
else
exp:= 0;
fi;
# Compute the 'n'-th power of 'xx'.
result:= ShallowCopy( xx );
n:= n - 1;
while n <> 0 do
if n mod 2 = 1 then
Append( result, xx );
n:= (n-1)/2;
else
n:= n/2;
fi;
Append( xx, xx );
od;
if exp = 0 then
# The exponents in the power do not exceed the exponents in 'x'.
return AssocWord( TypeObj( x )![ AWP_PURE_TYPE ], result );
else
result[2]:= exp;
Append( result, tail );
return ObjByExtRep( FamilyObj( x ), TypeObj( x )![ AWP_NR_BITS_EXP ],
xx[2], result );
fi;
elif n = 1 then
return x;
fi;
end );
BindGlobal( "AssocWordWithInverse_Power", function( x, n )
local xx, # external representation of 'x'
cxx, # external repres. of the inverse of 'x'
i, # loop over 'xx'
result, # external representation of the result
l, # actual length of 'xx'
p, # actual position in 'xx'
len, # length of 'xx' minus 1
head, # initial part of 'xx'
exp, # store one exponent value
tail; # trailing part in 'xx' (cancels with 'head')
# Consider special cases.
if n = 0 then
return One( FamilyObj( x ) );
elif n = 1 then
return x;
fi;
xx:= ExtRepOfObj( x );
if IsEmpty( xx ) then
return x;
fi;
l:= Length( xx );
if l = 2 then
n:= n * xx[2];
return ObjByExtRep( FamilyObj( x ), 1, n, [ xx[1], n ] );
fi;
# Invert the internal representation of 'x' if necessary.
if n < 0 then
i:= 1;
cxx:= [];
while i < l do
cxx[ l-i ] := xx[ i ];
cxx[ l-i+1 ] := - xx[ i+1 ];
i:= i+2;
od;
xx:= cxx;
n:= -n;
else
xx:= ShallowCopy( xx );
fi;
# Treat the case of cancellation.
# The word is split into three parts, namely
# 'head' (1 to 'p-1'), 'xx' ('p' to 'l+1'), and 'tail' ('l+2' to 'len').
p:= 1;
len:= l;
l:= l - 1;
while xx[l] = xx[p] and xx[ l+1 ] = - xx[ p+1 ] do
l:= l-2;
p:= p+2;
od;
# Again treat a special case.
if l = p then
exp:= n * xx[ l+1 ];
xx[ l+1 ]:= exp;
return ObjByExtRep( FamilyObj( x ), TypeObj( x )![ AWP_NR_BITS_EXP ], exp, xx );
fi;
head:= xx{ [ 1 .. p-1 ] };
tail:= xx{ [ l+2 .. len ] };
xx:= xx{ [ p .. l+1 ] };
l:= l - p + 2;
if xx[1] = xx[ l-1 ] then
# Treat the case of gluing.
tail:= Concatenation( [ xx[1], xx[l] ], tail );
exp:= xx[2];
xx[2]:= xx[2] + xx[l];
Unbind( xx[ l ] );
Unbind( xx[ l-1 ] );
else
exp:= 0;
fi;
# Compute the 'n'-th power of 'xx'.
result:= ShallowCopy( xx );
n:= n - 1;
while n <> 0 do
if n mod 2 = 1 then
Append( result, xx );
n:= (n-1)/2;
else
n:= n/2;
fi;
Append( xx, xx );
od;
# Put the three parts together.
if exp = 0 then
# The exponents in the power do not exceed the exponents in 'x'.
Append( head, result );
Append( head, tail );
return AssocWord( TypeObj( x )![ AWP_PURE_TYPE ], head );
else
result[2]:= exp;
Append( head, result );
Append( head, tail );
return ObjByExtRep( FamilyObj( x ), TypeObj( x )![ AWP_NR_BITS_EXP ],
xx[2], head );
fi;
end );
InstallMethod( \^,
"for an assoc. word with inverse in syllable rep, and an integer",
true,
[ IsAssocWordWithInverse and IsSyllableAssocWordRep, IsInt ], 0,
AssocWordWithInverse_Power );
BindGlobal( "AssocWordWithInverse_Inverse", function( x )
local xx, # external representation of 'x'
cxx, # external repres. of the inverse of 'x'
i, # loop over 'xx'
l; # actual length of 'xx'
# Consider special cases.
xx:= ExtRepOfObj( x );
if IsEmpty( xx ) then
return x;
fi;
l:= Length( xx );
if l = 2 then
l:= - xx[2];
return ObjByExtRep( FamilyObj( x ), 1, l, [ xx[1], l ] );
fi;
# Invert the internal representation of 'x'.
i:= 1;
cxx:= [];
while i < l do
cxx[ l-i ] := xx[ i ];
cxx[ l-i+1 ] := - xx[ i+1 ];
i:= i+2;
od;
# The exponents in the inverse do not exceed the exponents in 'x'.
#T ??
return AssocWord( TypeObj( x )![ AWP_PURE_TYPE ], cxx );
end );
InstallMethod( InverseOp,
"for an assoc. word with inverse in syllable rep",
true,
[ IsAssocWordWithInverse and IsSyllableAssocWordRep], 0,
AssocWordWithInverse_Inverse );
#############################################################################
##
#M ReversedOp( <word> )
##
InstallOtherMethod( ReversedOp, "for an assoc. word in syllable rep", true,
[ IsAssocWord and IsSyllableAssocWordRep], 0,
function( word )
local extrep, len, rev, i;
extrep:= ExtRepOfObj( word );
if IsEmpty( extrep ) then
return word;
fi;
len:= Length( extrep );
rev:= [];
for i in [ len-1, len-3 .. 1 ] do
Add( rev, extrep[ i ] );
Add( rev, extrep[ i+1 ] );
od;
return AssocWord( TypeObj( word )![ AWP_PURE_TYPE ], rev );
end );
#############################################################################
##
#M Subword( <w>, <from>, <to> )
##
InstallOtherMethod( Subword,"for syllable associative word and two positions",
true, [ IsAssocWord and IsSyllableAssocWordRep, IsPosInt, IsInt ], 0,
function( w, from, to )
local extw, pos, nextexp, firstexp, sub;
if to<from then
if IsMultiplicativeElementWithOne(w) then
return One(FamilyObj(w));
else
Error("<from> must be less than or equal to <to>");
fi;
fi;
extw:= ExtRepOfObj( w );
to:= to - from + 1;
# The relevant part is 'extw{ [ pos-1 .. Length( extw ) ] }'.
pos:= 2;
nextexp:= AbsInt( extw[ pos ] );
while nextexp < from do
pos:= pos + 2;
from:= from - nextexp;
nextexp:= AbsInt( extw[ pos ] );
od;
# Throw away 'Subword( w, 1, from-1 )'.
nextexp:= nextexp - from + 1;
if 0 < extw[ pos ] then
firstexp:= nextexp;
else
firstexp:= - nextexp;
fi;
# Fill the subword.
sub:= [];
while nextexp < to do
Add( sub, extw[ pos-1 ] );
Add( sub, extw[ pos ] );
pos:= pos+2;
to:= to - nextexp;
nextexp:= AbsInt( extw[ pos ] );
od;
# Adjust the first exponent.
if not IsEmpty( sub ) then
sub[2]:= firstexp;
fi;
# Add the trailing pair.
if 0 < to then
Add( sub, extw[ pos-1 ] );
if extw[ pos ] < 0 then
Add( sub, -to );
else
Add( sub, to );
fi;
fi;
return ObjByExtRep( FamilyObj( w ), sub );
end );
#############################################################################
##
#M SubSyllables( <w>, <from>, <to> )
##
InstallMethod( SubSyllables,
"for associative word and two positions, using ext rep.",true,
[ IsAssocWord, IsPosInt, IsInt ], 0,
function( w, from, to )
local e;
e:=ExtRepOfObj(w);
if to<from or 2*from>Length(e) then
return One(w);
else
e:=e{[2*from-1..Minimum(Length(e),2*to)]};
return ObjByExtRep(FamilyObj(w),e);
fi;
end);
#############################################################################
##
#M PositionWord( <w>, <sub>, <from> )
##
InstallOtherMethod( PositionWord,"for two associative words,start at 1",
IsIdenticalObj,[IsAssocWord ,IsAssocWord], 0,
function( w, sub )
return PositionWord(w,sub,1);
end);
InstallMethod( PositionWord,
"for two associative words and a positive integer, using syllables",
IsFamFamX,[IsAssocWord and IsSyllableAssocWordRep,IsAssocWord,IsPosInt], 0,
function( w, sub, from )
local i,j,m,n,l,s,e,f,li,nomatch;
from:=from-1; # make skip number from `from'
i:=1; #syllableindex in w
j:=1; #syllableindex in sub
n:=NumberSyllables(w);
m:=NumberSyllables(sub);
# skip `from' letters
l:=from+1; # index in w
s:=0; # the number of generators to be skipped if a supposed match did
# not work.
while from>0 and i<=n do
e:=ExponentSyllable(w,i);
if AbsInt(e)<=from then
# skip a full syllable
from:=from-AbsInt(e);
i:=i+1;
else
f:=ExponentSyllable(sub,1);
# skip only part of syllable. Now the behavior will differ depending
# on whether sub could start here
if GeneratorSyllable(w,i)=GeneratorSyllable(sub,1)
and AbsInt(e)-from>=AbsInt(f)
and SignInt(e)=SignInt(f) then
# special treatment for len(sub)=1
if m=1 then
return l;
fi;
s:=AbsInt(f);
# offset to make the syllables end fit
l:=l+AbsInt(e)-from-s;
li:=i;
j:=2;
else
# sub cannot start here, just skip the full syllable
l:=l+AbsInt(e)-from;
j:=1;
fi;
i:=i+1;
from:=0; #break the loop
fi;
od;
while i<=n do
nomatch:=true;
e:=ExponentSyllable(w,i);
if GeneratorSyllable(w,i)=GeneratorSyllable(sub,j) then
f:=ExponentSyllable(sub,j);
if SignInt(e)=SignInt(f) and AbsInt(e)>=AbsInt(f) then
if j=m then
# we are at the end and it fits nicely
return l;
elif AbsInt(e)=AbsInt(f) then
# we are in the word, so the exponents must match perfectly
if j=1 then
# just start, set up a new possible match
li:=i;
s:=AbsInt(e);
fi;
j:=j+1;
nomatch:=false;
elif j=1 then
# now AbsInt(e)>AbsInt(f) but we are just at the start and may
# offset:
s:=AbsInt(f);
l:=l+AbsInt(e)-s;
li:=i;
j:=j+1;
nomatch:=false;
fi;
fi;
fi;
if nomatch then
j:=1;
if s=0 then
l:=l+AbsInt(e);
else
# there was a partial match, go one on
l:=l+s;
s:=0;
i:=li;
fi;
fi;
i:=i+1;
# do we have a chance of hitting?
if n-i<m-j then
# no, we would run out.
return fail;
fi;
od;
return fail;
end );
#############################################################################
##
#M SubstitutedWord( <w>, <from>, <to>, <by> )
##
InstallMethod( SubstitutedWord,
"for assoc. word, two positive integers, and assoc. word", true,
[ IsAssocWord, IsPosInt, IsPosInt, IsAssocWord ], 0,
function( w, from, to, by )
local lw;
lw:=Length(w);
# if from>to or from>|w| or to>|w| then this does not make sense
if from>to or from>lw or to>lw then
Error("illegal values for <from> and <to>");
fi;
# otherwise there are four possibilities
# first if from=1 and to=Length(w) then
if from=1 and to=lw then
return by;
# second if from=1 (and to<Length(w)) then
elif from=1 then
return by*Subword(w,to+1,lw);
# third if to=1 (and from>1) then
elif to=lw then
return Subword(w,1,from-1)*by;
fi;
# finally
return Subword(w,1,from-1)*by*Subword(w,to+1,lw);
end );
#############################################################################
##
#M SubstitutedWord(<u>,<v>,<k>,<z>)
##
## for a word u, a subword v of u, an integer i and a word z
##
## it substitutes the first occurrence of v in u, starting from
## position k, by z
##
InstallOtherMethod(SubstitutedWord,
"for three associative words",true,
[IsAssocWord, IsAssocWord, IsPosInt, IsAssocWord], 0,
function(u,v,k,z)
local i;
i := PositionWord(u,v,k);
# if i= fail then it means that v is not a subword of u after position k
if i= fail then
return fail;
fi;
return SubstitutedWord(u,i,i+Length(v)-1,z);
end);
#############################################################################
##
#M EliminatedWord( <word>, <gen>, <by> )
##
InstallMethod( EliminatedWord,
"for three associative words, using the external rep.",IsFamFamFam,
[ IsAssocWord, IsAssocWord, IsAssocWord ],0,
function( word, gen, by )
local e,l,i,j,app,s;
e:=ExtRepOfObj(word);
gen:=GeneratorSyllable(gen,1);
l:=[];
for i in [1,3..Length(e)-1] do
if e[i]=gen then
app:=ExtRepOfObj(by^e[i+1]);
else
app:=e{[i,i+1]};
fi;
j:=Length(l)-1;
while j>0 and Length(app)>0 and l[j]=app[1] do
s:=l[j+1]+app[2];
if s=0 then
j:=j-2;
else
l[j+1]:=s;
fi;
app:=app{[3..Length(app)]};
od;
if j+1<Length(l) then
l:=l{[1..j+1]};
fi;
if Length(app)>0 then
Append(l,app);
fi;
od;
return ObjByExtRep(FamilyObj(word),l);
end );
#############################################################################
##
#M RenumberedWord( <word>, <renumber> )
##
InstallMethod( RenumberedWord, "associative words in syllable rep", true,
[IsAssocWord and IsSyllableAssocWordRep, IsList], 0,
function( w, renumber )
local t, i;
t := TypeObj( w );
w := ShallowCopy(ExtRepOfObj( w ));
for i in [1,3..Length(w)-1] do
w[i] := renumber[ w[i] ];
od;
return AssocWord( t, w );
end );
#############################################################################
##
#M MappedWord( <x>, <gens1>, <gens2> )
##
## This method performs the obvious multiplications of image powers
## except if <gens1> and <gens2> are lists of associative words in the
## same family
## such that additionally no cancellation happens when replacing a
## generator power by the corresponding power of the image;
## this special treatment is restricted to the case that the words in
## the list <gens2> are powers of pairwise different generators in <gens1>.
## (Note that if a generator appears in <gens2> that has been left out
## from <gens1>, we may have cancellation.)
##
## In the case of the above special treatment, the external representation
## of the image word is constructed without multiplications.
##
BindGlobal( "MappedWordSyllableAssocWord", function( x, gens1, gens2 )
local i, mapped, exp,ex2,p,fameq,invimg,sel,elm;
x:= ExtRepOfObj( x );
# First handle the case of an identity element.
# This happens for monoid element objects.
if IsEmpty( x ) then
return gens2[1] ^ 0;
fi;
# are the genimages simple generators themselves?
if IsAssocWordWithInverseCollection( gens2 )
and ForAll(gens2,i->Length(i)=1) then
ex2:= List( gens2, ExtRepOfObj );
else
# not words, forget special treatment
ex2:=fail;
fi;
fameq:=FamilyObj(gens1[1])=FamilyObj(gens2[1]);
gens1:= List( gens1, ExtRepOfObj );
sel:=Filtered([1..Length(gens1)],i->Length(gens1[i])=2 and gens1[i][2]=1);
p:=Difference([1..Length(gens1)],sel);
if not ForAll( gens1{p},i -> Length( i ) = 2 and i[2] = -1 ) then
Error( "<gens1> must be proper generators or inverses" );
fi;
mapped:=gens2{p};
p:=gens1{p};
gens1:=gens1{sel};
gens2:=gens2{sel};
gens1:= List( gens1, x -> x[1] );
IsSSortedList(gens1);
if ex2 <> fail then
ex2:=ex2{sel};
# special treatment for words. No need to do inverses extra
exp:= List( ex2, i -> i[2] );
ex2:= List( ex2, i -> i[1] );
mapped:= [];
# to be quick, we need there are no duplications among the images:
if Length(ex2)=Length(Set(ex2)) and not fameq then
for i in [ 2, 4 .. Length( x ) ] do
p:= Position( gens1, x[ i-1 ] );
Add( mapped, ex2[p] );
Add( mapped, exp[p] * x[i] );
od;
else
for i in [ 2, 4 .. Length( x ) ] do
p:= Position( gens1, x[ i-1 ] );
if p = fail then
if fameq then
mapped:=ERepAssWorProd(mapped,[x[i-1],x[i]]);
else
Error("generator image not defined");
fi;
else
mapped:=ERepAssWorProd(mapped,[ex2[p],exp[p]*x[i]]);
fi;
od;
fi;
mapped:= ObjByExtRep( FamilyObj( gens2[1] ), mapped );
return mapped;
fi;
invimg:=List(gens1,x->fail);
if Length(p)>0 then
for i in [1..Length(p)] do
invimg[Position(gens1,p[i][1])]:=mapped[i];
od;
fi;
# the hard case
p:= Position( gens1, x[1] );
exp:=x[2];
elm:=gens2[p];
if exp<0 and p<>fail and invimg[p]<>fail then
exp:=-exp;
elm:=invimg[p];
fi;
if p = fail then
mapped:= ObjByExtRep( FamilyObj( gens2[1] ), [ x[1], x[2] ] );
else
mapped:= elm ^ exp;
fi;
for i in [ 4,6 .. Length( x ) ] do
exp:= x[ i ];
if exp <> 0 then
p:= Position( gens1, x[ i-1 ] );
elm:=gens2[p];
fi;
if exp<0 and p<>fail and invimg[p]<>fail then
exp:=-exp;
elm:=invimg[p];
fi;
if exp <> 0 then
if p = fail then
mapped:= mapped * ObjByExtRep( FamilyObj( gens2[1] ),
[ x[ i-1 ], x[i] ] );
else
mapped:= mapped * elm ^ exp;
fi;
fi;
od;
return mapped;
end );
InstallMethod( MappedWord,
"for a syllable assoc. word, a homogeneous list, and a list",IsElmsCollsX,
[ IsAssocWord and IsSyllableAssocWordRep, IsAssocWordCollection, IsList ],
MappedWordSyllableAssocWord );
#############################################################################
##
#B LengthOfLongestCommonPrefixOfTwoAssocWords(<a>,<b>)
##
## returns the length of the longest common prefix of two
## assoc words.
## This is here because will be used by both
## the BasicWreathProductOrdering and the
## WreathProductOrdering
BindGlobal("LengthOfLongestCommonPrefixOfTwoAssocWords",
function(a,b)
local l,i,ea,eb;
#it runs through the words until finding a different letter
#and returns the length of that common prefix (or zero)
l:=0;
# this is code which presumably has to be very fast. `Subword' is very
# slow. So better run over syllables. (ahulpke 4/17/00)
for i in [1..Minimum(NrSyllables(a),NrSyllables(b))] do
ea:=ExponentSyllable(a,i);
eb:=ExponentSyllable(b,i);
if GeneratorSyllable(a,i)<>GeneratorSyllable(b,i)
or SignInt(ea)<>SignInt(eb) then
return l;
elif ea<>eb then
# the minimum of the exponents (both have the same sign) is the
# largest common prefix.
return l+Minimum(ea,eb);
fi;
# now generators and exponents are the same
l:=l+ea;
od;
#here we know that the smallest word is a subword of the other
#Hence the smallest word is a prefix of the other
#and that the length is l
return l;
end);
# functions to read a presentation as written in print
# actual evaluation function
BindGlobal("PPVWCD",Immutable(Union(CHARS_DIGITS,"+-")));
BindGlobal("PPValWord",function(gens,nams,s)
local ValNum, DoValWord, w;
Info(InfoFpGroup,2,"Parse ",s);
ValNum:=function(p)
local w;
w:="";
while p<=Length(s) and s[p] in PPVWCD do
Add(w,s[p]);
p:=p+1;
od;
return [p,Int(w)];
end;
DoValWord:=function(start)
local w, eps, p, c, g, h;
#Print("DVV ",start," ",s,"\n");
w:=One(gens[1]);
eps:=1;
p:=start;
while p<=Length(s) do
#Print("Loop ",p,"\n");
c:=s[p];
if c in ",)]^*/" then
# separator -- stop local parsing
return [p,w];
elif c='(' then
# open parenthesis
g:=DoValWord(p+1);
p:=g[1];
if s[p]<>')' then
Error("missing )");
fi;
p:=p+1;
g:=g[2];
elif c='[' then
# commutator
g:=DoValWord(p+1);
p:=g[1];
if s[p]<>',' then
Error("missing ,");
fi;
h:=DoValWord(p+1);
p:=h[1];
if s[p]<>']' then
Error("missing ]");
fi;
p:=p+1;
g:=Comm(g[2],h[2]);
else
g:=PositionProperty(nams,i->i[1]=c);
if g=fail then
Error("missing generator ",[c]);
fi;
g:=gens[g];
p:=p+1;
fi;
if p<=Length(s) and s[p]='^' then
# exponentiation
p:=p+1;
if s[p] in "(" then
h:=DoValWord(p+1);
p:=h[1];
if s[p]<>')' then
Error("missing )");
fi;
p:=p+1;
g:=g^h[2];
elif s[p] in CHARS_LALPHA or s[p] in CHARS_UALPHA then
h:=PositionProperty(nams,i->i[1]=s[p]);
if h=fail then
if IsBoundGlobal(s{[p]}) and IsInt(ValueGlobal(s{[p]})) then;
h:=ValueGlobal(s{[p]});
Info(InfoWarning,1,"parsing non-generator`",s{[p]},
"' as global variable value ",h);
p:=p+1;
g:=g^h;
else
Error("missing generator `",s{[p]},"'");
fi;
else
h:=gens[h];
p:=p+1;
g:=g^h;
fi;
else
# should be number
h:=ValNum(p);
p:=h[1];
g:=g^h[2];
fi;
elif p<=Length(s) and s[p] in PPVWCD then
# should be number
h:=ValNum(p);
p:=h[1];
g:=g^h[2];
fi;
w:=w*g^eps;
eps:=1;
# product/quotient?
while p<=Length(s) and s[p]='*' do
p:=p+1;
od;
while p<=Length(s) and s[p]='.' do
p:=p+1;
od;
while p<=Length(s) and s[p]='/' do
p:=p+1;
eps:=-eps;
od;
od;
return [p,w];
end;
if s="1" then
return One(gens[1]);
fi;
w:=DoValWord(1);
return w[2];
end);
InstallGlobalFunction(ParseRelators,function(gens,r)
local invname, nams, rels, p, a, b, z, i,br;
invname:=function(s)
local w, i;
w:="";
for i in s do
if i in CHARS_UALPHA then
Add(w,CHARS_LALPHA[Position(CHARS_UALPHA,i)]);
elif i in CHARS_LALPHA then
Add(w,CHARS_UALPHA[Position(CHARS_LALPHA,i)]);
else
Add(w,i);
fi;
od;
return w;
end;
if IsGroup(gens) then
gens:=GeneratorsOfGroup(gens);
fi;
gens:=ShallowCopy(gens);
nams:=List(gens,String);
if ForAny(nams,x->Length(x)>1) then
Error("generator names must have length 1");
fi;
Append(gens,List(gens,i->i^-1));
Append(nams,List(nams,invname));
SortParallel(nams,gens);
rels:=[];
while Length(r)>0 do
p:=1;
br:=0;
a:=false;
while p<=Length(r) do
if r[p]='[' then
br:=br+1;
elif r[p]=']' then
br:=br-1;
elif r[p]=',' and br=0 then
a:=r{[1..p-1]};
r:=r{[p+1..Length(r)]};
p:=Length(r)+1;
fi;
p:=p+1;
od;
if a=false then
a:=r;
r:="";
fi;
# remove fill
a:=Filtered(a,x->not x in "\n ");
# now check a -- does it contain equal signs?
b:=SplitString(a,"=");
if Length(b)=1 then
Add(rels,PPValWord(gens,nams,b[1]));
else
SortBy(b, Length);
z:=PPValWord(gens,nams,b[1]);
for i in [2..Length(b)] do
Add(rels,PPValWord(gens,nams,b[i])/z);
od;
fi;
od;
return rels;
end);
InstallGlobalFunction(StringFactorizationWord,function(word)
local wu, l, n, no, translate, findpatterns, nams, invnams, r, wordout, j;
wu:=UnderlyingElement(word);
l:=LetterRepAssocWord(wu);
if Length(l)=0 then
return "<identity>";
fi;
n:=Maximum(1,Maximum(l)+1);
no:=n;
translate:=[];
findpatterns:=function(l)
local p, c, notfound, jm, j, r, lr, z, a;
p:=1;
while p<Length(l) do
c:=l[p];
# does a repetitive phrase start?
notfound:=true;
jm:=p+QuoInt((Length(l)-p+1),2);
j:=p+1;
while j<=jm and notfound do
if l[j]=c and l{[p..j-1]}=l{[j..2*j-p-1]} then
notfound:=false;
else
j:=j+1;
fi;
od;
if not notfound then
# repetition found, define it as macro
r:=l{[p..j-1]};
lr:=j-p;
z:=1; # number of extras
while p+(z+1)*lr-1<=Length(l) and r=l{[p+z*lr..p+(z+1)*lr-1]} do
z:=z+1;
od;
z:=z-1;
# does `r' have any internal repetition?
r:=findpatterns(r);
a:=Position(translate,[r,z]);
if a=fail then
a:=n;
translate[n]:=[r,z];
n:=n+1;
fi;
# replace the word
l:=Concatenation(l{[1..p-1]},[a],l{[j+(z)*lr..Length(l)]});
fi;
p:=p+1;
od;
return l;
end;
l:=findpatterns(l);
# write out the word
nams:=FamilyObj(wu)!.names;
invnams:=[];
for j in nams do
r:=ShallowCopy(j);
if j[1] in CHARS_LALPHA then
r[1]:=CHARS_UALPHA[Position(CHARS_LALPHA,j[1])];
elif j[1] in CHARS_UALPHA then
r[1]:=CHARS_LALPHA[Position(CHARS_UALPHA,j[1])];
else
Error("name does not start with letter");
fi;
Add(invnams,r);
od;
r:="";
wordout:=function(k)
local i;
if k>=no then
if Length(translate[k][1])=1 and
translate[k][1][1]<no then
# original generator
wordout(translate[k][1][1]);
else
# translated
Add(r,'(');
for i in translate[k][1] do
wordout(i);
od;
Add(r,')');
fi;
Append(r,String(translate[k][2]+1));
elif k<1 then
Append(r,invnams[-k]);
else
Append(r,nams[k]);
fi;
end;
for j in l do
wordout(j);
od;
return r;
end);
[ Dauer der Verarbeitung: 0.8 Sekunden
(vorverarbeitet)
]
|
