/**************************************************************************** ** ** This file is part of GAP, a system for computational discrete algebra. ** ** 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 functions of for coset tables.
*/
/**************************************************************************** ** *V declaration of static variables
*/ static Obj objRel; // handle of a relator static Obj objNums; // handle of parallel numbers list static Obj objTable; // handle of the coset table static Obj objTable2; // handle of coset factor table static Obj objNext; static Obj objPrev; static Obj objFactor; static Obj objTree; // handle of subgroup gens tree
static Obj objTree1; // first tree component static Obj objTree2; // second tree component
static Obj objExponent; // handle of subgroup order static Obj objWordValue; // handle of word value
staticInt treeType; // tree type staticInt treeWordLength; // maximal tree word length staticInt firstDef; staticInt lastDef; staticInt firstFree; staticInt lastFree;
staticInt minGaps; // switch for marking mingaps staticInt nrdel;
staticInt dedfst; // position of first deduction staticInt dedlst; // position of last deduction staticInt dedgen [40960]; // deduction list keeping gens staticInt dedcos [40960]; // deduction list keeping cosets staticInt dedSize = 40960; // size of deduction list buffers staticInt dedprint; // print flag for warning
staticInt wordList [1024]; // coset rep word buffer staticInt wordSize = 1023; // maximal no. of coset rep words
/**************************************************************************** ** *F FuncApplyRel( <self>, <app>, <rel> ) apply a relator to a coset in a TC ** ** 'FuncApplyRel' implements the internal function 'ApplyRel'. ** ** 'ApplyRel( <app>, <rel> )' ** ** 'ApplyRel' applies the relator <rel> to the application list <app>. ** ** ... more about ApplyRel ...
*/ static Obj FuncApplyRel(Obj self,
Obj app, // handle of the application list
Obj rel) // handle of the relator
{
Int lp; // left pointer into relator Int lc; // left coset to apply to Int rp; // right pointer into relator Int rc; // right coset to apply to Int tc; // temporary coset
// check the application list
RequirePlainList(0, app); if ( LEN_PLIST(app) != 4 ) {
ErrorQuit(" must be a list of length 4 not %d",
(Int)LEN_PLIST(app), 0);
}
// get the four entries
lp = INT_INTOBJ( ELM_PLIST( app, 1 ) );
lc = INT_INTOBJ( ELM_PLIST( app, 2 ) );
rp = INT_INTOBJ( ELM_PLIST( app, 3 ) );
rc = INT_INTOBJ( ELM_PLIST( app, 4 ) );
// get and check the relator (well, only a little bit)
RequirePlainList(0, rel);
// fix right pointer if requested if ( rp == -1 )
rp = lp + INT_INTOBJ( ELM_PLIST( rel, 1 ) );
// scan as long as possible from the right to the left while ( lp < rp
&& 0 < (tc = INT_INTOBJ(ELM_PLIST(ELM_PLIST(rel,rp),rc))) )
{
rc = tc; rp = rp - 2;
}
// scan as long as possible from the left to the right while ( lp < rp
&& 0 < (tc = INT_INTOBJ(ELM_PLIST(ELM_PLIST(rel,lp),lc))) )
{
lc = tc; lp = lp + 2;
}
// copy the information back into the application list
SET_ELM_PLIST( app, 1, INTOBJ_INT( lp ) );
SET_ELM_PLIST( app, 2, INTOBJ_INT( lc ) );
SET_ELM_PLIST( app, 3, INTOBJ_INT( rp ) );
SET_ELM_PLIST( app, 4, INTOBJ_INT( rc ) );
// return 'true' if a coincidence or deduction was found if ( lp == rp+1
&& INT_INTOBJ(ELM_PLIST(ELM_PLIST(rel,lp),lc)) != rc )
{ returnTrue;
} else returnFalse;
}
/**************************************************************************** ** *F CompressDeductionList() . . . . removes unused items from deduction list ** ** 'CompressDeductionList' tries to find and delete deduction list entries ** which are not used any more. ** ** 'dedgen', 'dedcos', 'dedfst', 'dedlst', 'dedSize' and 'objTable' are ** assumed to be known as static variables.
*/ staticvoid CompressDeductionList ( void )
{
Obj * ptTable; // pointer to the coset table Int i; Int j;
// check if the situation is as assumed if ( dedlst != dedSize ) {
ErrorQuit("invalid call of CompressDeductionList", 0, 0);
}
// run through the lists and compress them
ptTable = BASE_PTR_PLIST(objTable) - 1;
j = 0; for ( i = dedfst; i < dedlst; i++ ) { if ( INT_INTOBJ(ELM_PLIST(ptTable[dedgen[i]],dedcos[i])) > 0
&& j < i )
{
dedgen[j] = dedgen[i];
dedcos[j] = dedcos[i];
j++;
}
}
// update the pointers
dedfst = 0;
dedlst = j;
// check if we have at least one free position if ( dedlst == dedSize ) { if ( dedprint == 0 ) {
Pr("#I WARNING: deductions being discarded\n", 0, 0);
dedprint = 1;
}
dedlst--;
}
}
/**************************************************************************** ** *F HandleCoinc( <cos1>, <cos2> ) . . . . . . . . handle coincidences in a TC ** ** 'HandleCoinc' is a subroutine of 'FuncMakeConsequences' and handles the ** coincidence cos2 = cos1.
*/ staticvoid HandleCoinc ( Int cos1, Int cos2 )
{
Obj * ptTable; // pointer to the coset table
Obj * ptNext;
Obj * ptPrev; Int c1; Int c2; Int c3; Int i; Int firstCoinc; Int lastCoinc;
Obj * gen;
Obj * inv;
// is this test necessary? if ( cos1 == cos2 ) return;
// get some pointers
ptTable = BASE_PTR_PLIST(objTable) - 1;
ptNext = BASE_PTR_PLIST(objNext) - 1;
ptPrev = BASE_PTR_PLIST(objPrev) - 1;
// take the smaller one as new representative if ( cos2 < cos1 ) { c3 = cos1; cos1 = cos2; cos2 = c3; }
// if we are removing an important coset update it if ( cos2 == lastDef )
lastDef = INT_INTOBJ( ptPrev[lastDef ] ); if ( cos2 == firstDef )
firstDef = INT_INTOBJ( ptPrev[firstDef] );
// remove <cos2> from the coset list
ptNext[INT_INTOBJ(ptPrev[cos2])] = ptNext[cos2]; if ( ptNext[cos2] != INTOBJ_INT( 0 ) )
ptPrev[INT_INTOBJ(ptNext[cos2])] = ptPrev[cos2];
// put the first coincidence into the list of coincidences
firstCoinc = cos2;
lastCoinc = cos2;
ptNext[lastCoinc] = INTOBJ_INT( 0 );
// <cos1> is the representative of <cos2> and its own representative
ptPrev[cos2] = INTOBJ_INT( cos1 );
// while there are coincidences to handle while ( firstCoinc != 0 ) {
// replace <firstCoinc> by its representative in the table
cos1 = INT_INTOBJ( ptPrev[firstCoinc] ); cos2 = firstCoinc; for ( i = 1; i <= LEN_PLIST(objTable); i++ ) {
gen = BASE_PTR_PLIST(ptTable[i]) - 1; // inv = ADDR_OBJ(ptTable[ ((i-1)^1)+1 ] );
inv = BASE_PTR_PLIST(ptTable[i + 2 * (i % 2) - 1]) - 1;
// replace <cos2> by <cos1> in the column of <gen>^-1
c2 = INT_INTOBJ( gen[cos2] ); if ( c2 > 0 ) {
c1 = INT_INTOBJ( gen[cos1] );
// if the other entry is empty copy it if ( c1 <= 0 ) {
gen[cos1] = INTOBJ_INT( c2 );
gen[cos2] = INTOBJ_INT( 0 );
inv[c2] = INTOBJ_INT( cos1 ); if ( dedlst == dedSize )
CompressDeductionList( );
dedgen[dedlst] = i;
dedcos[dedlst] = cos1;
dedlst++;
}
// find the representative of <c1> while ( c1 != 1
&& INT_INTOBJ(ptNext[INT_INTOBJ(ptPrev[c1])]) != c1 )
{
c1 = INT_INTOBJ(ptPrev[c1]);
}
// find the representative of <c2> while ( c2 != 1
&& INT_INTOBJ(ptNext[INT_INTOBJ(ptPrev[c2])]) != c2 )
{
c2 = INT_INTOBJ(ptPrev[c2]);
}
// if the representatives differ we got a coincindence if ( c1 != c2 ) {
// take the smaller one as new representative if ( c2 < c1 ) { c3 = c1; c1 = c2; c2 = c3; }
// if we are removing an important coset update it if ( c2 == lastDef )
lastDef = INT_INTOBJ(ptPrev[lastDef ]); if ( c2 == firstDef )
firstDef = INT_INTOBJ(ptPrev[firstDef]);
// remove <c2> from the coset list
ptNext[INT_INTOBJ(ptPrev[c2])] = ptNext[c2]; if ( ptNext[c2] != INTOBJ_INT( 0 ) )
ptPrev[INT_INTOBJ(ptNext[c2])] = ptPrev[c2];
// append <c2> to the coincidence list
ptNext[lastCoinc] = INTOBJ_INT( c2 );
lastCoinc = c2;
ptNext[lastCoinc] = INTOBJ_INT( 0 );
// <c1> is the rep of <c2> and its own rep.
ptPrev[c2] = INTOBJ_INT( c1 );
}
}
}
// move the replaced coset to the free list if ( firstFree == 0 ) {
firstFree = firstCoinc;
lastFree = firstCoinc;
} else {
ptNext[lastFree] = INTOBJ_INT( firstCoinc );
lastFree = firstCoinc;
}
firstCoinc = INT_INTOBJ( ptNext[firstCoinc] );
ptNext[lastFree] = INTOBJ_INT( 0 );
nrdel++;
}
}
/**************************************************************************** ** *F FuncMakeConsequences( <self>, <list> ) find consqs of a coset definition
*/ static Obj FuncMakeConsequences(Obj self, Obj list)
{
Obj hdSubs;
Obj objRels;
Obj * ptRel; // pointer to the relator bag
Obj * ptNums; // pointer to this list Int lp; // left pointer into relator Int lc; // left coset to apply to Int rp; // right pointer into relator Int rc; // right coset to apply to Int tc; // temporary coset Int i; // loop variable
Obj hdTmp; // temporary variable
// scan as long as possible from the right to the left while ( lp<rp && 0 < (tc=INT_INTOBJ(ELM_PLIST(ptRel[rp],rc))) ) {
rc = tc; rp = rp - 2;
}
// scan as long as possible from the left to the right while ( lp<rp && 0 < (tc=INT_INTOBJ(ELM_PLIST(ptRel[lp],lc))) ) {
lc = tc; lp = lp + 2;
}
// if a coincidence or deduction has been found, handle it if ( lp == rp + 1 ) { if ( INT_INTOBJ(ELM_PLIST(ptRel[lp],lc)) != rc ) { if ( INT_INTOBJ( ELM_PLIST(ptRel[lp],lc) ) > 0 ) {
HandleCoinc( INT_INTOBJ( ELM_PLIST(ptRel[lp],lc) ), rc );
} elseif ( INT_INTOBJ( ELM_PLIST(ptRel[rp],rc) ) > 0 ) {
HandleCoinc( INT_INTOBJ( ELM_PLIST(ptRel[rp],rc) ), lc );
} else {
SET_ELM_PLIST( ptRel[lp], lc, INTOBJ_INT( rc ) );
SET_ELM_PLIST( ptRel[rp], rc, INTOBJ_INT( lc ) ); if ( dedlst == dedSize )
CompressDeductionList();
dedgen[ dedlst ] = INT_INTOBJ( ptNums[lp] );
dedcos[ dedlst ] = lc;
dedlst++;
}
}
// remove the completed subgroup generator
SET_ELM_PLIST( hdSubs, i, 0 ); if ( i == LEN_PLIST(hdSubs) ) { while ( 0 < i && ELM_PLIST(hdSubs,i) == 0 )
--i;
SET_LEN_PLIST( hdSubs, i );
i++;
}
}
// if a minimal gap has been found, set a flag elseif ( minGaps != 0 && lp == rp - 1 ) {
SET_ELM_PLIST( ptRel[lp], lc, INTOBJ_INT( -1 ) );
SET_ELM_PLIST( ptRel[rp], rc, INTOBJ_INT( -1 ) );
}
}
}
// apply all relators that start with this generator
objRels = ELM_PLIST( ELM_PLIST( list, 4 ), dedgen[dedfst] ); for ( i = 1; i <= LEN_LIST( objRels ); i++ ) {
objNums = ELM_PLIST( ELM_PLIST(objRels,i), 1 );
ptNums = BASE_PTR_PLIST(objNums) - 1;
objRel = ELM_PLIST( ELM_PLIST(objRels,i), 2 );
ptRel = BASE_PTR_PLIST(objRel) - 1;
// if a minimal gap has been found, set a flag elseif ( minGaps != 0 && lp == rp - 1 ) {
SET_ELM_PLIST( ptRel[lp], lc, INTOBJ_INT( -1 ) );
SET_ELM_PLIST( ptRel[rp], rc, INTOBJ_INT( -1 ) );
}
}
/**************************************************************************** ** *F FuncMakeConsequencesPres( <self>, <list> ) . . . . . . find consequences ** ** This is a special version of `FuncMakeConsequences' for the subgroup ** presentation routines.
*/ static Obj FuncMakeConsequencesPres(Obj self, Obj list)
{
Obj objDefs1; // handle of defs list part 1
Obj objDefs2; // handle of defs list part 2
Obj objRels;
Obj * ptRel; // pointer to the relator bag
Obj * ptNums; // pointer to this list Int ndefs; // number of defs done so far Int undefined; // maximal of undefined entreis Int apply; // num of next def to be applied Int ndefsMax; // maximal number of definitions Int coset; // coset involved in current def Int gen; // gen involved in current def Int lp; // left pointer into relator Int lc; // left coset to apply to Int rp; // right pointer into relator Int rc; // right coset to apply to Int tc; // temporary coset Int i; // loop variable
// scan as long as possible from the right to the left while ( lp<rp && 0 < (tc=INT_INTOBJ(ELM_PLIST(ptRel[rp],rc))) ) {
rc = tc; rp = rp - 2;
}
// scan as long as possible from the left to the right while ( lp<rp && 0 < (tc=INT_INTOBJ(ELM_PLIST(ptRel[lp],lc))) ) {
lc = tc; lp = lp + 2;
}
// if a deduction has been found, handle it if ( lp == rp+1 && INT_INTOBJ(ELM_PLIST(ptRel[rp],rc)) <= 0 ) {
SET_ELM_PLIST( ptRel[lp], lc, INTOBJ_INT( rc ) );
undefined--; if ( INT_INTOBJ(ELM_PLIST(ptRel[rp],rc)) <= 0 ) {
SET_ELM_PLIST( ptRel[rp], rc, INTOBJ_INT( lc ) );
undefined--;
}
ndefs++; if ( ndefs > ndefsMax ) {
ErrorQuit("inconsistent definitions lists", 0, 0);
}
SET_ELM_PLIST( objDefs1, ndefs, INTOBJ_INT( lc ) );
SET_ELM_PLIST( objDefs2, ndefs, ptNums[lp] ); if ( undefined == 0 ) { return INTOBJ_INT( 0 );
}
}
}
apply++;
}
// clean out
CleanOut();
return INTOBJ_INT( undefined );
}
/**************************************************************************** ** *F FuncStandardizeTableC(<self>,<table>,<stan>) . . . . . . standardize CT ** ** This is the kernel routine for standardizing a coset table. It is called ** by the GAP routine 'StandardizeTable'. The user should not call the ** kernel routine but only the GAP routine. ** ** If <stan> = 1 the table is standardized using the (old) semilenlex ** standard. ** If not <stan> = 1 the table is standardized using the (new) lenlex ** standard (this is the default).
*/ static Obj FuncStandardizeTableC(Obj self, Obj table, Obj stan)
{
Obj * ptTable; // pointer to table
UInt nrgen; // number of rows of the table / 2
Obj * g; // one generator list from table
Obj * h; // generator list
Obj * i; // and inverse
UInt acos; // actual coset
UInt lcos; // last seen coset
UInt mcos;
UInt c1, c2; // coset temporaries
Obj tmp; // temporary for swap
UInt j, k, nloop; // loop variables
RequirePlainList(0, table);
// get the arguments
objTable = table;
ptTable = BASE_PTR_PLIST(objTable) - 1;
nrgen = LEN_PLIST(objTable) / 2; for ( j = 1; j <= nrgen*2; j++ ) { if ( ! IS_PLIST(ptTable[j]) ) {
ErrorQuit( "
[%d] must be a plain list (not a %s)",
(Int)j,
(Int)TNAM_OBJ(ptTable[j]) );
}
} if (stan == INTOBJ_INT(1)) { // use semilenlex standard
nloop = nrgen;
} else { // use lenlex standard
nloop = nrgen*2;
}
// run over all cosets
acos = 1;
lcos = 1; while ( acos <= lcos ) {
// scan through all columns of acos for ( j = 1; j <= nloop; j++ ) {
k = ( nloop == nrgen ) ? 2*j - 1 : j;
g = BASE_PTR_PLIST(ptTable[k]) - 1;
// if we haven't seen this coset yet if ( lcos+1 < INT_INTOBJ( g[acos] ) ) {
// swap rows lcos and g[acos]
lcos = lcos + 1;
mcos = INT_INTOBJ( g[acos] ); for ( k = 1; k <= nrgen; k++ ) {
h = BASE_PTR_PLIST(ptTable[2 * k - 1]) - 1;
i = BASE_PTR_PLIST(ptTable[2 * k]) - 1;
c1 = INT_INTOBJ( h[lcos] );
c2 = INT_INTOBJ( h[mcos] ); if ( c1 != 0 ) i[c1] = INTOBJ_INT( mcos ); if ( c2 != 0 ) i[c2] = INTOBJ_INT( lcos );
tmp = h[lcos];
h[lcos] = h[mcos];
h[mcos] = tmp; if ( i != h ) {
c1 = INT_INTOBJ( i[lcos] );
c2 = INT_INTOBJ( i[mcos] ); if ( c1 != 0 ) h[c1] = INTOBJ_INT( mcos ); if ( c2 != 0 ) h[c2] = INTOBJ_INT( lcos );
tmp = i[lcos];
i[lcos] = i[mcos];
i[mcos] = tmp;
}
}
}
// if this is already the next only bump lcos elseif ( lcos < INT_INTOBJ( g[acos] ) ) {
lcos = lcos + 1;
}
/**************************************************************************** ** *F InitializeCosetFactorWord() . . . . . . . initialize a coset factor word ** ** 'InitializeCosetFactorWord' initializes a word in which a new coset ** factor is to be built up. ** ** 'wordList', 'treeType', 'objTree2', and 'treeWordLength' are assumed to ** be known as static variables.
*/ staticvoid InitializeCosetFactorWord ( void )
{
Obj * ptWord; // pointer to the word Int i; // integer variable
// handle the one generator MTC case if ( treeType == 1 ) {
objWordValue = INTOBJ_INT(0);
}
// handle the abelianized case elseif ( treeType == 0 ) {
ptWord = BASE_PTR_PLIST(objTree2) - 1; for ( i = 1; i <= treeWordLength; i++ ) {
ptWord[i] = INTOBJ_INT(0);
}
}
// handle the general case else {
wordList[0] = 0;
}
}
/**************************************************************************** ** *F TreeEntryC() . . . . . . . . . . . . returns a tree entry for a rep word ** ** 'TreeEntryC' determines a tree entry which represents the word given in ** 'wordList', if it finds any, or it defines a new proper tree entry, and ** then returns it. ** ** Warning: It is assumed, but not checked, that the given word is freely ** reduced and that it does not contain zeros, and that the tree type is ** either 0 or 2. ** ** 'wordList' is assumed to be known as static variable. **
*/ staticInt TreeEntryC ( void )
{
Obj * ptTree1; // ptr to first tree component
Obj * ptTree2; // ptr to second tree component
Obj * ptWord; // ptr to given word
Obj * ptFac; // ptr to old word
Obj * ptNew; // ptr to new word
Obj objNew; // handle of new word Int treesize; // tree size Int numgens; // tree length Int leng; // word length Int sign; // sign flag Int i, k; // integer variables Int gen; // generator value Int u, u1, u2; // generator values Int v, v1, v2; // generator values Int t1, t2; // generator values Int uabs, vabs; // generator values
// Get the tree components
ptTree1 = BASE_PTR_PLIST(objTree1) - 1;
ptTree2 = BASE_PTR_PLIST(objTree2) - 1;
treesize = LEN_PLIST(objTree1);
numgens = INT_INTOBJ( ELM_PLIST( objTree, 3 ) );
// handle the abelianized case if ( treeType == 0 )
{
ptWord = BASE_PTR_PLIST(objTree2) - 1; for ( leng = treeWordLength; leng >= 1; leng-- ) { if ( ptWord[leng] != INTOBJ_INT(0) ) { break;
}
} if ( leng == 0 ) { return 0;
} for ( k = 1; k <= leng; k++ ) { if ( ptWord[k] != INTOBJ_INT(0) ) { break;
}
}
sign = 1; if ( INT_INTOBJ( ptWord[k] ) < 0 ) {
// invert the word
sign = - 1; for ( i = k; i <= leng; i++ ) {
ptWord[i] = INTOBJ_INT( - INT_INTOBJ( ptWord[i] ) );
}
} for ( k = 1; k <= numgens; k++ ) {
ptFac = BASE_PTR_PLIST(ptTree1[k]) - 1; if ( LEN_PLIST(ptTree1[k]) == leng ) { for ( i = 1; i <= leng; i++ ) { if ( ptFac[i] != ptWord[i] ) { break;
}
} if ( i > leng ) { return sign * k;
}
}
}
// copy the word to the new bag
ptWord = BASE_PTR_PLIST(objTree2) - 1;
ptNew = BASE_PTR_PLIST(objNew) - 1; while ( leng > 0 ) {
ptNew[leng] = ptWord[leng];
leng--;
}
return sign * numgens;
}
// handle the general case
// Get the length of the word
leng = wordList[0];
gen = ( leng == 0 ) ? 0 : wordList[1];
u2 = 0; // just to shut up gcc for ( i = 2; i <= leng; i++ ) {
u = gen;
v = wordList[i]; while ( i ) {
// First handle the trivial cases if ( u == 0 || v == 0 || ( u + v ) == 0 ) {
gen = u + v; break;
}
// Cancel out factors, if possible
u1 = INT_INTOBJ( ptTree1[ (u > 0) ? u : -u ] ); if ( u1 != 0 ) { if ( u > 0 ) {
u2 = INT_INTOBJ( ptTree2[u] );
} else {
u2 = - u1;
u1 = - INT_INTOBJ( ptTree2[-u] );
} if ( u2 == -v ) {
gen = u1; break;
}
}
v1 = INT_INTOBJ( ptTree1[ (v > 0) ? v : -v ] ); if ( v1 != 0 ) { if ( v > 0 ) {
v2 = INT_INTOBJ( ptTree2[v] );
} else {
v2 = - v1;
v1 = - INT_INTOBJ( ptTree2[-v] );
} if ( v1 == -u ) {
gen = v2; break;
} if ( u1 != 0 && v1 == - u2 ) {
u = u1;
v = v2; continue;
}
}
// Check if there is already a tree entry [u,v] or [-v,-u] if ( u < -v ) {
t1 = u;
t2 = v;
} else {
t1 = -v;
t2 = -u;
}
uabs = ( u > 0 ) ? u : -u;
vabs = ( v > 0 ) ? v : -v;
k = ( uabs > vabs ) ? uabs : vabs; for ( k++; k <= numgens; k++ ) { if ( INT_INTOBJ(ptTree1[k]) == t1 &&
INT_INTOBJ(ptTree2[k]) == t2 )
{ break;
}
}
/**************************************************************************** ** *F AddCosetFactor2( <factor> ) . add a factor to a coset representative word ** ** 'AddCosetFactor2' adds a factor to a coset representative word and ** extends the tree appropriately, if necessary. ** ** 'treeType', 'wordList', and 'wordSize' are assumed to be known as static ** variables, and 'treeType' is assumed to be either 0 or 2, ** ** Warning: 'factor' is not checked for being zero. ** ** it returns 0 if everything worked, and 1 if a problem arose.
*/ staticInt AddCosetFactor2 ( Int factor )
{
Obj * ptFac; // pointer to the factor
Obj * ptWord; // pointer to the word Int leng; // length of the factor
Obj sum; // intermediate result Int i; // integer variable
Obj tmp;
// handle the abelianized case if ( treeType == 0 ) {
ptWord = BASE_PTR_PLIST(objTree2) - 1; if ( factor > 0 ) {
tmp = ELM_PLIST( objTree1, factor );
ptFac = BASE_PTR_PLIST(tmp) - 1;
leng = LEN_PLIST(tmp); for ( i = 1; i <= leng; i++ ) { if ( ! SUM_INTOBJS( sum, ptWord[i], ptFac[i] ) ) { return 1; /* used to be unrecoverable error message: ErrorQuit( "exponent too large, Modified Todd-Coxeter aborted",
0, 0); */
}
ptWord[i] = sum;
}
} else
{
tmp = ELM_PLIST( objTree1, -factor );
ptFac = BASE_PTR_PLIST(tmp) - 1;
leng = LEN_PLIST(tmp); for ( i = 1; i <= leng; i++ ) { if ( ! DIFF_INTOBJS( sum, ptWord[i], ptFac[i] ) ) { return 1; /* used to be unrecoverable error message: ErrorQuit( "exponent too large, Modified Todd-Coxeter aborted",
0, 0); */
}
ptWord[i] = sum;
}
}
}
/**************************************************************************** ** *F FuncApplyRel2( <self>, <app>, <rel>, <nums> ) . . . . . . apply a relator ** ** 'FuncApplyRel2' implements the internal function 'ApplyRel2'. ** ** 'ApplyRel2( <app>, <rel>, <nums> )' ** ** 'ApplyRel2' applies the relator <rel> to a coset representative and ** returns the corresponding factors in "word" ** ** ...more about ApplyRel2... ** ** function returns `true` if everything worked, and `false` if there was a ** problem (e.g. exponents).
*/ static Obj FuncApplyRel2(Obj self, Obj app, Obj rel, Obj nums)
{
Obj * ptApp; // pointer to that list
Obj word; // handle of resulting word
Obj * ptWord; // pointer to this word
Obj * ptTree; // pointer to the tree
Obj * ptTree2; // ptr to second tree component
Obj * ptRel; // pointer to the relator bag
Obj * ptNums; // pointer to this list
Obj * ptTabl2; // pointer to coset factor table
Obj objRep; // handle of temporary factor Int lp; // left pointer into relator Int lc; // left coset to apply to Int rp; // right pointer into relator Int rc; // right coset to apply to Int rep; // temporary factor Int tc; // temporary coset Int bound; // maximal number of steps Int last; // proper word length Int size; // size of the word bag Int i; // loop variables Int tmp;
// get and check the application list
RequirePlainList(0, app); if ( LEN_PLIST(app) != 9 ) {
ErrorQuit(" must be a list of length 9 not %d",
(Int)LEN_PLIST(app), 0);
}
ptApp = BASE_PTR_PLIST(app) - 1;
// get the components of the proper application list
lp = INT_INTOBJ( ptApp[1] );
lc = INT_INTOBJ( ptApp[2] );
rp = INT_INTOBJ( ptApp[3] );
rc = INT_INTOBJ( ptApp[4] );
// get and check the relator (well, only a little bit)
objRel = rel;
RequirePlainList(0, rel);
// fix right pointer if requested if ( rp == -1 )
rp = lp + INT_INTOBJ( ELM_PLIST(objRel,1) );
// get and check the numbers list parallel to the relator
objNums = nums;
RequirePlainList(0, nums);
// get and check the corresponding factors list
objTable2 = ptApp[6];
RequirePlainList(0, objTable2);
// get the tree type
treeType = INT_INTOBJ( ptApp[5] );
// handle the one generator MTC case if ( treeType == 1 ) {
// initialize the resulting exponent by zero
objExponent = INTOBJ_INT( 0 );
// scan as long as possible from the left to the right while ( lp < rp + 2 &&
0 < (tc = INT_INTOBJ(ELM_PLIST(ELM_PLIST(objRel,lp),lc))) )
{
tmp = INT_INTOBJ( ELM_PLIST(objNums,lp) );
objRep = ELM_PLIST( objTable2, tmp );
objRep = ELM_PLIST( objRep, lc );
objExponent = DiffInt( objExponent, objRep );
lc = tc;
lp = lp + 2;
}
// scan as long as possible from the right to the left while ( lp < rp + 2 &&
0 < (tc = INT_INTOBJ(ELM_PLIST(ELM_PLIST(objRel,rp),rc))) )
{
tmp = INT_INTOBJ( ELM_PLIST(objNums,rp) );
objRep = ELM_PLIST( objTable2, tmp );
objRep = ELM_PLIST( objRep, rc );
objExponent = SumInt( objExponent, objRep );
rc = tc;
rp = rp - 2;
}
// The functions DiffInt or SumInt may have caused a garbage // collections. So restore the pointer.
// save the resulting exponent
SET_ELM_PLIST( app, 9, objExponent );
}
else {
// get and check the corresponding word
word = ptApp[7];
RequirePlainList(0, word);
// initialize the coset representative word
InitializeCosetFactorWord();
// scan as long as possible from the left to the right while ( lp < rp + 2 &&
0 < (tc=INT_INTOBJ(ELM_PLIST(ELM_PLIST(objRel,lp),lc))) )
{
tmp = INT_INTOBJ( ELM_PLIST(objNums,lp) );
objRep = ELM_PLIST(objTable2,tmp);
objRep = ELM_PLIST(objRep,lc);
rep = INT_INTOBJ(objRep); if ( rep != 0 ) { if (AddCosetFactor2(-rep)==1) {; returnFalse;
}
}
lc = tc;
lp = lp + 2;
}
// scan as long as possible from the right to the left while ( lp < rp + 2 &&
0 < (tc=INT_INTOBJ(ELM_PLIST(ELM_PLIST(objRel,rp),rc))) )
{
tmp = INT_INTOBJ( ELM_PLIST(objNums,rp) );
objRep = ELM_PLIST(objTable2,tmp);
objRep = ELM_PLIST(objRep,rc);
rep = INT_INTOBJ(objRep); if ( rep != 0 ) { if (AddCosetFactor2(rep)==1) { returnFalse;
}
}
rc = tc;
rp = rp - 2;
}
// initialize some local variables
ptWord = BASE_PTR_PLIST(word) - 1;
ptTree2 = BASE_PTR_PLIST(objTree2) - 1;
// copy the result to its destination, if necessary if ( ptWord != ptTree2 ) { if ( LEN_PLIST(word) != treeWordLength ) {
ErrorQuit("illegal word length", 0, 0);
} for ( i = 1; i <= treeWordLength; i++ ) {
ptWord[i] = ptTree2[i];
}
SET_LEN_PLIST( word, LEN_PLIST(objTree2) );
}
}
// handle the general case else {
// extend the word size, if necessary
bound = ( rp - lp + 3 ) / 2;
size = SIZE_OBJ(word)/sizeof(Obj) - 1; if ( size < bound ) {
size = ( bound > 2 * size ) ? bound : 2 * size;
GROW_PLIST( word, size );
CHANGED_BAG(app);
}
// initialize some local variables
ptRel = BASE_PTR_PLIST(objRel) - 1;
ptNums = BASE_PTR_PLIST(objNums) - 1;
ptTabl2 = BASE_PTR_PLIST(objTable2) - 1;
ptWord = BASE_PTR_PLIST(word) - 1;
last = 0;
// scan as long as possible from the left to the right while ( lp < rp + 2
&& 0 < (tc = INT_INTOBJ(ELM_PLIST(ptRel[lp],lc))) )
{
objRep = ELM_PLIST( ptTabl2[INT_INTOBJ(ptNums[lp])], lc );
rep = INT_INTOBJ(objRep); if ( rep != 0 ) { if ( last > 0 && INT_INTOBJ(ptWord[last]) == rep ) {
last--;
} else {
ptWord[++last] = INTOBJ_INT(-rep);
}
}
lc = tc;
lp = lp + 2;
}
// revert the ordering of the word constructed so far if ( last > 0 ) {
last++; for ( i = last / 2; i > 0; i-- ) {
objRep = ptWord[i];
ptWord[i] = ptWord[last-i];
ptWord[last-i] = objRep;
}
last--;
}
// scan as long as possible from the right to the left while ( lp < rp + 2
&& 0 < (tc = INT_INTOBJ(ELM_PLIST(ptRel[rp],rc))) )
{
objRep = ELM_PLIST( ptTabl2[INT_INTOBJ(ptNums[rp])], rc );
rep = INT_INTOBJ(objRep); if ( rep != 0 ) { if ( last > 0 && INT_INTOBJ(ptWord[last]) == -rep ) {
last--;
} else {
ptWord[++last] = INTOBJ_INT(rep);
}
}
rc = tc;
rp = rp - 2;
}
// save the word length
SET_LEN_PLIST( word, last );
}
}
// copy the information back into the application list
SET_ELM_PLIST( app, 1, INTOBJ_INT( lp ) );
SET_ELM_PLIST( app, 2, INTOBJ_INT( lc ) );
SET_ELM_PLIST( app, 3, INTOBJ_INT( rp ) );
SET_ELM_PLIST( app, 4, INTOBJ_INT( rc ) );
// return true returnTrue;
}
/**************************************************************************** ** *F FuncCopyRel( <self>, <rel> ) . . . . . . . . . . . . copy of a relator ** ** 'FuncCopyRel' returns a copy of the given RRS relator such that the bag ** of the copy does not exceed the minimal required size.
*/ static Obj FuncCopyRel(Obj self, Obj rel) // the given relator
{
Obj * ptRel; // pointer to the given relator
Obj copy; // the copy
Obj * ptCopy; // pointer to the copy Int leng; // length of the given word
RequirePlainList(0, rel);
leng = LEN_PLIST(rel);
// Allocate a bag for the copy
copy = NEW_PLIST( T_PLIST, leng );
SET_LEN_PLIST( copy, leng );
ptRel = BASE_PTR_PLIST(rel);
ptCopy = BASE_PTR_PLIST(copy);
// Copy the relator to the new bag while ( leng > 0 ) {
*ptCopy++ = *ptRel++;
leng--;
}
// Return the copy return copy;
}
/**************************************************************************** ** *F FuncMakeCanonical( <self>, <rel> ) . . . . . . . make a relator canonical ** ** 'FuncMakeCanonical' is a subroutine of the Reduced Reidemeister-Schreier ** routines. It replaces the given relator by its canonical representative. ** It does not return anything.
*/ static Obj FuncMakeCanonical(Obj self, Obj rel) // the given relator
{
Obj * ptRel; // pointer to the relator
Obj obj1, obj2; // handles 0f relator entries Int leng, leng1; // length of the relator Int max, min, next; // relator entries Int i, j, k, l; // integer variables Int ii, jj, kk; // integer variables
// cyclically reduce the relator, if necessary
i = 0; while ( i<leng1 && INT_INTOBJ(ptRel[i]) == -INT_INTOBJ(ptRel[leng1]) ) {
i++;
leng1--;
} if ( i > 0 ) { for ( j = i; j <= leng1; j++ ) {
ptRel[j-i] = ptRel[j];
}
leng1 = leng1 - i;
leng = leng1 + 1;
SET_LEN_PLIST( rel, leng );
}
// Loop over the relator and find the maximal postitve and negative // entries
max = min = INT_INTOBJ(ptRel[0]);
i = 0; j = 0; for ( k = 1; k < leng; k++ ) {
next = INT_INTOBJ( ptRel[k] ); if ( next > max ) {
max = next;
i = k;
} elseif ( next <= min ) {
min = next;
j = k;
}
}
// Find the lexicographically last cyclic permutation of the relator if ( max < -min ) {
i = leng;
} else { for ( k = i + 1; k < leng; k++ ) { for ( ii = i, kk = k, l = 0;
l < leng;
ii = (ii + 1) % leng, kk = (kk + 1) % leng, l++ )
{ if ( INT_INTOBJ(ptRel[kk]) < INT_INTOBJ(ptRel[ii]) ) { break;
} elseif ( INT_INTOBJ(ptRel[kk]) > INT_INTOBJ(ptRel[ii]) ) {
i = k; break;
}
} if ( l == leng ) { break;
}
}
}
// Find the lexicographically last cyclic permutation of its inverse if ( -max < min ) {
j = leng;
} else { for ( k = j - 1; k >= 0; k-- ) { for ( jj = j, kk = k, l = 0;
l < leng;
jj = (jj + leng1) % leng, kk = (kk + leng1) % leng, l++ )
{ if ( INT_INTOBJ(ptRel[kk]) > INT_INTOBJ(ptRel[jj]) ) { break;
} elseif ( INT_INTOBJ(ptRel[kk]) < INT_INTOBJ(ptRel[jj]) ) {
j = k; break;
}
} if ( l == leng ) { break;
}
}
}
// Compare the two words and find the lexicographically last one if ( -min == max ) { for ( ii = i, jj = j, l = 0;
l < leng;
ii = (ii + 1) % leng, jj = (jj + leng1) % leng, l++ )
{ if ( - INT_INTOBJ(ptRel[jj]) < INT_INTOBJ(ptRel[ii]) ) { break;
} elseif ( - INT_INTOBJ(ptRel[jj]) > INT_INTOBJ(ptRel[ii]) ) {
i = leng; break;
}
}
}
// Invert the given relator, if necessary if ( i == leng ) { for ( k = 0; k < leng / 2; k++ ) {
next = INT_INTOBJ( ptRel[k] );
ptRel[k] = INTOBJ_INT( - INT_INTOBJ( ptRel[leng1-k] ) );
ptRel[leng1-k] = INTOBJ_INT( - next );
} if ( leng % 2 ) {
ptRel[leng1/2] = INTOBJ_INT( - INT_INTOBJ( ptRel[leng1/2] ) );
}
i = leng1 - j;
}
// Now replace the given relator by the resulting word if ( i > 0 ) {
k = INT_INTOBJ( GcdInt( INTOBJ_INT(i), INTOBJ_INT(leng) ) );
l = leng / k;
leng1 = leng - i; for ( j = 0; j < k; j++ ) {
jj = (j + i) % leng;
obj1 = ptRel[jj]; for ( ii = 0; ii < l; ii++ ) {
jj = (jj + leng1) % leng;
obj2 = ptRel[jj]; ptRel[jj] = obj1; obj1 = obj2;
}
}
}
return 0;
}
/**************************************************************************** ** *F FuncTreeEntry( <self>, <tree>, <word> ) . tree entry for the given word ** ** 'FuncTreeEntry' determines a tree entry which represents the given word ** in the current generators, if it finds any, or it defines a new proper ** tree entry, and then returns it.
*/ static Obj FuncTreeEntry(Obj self, Obj tree, Obj word)
{
Obj * ptTree1; // pointer to that component
Obj * ptTree2; // pointer to that component
Obj * ptWord; // pointer to that word
Obj new; // handle of new word
Obj * ptNew; // pointer to new word
Obj * ptFac; // pointer to old word Int treesize; // tree size Int numgens; // tree length Int leng; // word length Int sign; // integer variable Int i, j, k; // integer variables Int gen; // generator value Int u, u1, u2; // generator values Int v, v1, v2; // generator values Int t1, t2; // generator values Int uabs, vabs; // generator values
// Get and check the first argument (tree)
objTree = tree; if ( ! IS_PLIST(tree) || LEN_PLIST(tree) < 5 ) {
ErrorQuit("invalid ", 0, 0);
}
// copy the word to the new bag
ptWord = BASE_PTR_PLIST(objTree2) - 1;
ptNew = BASE_PTR_PLIST(new) - 1; while ( leng > 0 ) {
ptNew[leng] = ptWord[leng];
leng--;
}
return INTOBJ_INT( sign * numgens );
}
// handle the general case if ( LEN_PLIST(objTree1) != LEN_PLIST(objTree2) ) {
ErrorQuit("inconsistent components", 0, 0);
}
for ( i = 1; i <= numgens; i++ ) { if ( INT_INTOBJ(ptTree1[i]) <= -i || INT_INTOBJ(ptTree1[i]) >= i
|| INT_INTOBJ(ptTree2[i]) <= -i || INT_INTOBJ(ptTree2[i]) >= i )
{
ErrorQuit("invalid components", 0, 0);
}
}
// Freely reduce the given word
leng = LEN_PLIST(word); for ( j = 0, i = 1; i <= leng; i++ ) {
gen = INT_INTOBJ(ptWord[i]); if ( gen == 0 ) { continue;
} if ( gen > numgens || gen < -numgens ) {
ErrorQuit("invalid entry [%d]", i, 0);
} if ( j > 0 && gen == - INT_INTOBJ(ptWord[j]) ) {
j--;
} else {
ptWord[++j] = ptWord[i];
}
} for ( i = j + 1; i <= leng; i++ ) {
ptWord[i] = INTOBJ_INT( 0 );
}
leng = j;
gen = ( leng == 0 ) ? 0 : INT_INTOBJ( ptWord[1] );
u2 = 0; // just to shut up gcc for ( i = 2; i <= leng; i++ ) {
u = gen;
v = INT_INTOBJ( ELM_PLIST(word,i) ); while ( i ) {
// First handle the trivial cases if ( u == 0 || v == 0 || ( u + v ) == 0 ) {
gen = u + v; break;
}
// Cancel out factors, if possible
u1 = INT_INTOBJ( ptTree1[ (u > 0) ? u : -u ] ); if ( u1 != 0 ) { if ( u > 0 ) {
u2 = INT_INTOBJ( ptTree2[u] );
} else {
u2 = - u1;
u1 = - INT_INTOBJ( ptTree2[-u] );
} if ( u2 == -v ) {
gen = u1; break;
}
}
v1 = INT_INTOBJ( ptTree1[ (v > 0) ? v : -v ] ); if ( v1 != 0 ) { if ( v > 0 ) {
v2 = INT_INTOBJ( ptTree2[v] );
} else {
v2 = - v1;
v1 = - INT_INTOBJ( ptTree2[-v] );
} if ( v1 == -u ) {
gen = v2; break;
} if ( u1 != 0 && v1 == - u2 ) {
u = u1;
v = v2; continue;
}
}
// Check if there is already a tree entry [u,v] or [-v,-u] if ( u < -v ) {
t1 = u;
t2 = v;
} else {
t1 = -v;
t2 = -u;
}
uabs = ( u > 0 ) ? u : -u;
vabs = ( v > 0 ) ? v : -v;
k = ( uabs > vabs ) ? uabs : vabs; for ( k++; k <= numgens; k++ ) { if ( INT_INTOBJ(ptTree1[k]) == t1 &&
INT_INTOBJ(ptTree2[k]) == t2 )
{ break;
}
}
/**************************************************************************** ** *F FuncStandardizeTable2C(<self>,<table>,<table2>,<stan>) . standardize ACT ** ** This is the kernel routine for standardizing an augmented coset table. It ** is called by the GAP routine 'StandardizeTable2'. The user should not ** call the kernel routine but only the GAP routine. ** ** If <stan> = 1 the table is standardized using the (old) semilenlex ** standard. ** If not <stan> = 1 the table is standardized using the (new) lenlex ** standard (this is the default).
*/ static Obj FuncStandardizeTable2C(Obj self, Obj table, Obj table2, Obj stan)
{
Obj * ptTable; // pointer to table
Obj * ptTabl2; // pointer to coset factor table
UInt nrgen; // number of rows of the table / 2
Obj * g; // one generator list from table
Obj * h; // generator list
Obj * i; // and inverse
Obj * h2; // corresponding factor lists
Obj * i2; // and inverse
UInt acos; // actual coset
UInt lcos; // last seen coset
UInt mcos;
UInt c1, c2; // coset temporaries
Obj tmp; // temporary for swap
UInt j, k, nloop; // loop variables
// get the arguments
objTable = table;
ptTable = BASE_PTR_PLIST(objTable) - 1;
nrgen = LEN_PLIST(objTable) / 2; for ( j = 1; j <= nrgen*2; j++ ) { if ( ! IS_PLIST(ptTable[j]) ) {
ErrorQuit( "
[%d] must be a plain list (not a %s)",
(Int)j,
(Int)TNAM_OBJ(ptTable[j]) );
}
}
objTable2 = table2;
ptTabl2 = BASE_PTR_PLIST(objTable2) - 1; if (stan == INTOBJ_INT(1)) { // use semilenlex standard
nloop = nrgen;
} else { // use lenlex standard
nloop = nrgen*2;
}
// run over all cosets
acos = 1;
lcos = 1; while ( acos <= lcos ) {
// scan through all columns of acos for ( j = 1; j <= nloop; j++ ) {
k = ( nloop == nrgen ) ? 2*j - 1 : j;
g = BASE_PTR_PLIST(ptTable[k]) - 1;
// if we haven't seen this coset yet if ( lcos+1 < INT_INTOBJ( g[acos] ) ) {
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
