Quellcode-Bibliothek stbcbckt.gi Sprache: unbekannt

#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Heiko Theißen.
##
## 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 basic routines for permutation group backtrack
## algorithms that are based on partitions. These routines are used in the
## calculation of set stabilizers, normalizers, centralizers and
## intersections.
##

if not IsBound( LARGE_TASK ) then LARGE_TASK := false; fi;

# set some global variables
BindGlobal("STBBCKT_STRING_CENTRALIZER",MakeImmutable("Centralizer"));
BindGlobal("STBBCKT_STRING_REGORB1",MakeImmutable("_RegularOrbit1"));
BindGlobal("STBBCKT_STRING_REGORB2",MakeImmutable("RegularOrbit2"));
BindGlobal("STBBCKT_STRING_REGORB3",MakeImmutable("RegularOrbit3"));
BindGlobal("STBBCKT_STRING_SPLITOFF",MakeImmutable("SplitOffBlock"));
BindGlobal("STBBCKT_STRING_INTERSECTION",MakeImmutable("Intersection"));
BindGlobal("STBBCKT_STRING_PROCESSFIX",MakeImmutable("ProcessFixpoint"));
BindGlobal("STBBCKT_STRING_MAKEBLOX",MakeImmutable("_MakeBlox"));
BindGlobal("STBBCKT_STRING_SUBORBITS0",MakeImmutable("Suborbits0"));
BindGlobal("STBBCKT_STRING_SUBORBITS1",MakeImmutable("Suborbits1"));
BindGlobal("STBBCKT_STRING_SUBORBITS2",MakeImmutable("Suborbits2"));
BindGlobal("STBBCKT_STRING_SUBORBITS3",MakeImmutable("Suborbits3"));
BindGlobal("STBBCKT_STRING_TWOCLOSURE",MakeImmutable("TwoClosure"));

#############################################################################
##
#V Refinements . . . . . . . . . . . . . . . record of refinement processes
##
BindGlobal( "Refinements", AtomicRecord() );

#############################################################################
##
#F IsSlicedPerm( <perm> ) . . . . . . . . . . . . . . . sliced permutations
##
DeclareRepresentation( "IsSlicedPerm", IsPerm and IsComponentObjectRep,
 [ "length", "word", "lftObj","opr" ] );

#############################################################################
##
#F UnslicedPerm@( <perm> ) . . . . . . . . . . . . . . . . . . . . . . local
##
InstallGlobalFunction( UnslicedPerm@, function( perm )
 local prm, i;

 if IsSlicedPerm( perm ) then
 prm := ();
 for i in [ 1 .. perm!.length ] do
 prm := LeftQuotient( perm!.word[ i ], prm );
 od;
 return prm;
 else
 return perm;
 fi;
end );

InstallMethod( \^, "sliced perm",true, [ IsPerm, IsSlicedPerm ], 0,
 function( p, perm ) return p ^ UnslicedPerm@( perm ); end );
InstallMethod( \^, "sliced perm",true, [ IsInt, IsSlicedPerm ], 0,
 function( p, perm )
 local i;

 for i in Reversed( [ 1 .. perm!.length ] ) do
 p := p / perm!.word[ i ];
 od;
 return p;
end );

InstallOtherMethod( \/,"sliced perm", true, [ IsObject, IsSlicedPerm ], 0,
 function( p, perm )
 local i;

 for i in [ 1 .. perm!.length ] do
 p := p ^ perm!.word[ i ];
 od;
 return p;
end );

InstallMethod( PrintObj,"sliced perm", true, [ IsSlicedPerm ], 0,
 function( perm )
 Print( "<perm word of length ", perm!.length, ">" );
end );

InstallMethod( ViewObj,"sliced perm", true, [ IsSlicedPerm ], 0,
 function( perm )
 Print( "<perm word of length ", perm!.length, ">" );
end );

DeclareRepresentation( "IsSlicedPermInv", IsPerm and IsComponentObjectRep,
 [ "length", "word", "lftObj", "opr" ] );

InstallOtherMethod( \^,"sliced perm", true, [ IsObject, IsSlicedPermInv ], 0,
 function( p, perm )
 local i;

 for i in [ 1 .. perm!.length ] do
 p := p ^ perm!.word[ i ];
 od;
 return p;
end );

InstallMethod( PrintObj,"sliced perm", true, [ IsSlicedPermInv ], 0,
 function( perm )
 Print( "<perm word of length ", perm!.length, ">" );
end );

InstallMethod( ViewObj,"sliced perm", true, [ IsSlicedPermInv ], 0,
 function( perm )
 Print( "<perm word of length ", perm!.length, ">" );
end );

#############################################################################
##
#F PreImageWord( , <word> ) . . . . . . preimage under sliced permutation
##
InstallGlobalFunction( PreImageWord, function( p, word )
 local i;

 for i in Reversed( [ 1 .. Length( word ) ] ) do
 p := p / word[ i ];
 od;
 return p;
end );

#############################################################################
##
#F ExtendedT( <t>, <pnt>, <img>, <G> ) . . prescribe one more image for <t>
##
InstallGlobalFunction( ExtendedT, function( t, pnt, img, simg, G )
 local bpt, len, edg;

 # Map the image with the part <t> that is already known.
 if simg = 0 then img := img / t;
 else img := simg; fi;

 # If <G> fixes <pnt>, nothing more can be changed, so test whether <pnt>
 # = <img>.
 bpt := BasePoint( G );
 if bpt <> pnt then
 if pnt <> img then
 return false;
 fi;

 elif not IsBound( G.translabels[ img ] ) then
 return false;
 elif IsSlicedPerm( t ) then
 len := t!.length;
 while img <> bpt do
 len := len + 1;
 edg := G.transversal[ img ];
 img := img ^ edg;
# t!.rgtObj := t!.opr( t!.rgtObj, edg );
 t!.word[ len ] := edg;
 od;
 t!.length := len;
 else
 t := LeftQuotient( InverseRepresentative( G, img ), t );
 fi;

 return t;
end );

#############################################################################
##
#F MeetPartitionStrat( <rbase>,<image>,<S>,<strat> ) . meet acc. to <strat>
##
InstallGlobalFunction( MeetPartitionStrat, function(rbase,image,S,g,strat )
local P, p;

 if Length( strat ) = 0 then
 return false;
 fi;

 P := image.partition;
 for p in strat do
 if p[1] = 0 and
 not ProcessFixpoint( image, p[2], FixpointCellNo( P, p[3] ) )
 or p[1] <> 0 and
 SplitCell( P, p[1], S, p[2], g, p[3] ) <> p[3] then
 return false;
 fi;
 od;
 return true;
end );

