|
#############################################################################
##
## 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
##
#############################################################################
##
#F ExternalSet( <arg> ) . . . . . . . . . . . . . external set constructor
##
InstallMethod( ExternalSet, "G, D, gens, acts, act", true, OrbitsishReq, 0,
function( G, D, gens, acts, act )
return ExternalSetByFilterConstructor( IsExternalSet,
G, D, gens, acts, act );
end );
#############################################################################
##
#F ExternalSetByFilterConstructor(<filter>,<G>,<D>,<gens>,<acts>,<act>)
##
InstallGlobalFunction( ExternalSetByFilterConstructor,
function( filter, G, D, gens, acts, act )
local xset;
xset := rec( );
if IsPcgs( gens ) then
filter := filter and IsExternalSetByPcgs;
fi;
if not IsIdenticalObj( gens, acts ) then
filter := filter and IsExternalSetByActorsRep;
xset.generators := gens;
xset.operators := acts;
xset.funcOperation := act;
else
filter := filter and IsExternalSetDefaultRep;
fi;
# Catch the case that 'D' is an empty list.
# (Note that an external set shall be a collection and not a list.)
if IsList( D ) and IsEmpty( D ) then
D:= EmptyRowVector( CyclotomicsFamily );
fi;
Objectify( NewType( FamilyObj( D ), filter ), xset );
SetActingDomain ( xset, G );
SetHomeEnumerator( xset, D );
if not IsExternalSetByActorsRep( xset ) then
SetFunctionAction( xset, act );
fi;
return xset;
end );
#############################################################################
##
#F ExternalSetByTypeConstructor(<type>,<G>,<D>,<gens>,<acts>,<act>)
##
# The following function expects the type as first argument, to avoid a call
# of `NewType'. It is called by `ExternalSubsetOp' and `ExternalOrbitOp' when
# they are called with an external set (which has already stored this type).
#
InstallGlobalFunction( ExternalSetByTypeConstructor,
function( type, G, D, gens, acts, act )
local xset;
xset := Objectify( type, rec( ) );
if not IsIdenticalObj( gens, acts ) then
xset!.generators := gens;
xset!.operators := acts;
xset!.funcOperation := act;
fi;
xset!.ActingDomain := G;
xset!.HomeEnumerator := D;
if not IsExternalSetByActorsRep( xset ) then
xset!.FunctionAction := act;
fi;
return xset;
end );
#############################################################################
##
#M RestrictedExternalSet
##
InstallMethod(RestrictedExternalSet,"restrict the acting domain",
true,[IsExternalSet,IsGroup],0,
function(xset,U)
local A,newx;
A:=ActingDomain(xset);
if IsSubset(U,A) then
return xset; # no restriction happens
fi;
if IsBound(xset!.gens) then
# we would have to decompose into generators
TryNextMethod();
fi;
newx:=ExternalSet(U,HomeEnumerator(xset),FunctionAction(xset));
return newx;
end);
#############################################################################
##
#M Enumerator( <xset> ) . . . . . . . . . . . . . . . . the underlying set
##
InstallMethod( Enumerator,"external set -> HomeEnumerator", true,
[ IsExternalSet ], 0, HomeEnumerator );
#############################################################################
##
#M FunctionAction( <p>, <g> ) . . . . . . . . . . . . acting function
##
InstallMethod( FunctionAction,"ExternalSetByActorsRep", true,
[ IsExternalSetByActorsRep ], 0,
xset -> function( p, g )
local pos,actor;
pos:=Position(xset!.generators,g);
if pos<>fail then
actor:=xset!.operators[pos];
else
pos:=Position(xset!.generators,g^-1);
if pos<>fail then
actor:=xset!.operators[pos]^-1;
else
Error("need to factor -- not yet implemented");
fi;
fi;
return xset!.funcOperation(p,actor);
# local D;
# D := Enumerator( xset );
# return D[ PositionCanonical( D, p ) ^
# ( g ^ ActionHomomorphismAttr( xset ) ) ];
end );
#############################################################################
##
#M PrintObj( <xset> ) . . . . . . . . . . . . . . . . print an external set
##
InstallMethod( PrintObj,"External Set", true, [ IsExternalSet ], 0,
function( xset )
Print(HomeEnumerator( xset ));
end );
#############################################################################
##
#M ViewObj( <xset> ) . . . . . . . . . . . . . . . . print an external set
##
InstallMethod( ViewObj,"External Set", true, [ IsExternalSet ], 0,
function( xset )
local he,i;
if not HasHomeEnumerator(xset) then
TryNextMethod();
fi;
Print("<xset:");
he:=HomeEnumerator(xset);
if Length(he)<15 then
View(he);
else
Print("[");
for i in [1..15] do
View(he[i]);
Print(",");
od;
Print(" ...]");
fi;
Print(">");
end );
#############################################################################
##
#M Representative( <xset> ) . . . . . . . . . . first element in enumerator
##
InstallMethod( Representative,"External Set", true, [ IsExternalSet ], 0,
xset -> Enumerator( xset )[ 1 ] );
#############################################################################
##
#F ExternalSubset( <arg> ) . . . . . . . . . . . . . external set on subset
##
InstallMethod( ExternalSubsetOp, "G, D, start, gens, acts, act", true,
[ IsGroup, IsList, IsList,
IsList,
IsList,
IsFunction ], 0,
function( G, D, start, gens, acts, act )
local xset;
xset := ExternalSetByFilterConstructor( IsExternalSubset,
G, D, gens, acts, act );
xset!.start := Immutable( start );
return xset;
end );
InstallOtherMethod( ExternalSubsetOp,
"G, xset, start, gens, acts, act", true,
[ IsGroup, IsExternalSet, IsList,
IsList,
IsList,
IsFunction ], 0,
function( G, xset, start, gens, acts, act )
local xsset;
xsset := ExternalSetByFilterConstructor( IsExternalSubset,
G, HomeEnumerator( xset ), gens, acts, act );
xsset!.start := Immutable( start );
return xsset;
end );
InstallOtherMethod( ExternalSubsetOp,
"G, start, gens, acts, act", true,
[ IsGroup, IsList,
IsList,
IsList,
IsFunction ], 0,
function( G, start, gens, acts, act )
return ExternalSubsetOp( G,
Concatenation( Orbits( G, start, gens, acts, act ) ),
start, gens, acts, act );
end );
#############################################################################
##
#M ViewObj( <xset> ) . . . . . . . . . . . . . . . . . for external subsets
##
InstallMethod( ViewObj, "for external subset", true,
[ IsExternalSubset ], 0,
function( xset )
Print( xset!.start, "^G");
end );
#############################################################################
##
#M PrintObj( <xset> ) . . . . . . . . . . . . . . . . for external subsets
##
InstallMethod( PrintObj, "for external subset", true,
[ IsExternalSubset ], 0,
function( xset )
Print( xset!.start, "^G < ", HomeEnumerator( xset ) );
end );
#T It seems to be necessary to distinguish representations
#T for a correct treatment of `PrintObj'.
#############################################################################
##
#M Enumerator( <xset> ) . . . . . . . . . . . . . . . for external subsets
##
InstallMethod( Enumerator, "for external subset with home enumerator",
[ IsExternalSubset and HasHomeEnumerator],
function( xset )
local G, henum, gens, acts, act, sublist, pnt, pos;
henum := HomeEnumerator( xset );
if IsPlistRep(henum) and not IsSSortedList(henum) then
TryNextMethod(); # there is no reason to use the home enumerator
fi;
G := ActingDomain( xset );
if IsExternalSetByActorsRep( xset ) then
gens := xset!.generators;
acts := xset!.operators;
act := xset!.funcOperation;
else
gens := GeneratorsOfGroup( G );
acts := gens;
act := FunctionAction( xset );
fi;
sublist := BlistList( [ 1 .. Length( henum ) ], [ ] );
for pnt in xset!.start do
pos := PositionCanonical( henum, pnt );
if not sublist[ pos ] then
OrbitByPosOp( G, henum, sublist, pos, pnt, gens, acts, act );
fi;
od;
return EnumeratorOfSubset( henum, sublist );
end );
InstallMethod( Enumerator,"for external orbit: compute orbit", true,
[ IsExternalOrbit ], 0,
function( xset )
if HasHomeEnumerator(xset) and not IsPlistRep(HomeEnumerator(xset)) then
TryNextMethod(); # can't do orbit because the home enumerator might
# imply a different `PositionCanonical' (and thus equivalence of objects)
# method.
fi;
return Orbit(xset,Representative(xset));
end);
InstallMethodWithRandomSource( Random,
"for a random source and for an external orbit: via acting domain", true,
[ IsRandomSource, IsExternalOrbit ], 0,
function( rs, xset )
if HasHomeEnumerator(xset) and not IsPlistRep(HomeEnumerator(xset)) then
TryNextMethod(); # can't do orbit because the home enumerator might
# imply a different `PositionCanonical' (and thus equivalence of objects)
# method.
fi;
return FunctionAction(xset)(Representative(xset),Random(rs, ActingDomain(xset)));
end);
#############################################################################
##
#F ExternalOrbit( <arg> ) . . . . . . . . . . . . . . external set on orbit
##
InstallMethod( ExternalOrbitOp, "G, D, pnt, gens, acts, act", true,
OrbitishReq, 0,
function( G, D, pnt, gens, acts, act )
local xorb;
xorb := ExternalSetByFilterConstructor( IsExternalOrbit,
G, D, gens, acts, act );
SetRepresentative( xorb, pnt );
xorb!.start := Immutable( [ pnt ] );
return xorb;
end );
InstallOtherMethod( ExternalOrbitOp,
"G, xset, pnt, gens, acts, act", true,
[ IsGroup, IsExternalSet, IsObject,
IsList,
IsList,
IsFunction ], 0,
function( G, xset, pnt, gens, acts, act )
local xorb;
xorb := ExternalSetByFilterConstructor( IsExternalOrbit,
G, HomeEnumerator( xset ), gens, acts, act );
SetRepresentative( xorb, pnt );
xorb!.start := Immutable( [ pnt ] );
return xorb;
end );
InstallOtherMethod( ExternalOrbitOp,
"G, pnt, gens, acts, act", true,
[ IsGroup, IsObject,
IsList,
IsList,
IsFunction ], 0,
function( G, pnt, gens, acts, act )
return ExternalOrbitOp( G, OrbitOp( G, pnt, gens, acts, act ),
gens, acts, act );
end );
#############################################################################
##
#M ViewObj( <xorb> ) . . . . . . . . . . . . . . . . . . for external orbit
##
InstallMethod( ViewObj, "for external orbit", true,
[ IsExternalOrbit ], 0,
function( xorb )
Print( Representative( xorb ), "^G");
end );
#############################################################################
##
#M PrintObj( <xorb> ) . . . . . . . . . . . . . . . . . for external orbit
##
InstallMethod( PrintObj, "for external orbit", true,
[ IsExternalOrbit ], 0,
function( xorb )
Print( Representative( xorb ), "^G < ", HomeEnumerator( xorb ) );
end );
#T It seems to be necessary to distinguish representations
#T for a correct treatment of `PrintObj'.
#############################################################################
##
#M AsList( <xorb> ) . . . . . . . . . . . . . . . . . . by orbit algorithm
##
InstallMethod( AsList,"external orbit", true, [ IsExternalOrbit ], 0,
xorb -> Orbit( xorb, Representative( xorb ) ) );
#############################################################################
##
#M AsSSortedList( <xorb> )
##
InstallMethod( AsSSortedList,"external orbit", true, [ IsExternalOrbit ], 0,
xorb -> Set(Orbit( xorb, Representative( xorb ) )) );
#############################################################################
##
#M <xorb> = <yorb> . . . . . . . . . . . . . . . . . . by ``conjugacy'' test
##
InstallMethod( \=, "xorbs",IsIdenticalObj,
[ IsExternalOrbit, IsExternalOrbit ], 0,
function( xorb, yorb )
if not IsIdenticalObj(ActingDomain (xorb),ActingDomain (yorb))
or not IsIdenticalObj(FunctionAction(xorb),FunctionAction(yorb))
then
TryNextMethod();
fi;
return RepresentativeAction( xorb, Representative( xorb ),
Representative( yorb ) ) <> fail;
end );
#############################################################################
##
#M <xorb> < <yorb>
##
InstallMethod( \<, "xorbs, via AsSSortedList",IsIdenticalObj,
[ IsExternalOrbit, IsExternalOrbit ], 0,
function( xorb, yorb )
if not IsIdenticalObj(ActingDomain (xorb),ActingDomain (yorb))
or not IsIdenticalObj(FunctionAction(xorb),FunctionAction(yorb))
then
TryNextMethod();
fi;
return AsSSortedList(xorb)<AsSSortedList(yorb);
end );
InstallMethod( \=, "xorbs which know their size", IsIdenticalObj,
[ IsExternalOrbit and HasSize, IsExternalOrbit and HasSize], 0,
function( xorb, yorb )
if Size(xorb)<>Size(yorb) then
return false;
fi;
if (Size(xorb)>10 and not HasAsList(yorb))
or not IsIdenticalObj(ActingDomain (xorb),ActingDomain (yorb))
or not IsIdenticalObj(FunctionAction(xorb),FunctionAction(yorb))
then
TryNextMethod();
fi;
return Representative( xorb ) in AsList(yorb);
end );
InstallMethod( \=, "xorbs with canonicalRepresentativeDeterminator",
IsIdenticalObj,
[IsExternalOrbit and CanEasilyDetermineCanonicalRepresentativeExternalSet,
IsExternalOrbit and CanEasilyDetermineCanonicalRepresentativeExternalSet],
0,
function( xorb, yorb )
if not IsIdenticalObj(ActingDomain (xorb),ActingDomain (yorb))
or not IsIdenticalObj(FunctionAction(xorb),FunctionAction(yorb))
then
TryNextMethod();
fi;
return CanonicalRepresentativeOfExternalSet( xorb ) =
CanonicalRepresentativeOfExternalSet( yorb );
end );
# as this is not necessarily compatible with the global ordering, this
# method is disabled.
# #############################################################################
# ##
# #M <xorb> < <yorb> . . . . . . . . . . . . . . . . . by ``canon. rep'' test
# ##
# InstallMethod( \<,"xorbs with canonicalRepresentativeDeterminator",
# IsIdenticalObj,
# [ IsExternalOrbit and HasCanonicalRepresentativeDeterminatorOfExternalSet,
# IsExternalOrbit and HasCanonicalRepresentativeDeterminatorOfExternalSet ],
# 0,
# function( xorb, yorb )
# if not IsIdenticalObj(ActingDomain (xorb),ActingDomain (yorb))
# or not IsIdenticalObj(FunctionAction(xorb),FunctionAction(yorb))
# then
# TryNextMethod();
# fi;
# return CanonicalRepresentativeOfExternalSet( xorb ) <
# CanonicalRepresentativeOfExternalSet( yorb );
# end );
#############################################################################
##
#M <pnt> in <xorb> . . . . . . . . . . . . . . . . . . by ``conjugacy'' test
##
InstallMethod( \in,"very small xorbs: test in AsList", IsElmsColls,
[ IsObject, IsExternalOrbit and HasSize], 0,
function( pnt, xorb )
if Size(xorb)>10 then
TryNextMethod();
fi;
return pnt in AsList(xorb);
end );
InstallMethod( \in,"xorb: RepresentativeAction", IsElmsColls,
[ IsObject, IsExternalOrbit ], 0,
function( pnt, xorb )
return RepresentativeAction( xorb, Representative( xorb ),
pnt ) <> fail;
end );
# if we keep a list we will often test the representative
InstallMethod( \in,"xset: Test representative equal", IsElmsColls, [ IsObject,
IsExternalSet and HasRepresentative ],
10, #override even tests in element lists
function( pnt, xset )
if Representative( xset ) = pnt then
return true;
else
TryNextMethod();
fi;
end );
InstallMethod( \in, "xorb: HasEnumerator",IsElmsColls,
[ IsObject, IsExternalOrbit and HasEnumerator ], 0,
function( pnt, xorb )
local enum;
enum := Enumerator( xorb );
if IsConstantTimeAccessList( enum ) then return pnt in enum;
else TryNextMethod(); fi;
end );
InstallMethod(\in,"xorb HasAsList",IsElmsColls,
[ IsObject,IsExternalOrbit and HasAsList],
1, # AsList should override Enumerator
function( pnt, xorb )
local l;
l := AsList( xorb );
if IsConstantTimeAccessList( l ) then return pnt in l;
else TryNextMethod(); fi;
end );
InstallMethod(\in,"xorb HasAsSSortedList",IsElmsColls,
[ IsObject,IsExternalOrbit and HasAsSSortedList],
2, # AsSSorrtedList should override AsList
function( pnt, xorb )
local l;
l := AsSSortedList( xorb );
if IsConstantTimeAccessList( l ) then return pnt in l;
else TryNextMethod(); fi;
end );
# this method should have a higher priority than the previous to avoid
# searches in vain.
InstallMethod( \in, "by CanonicalRepresentativeDeterminator",
IsElmsColls, [ IsObject,
IsExternalOrbit and
HasCanonicalRepresentativeDeterminatorOfExternalSet ], 1,
function( pnt, xorb )
local func;
func:=CanonicalRepresentativeDeterminatorOfExternalSet(xorb);
return CanonicalRepresentativeOfExternalSet( xorb ) =
func(ActingDomain(xorb),pnt)[1];
end );
#############################################################################
##
#M ActionHomomorphism( <xset> ) . . . . . . . . . action homomorphism
##
InstallGlobalFunction( ActionHomomorphism, function( arg )
local attr, xset, p;
if Last( arg ) = "surjective" or
Last( arg ) = "onto" then
attr := SurjectiveActionHomomorphismAttr;
Remove( arg );
else
attr := ActionHomomorphismAttr;
fi;
if Length( arg ) = 1 then
xset := arg[ 1 ];
elif Length( arg ) = 2
and IsComponentObjectRep( arg[ 2 ] )
and IsBound( arg[ 2 ]!.actionHomomorphism )
and IsActionHomomorphism( arg[ 2 ]!.actionHomomorphism )
and Source( arg[ 2 ]!.actionHomomorphism ) = arg[ 1 ] then
return arg[ 2 ]!.actionHomomorphism; # GAP-3 compatibility
else
if IsFunction( Last( arg ) ) then p := 1;
else p := 0; fi;
if Length( arg ) mod 2 = p then
xset := CallFuncList( ExternalSet, arg );
elif IsIdenticalObj( FamilyObj( arg[ 2 ] ),
FamilyObj( arg[ 3 ] ) ) then
xset := CallFuncList( ExternalSubset, arg );
else
xset := CallFuncList( ExternalOrbit, arg );
fi;
fi;
return attr( xset );
end );
#############################################################################
##
#M ActionHomomorphismConstructor( <xset>, <surj> )
##
InstallGlobalFunction( ActionHomomorphismConstructor, function(arg)
local xset,surj,G, D, act, fam, filter, hom, i,blockacttest;
xset:=arg[1];surj:=arg[2];
G := ActingDomain( xset );
D := HomeEnumerator( xset );
act := FunctionAction( xset );
fam := GeneralMappingsFamily( ElementsFamily( FamilyObj( G ) ),
PermutationsFamily );
if IsExternalSubset( xset ) then
filter := IsActionHomomorphismSubset;
else
filter := IsActionHomomorphism;
fi;
if IsPermGroup( G ) then
filter := filter and IsPermGroupGeneralMapping;
fi;
blockacttest:=function()
#
# Test if D is a block system for G
#
local x, l1, i, b, y, a, p, g;
D:=List(D,Immutable);
if Length(D) = 0 then
return false;
fi;
#
# x will map from points to blocks
#
x := [];
l1 := Length(D[1]);
if l1 = 0 then
return false;
fi;
for i in [1..Length(D)] do
b := D[i];
if not IsSSortedList(b) or Length(b) <> l1 then
# putative blocks not sets or not all the same size
return false;
fi;
for y in b do
if not IsPosInt(y) or IsBound(x[y]) then
# bad block entry or blocks overlap
return false;
fi;
x[y] := i;
od;
od;
for b in D do
for g in GeneratorsOfGroup(G) do
a:=b[1]^g;
p:=x[a];
if OnSets(b,g)<>D[p] then
# blocks not preserved by group action
return false;
fi;
od;
od;
return true;
end;
hom := rec( );
if Length(arg)>2 then
filter:=arg[3];
elif IsExternalSetByActorsRep( xset ) then
filter := filter and IsActionHomomorphismByActors;
elif IsMatrixGroup( G )
and IsScalarList( D[ 1 ] ) then
if act in [ OnPoints, OnRight ] then
# we act linearly. This might be used to compute preimages by linear
# algebra
# note that we do not test whether the domain actually contains a
# vector space base. This will be done the first time,
# `LinearActionBasis' is called (i.e. in the preimages routine).
filter := filter and IsLinearActionHomomorphism;
elif act=OnLines then
filter := filter and IsProjectiveActionHomomorphism;
fi;
# if not IsExternalSubset( xset )
# and IsDomainEnumerator( D )
# and IsFreeLeftModule( UnderlyingCollection( D ) )
# and IsFullRowModule( UnderlyingCollection( D ) )
# and IsLeftActedOnByDivisionRing( UnderlyingCollection( D ) ) then
# filter := filter and IsLinearActionHomomorphism;
# else
# if IsExternalSubset( xset ) then
# if HasEnumerator( xset ) then D := Enumerator( xset );
# else D := xset!.start; fi;
# fi;
# Error("hier");
# if IsSubset( D, IdentityMat
# ( Length( D[ 1 ] ), One( D[ 1 ][ 1 ] ) ) ) then
# fi;
# fi;
# test for constituent homomorphism
elif not IsExternalSubset( xset )
and IsPermGroup( G )
and IsList( D ) and IsCyclotomicCollection( D )
and act = OnPoints then
filter := IsConstituentHomomorphism;
hom.conperm := MappingPermListList( D, [ 1 .. Length( D ) ] );
# if MappingPermListList took a family/group as an
# argument then we could patch it instead
#if IsHomCosetToPerm(One(G)) then
# hom.conperm := HomCosetWithImage( Homomorphism(G.1),
# One(Source(G)), hom.conperm );
#fi;
# test for action on disjoint sets of numbers, preserved by group -> blocks homomorphism
elif not IsExternalSubset( xset )
and IsPermGroup( G )
and IsList( D )
and act = OnSets
# preserved test
and blockacttest()
then
filter := IsBlocksHomomorphism;
hom.reps := [ ];
for i in [ 1 .. Length( D ) ] do
hom.reps{ D[ i ] } := i + 0 * D[ i ];
od;
# try to find under which circumstances we want to avoid computing
# images by the action but always use the AsGHBI
elif
# we can decompose into generators
(IsPermGroup( G ) or IsPcGroup( G )) and
# the action is not harmless
not (act=OnPoints or act=OnSets or act=OnTuples)
then
filter := filter and
IsGroupGeneralMappingByAsGroupGeneralMappingByImages;
# action of fp group
elif IsSubgroupFpGroup(G) then
filter:=filter and IsFromFpGroupHomomorphism;
fi;
if HasBaseOfGroup( xset ) then
filter := filter and IsActionHomomorphismByBase;
fi;
if surj then
filter := filter and IsSurjective;
fi;
Objectify( NewType( fam, filter ), hom );
SetUnderlyingExternalSet( hom, xset );
return hom;
end );
InstallMethod( ActionHomomorphismAttr,"call OpHomConstructor", true,
[ IsExternalSet ], 0,
xset -> ActionHomomorphismConstructor( xset, false ) );
#############################################################################
##
#M SurjectiveActionHomomorphism( <xset> ) . surj. action homomorphism
##
InstallMethod( SurjectiveActionHomomorphismAttr,
"call Ac.Hom.Constructor", true, [ IsExternalSet ], 0,
xset -> ActionHomomorphismConstructor( xset, true ) );
BindGlobal( "VPActionHom", function( hom )
local name;
name:="homo";
if HasIsInjective(hom) and IsInjective(hom) then
name:="mono";
if HasIsSurjective(hom) and IsSurjective(hom) then
name:="iso";
fi;
elif HasIsSurjective(hom) and IsSurjective(hom) then
name:="epi";
fi;
Print( "<action ",name,"morphism>" );
end );
#############################################################################
##
#F MultiActionsHomomorphism(G,pnts,ops)
##
InstallGlobalFunction(MultiActionsHomomorphism,function(G,pnts,ops)
local gens,homs,trans,n,d,i,j,mgi,ran,hom,imgs,c;
gens:=GeneratorsOfGroup(G);
homs:=[];
trans:=[];
n:=1;
if Length(pnts)=1 then
return DoSparseActionHomomorphism(G,[pnts[1]],gens,gens,ops[1],false);
fi;
imgs:=List(gens,x->());
c:=0;
for i in [1..Length(pnts)] do
if ForAny(homs,x->FunctionAction(UnderlyingExternalSet(x))=ops[i] and
pnts[i] in HomeEnumerator(UnderlyingExternalSet(x))) then
Info(InfoGroup,1,"point ",i," already covered");
else
hom:=DoSparseActionHomomorphism(G,[pnts[i]],gens,gens,ops[i],false);
d:=NrMovedPoints(Range(hom));
if d>0 then
c:=c+1;
homs[c]:=hom;
trans[c]:=MappingPermListList([1..d],[n..n+d-1]);
mgi:=MappingGeneratorsImages(hom)[2];
for j in [1..Length(gens)] do
imgs[j]:=imgs[j]*mgi[j]^trans[c];
od;
n:=n+d;
fi;
fi;
od;
ran:=Group(imgs,());
hom:=GroupHomomorphismByFunction(G,ran,
function(elm)
local i,p,q;
p:=();
for i in [1..Length(homs)] do
q:=ImagesRepresentative(homs[i],elm);
if q = fail and ValueOption("actioncanfail")=true then
return fail;
fi;
p:=p*(q^trans[i]);
od;
return p;
end);
SetImagesSource(hom,ran);
SetMappingGeneratorsImages(hom,[gens,imgs]);
SetAsGroupGeneralMappingByImages( hom, GroupHomomorphismByImagesNC
( G, ran, gens, imgs ) );
return hom;
end);
#############################################################################
##
#M ViewObj( <hom> ) . . . . . . . . . . . . view an action homomorphism
##
InstallMethod( ViewObj, "for action homomorphism", true,
[ IsActionHomomorphism ], 0, VPActionHom);
#############################################################################
##
#M PrintObj( <hom> ) . . . . . . . . . . . . print an action homomorphism
##
InstallMethod( PrintObj, "for action homomorphism", true,
[ IsActionHomomorphism ], 0, VPActionHom);
#T It seems to be difficult to find out what I can use
#T for a correct treatment of `PrintObj'.
#############################################################################
##
#M Source( <hom> ) . . . . . . . . . . . . source of action homomorphism
##
InstallMethod( Source, "action homomorphism",true,
[ IsActionHomomorphism ], 0,
hom -> ActingDomain( UnderlyingExternalSet( hom ) ) );
#############################################################################
##
#M Range( <hom> ) . . . . . . . . . . . . . range of action homomorphism
##
InstallMethod( Range,"ophom: S(domain)", true,
[ IsActionHomomorphism ], 0, hom ->
SymmetricGroup( Length( HomeEnumerator(UnderlyingExternalSet(hom)) ) ) );
InstallMethod( Range, "surjective action homomorphism",
[ IsActionHomomorphism and IsSurjective ],
function(hom)
local gens, imgs, ran, i, a, xset,opt;
gens:=GeneratorsOfGroup( Source( hom ) );
if false and HasSize(Source(hom)) and Length(gens)>0 then
imgs:=[ImageElmActionHomomorphism(hom,gens[1])];
opt:=rec(limit:=Size(Source(hom)));
if IsBound(hom!.basepos) then
opt!.knownBase:=hom!.basepos;
fi;
ran:=Group(imgs[1]);
i:=2;
while i<=Length(gens) and Size(ran)<Size(Source(hom)) do
a:=ImageElmActionHomomorphism( hom, gens[i]);
Add(imgs,a);
ran:=DoClosurePrmGp(ran,[a],opt);
i:=i+1;
od;
else
imgs:=List(gens,gen->ImageElmActionHomomorphism( hom, gen ) );
if Length(imgs)=0 then
ran:= GroupByGenerators( imgs,
ImageElmActionHomomorphism( hom, One( Source( hom ) ) ) );
else
ran:= GroupByGenerators(imgs,One(imgs[1]));
fi;
fi;
# remember a known base
if HasBaseOfGroup(UnderlyingExternalSet(hom)) then
xset:=UnderlyingExternalSet(hom);
if not IsBound( xset!.basePermImage ) then
xset!.basePermImage:=List(BaseOfGroup( xset ),
b->PositionCanonical(Enumerator(xset),b));
fi;
SetBaseOfGroup(ran,xset!.basePermImage);
fi;
SetMappingGeneratorsImages(hom,[gens{[1..Length(imgs)]},imgs]);
if HasSize(Source(hom)) then
StabChainOptions(ran).limit:=Size(Source(hom));
fi;
if HasIsInjective(hom) and HasSource(hom) and IsInjective(hom) then
UseIsomorphismRelation( Source(hom), ran );
fi;
return ran;
end);
#############################################################################
##
#M RestrictedMapping(<ophom>,<U>)
##
InstallMethod(RestrictedMapping,"action homomorphism",
CollFamSourceEqFamElms,[IsActionHomomorphism,IsGroup],0,
function(hom,U)
local xset,rest;
xset:=RestrictedExternalSet(UnderlyingExternalSet(hom),U);
if ValueOption("surjective")=true or (HasIsSurjective(hom) and
IsSurjective(hom)) then
rest:=SurjectiveActionHomomorphismAttr( xset );
else
rest:=ActionHomomorphismAttr( xset );
fi;
if HasIsInjective(hom) and IsInjective(hom) then
SetIsInjective(rest,true);
fi;
if HasIsTotal(hom) and IsTotal(hom) then
SetIsTotal(rest,true);
fi;
return rest;
end);
#############################################################################
##
#F Action( <arg> )
##
InstallGlobalFunction( Action, function( arg )
local hom, O;
if not IsString(Last(arg)) then
Add(arg,"surjective"); # enforce surjective action homomorphism -- we
# anyhow compute the image
fi;
PushOptions(rec(onlyimage:=true)); # we don't want `ActionHom' to build
# a stabilizer chain.
hom := CallFuncList( ActionHomomorphism, arg );
PopOptions();
O := ImagesSource( hom );
O!.actionHomomorphism := hom;
return O;
end );
#############################################################################
##
#F Orbit( <arg> ) . . . . . . . . . . . . . . . . . . . . . . . . . . orbit
##
InstallMethod( OrbitOp,
"G, D, pnt, [ 1gen ], [ 1act ], act", true,
OrbitishReq,
20, # we claim this method is very good
function( G, D, pnt, gens, acts, act )
if Length( acts ) <> 1 then TryNextMethod();
else return CycleOp( acts[ 1 ], D, pnt, act );
fi;
end );
InstallOtherMethod( OrbitOp,
"G, pnt, [ 1gen ], [ 1act ], act", true,
[ IsGroup, IsObject,
IsList,
IsList,
IsFunction ],
20, # we claim this method is very good
function( G, pnt, gens, acts, act )
if Length( acts ) <> 1 then TryNextMethod();
else return CycleOp( acts[ 1 ], pnt, act ); fi;
end );
InstallMethod( OrbitOp, "with domain", true, OrbitishReq,0,
function( G, D, pnt, gens, acts, act )
local orb,d,gen,i,p,permrec,perms;
# is there an option indicating a wish to calculate permutations?
permrec:=ValueOption("permutations");
if permrec<>fail then
if not IsRecord(permrec) then
Error("asks for permutations, but no record given");
fi;
perms:=List(gens,x->[]);
permrec.generators:=gens;
permrec.permutations:=perms;
fi;
pnt:=Immutable(pnt);
orb := [ pnt ];
if permrec=fail then
d:=NewDictionary(pnt,false,D);
AddDictionary(d,pnt);
fi;
for p in orb do
for gen in acts do
i:=act(p,gen);
MakeImmutable(i);
if not KnowsDictionary(d,i) then
Add( orb, i );
AddDictionary(d,i);
fi;
od;
od;
return Immutable(orb);
end );
InstallOtherMethod( OrbitOp, "standard orbit algorithm:list", true,
[ IsGroup, IsObject,
IsList,
IsList,
IsFunction ], 0,
function( G, pnt, gens, acts, act )
local orb,d,gen,i,p,D,perms,permrec,gp,op,l;
# is there an option indicating a wish to calculate permutations?
permrec:=ValueOption("permutations");
if permrec<>fail then
if not IsRecord(permrec) then
Error("asks for permutations, but no record given");
fi;
perms:=List(gens,x->[]);
permrec.generators:=gens;
permrec.permutations:=perms;
fi;
# try to find a domain
D:=DomainForAction(pnt,acts,act);
pnt:=Immutable(pnt);
orb := [ pnt ];
if permrec=fail then
d:=NewDictionary(pnt,false,D);
AddDictionary(d,pnt);
else
d:=NewDictionary(pnt,true,D);
AddDictionary(d,pnt,1);
fi;
op:=0;
for p in orb do
op:=op+1;
gp:=0;
for gen in acts do
gp:=gp+1;
i:=act(p,gen);
MakeImmutable(i);
if permrec=fail then
if not KnowsDictionary(d,i) then
Add( orb, i );
AddDictionary(d,i);
fi;
else
l:=LookupDictionary(d,i);
if l=fail then
Add( orb, i );
AddDictionary(d,i,Length(orb));
perms[gp][op]:=Length(orb);
else
perms[gp][op]:=l;
fi;
fi;
od;
od;
return Immutable(orb);
end );
# all other orbit methods now become obsolete -- the dictionaries do the
# magic.
# InstallMethod( OrbitOp, "with quick position domain", true, [IsGroup,
# IsList and IsQuickPositionList,IsObject,IsList,IsList,IsFunction],0,
# function( G, D, pnt, gens, acts, act )
# return OrbitByPosOp( G, D, BlistList( [ 1 .. Length( D ) ], [ ] ),
# PositionCanonical( D, pnt ), pnt, gens, acts, act );
# end );
InstallGlobalFunction( OrbitByPosOp,
function( G, D, blist, pos, pnt, gens, acts, act )
local orb, p, gen, img,pofu;
if IsInternalRep(D) then
pofu:=Position; # avoids one redirection, epsilon faster
else
pofu:=PositionCanonical;
fi;
blist[ pos ] := true;
orb := [ pnt ];
for p in orb do
for gen in acts do
img := act( p, gen );
pos := pofu( D, img );
if not blist[ pos ] then
blist[ pos ] := true;
#Add( orb, img );
Add( orb, D[pos] ); # this way we do not store the new element
# but the already existing old one in D. This saves memory.
fi;
od;
od;
return Immutable( orb );
end );
#############################################################################
##
#M \^( <p>, <G> ) . . . . . . . orbit of a point under the action of a group
##
## Returns the orbit of the point <A>p</A> under the action of the group
## <A>G</A>, with respect to the action <C>OnPoints</C>.
##
InstallOtherMethod( \^, "orbit of a point under the action of a group",
ReturnTrue, [ IsObject, IsGroup ], 0,
function ( p, G )
return Orbit(G,p,OnPoints);
end );
#############################################################################
##
#F OrbitStabilizer( <arg> ) . . . . . . . . . . . . . orbit and stabilizer
##
InstallMethod( OrbitStabilizerOp, "`OrbitStabilizerAlgorithm' with domain",
true, OrbitishReq, 0,
function( G, D, pnt, gens, acts, act )
local orbstab;
orbstab:=OrbitStabilizerAlgorithm(G,D,false,gens,acts,
rec(pnt:=pnt,act:=act));
return Immutable( orbstab );
end );
InstallOtherMethod( OrbitStabilizerOp,
"`OrbitStabilizerAlgorithm' without domain",true,
[ IsGroup, IsObject, IsList, IsList, IsFunction ], 0,
function( G, pnt, gens, acts, act )
local orbstab;
orbstab:=OrbitStabilizerAlgorithm(G,false,false,gens,acts,
rec(pnt:=pnt,act:=act));
return Immutable( orbstab );
end );
#############################################################################
##
#M OrbitStabilizerAlgorithm
##
BindGlobal("DoOrbitStabilizerAlgorithmStabsize",
function( G,D,blist,gens,acts, dopr )
local orb, stb, rep, p, q, img, sch, i,d,act,r,
onlystab, # do we only care about stabilizer?
getrep, # function to get representative
actsinv,# inverses of acts
stopat, # index at which increasal stopped
notinc, # nr of steps in whiuch we did not increase
stabsub,# stabilizer seed
doml, # maximal orbit length
dict, # dictionary
blico, # copy of initial blist (to find out the true domain)
ind, # stabilizer index
indh, # 1/2 stabilizer index
increp, # do we still want to increase the rep list?
incstb; # do we still want to increase the stabilizer?
stopat:=fail; # to trigger error if wrong generators
d:=Immutable(dopr.pnt);
if IsBound(dopr.act) then
act:=dopr.act;
else
act:=dopr.opr;
fi;
onlystab:=IsBound(dopr.onlystab) and dopr.onlystab=true;
# try to find a domain
if IsBool(D) then
D:=DomainForAction(d,acts,act);
fi;
dict:=NewDictionary(d,true,D);
if IsBound(dopr.stabsub) then
stabsub:=AsSubgroup(Parent(G),dopr.stabsub);
else
stabsub:=TrivialSubgroup(G);
fi;
# NC is safe
stabsub:=ClosureSubgroupNC(stabsub,gens{Filtered([1..Length(acts)],
i->act(d,acts[i])=d)});
if IsBool(D) or IsRecord(D) then
doml:=Size(G);
else
if blist<>false then
doml:=Size(D)-SizeBlist(blist);
blico:=ShallowCopy(blist); # the original indices, needed to see what
# a full orbit is
else
doml:=Size(D);
fi;
fi;
incstb:=Index(G,stabsub)>1; # do we still include stabilizer elements. If
# it is `false' the index `ind' must be equal to the orbit size.
orb := [ d ];
if incstb=false then
# do we still need to tick off the orbit in `blist' to
# please the caller? (see below as well)
if blist<>false then
q:=PositionCanonical(D,d);
blist[q]:=true;
fi;
r:=rec( orbit := orb, stabilizer := G );
return r;
fi;
# # test for small domains whether the orbit has length 1
# if doml<10 then
# if doml=1 or ForAll(acts,i->act( d, i )=d) then
#
# # do we still need to tick off the orbit in `blist' to
# # please the caller? (see below as well)
# if blist<>false then
# q:=PositionCanonical(D,d);
# blist[q]:=true;
# fi;
#
# return rec( orbit := orb, stabilizer := G );
# fi;
#
# fi;
AddDictionary(dict,d,1);
stb := stabsub; # stabilizer seed
ind:=Size(G);
indh:=QuoInt(Size(G),2);
if not IsEmpty( acts ) then
# using only a factorized transversal can be expensive, in particular if
# the action is more complicated. We therefore store a certain number of
# representatives fixed.
actsinv:=false;
getrep:=function(pos)
local a,r;
a:=rep[pos];
if not IsInt(a) then
return a;
else
r:=fail;
while pos>1 and IsInt(a) do
if r=fail then
r:=gens[a];
else
r:=gens[a]*r;
fi;
pos:=LookupDictionary(dict,act(orb[pos],actsinv[a]));
a:=rep[pos];
od;
if pos>1 then
r:=a*r;
fi;
return r;
fi;
end;
notinc:=0;
increp:=true;
rep := [ One( gens[ 1 ] ) ];
p := 1;
while p <= Length( orb ) do
for i in [ 1 .. Length( gens ) ] do
img := act( orb[ p ], acts[ i ] );
MakeImmutable(img);
q:=LookupDictionary(dict,img);
if q = fail then
Add( orb, img );
AddDictionary(dict,img,Length(orb));
if increp then
if actsinv=false then
Add( rep, rep[ p ] * gens[ i ] );
else
Add( rep, i );
fi;
if indh<Length(orb) then
# the stabilizer cannot grow any more
if not (IsBound(dopr.returnReps) and dopr.returnReps) then
increp:=false;
fi;
incstb:=false;
fi;
fi;
elif incstb then
#sch := rep[ p ] * gens[ i ] / rep[ q ];
sch := getrep( p ) * gens[ i ] / getrep( q );
if not sch in stb then
notinc:=0;
# NC is safe
stb:=ClosureSubgroupNC(stb,sch);
ind:=Index(G,stb);
indh:=QuoInt(ind,2);
if indh<Length(orb) then
# the stabilizer cannot grow any more
if not (IsBound(dopr.returnReps) and dopr.returnReps) then
increp:=false;
fi;
incstb:=false;
fi;
else
notinc:=notinc+1;
if notinc*50>indh and notinc>1000 then
# we have failed often enough -- assume for the moment we have
# the right stabilizer
#Error("stop stabilizer increase");
stopat:=p;
incstb:=false; # do not increase the stabilizer, but keep
# representatives
actsinv:=List(acts,Inverse);
fi;
fi;
fi;
if increp=false then #we know the stabilizer
if onlystab then
r:=rec(stabilizer:=stb);
if IsBound(dopr.returnReps) and dopr.returnReps then
r.rep:=rep;r.getrep:=getrep;r.actsinv:=actsinv;
r.dictionary:=dict;
fi;
return r;
# must the orbit contain the whole domain => extend?
elif ind=doml and (not IsBool(D)) and Length(orb)<doml then
if blist=false then
orb:=D;
else
orb:=D{Filtered([1..Length(blico)],i->blico[i]=false)};
# we need to tick off the rest
UniteBlist(blist,
BlistList([1..Length(blist)],[1..Length(blist)]));
fi;
r:=rec( orbit := orb, stabilizer := stb );
if IsBound(dopr.returnReps) and dopr.returnReps then
r.rep:=rep;r.getrep:=getrep;r.actsinv:=actsinv;
r.dictionary:=dict;
fi;
return r;
elif ind=Length(orb) then
# we have reached the full orbit. No further tests
# necessary
# do we still need to tick off the orbit in `blist' to
# please the caller?
if blist<>false then
# we decided not to use blists for the orbit calculation
# but a blist was given in which we have to tick off the
# orbit
if IsPositionDictionary(dict) then
UniteBlist(blist,dict!.blist);
else
for img in orb do
blist[PositionCanonical(D,img)]:=true;
od;
fi;
fi;
r:= rec( orbit := orb, stabilizer := stb );
if IsBound(dopr.returnReps) and dopr.returnReps then
r.rep:=rep;r.getrep:=getrep;r.actsinv:=actsinv;
r.dictionary:=dict;
fi;
return r;
fi;
fi;
od;
p := p + 1;
od;
if Size(G)/Size(stb)>Length(orb) then
if stopat=fail then
Error("generators do not match group");
fi;
p:=stopat;
while p<=Length(orb) do
i:=1;
while i<=Length(gens) do
img := act( orb[ p ], acts[ i ] );
MakeImmutable(img);
q:=LookupDictionary(dict,img);
sch := getrep( p ) * gens[ i ] / getrep( q );
if not sch in stb then
stb:=ClosureSubgroupNC(stb,sch);
if Size(G)/Size(stb)=Length(orb) then
p:=Length(orb);i:=Length(gens); #done
fi;
fi;
i:=i+1;
od;
p:=p+1;
od;
#Error("after");
fi;
fi;
if blist<>false then
# we decided not to use blists for the orbit calculation
# but a blist was given in which we have to tick off the
# orbit
if IsPositionDictionary(dict) then
UniteBlist(blist,dict!.blist);
else
for img in orb do
blist[PositionCanonical(D,img)]:=true;
od;
fi;
fi;
r:=rec( orbit := orb, stabilizer := stb );
if IsBound(dopr.returnReps) and dopr.returnReps then
r.rep:=rep;r.getrep:=getrep;r.actsinv:=actsinv;
r.dictionary:=dict;
fi;
return r;
end );
InstallMethod( OrbitStabilizerAlgorithm,"use stabilizer size",true,
[IsGroup and IsFinite and CanComputeSizeAnySubgroup,IsObject,IsObject,
IsList,IsList,IsRecord],0,
function( G,D,blist,gens,acts, dopr )
local pr,hom,pgens,pacts,pdopr,erg,cs,i,dict,orb,stb,rep,getrep,q,img,gen,
gena,j,k,e,l,orbl,pcgs;
if HasSize(G) and Size(G)>10^5
# not yet implemented for blist case
and blist=false then
pr:=PerfectResiduum(G);
if IndexNC(G,pr)>3 then
hom:=GroupHomomorphismByImagesNC(G,Group(acts),gens,acts);;
pgens:=ShallowCopy(SmallGeneratingSet(pr));
pacts:=List(pgens,x->ImagesRepresentative(hom,x));
pdopr:=ShallowCopy(dopr);
pdopr.returnReps:=true;
pdopr.onlystab:=false;
erg:=DoOrbitStabilizerAlgorithmStabsize(pr,D,blist,pgens,pacts,pdopr);
if not IsBound(erg.dictionary) then
# degenerate case, routine did not set up everything
return DoOrbitStabilizerAlgorithmStabsize(G,D,blist,gens,acts,dopr);
fi;
dict:=erg.dictionary; orb:=erg.orbit; stb:=erg.stabilizer;
rep:=erg.rep; getrep:=erg.getrep;
orbl:=Length(orb);
if IsBound(dopr.onlystab) and dopr.onlystab=true
and 10*IndexNC(G,pr)<Length(orb) then
# it is cheaper to just find the right cosets than to (potentially)
# map the whole orbit
for i in RightTransversal(G,pr) do
gena:=ImagesRepresentative(hom,i);
img:=dopr.act(orb[1],gena);
q:=LookupDictionary(dict,img);
if IsInt(q) then
img:=i/getrep(q);
stb:=ClosureGroup(stb,img);
fi;
od;
return rec(stabilizer := stb);
else
cs:=CompositionSeriesThrough(G,[pr]);
cs:=Reversed(Filtered(cs,x->Size(x)>=Size(pr)));
pcgs:=[];
# step over the cyclic factors
for i in [2..Length(cs)] do
gen:=First(GeneratorsOfGroup(cs[i]),x->not x in cs[i-1]);
gena:=ImagesRepresentative(hom,gen);
img:=dopr.act(orb[1],gena);
q:=LookupDictionary(dict,img);
if q=fail then
# orbit grows
e:=First([1..Order(gen)],x->gen^x in cs[i-1]); # local order
Add(pcgs,[e,gen,gena]);
l:=Length(orb);
for j in [1..e-1] do
for k in [1..l] do
q:=(j-1)*l+k;
img:=dopr.act(orb[q],gena);
Add(orb,img);
AddDictionary(dict,img,Length(orb));
od;
od;
else
#Print(q,":",QuoInt(q-1,orbl),"\n");
if Length(pcgs)>0 then
# find correct position of orbit block
j:=Reversed(CoefficientsMultiadic(List(Reversed(pcgs),x->x[1]),
QuoInt(q-1,orbl)));
k:=Product([1..Length(pcgs)],x->pcgs[x][3]^j[x]);
img:=dopr.act(img,k^-1);
q:=LookupDictionary(dict,img);
k:=Product([1..Length(pcgs)],x->pcgs[x][2]^j[x]);
else
k:=One(G);
fi;
stb:=ClosureGroup(stb,gen/k/getrep(q));
fi;
od;
if IsBound(dopr.onlystab) and dopr.onlystab=true then
return rec(stabilizer := stb);
else
return rec( orbit := orb, stabilizer := stb );
fi;
fi;
fi;
fi;
return DoOrbitStabilizerAlgorithmStabsize(G,D,blist,gens,acts,dopr);
end);
InstallMethod( OrbitStabilizerAlgorithm,"collect stabilizer generators",true,
[IsGroup,IsObject,IsObject, IsList,IsList,IsRecord],0,
function( G,D,blist,gens, acts, dopr )
local orb, stb, rep, p, q, img, sch, i,d,act,
stabsub, # stabilizer seed
dict; # dictionary
d:=Immutable(dopr.pnt);
if IsBound(dopr.act) then
act:=dopr.act;
else
act:=dopr.opr;
fi;
# try to find a domain
if IsBool(D) then
D:=DomainForAction(d,acts,act);
fi;
if IsBound(dopr.stabsub) then
stabsub:=AsSubgroup(Parent(G),dopr.stabsub);
else
stabsub:=TrivialSubgroup(G);
fi;
dict:=NewDictionary(d,true,D);
# `false' the index `ind' must be equal to the orbit size.
orb := [ d ];
AddDictionary(dict,d,1);
stb := stabsub; # stabilizer seed
if not IsEmpty( acts ) then
rep := [ One( gens[ 1 ] ) ];
p := 1;
while p <= Length( orb ) do
for i in [ 1 .. Length( gens ) ] do
img := act( orb[ p ], acts[ i ] );
MakeImmutable(img);
q:=LookupDictionary(dict,img);
if q = fail then
Add( orb, img );
AddDictionary(dict,img,Length(orb));
Add( rep, rep[ p ] * gens[ i ] );
else
sch := rep[ p ] * gens[ i ] / rep[ q ];
# NC is safe
stb:=ClosureSubgroupNC(stb,sch);
fi;
od;
p := p + 1;
od;
fi;
# can we compute the index from the orbit length?
if HasSize(G) then
if IsFinite(G) then
SetSize(stb,Size(G)/Length(orb));
else
SetSize(stb,infinity);
fi;
fi;
# do we care about a blist?
if blist<>false then
if IsPositionDictionary(dict) then
# just copy over
UniteBlist(blist,dict!.blist);
else
# tick off by hand
for i in orb do
blist[PositionCanonical(D,i)]:=true;
od;
fi;
fi;
return rec( orbit := orb, stabilizer := stb );
end );
#############################################################################
##
#F Orbits( <arg> ) . . . . . . . . . . . . . . . . . . . . . . . . . orbits
##
BindGlobal("OrbitsByPosOp",function( G, D, gens, acts, act )
local blist, orbs, next, orb;
blist := BlistList( [ 1 .. Length( D ) ], [ ] );
orbs := [ ];
for next in [1..Length(D)] do
if blist[next]=false then
# by calling `OrbitByPosOp' we avoid testing for positions twice.
orb:=OrbitByPosOp(G,D,blist,next,D[next],gens,acts,act);
Add( orbs, orb );
fi;
od;
return Immutable( orbs );
end );
InstallMethod( OrbitsDomain, "for quick position domains", true,
[ IsGroup, IsList and IsQuickPositionList, IsList, IsList, IsFunction ], 0,
OrbitsByPosOp);
InstallMethod( OrbitsDomain, "for arbitrary domains", true,
OrbitsishReq, 0,
function( G, D, gens, acts, act )
local orbs, orb,sort,plist,pos,use,o,i,p;
if Length(D)>0 and not IsMutable(D) and HasIsSSortedList(D) and IsSSortedList(D)
and CanEasilySortElements(D[1]) then
return OrbitsByPosOp( G, D, gens, acts, act );
fi;
sort:=Length(D)>0 and CanEasilySortElements(D[1]);
plist:=IsPlistRep(D);
if plist and Length(D)>0 and IsHomogeneousList(D) and CanEasilySortElements(D[1]) then
plist:=false;
D:=AsSortedList(D);
fi;
if not plist then
use:=BlistList([1..Length(D)],[]);
fi;
orbs := [ ];
pos:=1;
while Length(D)>0 and pos<=Length(D) do
orb := OrbitOp( G,D, D[pos], gens, acts, act );
if plist then
orb:=ShallowCopy(orb);
use:=[1..Length(D)];
for i in [1..Length(orb)] do
p:=Position(D,orb[i]);
if p<>fail then # catch if domain is not closed
orb[i]:=D[p];
RemoveSet(use,p);
fi;
od;
D:=D{use};
if sort then
MakeImmutable(D); # to remember sortedness
IsSSortedList(D);
fi;
else
for o in orb do
use[PositionCanonical(D,o)]:=true;
od;
# not plist -- do not take difference as there may be special
# `PositionCanonical' method.
while pos<=Length(D) and use[pos] do
pos:=pos+1;
od;
fi;
Add( orbs, orb );
od;
return Immutable( orbs );
end );
InstallMethod( OrbitsDomain, "empty domain", true,
[ IsGroup, IsList and IsEmpty, IsList, IsList, IsFunction ], 0,
function( G, D, gens, acts, act )
return Immutable( [ ] );
end );
InstallOtherMethod(OrbitsDomain,"group without domain",true,[ IsGroup ], 0,
function( G )
Error("You must give a domain on which the group acts");
end );
InstallMethod( Orbits, "for arbitrary domains", true, OrbitsishReq, 0,
function( G, D, gens, acts, act )
local orbs, orb,sort,plist,pos,use,o,nc,ld,ld1,pc;
sort:=Length(D)>0 and CanEasilySortElements(D[1]);
plist:=IsPlistRep(D);
if not plist then
use:=BlistList([1..Length(D)],[]);
fi;
nc:=true;
ld1:=Length(D);
orbs := [ ];
pos:=1;
while Length(D)>0 and pos<=Length(D) do
orb := OrbitOp( G,D[pos], gens, acts, act );
Add( orbs, orb );
if plist then
ld:=Length(D);
if sort then
D:=Difference(D,orb);
MakeImmutable(D); # to remember sortedness
else
D:=Filtered(D,i-> not i in orb);
fi;
if Length(D)+Length(orb)>ld then
nc:=false; # there are elements in `orb' not in D
fi;
else
for o in orb do
pc:=PositionCanonical(D,o);
if pc <> fail then
use[pc]:=true;
fi;
od;
# not plist -- do not take difference as there may be special
# `PositionCanonical' method.
while pos<=Length(D) and use[pos] do
pos:=pos+1;
od;
fi;
od;
if nc and ld1>10000 then
Info(InfoPerformance,1,
"You are calculating `Orbits' with a large set of seeds.\n",
"#I If you gave a domain and not seeds consider `OrbitsDomain' instead.");
fi;
return Immutable( orbs );
end );
InstallMethod( OrbitsDomain, "empty domain", true,
[ IsGroup, IsList and IsEmpty, IsList, IsList, IsFunction ], 0,
function( G, D, gens, acts, act )
return Immutable( [ ] );
end );
InstallOtherMethod( Orbits, "group without domain", true, [ IsGroup ], 0,
function( G )
Error("You must give a domain on which the group acts");
end );
#############################################################################
##
#F SparseActionHomomorphism( <arg> ) action homomorphism on `[1..n]'
##
InstallMethod( SparseActionHomomorphismOp,
"domain given", true,
[ IsGroup, IsList, IsList, IsList, IsList, IsFunction ], 0,
function( G, D, start, gens, acts, act )
local list, ps, p, i, gen, img, pos, imgs, hom,orb,ran,xset;
orb := List( start, p -> PositionCanonical( D, p ) );
list := List( gens, gen -> [ ] );
ps := 1;
while ps <= Length( orb ) do
p := D[ orb[ ps ] ];
for i in [ 1 .. Length( gens ) ] do
gen := acts[ i ];
img := PositionCanonical( D, act( p, gen ) );
pos := Position( orb, img );
if pos = fail then
Add( orb, img );
pos := Length( orb );
fi;
list[ i ][ ps ] := pos;
od;
ps := ps + 1;
od;
imgs := List( list, PermList );
xset := ExternalSet( G, D{orb}, gens, acts, act);
SetBaseOfGroup( xset, start );
p:=RUN_IN_GGMBI; # no niceomorphism translation here
RUN_IN_GGMBI:=true;
hom := ActionHomomorphism(xset,"surjective" );
ran:= Group( imgs, () ); # `imgs' has been created with `PermList'
SetRange(hom,ran);
SetImagesSource(hom,ran);
SetAsGroupGeneralMappingByImages( hom, GroupHomomorphismByImagesNC
( G, ran, gens, imgs ) );
# We know that the points corresponding to `start' give a base. We can use
# this to get images quickly, using a stabilizer chain in the permutation
# group
SetFilterObj( hom, IsActionHomomorphismByBase );
RUN_IN_GGMBI:=p;
return hom;
end );
#############################################################################
##
#F DoSparseActionHomomorphism( <arg> )
##
InstallGlobalFunction(DoSparseActionHomomorphism,
function(G,start,gens,acts,act,sort)
local dict,p,i,img,imgs,hom,permimg,orb,imgn,ran,D,xset;
# get a dictionary
if IsMatrix(start) and Length(start)>0 and Length(start)=Length(start[1]) then
# if we have matrices, we need to give a domain as well, to ensure the
# right field
D:=DomainForAction(start[1],acts,act);
else # just base on the start values
D:=fail;
fi;
dict:=NewDictionary(start[1],true,D);
orb:=List(start,x->x); # do force list rep.
for i in [1..Length(orb)] do
AddDictionary(dict,orb[i],i);
od;
permimg:=List(acts,i->[]);
# orbit algorithm with image keeper
p:=1;
while p<=Length(orb) do
for i in [1..Length(gens)] do
img := act(orb[p],acts[i]);
imgn:=LookupDictionary(dict,img);
if imgn=fail then
Add(orb,img);
AddDictionary(dict,img,Length(orb));
permimg[i][p]:=Length(orb);
else
permimg[i][p]:=imgn;
fi;
od;
p:=p+1;
od;
# any asymptotic argument is pointless here: In practice sorting is much
# quicker than image computation.
if sort then
imgs:=Sortex(orb); # permutation we must apply to the points to be sorted.
# was: permimg:=List(permimg,i->OnTuples(Permuted(i,imgs),imgs));
# run in loop to save memory
for i in [1..Length(permimg)] do
permimg[i]:=Permuted(permimg[i],imgs);
permimg[i]:=OnTuples(permimg[i],imgs);
od;
fi;
for i in [1..Length(permimg)] do
permimg[i]:=PermList(permimg[i]);
od;
# We know that the points corresponding to `start' give a base. We can use
# this to get images quickly, using a stabilizer chain in the permutation
# group
if fail in permimg then
Error("not permutations");
fi;
imgs:=permimg;
ran:= Group( imgs, () ); # `imgs' has been created with `PermList'
xset := ExternalSet( G, orb, gens, acts, act);
if IsMatrix(start) and (act=OnPoints or act=OnRight) then
# act on vectors -- if we have a basis we have a base for ordinary
# action
p:=RankMat(start);
if p=Length(start[1]) then
SetBaseOfGroup( xset, start );
elif RankMat(orb{[1..Minimum(Length(orb),200)]})=Length(start[1]) then
start:=ShallowCopy(start);
i:=0;
# we know we will be successful
while p<Length(start[1]) do
i:=i+1;
if RankMat(Concatenation(start,[orb[i]]))>p then
Add(start,orb[i]);
p:=p+1;
fi;
od;
SetBaseOfGroup( xset, start );
fi;
elif IsMatrix(start) and act=OnLines then
# projective action also needs all-1 vector.
img:=1+Zero(start);
if img in orb then
start:=ShallowCopy(start);
p:=RankMat(start);
Add(start,img);
if p=Length(start[1]) then
SetBaseOfGroup( xset, start );
elif RankMat(orb{[1..Minimum(Length(orb),200)]})=Length(start[1]) then
i:=0;
# we know we will be successful
while p<Length(start[1]) do
i:=i+1;
if RankMat(Concatenation(start,[orb[i]]))>p then
Add(start,orb[i]);
p:=p+1;
fi;
od;
SetBaseOfGroup( xset, start );
fi;
fi;
fi;
p:=RUN_IN_GGMBI; # no niceomorphism translation here
RUN_IN_GGMBI:=true;
hom := ActionHomomorphism( xset,"surjective" );
SetRange(hom,ran);
SetImagesSource(hom,ran);
SetMappingGeneratorsImages(hom,[gens,imgs]);
SetAsGroupGeneralMappingByImages( hom, GroupHomomorphismByImagesNC
( G, ran, gens, imgs ) );
if HasBaseOfGroup(xset) then
SetFilterObj( hom, IsActionHomomorphismByBase );
fi;
RUN_IN_GGMBI:=p;
return hom;
end);
#############################################################################
##
#M SparseActionHomomorphism( <arg> )
##
InstallOtherMethod( SparseActionHomomorphismOp,
"no domain given", true,
[ IsGroup, IsList, IsList, IsList, IsFunction ], 0,
function( G, start, gens, acts, act )
return DoSparseActionHomomorphism(G,start,gens,acts,act,false);
end);
#############################################################################
##
#M SortedSparseActionHomomorphism( <arg> )
##
InstallOtherMethod( SortedSparseActionHomomorphismOp,
"no domain given", true,
[ IsGroup, IsList, IsList, IsList, IsFunction ], 0,
function( G, start, gens, acts, act )
return DoSparseActionHomomorphism(G,start,gens,acts,act,true);
end );
#############################################################################
##
#F ExternalOrbits( <arg> ) . . . . . . . . . . . . list of transitive xsets
##
InstallMethod( ExternalOrbits,
"G, D, gens, acts, act",
true,
OrbitsishReq, 0,
function( G, D, gens, acts, act )
local blist, orbs, next, pnt, orb;
blist := BlistList( [ 1 .. Length( D ) ], [ ] );
orbs := [ ];
for next in [1..Length(D)] do
if blist[next]=false then
pnt := D[ next ];
orb := ExternalOrbitOp( G, D, pnt, gens, acts, act );
#SetCanonicalRepresentativeOfExternalSet( orb, pnt );
SetEnumerator( orb, OrbitByPosOp( G, D, blist, next, pnt,
gens, acts, act ) );
Add( orbs, orb );
fi;
od;
return Immutable( orbs );
end );
InstallOtherMethod( ExternalOrbits,
"G, xset, gens, acts, act",
true,
[ IsGroup, IsExternalSet,
IsList,
IsList,
IsFunction ], 0,
function( G, xset, gens, acts, act )
local D, blist, orbs, next, pnt, orb;
D := Enumerator( xset );
blist := BlistList( [ 1 .. Length( D ) ], [ ] );
orbs := [ ];
for next in [1..Length(D)] do
if blist[next]=false then
pnt := D[ next ];
orb := ExternalOrbitOp( G, xset, pnt, gens, acts, act );
#SetCanonicalRepresentativeOfExternalSet( orb, pnt );
SetEnumerator( orb, OrbitByPosOp( G, D, blist, next, pnt,
gens, acts, act ) );
Add( orbs, orb );
fi;
od;
return Immutable( orbs );
end );
#############################################################################
##
#F ExternalOrbitsStabilizers( <arg> ) . . . . . . list of transitive xsets
##
BindGlobal("ExtOrbStabDom",function( G, xsetD,D, gens, acts, act )
local blist, orbs, next, pnt, orb, orbstab,actrec;
orbs := [ ];
if IsEmpty( D ) then
return Immutable( orbs );
else
blist:= BlistList( [ 1 .. Length( D ) ], [ ] );
fi;
for next in [1..Length(D)] do
if blist[next]=false then
pnt := D[ next ];
orb := ExternalOrbitOp( G, xsetD, pnt, gens, acts, act );
# was orbstab := OrbitStabilizer( G, D, pnt, gens, acts, act );
actrec:=rec(pnt:=pnt, act:=act );
# Does the external set give a kernel? Use it!
if IsExternalSet(xsetD) and HasActionKernelExternalSet(xsetD) then
actrec.stabsub:=ActionKernelExternalSet(xsetD);
fi;
orbstab := OrbitStabilizerAlgorithm( G, D, blist, gens, acts, actrec);
#SetCanonicalRepresentativeOfExternalSet( orb, pnt );
if IsSSortedList(orbstab.orbit) then
SetAsSSortedList( orb, orbstab.orbit );
else
SetAsList( orb, orbstab.orbit );
fi;
SetEnumerator( orb, orbstab.orbit );
SetStabilizerOfExternalSet( orb, orbstab.stabilizer );
Add( orbs, orb );
fi;
od;
return Immutable( orbs );
end );
InstallMethod( ExternalOrbitsStabilizers,
"arbitrary domain",
true,
OrbitsishReq, 0,
function( G, D, gens, acts, act )
return ExtOrbStabDom(G,D,D,gens,acts,act);
end );
InstallOtherMethod( ExternalOrbitsStabilizers,
"external set",
true,
[ IsGroup, IsExternalSet, IsList, IsList, IsFunction ], 0,
function( G, xset, gens, acts, act )
return ExtOrbStabDom(G,xset,Enumerator(xset),gens,acts,act);
end );
#############################################################################
##
#F Permutation( <arg> ) . . . . . . . . . . . . . . . . . . . . permutation
##
InstallGlobalFunction( Permutation, function( arg )
local g, D, gens, acts, act, xset, hom;
# Get the arguments.
g := arg[ 1 ];
if Length( arg ) = 2 and IsExternalSet( arg[ 2 ] ) then
xset := arg[ 2 ];
D := Enumerator( xset );
if IsExternalSetByActorsRep( xset ) then
gens := xset!.generators;
acts := xset!.operators;
act := xset!.funcOperation;
else
act := FunctionAction( xset );
fi;
else
D := arg[ 2 ];
if IsDomain( D ) then
D := Enumerator( D );
fi;
if IsFunction( Last( arg ) ) then
--> --------------------
--> maximum size reached
--> --------------------
[ Verzeichnis aufwärts0.64unsichere Verbindung
Übersetzung europäischer Sprachen durch Browser
]
|
