|
#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Frank Celler.
##
## 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 the methods for groups defined by a polycyclic
## collector.
##
#############################################################################
##
#M IsConfluent( <pc-group> )
##
InstallOtherMethod( IsConfluent,
"for pc group",
true,
[ IsPcGroup ],
0,
function( g )
local gens, fam, exps, R, R1, k, gk, j, gj, i, gi, r;
gens := GeneratorsOfGroup(g);
fam := ElementsFamily(FamilyObj(g));
exps := fam!.rewritingSystem![SCP_RELATIVE_ORDERS];
# be verbose for debugging
Info( InfoTiming + InfoConfluence, 2,
"'IsConfluent' starting part 1" );
R := Runtime(); R1 := R;
# Consistency relations: gk * ( gj * gi ) = ( gk * gj ) * gi
for k in [ 1 .. Length(gens) ] do
gk := gens[k];
for j in [ 1 .. k-1 ] do
gj := gens[j];
for i in [ 1 .. j-1 ] do
gi := gens[i];
r := [ gk * ( gj * gi ), ( gk * gj ) * gi ];
if r[1] <> r[2] then
return false;
fi;
od;
od;
od;
# be verbose for debugging
Info( InfoTiming + InfoConfluence, 2,
"'IsConfluent' part 1 took ", Runtime()-R, " ms, ",
"starting part 2" );
R := Runtime();
# Consistency relations: gj^ej-1 * ( gj * gi ) = ( gj^ej-1 * gj ) * gi
for j in [ 1 .. Length(gens) ] do
gj := gens[j];
for i in [ 1 .. j-1 ] do
gi := gens[i];
r := [ gj^(exps[j]-1)*(gj*gi), (gj^(exps[j]-1)*gj)*gi ];
if r[1] <> r[2] then
return false;
fi;
od;
od;
# be verbose for debugging
Info( InfoTiming + InfoConfluence, 2,
"'IsConfluent' part 2 took ", Runtime()-R, " ms, ",
"'IsConfluent' starting part 3" );
R := Runtime();
# Consistency relations: gj * ( gi^ei-1 * gi ) = ( gj * gi^ei-1 ) * gi
for j in [ 1 .. Length( gens ) ] do
gj := gens[j];
for i in [ 1 .. j-1 ] do
gi := gens[i];
r := [ gj*(gi^(exps[i]-1)*gi), (gj*gi^(exps[i]-1))*gi ];
if r[1] <> r[2] then
return false;
fi;
od;
od;
# be verbose for debugging
Info( InfoTiming + InfoConfluence, 2,
"'IsConfluent' part 3 took ", Runtime()-R, " ms, ",
"'IsConfluent' starting part 4" );
R := Runtime();
# Consistency relations: gi * ( gi^ei-1 * gi ) = ( gi * gi^ei-1 ) * gi
for i in [ 1 .. Length(gens) ] do
gi := gens[ i ];
r := [ gi*(gi^(exps[i]-1)*gi), (gi*gi^(exps[i]-1))*gi ];
if r[1] <> r[2] then
return false;
fi;
od;
Info( InfoTiming + InfoConfluence, 2,
"'IsConfluent' part 4 took, ", Runtime()-R, " ms" );
Info( InfoTiming + InfoConfluence, 1,
"'IsConfluent' took ", Runtime()-R1, " ms" );
# Report if one check failed and <all> was set.
return true;
end );
#############################################################################
##
#M MultiplicativeElementsWithInversesFamilyByRws( <rws> )
##
InstallMethod( MultiplicativeElementsWithInversesFamilyByRws,
"generic method",
true,
[ IsPolycyclicCollector ],
0,
function( rws )
local fam, pcs, implied;
implied:=IsObject;
# not sure whether this would work: Has the rewriting system the relative
# Orders component? (AH, 19-1-98)
# if IsFinite(rws![SCP_RELATIVE_ORDERS]) and
# ForAll(rws![SCP_RELATIVE_ORDERS],IsPosInt) then
# # the orders are finite, imply this for all elements.
# implied:=implied and IsElementFinitePolycyclicGroup;
# fi;
# create a new family in the category <IsElementsFamilyByRws>
fam := NewFamily(
"MultiplicativeElementsWithInversesFamilyByPolycyclicCollector(...)",
IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsAssociativeElement,
CanEasilySortElements and implied,
CanEasilySortElements and IsElementsFamilyByRws );
# create the default type for the elements
fam!.defaultType := NewType( fam, IsPackedElementDefaultRep );
# store the identity
SetOne( fam, ElementByRws( fam, ReducedOne(rws) ) );
# store the rewriting system
UpdatePolycyclicCollector(rws);
fam!.rewritingSystem := Immutable(rws);
# this family has a defining pcgs
pcs := List( GeneratorsOfRws(rws), x -> ElementByRws(fam,x) );
SetDefiningPcgs( fam, PcgsByPcSequenceNC( fam, pcs ) );
# that's it
return fam;
end );
#############################################################################
##
#R IsNBitsPcWordRep
##
DeclareRepresentation(
"IsNBitsPcWordRep",
IsDataObjectRep, [] );
#############################################################################
##
#M PrintObj( <IsNBitsPcWordRep> )
##
InstallMethod( PrintObj,"pcword", true,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep ],
0,
function( obj )
local names, word, len, i;
names := TypeObj(obj)![PCWP_NAMES];
word := ExtRepOfObj(obj);
len := Length(word) - 1;
if len < 0 then
Print( "<identity> of ..." );
else
i := 1;
while i < len do
Print( names[ word[i] ] );
if word[i+1] <> 1 then
Print( "^", word[i+1] );
fi;
Print( "*" );
i := i+2;
od;
Print( names[word[i]] );
if word[i+1] <> 1 then
Print( "^", word[ i+1 ] );
fi;
fi;
end );
#############################################################################
##
#M String( <IsNBitsPcWordRep> )
##
InstallMethod( String,"pcword",true,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep ], 0,
function( obj )
local names, word, len, i,s;
names := TypeObj(obj)![PCWP_NAMES];
word := ExtRepOfObj(obj);
len := Length(word) - 1;
if len < 0 then
return "<identity> of ...";
else
s:="";
i := 1;
while i < len do
Append(s,names[ word[i] ]);
if word[i+1] <> 1 then
Add(s,'^');
Append(s, String(word[i+1]) );
fi;
Add(s,'*');
i := i+2;
od;
Append(s,names[word[i]] );
if word[i+1] <> 1 then
Add(s,'^');
Append(s,String(word[ i+1 ]));
fi;
fi;
return s;
end );
#############################################################################
##
#M InverseOp( <IsNBitsPcWordRep> )
##
InstallMethod( InverseOp,
"generic method for n bits pc word rep",
true,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep ],
0,
function( obj )
return FinPowConjCol_ReducedPowerSmallInt(
TypeObj(obj)![PCWP_COLLECTOR], obj, -1 );
end );
#############################################################################
##
#M Comm( <IsNBitsPcWordRep>, <IsNBitsPcWordRep> )
##
InstallMethod( Comm,
"generic method for n bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep ],
0,
function( left, right )
return FinPowConjCol_ReducedComm( TypeObj(left)![PCWP_COLLECTOR], left, right );
end );
#############################################################################
##
#M LeftQuotient( <IsNBitsPcWordRep>, <IsNBitsPcWordRep> )
##
InstallMethod( LeftQuotient,
"generic method for n bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep ],
0,
function( left, right )
return FinPowConjCol_ReducedLeftQuotient( TypeObj(left)![PCWP_COLLECTOR], left, right );
end );
#############################################################################
##
#M <IsNBitsPcWordRep> / <IsNBitsPcWordRep>
##
InstallMethod( \/,
"generic method for n bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep ],
0,
function( left, right )
return FinPowConjCol_ReducedQuotient( TypeObj(left)![PCWP_COLLECTOR], left, right );
end );
#############################################################################
##
#M <IsNBitsPcWordRep> * <IsNBitsPcWordRep>
##
InstallMethod( \*,
"generic method for n bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep ],
0,
function( left, right )
return FinPowConjCol_ReducedProduct( TypeObj(left)![PCWP_COLLECTOR], left, right );
end );
#############################################################################
##
#M <IsNBitsPcWordRep> ^ <IsNBitsPcWordRep>
##
InstallMethod( \^,
"generic method for n bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep ],
0,
function( left, right )
left := FinPowConjCol_ReducedProduct(
TypeObj(left)![PCWP_COLLECTOR], left, right );
return FinPowConjCol_ReducedLeftQuotient(
TypeObj(left)![PCWP_COLLECTOR], right, left );
end );
#############################################################################
##
#M <IsNBitsPcWordRep> ^ <small-int>
##
InstallMethod( \^,
"generic method for n bits pc word rep and small int",
true,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsNBitsPcWordRep,
IsInt and IsSmallIntRep ],
0,
function( left, right )
return FinPowConjCol_ReducedPowerSmallInt(
TypeObj(left)![PCWP_COLLECTOR], left, right );
end );
#############################################################################
##
#R Is8BitsPcWordRep
##
DeclareRepresentation(
"Is8BitsPcWordRep",
IsNBitsPcWordRep and IsKernelPcWord, [] );
#############################################################################
##
#M MultiplicativeElementsWithInversesFamilyByRws( <8bits-sc> )
##
InstallMethod( MultiplicativeElementsWithInversesFamilyByRws,
"8 bits family",
true,
[ IsPolycyclicCollector and IsFinite and Is8BitsSingleCollectorRep
and IsDefaultRhsTypeSingleCollector
and IsUpToDatePolycyclicCollector ],
0,
function( sc )
local fam, i, pcs, implied;
implied:=IsObject;
if IsFinite(sc![SCP_RELATIVE_ORDERS]) and
ForAll(sc![SCP_RELATIVE_ORDERS],IsPosInt) then
# the orders are finite, imply this for all elements.
implied:=implied and IsElementFinitePolycyclicGroup;
fi;
# create a new family in the category <IsElementsFamilyByRws>
fam := NewFamily(
"MultiplicativeElementsWithInversesFamilyBy8BitsSingleCollector(...)",
IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsAssociativeElement,
CanEasilySortElements and implied,
CanEasilySortElements and IsElementsFamilyBy8BitsSingleCollector);
# store the rewriting system
fam!.rewritingSystem := Immutable(sc);
# create the default type for the elements
fam!.defaultType := NewType( fam, IsPackedElementDefaultRep );
# create the special 8 bits type
fam!.8BitsType := NewType( fam, Is8BitsPcWordRep );
# copy the assoc word type
for i in [ AWP_FIRST_ENTRY+1 .. AWP_LAST_ENTRY ] do
fam!.8BitsType![i] := sc![SCP_DEFAULT_TYPE]![i];
od;
# default type to use
fam!.8BitsType![AWP_PURE_TYPE] := fam!.8BitsType;
# store the names
fam!.8BitsType![PCWP_NAMES] := FamilyObj(ReducedOne(sc))!.names;
# force the single collector to return elements of that type
sc := ShallowCopy(sc);
sc![SCP_DEFAULT_TYPE] := fam!.8BitsType;
fam!.8BitsType![PCWP_COLLECTOR] := sc;
# store the identity
SetOne( fam, ElementByRws( fam, ReducedOne(fam!.rewritingSystem) ) );
# this family has a defining pcgs
pcs := List( GeneratorsOfRws(sc), x -> ElementByRws(fam,x) );
SetDefiningPcgs( fam, PcgsByPcSequenceNC( fam, pcs ) );
# that's it
return fam;
end );
#############################################################################
##
#M ElementByRws( <fam>, <elm> )
##
InstallMethod( ElementByRws,
"using 8Bits_AssocWord",
true,
[ IsElementsFamilyBy8BitsSingleCollector,
Is8BitsAssocWord ],
0,
function( fam, elm )
return 8Bits_AssocWord( fam!.8BitsType, ExtRepOfObj(elm) );
end );
#############################################################################
##
#M UnderlyingElement( <Is8BitsPcWordRep> )
##
InstallMethod( UnderlyingElement,
"using 8Bits_ExtRepOfObj",
true,
[ Is8BitsPcWordRep ],
0,
function( obj )
local fam;
fam := UnderlyingFamily( FamilyObj(obj)!.rewritingSystem );
return ObjByExtRep( fam, 8Bits_ExtRepOfObj(obj) );
end );
#############################################################################
##
#M ExtRepOfObj( <Is8BitsPcWordRep> )
##
InstallMethod( ExtRepOfObj,
"using 8Bits_ExtRepOfObj",
true,
[ Is8BitsPcWordRep ],
0,
8Bits_ExtRepOfObj );
#############################################################################
##
#M ObjByExtRep( <fam>, <elm> )
##
InstallMethod( ObjByExtRep,
"using 8Bits_AssocWord",
true,
[ IsElementsFamilyBy8BitsSingleCollector,
IsList ],
0,
function( fam, elm )
return 8Bits_AssocWord( fam!.8BitsType, elm );
end );
#############################################################################
##
#M <Is8BitsPcWordRep> = <Is8BitsPcWordRep>
##
InstallMethod( \=,
"for 8 bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is8BitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is8BitsPcWordRep ],
0,
8Bits_Equal );
#############################################################################
##
#M <Is8BitsPcWordRep> < <Is8BitsPcWordRep>
##
InstallMethod( \<,
"method for 8 bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is8BitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is8BitsPcWordRep ],
0,
8Bits_Less );
#############################################################################
##
#R Is16BitsPcWordRep
##
DeclareRepresentation(
"Is16BitsPcWordRep",
IsNBitsPcWordRep and IsKernelPcWord, [] );
#############################################################################
##
#M MultiplicativeElementsWithInversesFamilyByRws( <16bits-sc> )
##
InstallMethod( MultiplicativeElementsWithInversesFamilyByRws,
"16 bits family",
true,
[ IsPolycyclicCollector and IsFinite and Is16BitsSingleCollectorRep
and IsDefaultRhsTypeSingleCollector
and IsUpToDatePolycyclicCollector ],
0,
function( sc )
local fam, i, pcs, implied;
implied:=IsObject;
if IsFinite(sc![SCP_RELATIVE_ORDERS]) and
ForAll(sc![SCP_RELATIVE_ORDERS],IsPosInt) then
# the orders are finite, imply this for all elements.
implied:=implied and IsElementFinitePolycyclicGroup;
fi;
# create a new family in the category <IsElementsFamilyByRws>
fam := NewFamily(
"MultiplicativeElementsWithInversesFamilyBy16BitsSingleCollector(...)",
IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsAssociativeElement,
CanEasilySortElements and implied,
CanEasilySortElements and IsElementsFamilyBy16BitsSingleCollector);
# store the rewriting system
fam!.rewritingSystem := Immutable(sc);
# create the default type for the elements
fam!.defaultType := NewType( fam, IsPackedElementDefaultRep );
# create the special 16 bits type
fam!.16BitsType := NewType( fam, Is16BitsPcWordRep );
# copy the assoc word type
for i in [ AWP_FIRST_ENTRY+1 .. AWP_LAST_ENTRY ] do
fam!.16BitsType![i] := sc![SCP_DEFAULT_TYPE]![i];
od;
# default type to use
fam!.16BitsType![AWP_PURE_TYPE] := fam!.16BitsType;
# store the names
fam!.16BitsType![PCWP_NAMES] := FamilyObj(ReducedOne(sc))!.names;
# force the single collector to return elements of that type
sc := ShallowCopy(sc);
sc![SCP_DEFAULT_TYPE] := fam!.16BitsType;
fam!.16BitsType![PCWP_COLLECTOR] := sc;
# store the identity
SetOne( fam, ElementByRws( fam, ReducedOne(fam!.rewritingSystem) ) );
# this family has a defining pcgs
pcs := List( GeneratorsOfRws(sc), x -> ElementByRws(fam,x) );
SetDefiningPcgs( fam, PcgsByPcSequenceNC( fam, pcs ) );
# that's it
return fam;
end );
#############################################################################
##
#M ElementByRws( <fam>, <elm> )
##
InstallMethod( ElementByRws,
"using 16Bits_AssocWord",
true,
[ IsElementsFamilyBy16BitsSingleCollector,
Is16BitsAssocWord ],
0,
function( fam, elm )
return 16Bits_AssocWord( fam!.16BitsType, ExtRepOfObj(elm) );
end );
#############################################################################
##
#M UnderlyingElement( <Is16BitsPcWordRep> )
##
InstallMethod( UnderlyingElement,
"using 16Bits_ExtRepOfObj",
true,
[ Is16BitsPcWordRep ],
0,
function( obj )
local fam;
fam := UnderlyingFamily( FamilyObj(obj)!.rewritingSystem );
return ObjByExtRep( fam, 16Bits_ExtRepOfObj(obj) );
end );
#############################################################################
##
#M ExtRepOfObj( <Is16BitsPcWordRep> )
##
InstallMethod( ExtRepOfObj,
"using 16Bits_ExtRepOfObj",
true,
[ Is16BitsPcWordRep ],
0,
16Bits_ExtRepOfObj );
#############################################################################
##
#M ObjByExtRep( <fam>, <elm> )
##
InstallMethod( ObjByExtRep,
"using 16Bits_AssocWord",
true,
[ IsElementsFamilyBy16BitsSingleCollector,
IsList ],
0,
function( fam, elm )
return 16Bits_AssocWord( fam!.16BitsType, elm );
end );
#############################################################################
##
#M <Is16BitsPcWordRep> = <Is16BitsPcWordRep>
##
InstallMethod( \=,
"for 16 bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is16BitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is16BitsPcWordRep ],
0,
16Bits_Equal );
#############################################################################
##
#M <Is16BitsPcWordRep> < <Is16BitsPcWordRep>
##
InstallMethod( \<,
"for 16 bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is16BitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is16BitsPcWordRep ],
0,
16Bits_Less );
#############################################################################
##
#R Is32BitsPcWordRep
##
DeclareRepresentation(
"Is32BitsPcWordRep",
IsNBitsPcWordRep and IsKernelPcWord, [] );
#############################################################################
##
#M MultiplicativeElementsWithInversesFamilyByRws( <32bits-sc> )
##
InstallMethod( MultiplicativeElementsWithInversesFamilyByRws,
"32 bits family",
true,
[ IsPolycyclicCollector and IsFinite and Is32BitsSingleCollectorRep
and IsDefaultRhsTypeSingleCollector
and IsUpToDatePolycyclicCollector ],
0,
function( sc )
local fam, i, pcs, implied;
implied:=IsObject;
if IsFinite(sc![SCP_RELATIVE_ORDERS]) and
ForAll(sc![SCP_RELATIVE_ORDERS],IsPosInt) then
# the orders are finite, imply this for all elements.
implied:=implied and IsElementFinitePolycyclicGroup;
fi;
# create a new family in the category <IsElementsFamilyByRws>
fam := NewFamily(
"MultiplicativeElementsWithInversesFamilyBy32BitsSingleCollector(...)",
IsMultiplicativeElementWithInverseByPolycyclicCollector
and IsAssociativeElement,
CanEasilySortElements and implied,
CanEasilySortElements and IsElementsFamilyBy32BitsSingleCollector);
# store the rewriting system
fam!.rewritingSystem := Immutable(sc);
# create the default type for the elements
fam!.defaultType := NewType( fam, IsPackedElementDefaultRep );
# create the special 32 bits type
fam!.32BitsType := NewType( fam, Is32BitsPcWordRep );
# copy the assoc word type
for i in [ AWP_FIRST_ENTRY+1 .. AWP_LAST_ENTRY ] do
fam!.32BitsType![i] := sc![SCP_DEFAULT_TYPE]![i];
od;
# default type to use
fam!.32BitsType![AWP_PURE_TYPE] := fam!.32BitsType;
# store the names
fam!.32BitsType![PCWP_NAMES] := FamilyObj(ReducedOne(sc))!.names;
# force the single collector to return elements of that type
sc := ShallowCopy(sc);
sc![SCP_DEFAULT_TYPE] := fam!.32BitsType;
fam!.32BitsType![PCWP_COLLECTOR] := sc;
# store the identity
SetOne( fam, ElementByRws( fam, ReducedOne(fam!.rewritingSystem) ) );
# this family has a defining pcgs
pcs := List( GeneratorsOfRws(sc), x -> ElementByRws(fam,x) );
SetDefiningPcgs( fam, PcgsByPcSequenceNC( fam, pcs ) );
# that's it
return fam;
end );
#############################################################################
##
#M ElementByRws( <fam>, <elm> )
##
InstallMethod( ElementByRws,
"using 32Bits_AssocWord",
true,
[ IsElementsFamilyBy32BitsSingleCollector,
Is32BitsAssocWord ],
0,
function( fam, elm )
return 32Bits_AssocWord( fam!.32BitsType, ExtRepOfObj(elm) );
end );
#############################################################################
##
#M UnderlyingElement( <Is32BitsPcWordRep> )
##
InstallMethod( UnderlyingElement,
"using 16Bits_ExtRepOfObj",
true,
[ Is32BitsPcWordRep ],
0,
function( obj )
local fam;
fam := UnderlyingFamily( FamilyObj(obj)!.rewritingSystem );
return ObjByExtRep( fam, 32Bits_ExtRepOfObj(obj) );
end );
#############################################################################
##
#M ExtRepOfObj( <Is32BitsPcWordRep> )
##
InstallMethod( ExtRepOfObj,
"using 32Bits_ExtRepOfObj",
true,
[ Is32BitsPcWordRep ],
0,
32Bits_ExtRepOfObj );
#############################################################################
##
#M ObjByExtRep( <fam>, <elm> )
##
InstallMethod( ObjByExtRep,
"using 32Bits_AssocWord",
true,
[ IsElementsFamilyBy32BitsSingleCollector,
IsList ],
0,
function( fam, elm )
return 32Bits_AssocWord( fam!.32BitsType, elm );
end );
#############################################################################
##
#M <Is32BitsPcWordRep> = <Is32BitsPcWordRep>
##
InstallMethod( \=,
"for 32 bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is32BitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is32BitsPcWordRep ],
0,
32Bits_Equal );
#############################################################################
##
#M <Is32BitsPcWordRep> < <Is32BitsPcWordRep>
##
InstallMethod( \<,
"for 32 bits pc word rep",
IsIdenticalObj,
[ IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is32BitsPcWordRep,
IsMultiplicativeElementWithInverseByPolycyclicCollector
and Is32BitsPcWordRep ],
0,
32Bits_Less );
#############################################################################
##
#F SingleCollector_GroupRelators( ... )
##
BindGlobal( "SingleCollector_GroupRelators", function(
efam, gens, rods, powersp, powersn,
commpp, commpn, commnp, commnn, conjpp,
conjpn, conjnp, conjnn, conflicts )
local col, i, j, rhs;
# be verbose
# Print( "#I SingleCollector_GroupRelators: ", Length(Flat(powersp)),
# "/", Length(Flat(powersn)), " ", Length(Flat(commpp)), "/",
# Length(Flat(commpn)), "/", Length(Flat(commnp)), "/",
# Length(Flat(commnn)), " ", Length(Flat(conjpp)), "/",
# Length(Flat(conjpn)), "/", Length(Flat(conjnp)), "/",
# Length(Flat(conjnn)), " ", Length(conflicts), "\n" );
# start with an empty single collector
col := SingleCollectorByGenerators( efam, gens, rods );
# we want to use positive powers first
for i in [ 1 .. Length(rods) ] do
if IsBound(powersp[i]) then
SetPower( col, i, powersp[i]^-1 * gens[i]^rods[i] );
fi;
od;
# we want to use positive conjugates/commutators first
for i in [ 1 .. Length(gens) ] do
for j in [ 1 .. i-1 ] do
if IsBound(conjpp[i][j]) then
rhs := ( (gens[i]^-1)^gens[j] * conjpp[i][j] ) ^ -1;
SetConjugate( col, i, j, rhs );
Unbind(conjpp[i][j]);
elif IsBound(commpp[i][j]) then
rhs := gens[i]*(Comm(gens[j],gens[i])*commpp[i][j])^-1;
SetConjugate( col, i, j, rhs );
Unbind(commpp[i][j]);
elif IsBound(conjnp[i][j]) then
rhs := gens[j]^-1*gens[i]*gens[j]*conjnp[i][j];
SetConjugate( col, i, j, rhs );
Unbind(conjnp[i][j]);
elif IsBound(commnp[i][j]) then
rhs := gens[i]^gens[j] * commnp[i][j]^gens[i];
SetConjugate( col, i, j, rhs );
Unbind(commnp[i][j]);
fi;
od;
od;
# everything must a consequence
Append( conflicts, Flat(commpp) );
Append( conflicts, Flat(conjpp) );
Append( conflicts, Flat(powersn) );
Append( conflicts, Flat(conjpn) );
Append( conflicts, Flat(conjnp) );
Append( conflicts, Flat(conjnn) );
Append( conflicts, Flat(commpn) );
Append( conflicts, Flat(commnp) );
Append( conflicts, Flat(commnn) );
# return the rewriting system
return col;
end );
#############################################################################
##
#M PolycyclicFactorGroupByRelators( <efam>, <gens>, <rels> )
##
InstallGlobalFunction( "SingleCollectorByRelators",
function( efam, gens, rels, conflicts )
local i, r, rel, powersp, powersn, powlst, commpp,
commpn, commnp, commnn, conjpp, conjpn, conjnp,
conjnn, n, g1, e1, g2, e2, g3, e3, g4,
e4, rods, col;
# check the generators
for i in [ 1 .. Length(gens) ] do
if 1 <> NumberSyllables(gens[i]) then
Error( gens[i], " must be a word of length 1" );
elif 1 <> ExponentSyllable( gens[i], 1 ) then
Error( gens[i], " must be a word of length 1" );
elif i <> GeneratorSyllable( gens[i], 1 ) then
Error( gens[i], " must be generator number ", i );
fi;
od;
# first convert relations into relators
r := [];
for rel in rels do
if IsList(rel) then
if 2 <> Length(rel) then
Error( rel, " is not a relation" );
fi;
AddSet( r, rel[1] / rel[2] );
else
AddSet( r, rel );
fi;
od;
rels := r;
# power relation
powersp := [];
powersn := [];
powlst := [];
# commutator pos, pos
commpp := List( gens, x -> [] );
# commutator pos, neg
commpn := List( gens, x -> [] );
# commutator neg, pos
commnp := List( gens, x -> [] );
# commutator neg, neg
commnn := List( gens, x -> [] );
# conjugate pos, pos
conjpp := List( gens, x -> [] );
# conjugate pos, neg
conjpn := List( gens, x -> [] );
# conjugate neg, pos
conjnp := List( gens, x -> [] );
# conjugate neg, neg
conjnn := List( gens, x -> [] );
# conflicts is passed already as argument and is changed!
# conflicts are collected in this list and tested later
#conflicts := [];
# sort relators into power and commutator/conjugate relators
for rel in rels do
n := NumberSyllables(rel);
# a word with only one or two syllabel is a power
if n = 1 or n = 2 then
Add( powlst, rel );
# ignore the trivial word
elif 2 < n then
# extract the first four entries
g1 := GeneratorSyllable( rel, 1 );
e1 := ExponentSyllable( rel, 1 );
g2 := GeneratorSyllable( rel, 2 );
e2 := ExponentSyllable( rel, 2 );
g3 := GeneratorSyllable( rel, 3 );
e3 := ExponentSyllable( rel, 3 );
if 3 < n then
g4 := GeneratorSyllable( rel, 4 );
e4 := ExponentSyllable( rel, 4 );
fi;
# a word starting with gi^-1gj^+-1gi is a conjugate or commutator
if e1 = -1 and e3 = 1 and g1 = g3 then
# gi^-1 gj^-1 gi gj is a commutator
if 3<n and e2 = -1 and e4 = 1 and g2 = g4 and g2 < g1 then
if IsBound(commpp[g1][g2]) then
Add( conflicts, rel );
else
commpp[g1][g2] := rel;
fi;
# gi^-1 gj^-1 gi is a conjugate
elif e2 = -1 and g1 < g2 then
if IsBound(conjnp[g2][g1]) then
Add( conflicts, rel );
else
conjnp[g2][g1] := rel;
fi;
# gi^-1 gj gi gj^-1 is a commutator
elif 3<n and e2 = 1 and e4 = -1 and g2 = g4 and g2 < g1 then
if IsBound(commpn[g1][g2]) then
Add( conflicts, rel );
else
commpn[g1][g2] := rel;
fi;
# gi^-1 gj gi is a conjugate
elif e2 = 1 and g1 < g2 then
if IsBound(conjpp[g2][g1]) then
Add( conflicts, rel );
else
conjpp[g2][g1] := rel;
fi;
# impossible
else
Error( "illegal relator ", rel );
fi;
# a word starting with gigjgi^-1 is a conjugate or commutator
elif e1 = 1 and e3 = -1 and g1 = g3 then
# gi gj gi^-1 gj^-1 is a commutator
if 3 < n and e2 = 1 and e4 = -1 and g2 = g4 and g2 < g1 then
if IsBound(commnn[g1][g2]) then
Add( conflicts, rel );
else
commnn[g1][g2] := rel;
fi;
# gi gj gi^-1 is a conjugate
elif e2 = 1 and g1 < g2 then
if IsBound(conjpn[g2][g1]) then
Add( conflicts, rel );
else
conjpn[g2][g1] := rel;
fi;
# gi gj^-1 gi^-1 gj is a commutator
elif 3<n and e2 = -1 and e4 = 1 and g2 = g4 and g2 < g1 then
if IsBound(commnp[g1][g2]) then
Add( conflicts, rel );
else
commnp[g1][g2] := rel;
fi;
# gi gj^-1 gi^-1 gj is a conjugate
elif e2 = -1 and g1 < g2 then
if IsBound(conjnp[g2][g1]) then
Add( conflicts, rel );
else
conjnp[g2][g1] := rel;
fi;
# impossible
else
Error( "illegal relator ", rel );
fi;
# it must be a power
else
Add( powlst, rel );
fi;
fi;
od;
# now check the powers
rods := List( gens, x -> 0 );
for rel in powlst do
g1 := GeneratorSyllable( rel, 1 );
e1 := ExponentSyllable( rel, 1 );
if rods[g1] <> 0 then
if IsBound(powersp[g1]) then
Add( conflicts, rel );
else
Add( conflicts, rel );
fi;
else
rods[g1] := AbsInt(e1);
if e1 < 0 then
powersn[g1] := rel;
else
powersp[g1] := rel;
fi;
fi;
od;
# now decide which collector to use
if ForAny( rods, x -> x = 0 ) then
Error( "not ready yet, only finite polycyclic groups are allowed" );
else
col := SingleCollector_GroupRelators( efam, gens,
rods, powersp, powersn,
commpp, commpn, commnp, commnn, conjpp, conjpn,
conjnp, conjnn, conflicts );
fi;
return col;
end );
InstallMethod( PolycyclicFactorGroupByRelatorsNC,
"generic method for family, generators, relators",
true,
[ IsFamily, IsList, IsList ], 0,
function( efam, gens, rels )
local col;
col := SingleCollectorByRelators( efam, gens, rels, [] );
return GroupByRwsNC(col);
end );
InstallMethod( PolycyclicFactorGroupByRelators,
"generic method for family, generators, relators",
true,
[ IsFamily, IsList, IsList ], 0,
function( efam, gens, rels )
local col, conflicts, e1, rel;
conflicts := [];
col := SingleCollectorByRelators( efam, gens, rels, conflicts );
# check that there are no conflicts between the relations
e1 := ReducedOne(col);
for rel in conflicts do
if ReducedForm( col, rel ) <> e1 then
Error( "relator ", rel, " is not trivial" );
fi;
od;
# check consistency & return the group described by this system
return GroupByRws(col);
end );
#############################################################################
##
#M PolycyclicFactorGroup( <fgrp>, <rels> )
##
#############################################################################
InstallMethod( PolycyclicFactorGroup,
"for free group, list using ' PolycyclicFactorGroupByRelators'",
IsIdenticalObj,
[ IsFreeGroup,
IsHomogeneousList ],
0,
function( fgrp, rels )
return PolycyclicFactorGroupByRelators(
ElementsFamily(FamilyObj(fgrp)),
GeneratorsOfGroup(fgrp),
rels );
end );
InstallMethod( PolycyclicFactorGroupNC,
"for free group, list using ' PolycyclicFactorGroupByRelators'",
IsIdenticalObj,
[ IsFreeGroup,
IsHomogeneousList ],
0,
function( fgrp, rels )
return PolycyclicFactorGroupByRelatorsNC(
ElementsFamily(FamilyObj(fgrp)),
GeneratorsOfGroup(fgrp),
rels );
end );
#############################################################################
InstallMethod( PolycyclicFactorGroup,
"for free group, empty list using ' PolycyclicFactorGroupByRelators'",
true,
[ IsFreeGroup,
IsList and IsEmpty ],
0,
function( fgrp, rels )
return PolycyclicFactorGroupByRelators(
ElementsFamily(FamilyObj(fgrp)),
GeneratorsOfGroup(fgrp),
rels );
end );
[ Dauer der Verarbeitung: 0.9 Sekunden
(vorverarbeitet)
]
|