#############################################################################
##
#F StratMeetPartition( <rbase>, , <S>, <g> ) . construct a meet strategy
##
## Entries in <strat> have the following meaning:
## [p,s,i] (p<>0) means that `0 < |P[p]\cap S[s]/g| = i < |P[p]|',
## i.e., a new cell with points was appended to 
## (and these have been taken out of `P[p]'),
## [0,a,p] means that fixpoint <a> was mapped to fixpoint in `P[p]',
## i.e., `P[p]' has become a one-point cell.
##
InstallGlobalFunction( StratMeetPartition, function( arg )
 local P, S, # first and second partition
 g, # permutation such that meet <S> / <g> is constructed
 rbase, # R-base record, which records processing of fixpoints
 strat, # meet strategy, the result
 p, s, # indices looping over the cells of resp. <S>
 i, # result of call to `SpliltCell'
 pnt, # fixpoint to be processed
 cellsP, #\
 blist, #/ see explanation below
 splits,
 lS,
 cell, nrcells;

 if not IsPartition( arg[ 1 ] ) then rbase := arg[ 1 ]; p := 2;
 else rbase := false; p := 1; fi;
 P := arg[ p ];
 S := arg[ p + 1 ];
 if Length( arg ) = p + 2 then g := arg[ p + 2 ];
 else g := (); fi;
 strat := [ ];

 # <cellsP> is a list whose <a>th entry is if `a^g in P[p]'. Then
 # `Set(cellsP{S[s]})' is the set of (numbers of) cells of that
 # contain a point from `S[s]/g'. A cell splits iff it contains points for
 # two such values of <s>.
 if IsOne( g ) then
 cellsP := P.cellno;
 else
 cellsP := ListWithIdenticalEntries( Length( P.cellno ), 0 );
 for i in [ 1 .. NumberCells( P ) ] do
 cell := Cell( P, i );
 cellsP{ OnTuples( cell, g ) } := i + 0 * cell;
 od;
 fi;

 # If <S> is just a set, it is interpreted as partition ( <S>|<S>^compl ).
 if IsPartition( S ) then
 nrcells := NumberCells( S ) - 1;
 lS:=S;
 else
 nrcells := 1;
 blist := BlistList( [ 1 .. NumberCells( P ) ], cellsP{ S } );
 p := Position( blist, true );
 if p <> fail then
 IntersectBlist( blist, BlistList( [ 1 .. NumberCells( P ) ],
 cellsP{ Difference( [ 1 .. Length( P.cellno ) ], S ) } ) );
 p := Position( blist, true );
 fi;
 lS:=S;
 S := false;
 fi;

 for s in [ 1 .. nrcells ] do
 # now split with cell number s of S.
 if S=false then
 p:=lS;
 else
 p:=Cell(S,s);
 fi;
 p:=cellsP{p}; # the affected P-cells
 p:=Collected(p);
 splits:=[];
 for i in p do
 # a cell will split iff it contains more points than are in the
 # s-cell
 if P.lengths[i[1]]>i[2] then
 Add(splits,i[1]);
 fi;
 od;

 # this code is new, the extensive construction of blists in the old
 # version was awfully slow in larger degrees. ahulpke 11-aug-00
 for p in splits do
 # Last argument `true' means that the cell will split.
 i := SplitCell( P, p, lS, s, g, true );
 if not IsOne( g ) then
 cell := Cell( P, NumberCells( P ) );
 cellsP{ OnTuples( cell, g ) } := NumberCells( P ) + 0 * cell;
 fi;

 if rbase <> false then
 Add( strat, [ p, s, i ] );

 # If we have one or two new fixpoints, put them into the
 # base.
 if i = 1 then
 pnt := FixpointCellNo( P, NumberCells( P ) );
 ProcessFixpoint( rbase, pnt );
 Add( strat, [ 0, pnt, NumberCells( P ) ] );
 if IsTrivialRBase( rbase ) then
 return strat;
 fi;
 fi;
 if P.lengths[ p ] = 1 then
 pnt := FixpointCellNo( P, p );
 ProcessFixpoint( rbase, pnt );
 Add( strat, [ 0, pnt, p ] );
 if IsTrivialRBase( rbase ) then
 return strat;
 fi;
 fi;

 fi;
# p := Position( blist, true, p );
 od;
 od;
 return strat;
end );

# the following functions are for suborbits given by blists, by element
# lists, or as points (the latter are crucial to save memory)
InstallGlobalFunction(SuboLiBli,function(ran,b)
 if IsInt(b) then
 return [b];
 elif IsBlistRep(b) then
 return ListBlist(ran,b);
 fi;
 return b;
end);

InstallGlobalFunction(SuboSiBli,function(b)
 if IsInt(b) then
 return 1;
 elif IsBlistRep(b) then
 return SizeBlist(b);
 else
 return Length(b);
 fi;
end);

InstallGlobalFunction(SuboTruePos,function(ran,b)
 if IsInt(b) then
 return Position(ran,b);
 elif IsBlistRep(b) then
 return Position(b,true);
 elif HasIsSSortedList(b) and IsSSortedList(b) then
 return Position(ran,MinimumList(b));
 else
 return First([1..Length(ran)],i->ran[i] in b);
 fi;
end);

InstallGlobalFunction(SuboUniteBlist,function(ran,a,b)
 if IsInt(b) then
 a[Position(ran,b)]:=true;
 elif IsBlistRep(b) then
 UniteBlist(a,b);
 else
 #UniteBlist(a,BlistList(ran,b));
 UniteBlistList(ran,a,b);
 fi;
end);

# sb is a list of length 3: [points,subs,blists]. The function returns a
# cell as sorted list of points
InstallGlobalFunction(ConcatSubos,function(ran,sb)
local b,i;
 if Length(sb[3])>0 then
 # blists are used
 b:=ShallowCopy(sb[3][1]);
 for i in [2..Length(sb[3])] do
 UniteBlist(b,sb[3][i]);
 od;
 UniteBlistList(ran,b,sb[1]);
 for i in sb[2] do
 UniteBlistList(ran,b,i);
 od;
 return ListBlist(ran,b);
 elif Length(sb[2])>0 then
 # blists are not used but worth using
 b:=BlistList(ran,sb[1]);
 for i in sb[2] do
 UniteBlistList(ran,b,i);
 od;
 return ListBlist(ran,b);
 else
 b:=ShallowCopy(sb[1]);
 for i in sb[2] do
 UniteSet(b,i);
 od;
 return b;
 fi;
end);

