|
#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include 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 methods for associative words in letter
## representation
InstallMethod(AssocWordByLetterRep, "W letter words family", true,
[ IsWLetterWordsFamily, IsHomogeneousList ], 0,
function( F, l )
return Objectify(F!.letterWordType,[Immutable(l)]);
end);
InstallMethod(AssocWordByLetterRep, "B letter words family", true,
[ IsBLetterWordsFamily, IsHomogeneousList ], 0,
function( F, l )
return Objectify(F!.letterWordType,[Immutable(STRING_SINTLIST(l))]);
end);
InstallOtherMethod(AssocWordByLetterRep, "letter words family", true,
[ IsLetterWordsFamily, IsHomogeneousList, IsHomogeneousList ], 0,
function( F, l,gens )
local t,n,i,nl;
n:=Length(gens);
t:=[];
for i in [1..n] do
t[i]:=GeneratorSyllable(gens[i],1);
od;
if n>0 and (not IsRange(t) or t[1]<>1 or t[n]<>n) then
# translate
nl:=[];
for i in l do
if i<0 then Add(nl,-t[-i]);
else Add(nl,t[i]);
fi;
od;
l:=nl;
MakeImmutable(l);
fi;
return AssocWordByLetterRep(F,l);
end);
InstallMethod(LetterRepAssocWord,"W letter rep",true,
[IsWLetterAssocWordRep],0,w->w![1]);
InstallMethod(LetterRepAssocWord,"B letter rep",true,
[IsBLetterAssocWordRep],0,w->INTLIST_STRING(w![1],-1));
InstallOtherMethod(LetterRepAssocWord,"letter rep,gens",
true, #TODO: This should be IsElmsColls once the tietze code is fixed.
[IsLetterAssocWordRep,IsHomogeneousList],0,
function(w,gens)
local n,t,i,l;
t:=[];
n:=Length(gens);
for i in [1..n] do
t[GeneratorSyllable(gens[i],1)]:=i;
od;
if not IsRange(t) or t[1]<>1 or t[n]<>n then
l:=[];
for i in LetterRepAssocWord(w) do
if i<0 then Add(l,-t[-i]);
else Add(l,t[i]);
fi;
od;
MakeImmutable(l);
return l;
fi;
return LetterRepAssocWord(w);
end);
# Earlier, seemingly slower method:
# InstallMethod( ObjByExtRep, "letter rep family", true,
# [ IsAssocWordFamily and IsLetterWordsFamily, IsHomogeneousList ], 0,
# function( F, e )
# local n,i,l,g;
# l:=[];
# for i in [1,3..Length(e)-1] do
# g:=e[i];
# n:=e[i+1];
# if n<0 then
# g:=-g;
# n:=-n;
# fi;
# Append(l,ListWithIdenticalEntries(n,g));
# od;
# return AssocWordByLetterRep(F,l);
# end);
InstallMethod( ObjByExtRep, "letter rep family", true,
[ IsAssocWordFamily and IsLetterWordsFamily, IsHomogeneousList ], 0,
function( F, e )
local n,i,l,g;
l:=AssocWordByLetterRep(F,[]);
for i in [1,3..Length(e)-1] do
g:=e[i];
n:=e[i+1];
if n<0 then
g:=-g;
n:=-n;
fi;
l := l * AssocWordByLetterRep(F,[g])^n;
od;
return l;
end);
InstallOtherMethod( ObjByExtRep, "letter rep family,integers (ignored)", true,
[IsAssocWordFamily and IsLetterWordsFamily,IsInt,IsInt,IsHomogeneousList],0,
function( F, a,b,e )
return ObjByExtRep(F,e);
end);
#############################################################################
##
#M ExtRepOfObj(<wor> )
##
## We cache the last three external representations. Thus we can use them
## also for syllable access.
LETTER_WORD_EREP_CACHE:=[1,1,1]; # initialization with dummys
LETTER_WORD_EREP_CACHEVAL:=[1,1,1]; # initialization with dummys
LETTER_WORD_EREP_CACHEPOS:=1;
if IsHPCGAP then
MakeThreadLocal( "LETTER_WORD_EREP_CACHE" );
MakeThreadLocal( "LETTER_WORD_EREP_CACHEVAL" );
MakeThreadLocal( "LETTER_WORD_EREP_CACHEPOS" );
fi;
BindGlobal("ERepLettWord",function(w)
local i,r,elm,len,g,h,e;
for i in [1..3] do
if IsIdenticalObj(LETTER_WORD_EREP_CACHE[i],w) then
return LETTER_WORD_EREP_CACHEVAL[i];
fi;
od;
r:=[];
elm:=LetterRepAssocWord(w);
len:= Length( elm );
if len=0 then
return r;
fi;
i:= 2;
g:=AbsInt(elm[1]);
e:=SignInt(elm[1]);
while i <= len do
h:=AbsInt(elm[i]);
if h=g then
e:=e+SignInt(elm[i]);
else
Add(r,g);
Add(r,e);
g:=h;
e:=SignInt(elm[i]);
fi;
i:=i+1;
od;
Add(r,g);
Add(r,e);
LETTER_WORD_EREP_CACHE[LETTER_WORD_EREP_CACHEPOS]:=w;
LETTER_WORD_EREP_CACHEVAL[LETTER_WORD_EREP_CACHEPOS]:=MakeImmutable(r);
LETTER_WORD_EREP_CACHEPOS:=(LETTER_WORD_EREP_CACHEPOS mod 3)+1;
return r;
end);
InstallMethod(ExtRepOfObj,"assoc word in letter rep",true,
[IsAssocWord and IsLetterAssocWordRep],0,x->ShallowCopy(ERepLettWord(x)));
InstallMethod(NumberSyllables,"assoc word in letter rep",true,
[IsAssocWord and IsLetterAssocWordRep],0,
w->Length(ERepLettWord(w))/2);
InstallMethod(GeneratorSyllable,"assoc word in W letter rep",true,
[IsAssocWord and IsWLetterAssocWordRep,IsPosInt],0,
function(w,n)
if n=1 then return AbsInt(w![1][1]);fi;
return ERepLettWord(w)[2*n-1];
end);
InstallMethod(GeneratorSyllable,"assoc word in B letter rep",true,
[IsAssocWord and IsBLetterAssocWordRep,IsPosInt],0,
function(w,n)
if n=1 then return AbsInt(SINT_CHAR(w![1][1]));fi;
return ERepLettWord(w)[2*n-1];
end);
InstallMethod(ExponentSyllable,"assoc word in letter rep",true,
[IsAssocWord and IsLetterAssocWordRep,IsPosInt],0,
function(w,n)
return ERepLettWord(w)[2*n];
end);
#############################################################################
##
#M ExponentSumWord( <w>, <gen> )
##
InstallMethod( ExponentSumWord, "letter rep as.word, gen", IsIdenticalObj,
[ IsAssocWord and IsLetterAssocWordRep, IsAssocWord ], 0,
function( w, gen )
local n, g, i;
w:= LetterRepAssocWord( w );
gen:= LetterRepAssocWord( gen );
if Length( gen ) <> 1 then
Error( "<gen> must be a generator" );
fi;
n:= 0;
g:= AbsInt(gen[1]);
for i in w do
if i=g then
n:=n+1;
elif
i=-g then
n:=n-1;
fi;
od;
if gen[1] < 0 then
n:= -n;
fi;
return n;
end );
InstallMethod(ExponentSums,"assoc word in letter rep",true,
[IsAssocWord and IsLetterAssocWordRep],0,
function(w)
local e,i;
e:=ListWithIdenticalEntries(Length(FamilyObj(w)!.names),0);
for i in LetterRepAssocWord(w) do
if i>0 then e[i]:=e[i]+1;
else e[-i]:=e[-i]-1;
fi;
od;
return e;
end);
InstallOtherMethod(ExponentSums,"assoc word in letter rep,ints",true,
[IsAssocWord and IsLetterAssocWordRep,IsInt,IsInt],0,
function(w,from,to)
local e,i;
if from < 2 then from:= 1; else from:= 2 * from - 1; fi;
e:=ListWithIdenticalEntries(Length(FamilyObj(w)!.names),0);
w:=ERepLettWord(w);
to:= 2 * to - 1;
if to>Length(w) then
to:=Length(w)-1;
fi;
for i in [ from, from + 2 .. to ] do
e[ w[i] ]:= e[ w[i] ] + w[ i+1 ];
od;
return e;
end);
InstallMethod(Length,"assoc word in letter rep",true,
[IsAssocWord and IsLetterAssocWordRep],0,
e->Length(e![1]));
InstallMethod(OneOp,"assoc word in W letter rep",true,
[IsAssocWord and IsWLetterAssocWordRep and IsMultiplicativeElementWithOne],0,
e->Objectify(FamilyObj(e)!.letterWordType,[Immutable([])]));
InstallMethod(OneOp,"assoc word in B letter rep",true,
[IsAssocWord and IsBLetterAssocWordRep and IsMultiplicativeElementWithOne],0,
e->Objectify(FamilyObj(e)!.letterWordType,[Immutable("")]));
InstallMethod(InverseOp,"assoc word in W letter rep",true,
[ IsAssocWord and IsWLetterAssocWordRep and
IsMultiplicativeElementWithInverse],0,
function(a)
local l,e;
e:=a![1];
l:=Length(e);
return Objectify(FamilyObj(a)!.letterWordType,
# invert and revert
[-Immutable(e{[l,l-1..1]})]);
end);
InstallMethod(InverseOp,"assoc word in B letter rep",true,
[ IsAssocWord and IsBLetterAssocWordRep and
IsMultiplicativeElementWithInverse],0,
function(a)
local e;
e:=REVNEG_STRING(a![1]);
MakeImmutable(e);
return Objectify(FamilyObj(a)!.letterWordType,[e]);
end);
InstallMethod(PrintObj,"assoc word in letter rep",true,
[IsAssocWord and IsLetterAssocWordRep],0,
function(elm)
Print(NiceStringAssocWord(elm));
end);
# operations for two associative words
InstallMethod(\=,"assoc words in letter rep",IsIdenticalObj,
[IsAssocWord and IsLetterAssocWordRep,
IsAssocWord and IsLetterAssocWordRep],0,
function(a,b)
return a![1]=b![1];
end);
InstallMethod(\<,"assoc words in letter rep",IsIdenticalObj,
[IsAssocWord and IsLetterAssocWordRep,
IsAssocWord and IsLetterAssocWordRep],0,
function(a,b)
local l,m,p,q,i;
a:=LetterRepAssocWord(a);
b:=LetterRepAssocWord(b);
l:=Length(a);
m:=Length(b);
# implement lenlex order
if l<m then
return true;
elif l>m then
return false;
fi;
for i in [1..l] do
p:=AbsInt(a[i]);
q:=AbsInt(b[i]);
if p<q then
return true;
elif p>q then
return false;
elif a[i]<b[i] then
return true;
elif a[i]>b[i] then
return false;
fi;
od;
return false;
end);
# operations for two associative words
InstallMethod(\*,"assoc words in W letter rep",IsIdenticalObj,
[IsAssocWord and IsWLetterAssocWordRep,
IsAssocWord and IsWLetterAssocWordRep],0,
function(a,b)
local fam;
fam:=FamilyObj(a);
a:=a![1];
b:=b![1];
# call the kernel multiplication routine
a:=MULT_WOR_LETTREP(a,b);
if a=false then
return One(fam);
else
MakeImmutable(a);
return Objectify(fam!.letterWordType,[a]);
fi;
end);
# operations for two associative words
InstallMethod(\*,"assoc words in B letter rep",IsIdenticalObj,
[IsAssocWord and IsBLetterAssocWordRep,
IsAssocWord and IsBLetterAssocWordRep],0,
function(a,b)
local fam;
fam:=FamilyObj(a);
a:=a![1];
b:=b![1];
# call the kernel multiplication routine
a:=MULT_BYT_LETTREP(a,b);
if a=false then
return One(fam);
else
MakeImmutable(a);
return Objectify(fam!.letterWordType,[a]);
fi;
end);
# power: exponent must be not equal zero.
BindGlobal( "AssocWWorLetRepPow", function(w,e)
local fam,a,l,i,j,mp,pt,head,tail,mid;
fam:=FamilyObj(w);
a:=w![1];
l:=Length(a);
if e=1 or l=0 then
return w;
elif e=-1 then
return Inverse(w);
# now e is guaranteed to be at least two
elif e<0 then
a:=-a{[l,l-1..1]};
e:=-e;
fi;
# find overlap of word with itself
i:=1;
j:=l;
while i<=j and a[i]=-a[j] do
i:=i+1;
j:=j-1;
od;
if i>j then
Error("self-overlap over length half cannot happen");
fi;
head:=a{[1..j]};
tail:=a{[i..l]};
if e>2 then
# get the middle part
mid:=a{[i..j]};
# repeat it e-2 times
e:=e-1;
l:=LogInt(e,2)+1;
mp:=[mid];
pt:=1;
for i in [2..l] do
pt:=pt*2;
mp[i]:=Concatenation(mp[i-1],mp[i-1]);
od;
mid:=[];
for i in [l,l-1..1] do
if e>pt then
e:=e-pt;
Append(mid,mp[i]);
fi;
pt:=QuoInt(pt,2);
od;
a:=Concatenation(head,mid,tail);
else
a:=Concatenation(head,tail);
fi;
MakeImmutable(a);
return Objectify(fam!.letterWordType,[a]);
end );
InstallMethod(\^,"assoc word in W letter rep and positive integer",true,
[IsAssocWord and IsWLetterAssocWordRep,IsPosInt],0,AssocWWorLetRepPow);
InstallMethod(\^,"assoc word in W letter rep and negative integer",true,
[IsAssocWord and IsWLetterAssocWordRep,IsNegRat and IsInt],0,
AssocWWorLetRepPow);
# power: exponent must be not equal zero.
BindGlobal( "AssocBWorLetRepPow", function(w,e)
local fam,a,l,i,j,mp,pt,head,tail,mid;
fam:=FamilyObj(w);
a:=w![1];
l:=Length(a);
if e=1 or l=0 then
return w;
elif e=-1 then
return Inverse(w);
# now e is guaranteed to be at least two
elif e<0 then
a:=REVNEG_STRING(a);
e:=-e;
fi;
# find overlap of word with itself
i:=1;
j:=l;
while i<=j and SINT_CHAR(a[i])=-SINT_CHAR(a[j]) do
i:=i+1;
j:=j-1;
od;
if i>j then
Error("self-overlap over length half cannot happen");
fi;
head:=a{[1..j]};
tail:=a{[i..l]};
if e>2 then
# get the middle part
mid:=a{[i..j]};
# repeat it e-2 times
e:=e-1;
l:=LogInt(e,2)+1;
mp:=[mid];
pt:=1;
for i in [2..l] do
pt:=pt*2;
mp[i]:=Concatenation(mp[i-1],mp[i-1]);
od;
mid:="";
for i in [l,l-1..1] do
if e>pt then
e:=e-pt;
mid:=Concatenation(mid,mp[i]);
fi;
pt:=QuoInt(pt,2);
od;
a:=Concatenation(head,mid,tail);
else
a:=Concatenation(head,tail);
fi;
MakeImmutable(a);
return Objectify(fam!.letterWordType,[a]);
end );
InstallMethod(\^,"assoc word in B letter rep and positive integer",true,
[IsAssocWord and IsBLetterAssocWordRep,IsPosInt],0,AssocBWorLetRepPow);
InstallMethod(\^,"assoc word in B letter rep and negative integer",true,
[IsAssocWord and IsBLetterAssocWordRep,IsNegRat and IsInt],0,
AssocBWorLetRepPow);
#############################################################################
##
#M ReversedOp( <word> )
##
InstallOtherMethod( ReversedOp, "for an assoc. word in letter rep", true,
[ IsAssocWord and IsLetterAssocWordRep], 0,
function( word )
local l;
l:=Reversed(word![1]);
MakeImmutable(l);
return Objectify(FamilyObj(word)!.letterWordType,[l]);
end );
#############################################################################
##
#M Subword( <w>, <from>, <to> )
##
InstallOtherMethod( Subword,"for letter associative word and two positions",
true, [ IsAssocWord and IsLetterAssocWordRep, IsPosInt, IsInt ], 0,
function( w, from, to )
local l;
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;
l:=w![1]{[from..to]};
MakeImmutable(l);
return Objectify(FamilyObj(w)!.letterWordType,[l]);
end);
#############################################################################
##
#M PositionWord( <w>, <sub>, <from> )
##
InstallMethod( PositionWord,
"for two associative words and a positive integer, using letters",
IsFamFamX,[IsAssocWord and IsLetterAssocWordRep,IsAssocWord,IsPosInt],0,
function( w, sub, from )
# the from index is handled differently between PositionWord and
# PositionSublist!
return PositionSublist(w![1],sub![1],from-1);
end);
#TODO: EliminatedWord method (but its nowhere used, so low priority
#############################################################################
##
#M RenumberedWord( <word>, <renumber> )
##
InstallMethod( RenumberedWord, "associative words in letter rep", true,
[IsAssocWord and IsLetterAssocWordRep, IsList], 0,
function( w, renumber )
local f, i;
f := FamilyObj(w);
w := ShallowCopy(LetterRepAssocWord(w));
for i in [1..Length(w)-1] do
if w[i]<0 then
w[i] := -renumber[ -w[i] ];
else
w[i] := renumber[ w[i] ];
fi;
od;
return AssocWordByLetterRep(f,w);
end );
#############################################################################
##
#M MappedWord( <x>, <gens1>, <gens2> )
##
InstallMethod( MappedWord,
"for a letter assoc. word, a homogeneous list, and a list",IsElmsCollsX,
[ IsAssocWord and IsLetterAssocWordRep, IsAssocWordCollection, IsList ],
function( x, gens1, gens2 )
local i,l,fam,e,m,mm,p,inv;
if IsEmpty( gens1) then
return x;
elif Length( x )=0 then
return gens2[1] ^ 0;
fi;
fam:=FamilyObj(x);
x:=LetterRepAssocWord(x);
l:=Length(x);
gens1:= List( gens1, LetterRepAssocWord );
if not ForAll( gens1, i -> Length( i ) = 1 ) then
Error( "<gens1> must be proper generators or inverses" );
fi;
gens1:= List( gens1, i -> i[1] );
IsSSortedList(gens1);
# are the genimages simple generators themselves?
if IsAssocWordWithInverseCollection(gens2)
and ForAll(gens2,i->Length(i)=1 and not IsStraightLineProgElm(i)) then
e:= List( gens2, i->LetterRepAssocWord(i)[1] );
if Length(e)=Length(Set(e,AbsInt)) then
# all images are different, no overlap. Try to form the image word
# directly
m:=ShallowCopy(x);
i:=1;
while i<=l and IsList(m) do
p:=Position(gens1,AbsInt(m[i]));
if p=fail then
m:=fail; # extra generators in word -- could be overlap, dangerous
else
m[i]:=e[p]*SignInt(m[i]);
fi;
i:=i+1;
od;
# all worked?
if IsList(m) then
return AssocWordByLetterRep(FamilyObj(gens2[1]),m);
fi;
#no -- go the long way
fi;
fi;
# List of given, or computed, inverses
inv:=[];
for i in [1..Length(gens1)] do
p:=Position(gens1,-gens1[i]);
if p<>fail then
inv[i]:=gens2[p];
elif gens1[i]>0 then
if x[1]=-gens1[i] or Number(x,j->j=-gens1[i])>1 then
# if it is a generator and its inverse occurs at least twice,
# or its inverse occurs in the first position, then
# (pre)-compute the inverse (otherwise just rely on the / operator
# which can be slightly faster than inverse+product)
inv[i]:=Inverse(gens2[i]);
fi;
fi;
od;
m:=fail;
for i in [1..Length(x)] do
p:= Position(gens1,x[i]);
if p<>fail then
mm:=gens2[p];
elif x[i]<0 then
# was the inverse give/precomputed
p:= Position(gens1,-x[i]);
if p=fail then
# unmapped letter gen
mm:=AssocWordByLetterRep(fam,[x[i]]);
elif IsBound(inv[p]) then
mm:=inv[p];
else
mm:=fail; # to flag that division will happen
fi;
else
# unmapped letter gen
mm:=AssocWordByLetterRep(fam,[x[i]]);
fi;
if m=fail then
m:=mm;
elif mm<>fail then
m:=m*mm;
else
m:=m/gens2[p];
fi;
od;
return m;
end );
[ Dauer der Verarbeitung: 0.29 Sekunden
(vorverarbeitet)
]
|