#############################################################################
##
#F Suborbits( <G>, <tofix>, , <Omega> ) . . . . . . . . . . . . suborbits
##
## Returns a record with the following components:
##
## domain: the set <Omega>
## stabChainTop: top level of stabilizer chain for $G_tofix$ (pointwise stabilizer) with
## base point <a> (may be different from )
## conj: an element mapping to <a>
## which: a list whose th entry is the number of the suborbit
## containing 
## lengths: a (not strictly) sorted list of suborbit lengths (subdegrees)
## byLengths: a list whose th entry is the set of numbers of suborbits of
## the th distinct length appearing in `lengths'
## partition: the partition into unions of suborbits of equal length
## The next three entries are lists whose <k> entry refers to the <k>th
## suborbit.
## blists: the suborbits as boolean lists
## reps: a transversal in <G> s.t. $a.reps[k]$ lies in the <k>th
## suborbit (reps[k] = `false' if this is impossible)
## orbitalPartitions:
## a list to store the `OrbitalPartition' for each suborbit in
##
InstallGlobalFunction( Suborbits, function( arg )
 local H, tofix, b, Omega, suborbits, len, bylen,
 G, GG, a, conj, ran, subs, all, k, pnt, orb, gen,
 perm, omega, P, cell, part, p, i, la,bl,
 rep,rep2,te,stabgens;

 # Get the arguments.
 H := arg[ 1 ];
 tofix := arg[ 2 ];
 b := arg[ 3 ];
 Omega := arg[ 4 ];
 IsRange(Omega);
 if b = 0 then part := false; b := Omega[ 1 ];
 else part := true; fi;

 G := StabChainMutable( H );
 bl:=Length(BaseStabChain(G));
 conj := One( H );

 # Replace <H> by the stabilizer of all elements of <tofix> except the
 # last.
 len := Length( tofix );
 for i in [ 1 .. len ] do
 conj := conj * InverseRepresentative( G, tofix[ i ] ^ conj );
 G := G.stabilizer;
 od;

 if len <> 0 then
 b := b ^ conj;
 suborbits:=[];
 else
 if not IsBound( H!.suborbits ) then
 H!.suborbits := [ ];
 fi;
 suborbits := H!.suborbits;
 fi;

 # Replace by the minimal element <a> in its <G>-orbit.
 # rep 0 is an element that maps to the orbits base point
 if not IsInBasicOrbit( G, b ) then
 GG := EmptyStabChain( [ ], One( H ), b );
 AddGeneratorsExtendSchreierTree( GG, G.generators );
 else
 GG := G;
 fi;
 a := Minimum( GG.orbit );

 rep:=InverseRepresentative(GG,b);
 rep2:=InverseRepresentative(GG,a)^-1;
 conj := conj * rep*rep2;

 # try whether a and b are in the same path
 #conj := conj * InverseRepresentative( GG, b ) /
 # InverseRepresentative( GG, a );

 ran := Immutable([ 1 .. Maximum( Omega ) ]);
 IsSSortedList(ran);

 k:=1;
 while k<=Length(suborbits)
 and (suborbits[k][1]<>a or Omega<>suborbits[k][2]) do
 k:=k+1;
 od;
 if k<=Length(suborbits) and suborbits[k][1]=a and Omega=suborbits[k][2] then
 subs := suborbits[ k ][3];
 Info(InfoBckt,2,"Cached suborbits ",a);
 else
 Info(InfoBckt,2,"Enter suborbits ",Size(H),":",a);

 # Construct the suborbits rooted at <a>.
 # GG is a head of a stabilizer chain with base orbit containing
 # b with min elm a
 if not IsIdenticalObj(G,GG) then
 GG:=CopyStabChain( G );
 ChangeStabChain( GG, [ a ], false );
 te:=GG.transversal;
 stabgens:=GG.stabilizer.generators;
 Unbind(GG);
 else
 stabgens:=G.stabilizer.generators;
 # now conjugate with rep, so that we get things based at 'a'
 # rep2 maps the basepoint to a
 te:=ShallowCopy(G.transversal);
 te[G.orbit[1]]:=rep2; # just one mapper further
 te[a]:=G.identity;
 stabgens:=List(stabgens,i->i^rep2);
 fi;

 subs := rec( stabChainTop := rec(orbit:=[a],
 transversal:=te,
 identity:=G.identity),
 domain := Omega,
 which := ListWithIdenticalEntries( Length(ran), 0 ),
 reps := [ G.identity ],
 blists:=[],
 lengths := [ 1 ],
 orbitalPartitions := [ ] );
 subs.blists[1]:=[a];
 subs.which[ a ] := 1;
 if IsRange(Omega) and 1 in Omega then
 all:=BlistList(ran,[]);
 else
 all := BlistList( ran, ran );
 SubtractBlist( all, BlistList( ran, Omega ) );
 fi;
 all[ a ] := true;
 la:=Length(all)-1;

 k := 1;
 pnt := Position( all, false );
 while pnt <> fail do
 k := k + 1;
 orb := [ pnt ];
 all[ pnt ] := true;
 for p in orb do
 for gen in stabgens do
 i := p ^ gen;
 if not all[ i ] then
 Add( orb, i );
 all[ i ] := true;
 fi;
 od;
 od;
 la:=la-Length(orb);
 subs.which{ orb } := k + 0 * orb;
 #if IsInBasicOrbit( G, pnt ) then
 if IsBound(te[pnt]) then
 subs.reps[ k ] := true;
 subs.lengths[ k ] := Length( orb );
 else
 # Suborbits outside the root's orbit get negative length.
 subs.reps[ k ] := false;
 subs.lengths[ k ] := -Length( orb );
 fi;
 #UniteBlist( all, sublique );
 if QuoInt(Length(ran),Length(orb))>100 then
 if Length(orb)=1 then
 subs.blists[ k ] := orb[1];
 else
 subs.blists[ k ] := Immutable(Set(orb));
 fi;
 else
 subs.blists[ k ] := BlistList(ran,orb);
 fi;
 if la=0 then
 pnt:=fail;
 else
 pnt := Position( all, false, pnt );
 fi;
 od;
 subs.sublilen:=Length(subs.blists);

 # store if not too many
 if Length(suborbits)>bl then
 for i in [1..Length(suborbits)-1] do
 suborbits[i]:=suborbits[i+1];
 od;
 suborbits[Length(suborbits)]:=[a,Omega,subs];
 else
 Add(suborbits,[a,Omega,subs]);
 fi;

 fi;

 if part and not IsBound( subs.partition ) then
 if not IsBound( subs.lengths ) then
Error("this should not happen 2719");
# subs.lengths := [ ];
# for k in [ 1 .. subs.sublilen ] do
# if subs.reps[ k ] = false then
# Add( subs.lengths, -SizeBlist( subs.blists[k] ) );
# else
# Add( subs.lengths, SizeBlist( subs.blists[k] ) );
# fi;
# od;
 fi;
 perm := Sortex( subs.lengths ) ^ -1;

 # Determine the partition into unions of suborbits of equal length.
 subs.byLengths := [ ];
 P := [ ]; omega := Set( Omega ); cell := [ ]; bylen := [ ];
 for k in [ 1 .. Length( subs.lengths ) ] do
 Append( cell, SuboLiBli( ran, subs.blists[ k ^ perm ] ) );
 AddSet( bylen, k ^ perm );
 if k = Length( subs.lengths )
 or subs.lengths[ k + 1 ] <> subs.lengths[ k ] then
 Add( P, cell ); SubtractSet( omega, cell ); cell := [ ];
 Add( subs.byLengths, bylen ); bylen := [ ];
 fi;
 od;
 if Length( omega ) <> 0 then
 Add( P, omega );
 fi;
 subs.partition := Partition( P );
 fi;
 subs := ShallowCopy( subs );
 subs.conj := conj;
 return subs;
end );

#############################################################################
##
#F OrbitalPartition( <subs>, <k> ) . . . . . . . . . . make a nice partition
##
##
## ahulpke, added aug-2-00: If there are only one or two cells, the function
## will return just one cell (the partitions split functions can treat this
## as a special case anyhow).
InstallGlobalFunction( OrbitalPartition, function( subs, k )
local dom, # operation domain for the group
 ran, # range including <dom>, for blist construction
 d, # number of suborbits, estimate for diameter
 len, # current path length
 K, # set of suborbits <k> to process
 Key, # discriminating information for each suborbit
 key, # discriminating information for suborbit number <k>
 old, # farthest distance zone constructed so far
 new, # new distance zone being constructed
 img, # new endpoint of path with known predecessor
 o, i, # suborbit of predecessor resp. endpoint
 P, # points ordered by <key> information, as partition
 typ, # types of <key> information that occur
 sub, # suborbit as list of integers
 csiz,
 pos; # position of cell with given <key> in 

 if IsInt( k ) and IsBound( subs.orbitalPartitions[ k ] ) then
 Info(InfoBckt,2,"Orbital partition ",k," cached");
 P:=subs.orbitalPartitions[k];
 else
 ran := Immutable([ 1 .. Length( subs.which ) ]);
 IsSSortedList(ran);
 d := subs.sublilen;
 if IsRecord( k ) then K := k.several;
 else K := [ k ]; fi;
 Key := 0;
 for k in K do
 if IsList( k ) and Length( k ) = 1 then
 k := k[ 1 ];
 fi;
 key := ListWithIdenticalEntries( d, 0 );

 # Initialize the flooding algorithm for the <k>th suborbit.
 if IsInt( k ) then
 if subs.reps[ k ] = false then
 sub := 0;
 key[ k ] := -1;
 new := [ ];
 else
 sub := SuboLiBli( ran, subs.blists[ k ] );
 key[ k ] := 1;
 new := [ k ];
 fi;
 else
 #sub := ListBlist( ran, UnionBlist( subs.blists{ k } ) );
 if IsEmpty(k) then
 sub:=[];
 else
 sub:=subs.blists[k[1]];
 if IsInt(sub) then
 sub:=BlistList(ran,[sub]);
 elif not IsBool(sub[1]) then
 sub:=BlistList(ran,sub);
 else
 sub:=ShallowCopy(sub); # don't overwrite
 fi;
 for o in [2..Length(k)] do
 SuboUniteBlist(ran,sub,subs.blists[k[o]]);
 od;
 sub:=ListBlist(ran,sub);
 fi;

 key{ k } := 1 + 0 * k;
 new := Filtered( k, i -> subs.reps[ i ] <> false );
 fi;
 len := 1;

 # If no new points were found in the last round, stop.
 while Length( new ) <> 0 do
 len := len + 1;
 old := new;
 new := [ ];

 # Map the suborbit with each old representative.
 for o in old do
 if subs.reps[o]<>false then
 if subs.reps[ o ] = true then
 subs.reps[ o ] := InverseRepresentative( subs.stabChainTop,
 SuboTruePos(ran, subs.blists[ o ] ) ) ^ -1;
 fi;
 for img in OnTuples( sub, subs.reps[ o ] ) do

 # Find the suborbit of the image.
 i := subs.which[ img ];

 # If this suborbit is encountered for the first time, add
 # it to <new> and store its distance <len>.
 if key[ i ] = 0 then
 Add( new, i );
 key[ i ] := len;
 fi;

 # Store the arrow which starts at suborbit <o>.
 key[ o ] := key[ o ] + d *
 Length( sub ) ^ ( key[ i ] mod d );
 od;
 else
 Info(InfoWarning,1,"suborbits variant triggered, check!");
 fi;
 od;
 od;

 if sub <> 0 then
 Key := Key * ( d + d * Length( sub ) ^ d ) + key;
 fi;
 od;

 # Partition <dom> into unions of suborbits w.r.t. the values of
 # <Key>.
 if Key = 0 then
 P:=[];
 if IsInt( k ) then
 subs.orbitalPartitions[ k ] := P;
 fi;
 return P;
 else

#T1:=Runtime()-T1;
 typ := Set( Key );
 csiz:=ListWithIdenticalEntries(Length(typ),0);
 dom:=List(typ,i->[[],[],[]]);
 for i in [1..Length(Key)] do
 pos := Position( typ, Key[ i ] );
 csiz[pos]:=csiz[pos]+AbsInt(subs.lengths[i]);
 if IsInt(subs.blists[i]) then
 AddSet(dom[pos][1],subs.blists[i]);
 elif IsBlistRep(subs.blists[i]) then
 Add(dom[pos][3],subs.blists[i]);
 else
 Add(dom[pos][2],subs.blists[i]);
 fi;
 od;
 if Sum(csiz)=Length(subs.domain) and Length(typ)=1 then
 P:=[];
 if IsInt( k ) then
 subs.orbitalPartitions[ k ] := P;
 fi;
 return P;
 elif Sum(csiz)=Length(subs.domain) and Length(typ)=2 then
 # only two cells
 # we need to indicate the first cell, the trick to take the sorted
 # one does not work
 P:=ConcatSubos(ran,dom[1]);
 if IsInt( k ) then
 subs.orbitalPartitions[ k ] := P;
 fi;
 return P;
 fi;

 P:=[];
 for pos in [1..Length(typ)] do
 sub := ConcatSubos( ran, dom[pos] );
 Add(P,sub);
 od;
#fi;
#T1:=Runtime()-T1;

 if Sum(List(P,Length)) <> Length(subs.domain) then
 # there are fixpoints missing
 Add( P, Difference(subs.domain,Union(P)));
 fi;

 fi;

 P := Partition( P );
 if IsInt( k ) then
 subs.orbitalPartitions[ k ] := P;
 fi;

 fi;
 return P;
end );

#############################################################################
##
#F EmptyRBase( <G>, <Omega>, ) . . . . . . . . . . . . initialize R-base
##
InstallGlobalFunction( EmptyRBase, function( G, Omega, P )
 local rbase, pnt;

 rbase := rec( domain := Omega,
 base := [ ],
 where := [ ],
 rfm := [ ],
 partition := StructuralCopy( P ),
 lev := [ ] );
 if IsList( G ) then
 if IsIdenticalObj( G[ 1 ], G[ 2 ] ) then
 rbase.level2 := true;
 else
 rbase.level2 := CopyStabChain( StabChainImmutable( G[ 2 ] ) );
 rbase.lev2 := [ ];
 fi;
 G := G[ 1 ];
 else
 rbase.level2 := false;
 fi;
# if IsSymmetricGroupQuick( G ) then
# Info( InfoBckt, 1, "Searching in symmetric group" );
# rbase.fix := [ ];
# rbase.level := NrMovedPoints( G );
# else
 rbase.chain := CopyStabChain( StabChainImmutable( G ) );
 rbase.level := rbase.chain;
# fi;

 # Process all fixpoints in .
 for pnt in Fixcells( P ) do
 ProcessFixpoint( rbase, pnt );
 od;

 return rbase;
end );

#############################################################################
##
#F IsTrivialRBase( <rbase> ) . . . . . . . . . . . . . . is R-base trivial?
##
InstallGlobalFunction( IsTrivialRBase, function( rbase )
 return IsInt( rbase.level )
 and rbase.level <= 1
 or IsRecord( rbase.level )
 and Length( rbase.level.genlabels ) = 0;
end );

#############################################################################
##
#F AddRefinement( <rbase>, <func>, <args> ) . . . . . register R-refinement
##
InstallGlobalFunction( AddRefinement, function( rbase, func, args )
 if Length( args ) = 0
 or not IsList( Last(args) )
 or Length( Last(args) ) <> 0 then
 Add( Last(rbase.rfm), rec( func := func,
 args := args ) );
 Info( InfoBckt, 1, "Refinement ", func, ": ",
 NumberCells( rbase.partition ), " cells" );
 fi;
end );

#############################################################################
##
#F ProcessFixpoint( <rbase>|<image>, <pnt> [, <img> ] ) . process fixpoint
##
## `ProcessFixpoint( rbase, pnt )' puts in <pnt> as new base point and steps
## down to the stabilizer, unless <pnt> is redundant, in which case `false'
## is returned.
## `ProcessFixpoint( image, pnt, img )' prescribes <img> as image for <pnt>,
## extends the permutation and steps down to the stabilizer. Returns `true'
## if this was successful and `false' otherwise.
##
InstallGlobalFunction( ProcessFixpoint, function( arg )
 local rbase, image, pnt, img, simg, t;

 if Length( arg ) = 2 then
 rbase := arg[ 1 ];
 pnt := arg[ 2 ];
 if rbase.level2 <> false and rbase.level2 <> true then
 ChangeStabChain( rbase.level2, [ pnt ] );
 if BasePoint( rbase.level2 ) = pnt then
 rbase.level2 := rbase.level2.stabilizer;
 fi;
 fi;
 if IsInt( rbase.level ) then
 rbase.level := rbase.level - 1;
 else
 ChangeStabChain( rbase.level, [ pnt ] );
 if BasePoint( rbase.level ) = pnt then
 rbase.level := rbase.level.stabilizer;
 else
 return false;
 fi;
 fi;
 else
 image := arg[ 1 ];
 pnt := arg[ 2 ];
 img := arg[ 3 ];
 if image.perm <> true then
 if Length( arg ) = 4 then simg := arg[ 4 ];
 else simg := 0; fi;
 t := ExtendedT( image.perm, pnt, img, simg, image.level );
 if t = false then
 return false;
 elif BasePoint( image.level ) = pnt then
 image.level := image.level.stabilizer;
 fi;
 image.perm := t;
 fi;
 if image.level2 <> false then
 t := ExtendedT( image.perm2, pnt, img, 0, image.level2 );
 if t = false then
 return false;
 elif BasePoint( image.level2 ) = pnt then
 image.level2 := image.level2.stabilizer;
 fi;
 image.perm2 := t;
 fi;
 fi;
 return true;
end );

#############################################################################
##
#F RegisterRBasePoint( , <rbase>, <pnt> ) . . . . . register R-base point
##
InstallGlobalFunction( RegisterRBasePoint, function( P, rbase, pnt )
 local O, strat, k, lev;

 if rbase.level2 <> false and rbase.level2 <> true then
 Add( rbase.lev2, rbase.level2 );
 fi;
 Add( rbase.lev, rbase.level );
 Add( rbase.base, pnt );
 k := IsolatePoint( P, pnt );
 Info( InfoBckt, 1, "Level ", Length( rbase.base ), ": ", pnt, ", ",
 P.lengths[ k ] + 1, " possible images" );
 if not ProcessFixpoint( rbase, pnt ) then
 Info(InfoWarning,2,"Warning: R-base point is already fixed" );
 fi;
 Add( rbase.where, k );
 Add( rbase.rfm, [ ] );
 if P.lengths[ k ] = 1 then
 pnt := FixpointCellNo( P, k );
 ProcessFixpoint( rbase, pnt );
 AddRefinement( rbase, STBBCKT_STRING_PROCESSFIX, [ pnt, k ] );
 fi;
 if rbase.level2 <> false then
 if rbase.level2 = true then lev := rbase.level;
 else lev := rbase.level2; fi;
 if not IsInt( lev ) then
 O := OrbitsPartition( lev, rbase.domain );
 strat := StratMeetPartition( rbase, P, O );
 AddRefinement( rbase, STBBCKT_STRING_INTERSECTION, [ O, strat ] );
 fi;
 fi;
end );

#############################################################################
##
#F NextRBasePoint( , <rbase> [, <order> ] ) . . . find next R-base point
##
InstallGlobalFunction( NextRBasePoint, function( arg )
 local rbase, # R-base to be extended
 P, # partition of <Omega> to be refined
 order, # order in which to try the cells of <Omega>
 lens, # sequence of cell lengths of 
 p, # the next point chosen
 k, l; # loop variables

 # Get the arguments.
 P := arg[ 1 ];
 rbase := arg[ 2 ];
 if Length( arg ) > 2 then order := arg[ 3 ];
 else order := false; fi;

 # When this is called, there is a point that is neither fixed by
 # <rbase.level> nor in .
 lens := P.lengths;
 p := fail;
 if order <> false then
 if IsInt( rbase.level ) then
 p := PositionProperty( order, p ->
 lens[ CellNoPoint(P,p ) ] <> 1 );
 else
 p := PositionProperty( order, p ->
 lens[ CellNoPoint(P,p) ] <> 1
 and not IsFixedStabilizer( rbase.level, p ) );
 fi;
 fi;

 if p <> fail then
 p := order[ p ];
 else
 lens := ShallowCopy( lens );
 order := [ 1 .. NumberCells( P ) ];
 SortParallel( lens, order );
 k := PositionProperty( lens, x -> x <> 1 );
 l := fail;
 while l = fail do
 if IsInt( rbase.level ) then
 l := 1;
 else
 l := PositionProperty
 ( P.firsts[ order[ k ] ] - 1 + [ 1 .. lens[ k ] ],
 i -> not IsFixedStabilizer( rbase.level,
 P.points[ i ] ) );
 fi;
 k := k + 1;
 od;
 p := P.points[ P.firsts[ order[ k - 1 ] ] - 1 + l ];
 fi;

 RegisterRBasePoint( P, rbase, p );
end );

#############################################################################
##
#F RRefine( <rbase>, <image>, <uscore> ) . . . . . . . . . apply refinements
##
InstallGlobalFunction( RRefine, function( rbase, image, uscore )
local Rf, t;

 if not uscore then
 for Rf in rbase.rfm[ image.depth ] do
 t := CallFuncList( Refinements.( Rf.func ), Concatenation
 ( [ rbase, image ], Rf.args ) );
 if t = false then return fail;
 elif t <> true then return t; fi;
 od;
 return true;
 else
 for Rf in rbase.rfm[ image.depth ] do
 if Rf.func[ 1 ] = '_' then
 t := CallFuncList( Refinements.( Rf.func ), Concatenation
 ( [ rbase, image ], Rf.args ) );
 if t = false then return fail;
 elif t <> true then return t; fi;
 fi;
 od;
 return true;
 fi;

 #old code
 for Rf in rbase.rfm[ image.depth ] do
 if not uscore or Rf.func[ 1 ] = '_' then
 t := CallFuncList( Refinements.( Rf.func ), Concatenation
 ( [ rbase, image ], Rf.args ) );
 if t = false then return fail;
 elif t <> true then return t; fi;
 fi;
 od;
 return true;

end );

#############################################################################
##
#F PBIsMinimal( <range>, <a>, , <S> ) . . . . . . . . . . minimality test
##
InstallGlobalFunction( PBIsMinimal, function( range, a, b, S )
 local orb, old, pnt, l, img;

 if IsInBasicOrbit( S, b ) then
 return ForAll( S.orbit, p -> a <= p );
 elif b < a then return false;
 elif IsFixedStabilizer( S, b ) then return true; fi;

 orb := [ b ];
 old := BlistList( range, orb );
 for pnt in orb do
 for l in S.genlabels do
 img := pnt ^ S.labels[ l ];
 if not old[ img ] then
 if img < a then
 return false;
 fi;
 old[ img ] := true;
 Add( orb, img );
 fi;
 od;
 od;
 return true;
end );

#############################################################################
##
#F SubtractBlistOrbitStabChain( <blist>, <R>, <pnt> ) remove orbit as blist
##
InstallGlobalFunction( SubtractBlistOrbitStabChain, function( blist, R, pnt )
 local orb, gen, img;

 orb := [ pnt ];
 blist[ pnt ] := false;
 for pnt in orb do
 for gen in R.generators do
 img := pnt ^ gen;
 if blist[ img ] then
 blist[ img ] := false;
 Add( orb, img );
 fi;
 od;
 od;
end );

#############################################################################
##
#F PartitionBacktrack( <G>, <Pr>, <repr>, <rbase>, <data>, <L>, <R> ) . . .
##
InstallGlobalFunction( PartitionBacktrack,
 function( G, Pr, repr, rbase, data, L, R )
 local PBEnumerate,
 blen, # length of R-base
 rep, # representative or `false', the result
 branch, # level where $Lstab\ne Rstab$ starts
 image, # image information running through the tree
 oldcel, # old value of <image.partition.cellno>
 orb, org, # intersected (mapped) basic orbits of <G>
 orB, # backup of <orb>
 range, # range for construction of <orb>
 fix, fixP, # fixpoints of partitions at root of search tree
 obj, prm, # temporary variables for constructed permutation
 nrback, # backtrack counter
 bail, # do we want to bail out quickly?
 i, dd, p; # loop variables

#############################################################################
##
#F PBEnumerate( ... ) . . . . . . . recursive enumeration of a subgroup
##
 PBEnumerate := function( d, wasTriv )
 local undoto, # number of cells of wanted after undoing
 oldprm, #\
 oldprm2, #/ old values of <image>
 a, # current R-base point
 m, # initial number of candidates in <orb>
 max, # maximal number of candidates still needed
 b, # image of base point currently being considered
 t; # group element constructed, to be handed upwards

 if image.perm = false then
 return fail;
 fi;
 image.depth := d;

 # Store the original values of <image.*>.
 undoto := NumberCells( image.partition );
 if image.perm = true then
 oldcel := image.partition;
 else
 oldcel := image.partition.cellno;
 if IsSlicedPerm( image.perm ) then oldprm := image.perm!.length;
 else oldprm := image.perm;
 fi;
 fi;
 if image.level2 <> false then oldprm2 := image.perm2;
 else oldprm2 := false; fi;

 # Recursion comes to an end if all base points have been prescribed
 # images.
 if d > Length( rbase.base ) then
 if IsTrivialRBase( rbase ) then
 blen := Length( rbase.base );

 # Do not add the identity element in the subgroup
 # construction.
 if wasTriv then

 # In the subgroup case, assign to <L> and <R> stabilizer
 # chains when the R-base is complete.
 L := ListStabChain( CopyStabChain( StabChainOp( L,
 rec( base := rbase.base,
 reduced := false ) ) ) );
 R := ShallowCopy( L );

 if image.perm <> true then
 Info( InfoBckt, 1, "Stabilizer chain with depths ",
 DepthSchreierTrees( rbase.chain ) );
 fi;
 Info( InfoBckt, 1, "Indices: ",
 IndicesStabChain( L[ 1 ] ) );
 return fail;

 else
 if image.perm = true then
 prm := MappingPermListList
 ( rbase.fix[ Length( rbase.base ) ],
 Fixcells( image.partition ) );
 else
 prm := image.perm;
 fi;
 if image.level2 <> false then
 prm := UnslicedPerm@( prm );
 if SiftedPermutation( image.level2,
 prm / UnslicedPerm@( image.perm2 ) )
 = image.level2.identity then
 return prm;
 fi;
 elif Pr( prm ) then
 return UnslicedPerm@( prm );
 fi;
 return fail;
 fi;

 # Construct the next refinement level. This also initializes
 # <image.partition> for the case ``image = base point''.
 else
 if not repr then
 oldcel := StructuralCopy( oldcel );
 fi;
 rbase.nextLevel( rbase.partition, rbase );
 if image.perm = true then
 Add( rbase.fix, Fixcells( rbase.partition ) );
 fi;
 Add( org, ListWithIdenticalEntries( Length( range ), 0 ) );
 if repr then

 # In the representative case, change the stabilizer
 # chains of <L> and <R>.
 ChangeStabChain( L[ d ], [ rbase.base[ d ] ], false );
 L[ d + 1 ] := L[ d ].stabilizer;
 ChangeStabChain( R[ d ], [ rbase.base[ d ] ], false );
 R[ d + 1 ] := R[ d ].stabilizer;

 fi;
 fi;

 fi;
 a := rbase.base[ d ];
 Info(InfoBckt,3,Ordinal(d)," basepoint: ",a);

 # Intersect the current cell of with the mapped basic orbit of
 # <G> (and also with the one of <H> in the intersection case).
 if image.perm = true then
 orb[ d ] := BlistList( range, Cell( oldcel, rbase.where[ d ] ) );
 if image.level2 <> false then
 b := Position( orb[ d ], true );
 while b <> fail do
 if not IsInBasicOrbit( rbase.lev2[ d ], b / image.perm2 )
 then
 orb[ d ][ b ] := false;
 fi;
 b := Position( orb[ d ], true, b );
 od;
 fi;
 else
 orb[ d ] := BlistList( range, [ ] );
 for p in rbase.lev[ d ].orbit do
 b := p ^ image.perm;
 if oldcel[ b ] = rbase.where[ d ]
 and ( image.level2 = false
 or IsInBasicOrbit( rbase.lev2[d], b/image.perm2 ) ) then
 orb[ d ][ b ] := true;
 org[ d ][ b ] := p;
 fi;
 od;
 fi;
 if d=1 and ForAll(GeneratorsOfGroup(G),x->a^x=a) then
 orb[d][a]:=true; # ensure a is a possible image (can happen if
 # acting on permutations with more points)
 fi;

 orB[ d ] := StructuralCopy( orb[ d ] );

 # Loop over the candidate images for the current base point. First
 # the special case ``image = base'' up to current level.
 if wasTriv then
 image.bimg[ d ] := a;

 # Refinements that start with '_' must be executed even when base
 # = image since they modify `image.data' etc.
 RRefine( rbase, image, true );

 # Recursion.
 PBEnumerate( d + 1, true );
 image.depth := d;

 # Now we can remove the entire <R>-orbit of <a> from the
 # candidate list.
 SubtractBlist( orb[ d ], BlistList( range, L[ d ].orbit ) );

 fi;

 # Only the early points of the orbit have to be considered.
 m := SizeBlist( orB[ d ] );
 if m < Length( L[ d ].orbit ) then
 return fail;
 fi;
 max := PositionNthTrueBlist( orB[ d ],
 m - Length( L[ d ].orbit ) + 1 );
 if wasTriv and a > max then
 m := m - 1;
 if m < Length( L[ d ].orbit ) then
 return fail;
 fi;
 max := PositionNthTrueBlist( orB[ d ],
 m - Length( L[ d ].orbit ) + 1 );
 fi;

 # Now the other possible images.
 b := Position( orb[ d ], true );
 if b <> fail and b > max then
 b := fail;
 fi;
 while b <> fail do

 # Try to prune the node with prop 8(ii) of Leon's paper.
 if not repr and not wasTriv and IsBound( R[ d ].orbit ) then
 dd := branch;
 while dd < d do
 if IsInBasicOrbit( L[ dd ], a ) and not PBIsMinimal
 ( range, R[ dd ].orbit[ 1 ], b, R[ d ] ) then
 Info( InfoBckt, 3, d, ": point ", b,
 " pruned by minimality condition" );
 dd := d + 1;
 else
 dd := dd + 1;
 fi;
 od;
 else
 dd := d;
 fi;

 if dd = d then

 # Undo the changes made to <image.partition>, <image.level>
 # and <image.perm>.
 for i in [ undoto+1 .. NumberCells( image.partition ) ] do
 UndoRefinement( image.partition );
 od;
 if image.perm <> true then
 image.level := rbase.lev[ d ];
 if IsSlicedPerm( image.perm ) then
 image.perm!.length := oldprm;
 # Here and below the code that refers to `rgtObj` was used to avoid multiplication
 # of permutations. It has been commented out for a long time, but accidentally remained
 # documented in `doc/ref/stbchain.xml` until its withdrawal in 2018.
# image.perm!.rgtObj := oldrgt;
 else
 image.perm := oldprm;
 fi;
 fi;
 if image.level2 <> false then
 image.level2 := rbase.lev2[ d ];
 image.perm2 := oldprm2;
 fi;

 # If could not be prescribed as image for <a>, or if the
 # refinement was impossible, give up for this image.
 image.bimg[ d ] := b;
 IsolatePoint( image.partition, b );

 if ProcessFixpoint( image, a, b, org[ d ][ b ] ) then
#Error(a," ",b," ",Cells(rbase.partition),Cells(image.partition));
 t := RRefine( rbase, image, false );
 else
 t := fail;
 fi;

 if t <> fail then

 # Subgroup case, base <> image at current level: <R>,
 # which until now is identical to <L>, must be changed
 # without affecting <L>, so take a copy.
 if wasTriv and IsIdenticalObj( L[ d ], R[ d ] ) then
 R{ [ d .. Length( rbase.base ) ] } := List(
 L{ [ d .. Length( rbase.base ) ] }, CopyStabChain );
 branch := d;
 fi;

 if 2 * d <= blen then
 ChangeStabChain( R[ d ], [ b ], false );
 R[ d + 1 ] := R[ d ].stabilizer;
 else
 if IsBound( R[ d ].stabilizer ) then
 R[ d + 1 ] := StrongGeneratorsStabChain( R[ d ] );
 else
 R[ d + 1 ] := R[ d ].generators;
 fi;
 R[ d + 1 ] := rec( generators := Filtered
 ( R[ d + 1 ], gen -> b ^ gen = b ) );
 fi;

 else
 Info( InfoBckt, 5, d, ": point ", b,
 " pruned by partition condition" );
 fi;

 # Recursion.
 if t = true then
 t := PBEnumerate( d + 1, false );
 nrback:=nrback+1;
 if bail and nrback>500 then
 return infinity; # bail out, this will bail out
 # recursively
 fi;
 image.depth := d;
 fi;

 # If <t> = `fail', either the recursive call was
 # unsuccessful, or all new elements have been added to
 # levels below the current one (this happens if base =
 # image up to current level).
 if t <> fail then

 # Representative case, element found: Return it.
 # Subgroup case, base <> image before current level: We
 # need only find a representative because we already
 # know the stabilizer of <L> at an earlier level.
 if repr or not wasTriv then
 return t;

 # Subgroup case, base <> image at current level: Enlarge
 # <L> with <t>. Decrease <max> according to the
 # enlarged <L>. Reset <R> to the enlarged <L>.
 else
 for dd in [ 1 .. d ] do
 AddGeneratorsExtendSchreierTree( L[ dd ], [ t ] );
 od;
 Info( InfoBckt, 1, "Level ", d,
 ": ", IndicesStabChain( L[ 1 ] ) );
 if m < Length( L[ d ].orbit ) then
 return fail;
 fi;
 max := PositionNthTrueBlist( orB[ d ],
 m - Length( L[ d ].orbit ) + 1 );
 R{ [ d .. Length( rbase.base ) ] } := List(
 L{ [ d .. Length( rbase.base ) ] }, CopyStabChain );
 fi;

 fi;

 # Now we can remove the entire <R>-orbit of from the
 # candidate list.
 if IsBound( R[ d ].translabels )
 and IsBound( R[ d ].translabels[ b ] ) then
 SubtractBlist( orb[ d ],
 BlistList( range, R[ d ].orbit ) );
 else
 SubtractBlistOrbitStabChain( orb[ d ], R[ d ], b );
 fi;

 fi;

 b := Position( orb[ d ], true, b );
 if b <> fail and b > max then
 b := fail;
 fi;
 od;

 return fail;
 end;

##
#F main function . . . . . . . . . . . . . . . . . . . . . . . . . . . .
##

 nrback:=0; # count the number of times we jumped up
 bail:=repr and ValueOption("bailout")=true;

 # If necessary, convert <Pr> from a list to a function.
 if IsList( Pr )
 and ( IsTrivial( G )
 #or IsSymmetricGroupQuick( G )
 ) then
 obj := rec( lftObj := Pr[ 1 ],
# rgtObj := Pr[ 2 ],
 opr := Pr[ 3 ],
 prop := Pr[ 4 ] );
 Pr := gen -> obj.prop
 ( rec( lftObj := obj.lftObj
# ,
# rgtObj := obj.opr( obj.rgtObj, gen ^ -1 )
 ) );
 fi;

 # Trivial cases first.
 if IsTrivial( G ) then
 if not repr then return G;
 elif Pr( One( G ) ) then return One( G );
 else return fail; fi;
 fi;

 # Construct the <image>.
 image := rec( data := data,
 bimg := [ ],
 depth := 1 );
 if repr then image.partition := data[ 1 ];
 else image.partition := rbase.partition; fi;
 if IsBool( rbase.level2 ) then
 image.level2 := false;
 else
 image.level2 := rbase.level2;
 image.perm2 := rbase.level2.identity;
 fi;

 # If <Pr> is function, multiply permutations. Otherwise, keep them
 # factorized.
# if IsSymmetricGroupQuick( G ) then
# image.perm := true;
# else
 if IsList( Pr ) then
 image.perm := Objectify
 ( NewType( PermutationsFamily, IsSlicedPerm ),
 rec( length := 0, word := [ ] ) );
 image.perm!.lftObj := Pr[ 1 ];
# image.perm!.rgtObj := Pr[ 2 ];
 image.perm!.opr := Pr[ 3 ];
 Pr := Pr[ 4 ];
 else
 image.perm := One( G );
 fi;
 image.level := rbase.chain;
# fi;

 if repr then

 # In the representative case, map the fixpoints of the partitions at
 # the root of the search tree.
 if rbase.partition.lengths <> image.partition.lengths then
 image.perm := false;
 else
 fix := Fixcells( rbase.partition );
 fixP := Fixcells( image.partition );
 for i in [ 1 .. Length( fix ) ] do
 ProcessFixpoint( image, fix[ i ], fixP[ i ] );
 od;
 fi;

 # In the representative case, assign to <L> and <R> stabilizer
 # chains.
 L := ListStabChain( CopyStabChain( StabChainImmutable( L ) ) );
 R := ListStabChain( CopyStabChain( StabChainImmutable( R ) ) );

 fi;

 org := [ ]; orb := [ ]; orB := [ ];
 range := [ 1 .. Last(rbase.domain) ];
 blen := infinity;
 rep := PBEnumerate( 1, not repr );
 if not repr then
 ReduceStabChain( L[ 1 ] );
 return GroupStabChain( G, L[ 1 ], true );
 else
 return rep;
 fi;
end );

#############################################################################
##
#F Refinements.ProcessFixpoint( <pnt>, <cellnum> ) . . . process a fixpoint
##
InstallGlobalFunction(Refinements_ProcessFixpoint,
function( rbase, image, pnt, cellnum )
 local img;

 img := FixpointCellNo( image.partition, cellnum );
 return ProcessFixpoint( image, pnt, img );
end);
Refinements.(STBBCKT_STRING_PROCESSFIX) := Refinements_ProcessFixpoint;

#############################################################################
##
#F Refinements.Intersection( <O>, <strat> ) . . . . . . . . . . second type
##
InstallGlobalFunction(Refinements_Intersection,
function( rbase, image, Q, strat )
 local t;

 if image.level2 = false then t := image.perm;
 else t := image.perm2; fi;
 if IsSlicedPerm( t ) then
 t := ShallowCopy( t );
 SET_TYPE_COMOBJ( t, NewType( PermutationsFamily, IsSlicedPermInv ) );
 else
 t := t ^ -1;
 fi;
 return MeetPartitionStrat( rbase, image, Q, t, strat );
end);
Refinements.(STBBCKT_STRING_INTERSECTION) := Refinements_Intersection;

#############################################################################
##
#F Refinements.Centralizer(<no>,<g>,<pnt>,<strat>) . P meet Pz for one point
##
InstallGlobalFunction(Refinements_Centralizer,
function( rbase, image, cellnum, g, pnt, strat )
 local P, img;

 P := image.partition;
 img := FixpointCellNo( P, cellnum ) ^ image.data[ g + 1 ];
 return IsolatePoint( P, img ) = strat
 and ProcessFixpoint( image, pnt, img );
end);
Refinements.(STBBCKT_STRING_CENTRALIZER) := Refinements_Centralizer;

#############################################################################
##
#F Refinements._MakeBlox( <rbase>, <image>, <len> ) . . . . . . . make blox
##
InstallGlobalFunction(Refinements__MakeBlox,
function( rbase, image, len )
 local F;

 F := image.data[ 2 ];
 image.data[ 4 ] := Partition( Blocks( F, rbase.domain,
 image.bimg{ [ 1, len ] } ) );
 return Collected( rbase.blox.lengths ) =
 Collected( image.data[ 4 ].lengths );
end);
Refinements.(STBBCKT_STRING_MAKEBLOX) := Refinements__MakeBlox;

#############################################################################
##
#F Refinements.SplitOffBlock( <k>, <strat> ) . . . . . . . . split off block
##
InstallGlobalFunction(Refinements_SplitOffBlock,
function( rbase, image, k, strat )
 local B, a, orb;

 B := image.data[ 4 ];
 a := FixpointCellNo( image.partition, k );
 orb := Cell( B, CellNoPoint(B,a) );
 if Length( orb ) = Length( rbase.domain ) then
 return false;
 else
 return MeetPartitionStrat( rbase, image, orb, (),strat );
 fi;
end);
Refinements.(STBBCKT_STRING_SPLITOFF) := Refinements_SplitOffBlock;

#############################################################################
##
#F Refinements._RegularOrbit1( <d>, <len> ) . . . . . . extend mapped orbit
##
## Computes orbit and transversal `bF' for group <F> = `data[6]' regular on
## that orbit.
##
InstallGlobalFunction(Refinements__RegularOrbit1,
function( rbase, image, d, len )
 local F, trees;

 trees := image.data[ 5 ];
 if d = 1 then
 F := image.data[ 6 ];
 image.regorb := EmptyStabChain( [ ], One( F ), image.bimg[ d ] );
 AddGeneratorsExtendSchreierTree( image.regorb,
 GeneratorsOfGroup( F ) );
 if Length( image.regorb.orbit ) <> Length( rbase.regorb.orbit ) then
 return false;
 fi;
 trees[ d ] := EmptyStabChain( [ ], One( F ),
 image.regorb.orbit[ 1 ] );
 else
 trees[ d ] := StructuralCopy( trees[ d - 1 ] );
 AddGeneratorsExtendSchreierTree( trees[ d ],
 [ QuickInverseRepresentative
 ( image.regorb, image.bimg[ d ] ) ^ -1 ] );
 if Length( trees[ d ].orbit ) <> len then
 return false;
 fi;
 fi;
 return true;
end);
Refinements.(STBBCKT_STRING_REGORB1) := Refinements__RegularOrbit1;

#############################################################################
##
#F Refinements.RegularOrbit2( <d>, <orb>, <strat> ) . . . meet mapped orbit
##
## Compute images `bhg' of `bh' under $g$ in `trees[<d>].orbit = bE$ ($h\in
## E$).
## Entries in <strat> have the following meaning:
## [i,j] means that the image `bhg\in P[j]' of `bh = orb[]' can be
## calculated from `bg'.
## [-p,j] means that fixpoint was mapped to fixpoint in `P[j]',
## i.e., `P[j]' has become a one-point cell.
##
InstallGlobalFunction(Refinements_RegularOrbit2,
function( rbase, image, d, orbit, strat )
 local P, trees, orb, i;

 P := image.partition;
 trees := image.data[ 5 ];
 orb := trees[ d ].orbit;
 for i in strat do
 if ( i[ 1 ] < 0
 and not ProcessFixpoint( image, -i[1], FixpointCellNo(P,i[2]) ) )
 or ( i[ 1 ] > 0
 and ( IsolatePoint( P, orb[ i[ 1 ] ] ) <> i[ 2 ]
 or not ProcessFixpoint( image, orbit[i[1]], orb[i[1]] ) ) )
 then return false;
 fi;
 od;
 return true;
end);
Refinements.(STBBCKT_STRING_REGORB2) := Refinements_RegularOrbit2;

#############################################################################
##
#F Refinements.RegularOrbit3( <f>, <strat> ) . . . . . find images of orbit
##
## Register images `yhg' of `yh' under $g$ in an arbitrary orbit `yE' ($h\in
## E$). `yg\in P[f]' is a one-point cell.
## Entries in <strat> have the following meaning:
## [yh,i,j] means that the image `yhg\in P[j]' of `yh' can be calculated
## from `yg' and `bhg\in P[i]' (a one-point cell).
## [-p,j] means that fixpoint was mapped to fixpoint in `P[j]',
## i.e., `P[j]' has become a one-point cell.
##
InstallGlobalFunction(Refinements_RegularOrbit3,
function( rbase, image, f, strat )
 local P, yg, bhg, hg, yhg, i;

 P := image.partition;
 yg := FixpointCellNo( P, f );
 for i in strat do
 if i[ 1 ] < 0 then
 if not ProcessFixpoint( image, -i[1], FixpointCellNo(P,i[2]) )
 then
 return false;
 fi;
 else
 bhg := FixpointCellNo( P, i[ 2 ] );
 hg := InverseRepresentativeWord( image.regorb, bhg );
 yhg := PreImageWord( yg, hg );
 if IsolatePoint( P, yhg ) <> i[ 3 ]
 or not ProcessFixpoint( image, i[ 1 ], yhg ) then
 return false;
 fi;
 fi;
 od;
 return true;
end);
Refinements.(STBBCKT_STRING_REGORB3) := Refinements_RegularOrbit3;

#############################################################################
##
#F Refinements.Suborbits0( <tra>, <f>, <lens>, <byLen>, <strat> ) subdegrees
##
## Computes suborbits of the stabilizer in <F> = `image.data[2]' of the
## fixpoint in cell no. <f>. (If <F> is multiply transitive, replace it by
## the stabilizer of the first <tra>-1 images of R-base points.)
##
## Returns `true' if (1)~the list of suborbit lengths (subdegrees) equals
## <lens>, (2)~the list of subdegree frequencies equals <byLen> and (3)~the
## meet with the partition into unions of suborbits of equal length
## succeeds.
##
InstallGlobalFunction(Refinements_Suborbits0,
function( rbase, image, tra, f, lens, byLen, strat )
 local F, pnt, subs;

 F := image.data[ 2 ];
 pnt := FixpointCellNo( image.partition, f );
 subs := Suborbits( F, image.bimg{ [ 1 .. tra - 1 ] }, pnt,
 rbase.domain );
 if subs.lengths <> lens
 or List( subs.byLengths, Length ) <> byLen then
 return false;
 else
 return MeetPartitionStrat( rbase, image, subs.partition, subs.conj,
 strat );
 fi;
end);
Refinements.(STBBCKT_STRING_SUBORBITS0):=Refinements_Suborbits0;

#############################################################################
##
#F Refinements.Suborbits1( <rbase>, <image>, <tra>, <f>, <k>, <strat> ) . .
##
## Meets the image partition with the orbital partition of the union of
## orbital graphs of suborbits of length `subs.byLengths[ <k> ]'. (<tra> and
## <f> as in `Suborbits0'.)
##
InstallGlobalFunction(Refinements_Suborbits1,
function( rbase, image, tra, f, k, strat )
 local F, pnt, subs, Q;

 F := image.data[ 2 ];
 pnt := FixpointCellNo( image.partition, f );
 subs := Suborbits( F, image.bimg{ [ 1 .. tra - 1 ] }, pnt,
 rbase.domain );
 Q := OrbitalPartition( subs, subs.byLengths[ k ] );
 return MeetPartitionStrat( rbase, image, Q, subs.conj, strat );
end);
Refinements.(STBBCKT_STRING_SUBORBITS1) := Refinements_Suborbits1;

#############################################################################
##
#F Refinements.Suborbits2( <rbase>, <image>, <tra>, <f>, <start>, <coll> ) .
##
## Computes for each suborbit the intersection sizes with cells <start> or
## more in the image partition. Stores the result in `data[3]' (needed only
## on this level, hence no '_'). Returns `true' if the collected result
## equals <coll>.
##
InstallGlobalFunction(Refinements_Suborbits2,
function( rbase, image, tra, f, start, coll )
 local F, types, pnt, subs, i, k;

 F := image.data[ 2 ];
 pnt := FixpointCellNo( image.partition, f );
 subs := Suborbits( F, image.bimg{ [ 1 .. tra - 1 ] }, pnt,
 rbase.domain );
 if start = 1 then
 image.data[ 3 ] := List( subs.blists, o -> [ -SuboSiBli( o ) ] );
 fi;
 types := image.data[ 3 ];
 for i in [ start .. NumberCells( image.partition ) ] do
 for k in Set( subs.which
 { OnTuples( Cell( image.partition, i ), subs.conj ) } ) do
 AddSet( types[ k ], i );
 od;
 od;
 return Collected( types ) = coll;
end);
Refinements.(STBBCKT_STRING_SUBORBITS2) := Refinements_Suborbits2;

#############################################################################
##
#F Refinements.Suborbits3( <rbase>, <image>, <tra>, <f>, <typ>, <strat> ) .
##
## Meets the image partition with the orbital partition of the union of
## orbital graphs of suborbits of type <typ>. Returns `false' if there are
## not <many> of them. (<tra> and <f> as in `Suborbits0'.)
##
InstallGlobalFunction(Refinements_Suborbits3,
function( rbase, image, tra, f, typ, many, strat )
 local F, types, pnt, subs, k, Q;

 F := image.data[ 2 ];
 types := image.data[ 3 ];
 pnt := FixpointCellNo( image.partition, f );
 subs := Suborbits( F, image.bimg{ [ 1 .. tra - 1 ] }, pnt,
 rbase.domain );
 k := Filtered( [ 1 .. subs.sublilen ], k -> types[ k ] = typ );
 if Length( k ) <> many then
 return false;
 else
 Q := OrbitalPartition( subs, k );
 return MeetPartitionStrat( rbase, image, Q, subs.conj, strat );
 fi;
end);
Refinements.(STBBCKT_STRING_SUBORBITS3) := Refinements_Suborbits3;

#############################################################################
##
#F Refinements.TwoClosure( <G>, <Q>, <d>, <strat> ) . . . . . . two-closure
##
InstallGlobalFunction(Refinements_TwoClosure,
--> --------------------

--> maximum size reached

--> --------------------

Quellcode-Bibliothek stbcbckt.gi Sprache: unbekannt

[ Verzeichnis aufwärts0.63unsichere Verbindung Übersetzung europäischer Sprachen durch Browser ]