|
#############################################################################
##
#W resclass.gi GAP4 Package `ResClasses' Stefan Kohl
##
## This file contains implementations of methods and functions for computing
## with unions of residue classes +/- finite sets ('residue class unions').
##
#############################################################################
#############################################################################
##
#S Implications between the categories of residue class unions /////////////
#S and shorthands for commonly used filters. ///////////////////////////////
##
#############################################################################
InstallTrueMethod( IsResidueClassUnion,
IsResidueClassUnionOfZorZ_pi );
InstallTrueMethod( IsResidueClassUnionOfZorZ_pi,
IsResidueClassUnionOfZ );
InstallTrueMethod( IsResidueClassUnionOfZorZ_pi,
IsResidueClassUnionOfZ_pi );
InstallTrueMethod( IsResidueClassUnion,
IsResidueClassUnionOfZxZ );
InstallTrueMethod( IsResidueClassUnion,
IsResidueClassUnionOfGFqx );
BindGlobal( "IsResidueClassOfZ",
IsResidueClassUnionOfZ and IsResidueClass );
BindGlobal( "IsResidueClassOfZxZ",
IsResidueClassUnionOfZxZ and IsResidueClass );
BindGlobal( "IsResidueClassOfZ_pi",
IsResidueClassUnionOfZ_pi and IsResidueClass );
BindGlobal( "IsResidueClassOfZorZ_pi",
IsResidueClassUnionOfZorZ_pi and IsResidueClass );
BindGlobal( "IsResidueClassOfGFqx",
IsResidueClassUnionOfGFqx and IsResidueClass );
BindGlobal( "IsResidueClassUnionInResidueListRep",
IsResidueClassUnion and IsResidueClassUnionResidueListRep );
BindGlobal( "IsResidueClassUnionInClassListRep",
IsResidueClassUnion and IsResidueClassUnionClassListRep );
BindGlobal( "IsResidueClassUnionOfZInClassListRep",
IsResidueClassUnionOfZ and IsResidueClassUnionClassListRep );
#############################################################################
##
#S The families of residue class unions. ///////////////////////////////////
##
#############################################################################
# Internal variables for caching the families of residue class unions
# used in the current GAP session.
BindGlobal( "Z_RESIDUE_CLASS_UNIONS_FAMILIES", [] );
BindGlobal( "Z_PI_RESIDUE_CLASS_UNIONS_FAMILIES", [] );
BindGlobal( "GF_Q_X_RESIDUE_CLASS_UNIONS_FAMILIES", [] );
#############################################################################
##
#F ZResidueClassUnionsFamily( <fixedreps> )
##
InstallGlobalFunction( ZResidueClassUnionsFamily,
function ( fixedreps )
local fam, pos;
if not fixedreps then pos := 1; else pos := 2; fi;
if IsBound( Z_RESIDUE_CLASS_UNIONS_FAMILIES[ pos ] )
then return Z_RESIDUE_CLASS_UNIONS_FAMILIES[ pos ]; fi;
if not fixedreps then
fam := NewFamily( "ResidueClassUnionsFamily( Integers )",
IsResidueClassUnionOfZ,
CanEasilySortElements, CanEasilySortElements );
SetUnderlyingRing( fam, Integers );
SetElementsFamily( fam, FamilyObj( 1 ) );
else
fam := NewFamily( "ResidueClassUnionsFamily( Integers, true )",
IsUnionOfResidueClassesWithFixedRepresentatives,
CanEasilySortElements, CanEasilySortElements );
SetUnderlyingRing( fam, Integers );
SetElementsFamily( fam, fam );
fi;
MakeReadWriteGlobal( "Z_RESIDUE_CLASS_UNIONS_FAMILIES" );
Z_RESIDUE_CLASS_UNIONS_FAMILIES[ pos ] := fam;
MakeReadOnlyGlobal( "Z_RESIDUE_CLASS_UNIONS_FAMILIES" );
return fam;
end );
#############################################################################
##
#V ZxZResidueClassUnionsFamily . . family of all residue class unions of Z^2
##
## GAP does not view Z^2 as a ring, but rather as a row module.
## Anyway it is viewed as the underlying ring of the family, since it
## mathematically is a ring and since this avoids a case distinction
## in many places in the code.
##
BindGlobal( "ZxZResidueClassUnionsFamily",
NewFamily( "ResidueClassUnionsFamily( Integers^2 )",
IsResidueClassUnionOfZxZ,
CanEasilySortElements, CanEasilySortElements ) );
SetUnderlyingRing( ZxZResidueClassUnionsFamily, Integers^2 );
SetElementsFamily( ZxZResidueClassUnionsFamily, FamilyObj( [ 0, 0 ] ) );
#############################################################################
##
#F Z_piResidueClassUnionsFamily( <R> , <fixedreps> )
##
InstallGlobalFunction( Z_piResidueClassUnionsFamily,
function ( R, fixedreps )
local fam, cat, name;
fam := First( Z_PI_RESIDUE_CLASS_UNIONS_FAMILIES,
fam -> UnderlyingRing( fam ) = R
and PositionSublist( fam!.NAME,
String(fixedreps) ) <> fail );
if fam <> fail then return fam; fi;
if not fixedreps
then cat := IsResidueClassUnionOfZ_pi;
else cat := IsUnionOfResidueClassesOfZ_piWithFixedRepresentatives; fi;
name := Concatenation( "ResidueClassUnionsFamily( ",
String( R ),", ",String(fixedreps)," )" );
fam := NewFamily( name, cat,
CanEasilySortElements, CanEasilySortElements );
SetUnderlyingRing( fam, R );
if not fixedreps then SetElementsFamily( fam, FamilyObj( 1 ) );
else SetElementsFamily( fam, fam ); fi;
MakeReadWriteGlobal( "Z_PI_RESIDUE_CLASS_UNIONS_FAMILIES" );
Add( Z_PI_RESIDUE_CLASS_UNIONS_FAMILIES, fam );
MakeReadOnlyGlobal( "Z_PI_RESIDUE_CLASS_UNIONS_FAMILIES" );
return fam;
end );
#############################################################################
##
#F GFqxResidueClassUnionsFamily( <R>, <fixedreps> )
##
InstallGlobalFunction( GFqxResidueClassUnionsFamily,
function ( R, fixedreps )
local fam, cat, name, x;
x := IndeterminatesOfPolynomialRing( R )[ 1 ];
fam := First( GF_Q_X_RESIDUE_CLASS_UNIONS_FAMILIES,
fam -> UnderlyingRing( fam ) = R
and PositionSublist( fam!.NAME,
String(fixedreps) ) <> fail );
if fam <> fail then return fam; fi;
if not fixedreps
then cat := IsResidueClassUnionOfGFqx;
else cat := IsUnionOfResidueClassesOfGFqxWithFixedRepresentatives; fi;
name := Concatenation( "ResidueClassUnionsFamily( ",
ViewString( R ),", ",String(fixedreps)," )" );
fam := NewFamily( name, cat,
CanEasilySortElements, CanEasilySortElements );
SetUnderlyingIndeterminate( fam, x );
SetUnderlyingRing( fam, R );
if not fixedreps then SetElementsFamily( fam, FamilyObj( x ) );
else SetElementsFamily( fam, fam ); fi;
MakeReadWriteGlobal( "GF_Q_X_RESIDUE_CLASS_UNIONS_FAMILIES" );
Add( GF_Q_X_RESIDUE_CLASS_UNIONS_FAMILIES, fam );
MakeReadOnlyGlobal( "GF_Q_X_RESIDUE_CLASS_UNIONS_FAMILIES" );
return fam;
end );
#############################################################################
##
#F ResidueClassUnionsFamily( <R> [ , <fixedreps> ] )
##
InstallGlobalFunction( ResidueClassUnionsFamily,
function ( arg )
local R, fixedreps;
if not Length(arg) in [1,2]
or Length(arg) = 2 and not arg[2] in [true,false]
then Error("Usage: ResidueClassUnionsFamily( <R> [ , <fixedreps> ] )\n");
fi;
R := arg[1];
if Length(arg) = 2 then fixedreps := arg[2]; else fixedreps := false; fi;
if IsIntegers( R )
then return ZResidueClassUnionsFamily( fixedreps );
elif IsZxZ( R ) then return ZxZResidueClassUnionsFamily;
elif IsZ_pi( R )
then return Z_piResidueClassUnionsFamily( R, fixedreps );
elif IsUnivariatePolynomialRing( R ) and IsFiniteFieldPolynomialRing( R )
then return GFqxResidueClassUnionsFamily( R, fixedreps );
else Error("Sorry, residue class unions of ",R,
" are not yet implemented.\n");
fi;
end );
#############################################################################
##
#M IsZxZ( <R> ) . . . . . . . . . . . . . . . . . . Z^2 = Z x Z = Integers^2
##
InstallMethod( IsZxZ, "general method (ResClasses)", true,
[ IsObject ], 0, R -> R = Integers^2 );
#############################################################################
##
#S Residues / residue classes (mod m). /////////////////////////////////////
##
#############################################################################
# Buffer for storing already computed polynomial residue systems.
BindGlobal( "POLYNOMIAL_RESIDUE_CACHE", [] );
BindGlobal( "AllGFqPolynomialsModDegree",
function ( q, d, x )
local erg, mon, gflist;
if d = 0
then return [ Zero( x ) ];
elif IsBound( POLYNOMIAL_RESIDUE_CACHE[ q ] )
and IsBound( POLYNOMIAL_RESIDUE_CACHE[ q ][ d ] )
then return ShallowCopy( POLYNOMIAL_RESIDUE_CACHE[ q ][ d ] );
else gflist := AsList( GF( q ) );
mon := List( gflist, el -> List( [ 0 .. d - 1 ], i -> el * x^i ) );
erg := List( Tuples( GF( q ), d ),
t -> Sum( List( [ 1 .. d ],
i -> mon[ Position( gflist, t[ i ] ) ]
[ d - i + 1 ] ) ) );
MakeReadWriteGlobal( "POLYNOMIAL_RESIDUE_CACHE" );
if not IsBound( POLYNOMIAL_RESIDUE_CACHE[ q ] )
then POLYNOMIAL_RESIDUE_CACHE[ q ] := [ ]; fi;
POLYNOMIAL_RESIDUE_CACHE[ q ][ d ] := Immutable( erg );
MakeReadOnlyGlobal( "POLYNOMIAL_RESIDUE_CACHE" );
return erg;
fi;
end );
# Difference r1(m1) \ r2(m2) of two residue classes;
# the residue classes r1(m1) and r2(m2) are to be given as pairs
# [r1,m1] and [r2,m2] of integers, and the output is a list of
# residue classes represented in the same way.
BindGlobal( "DIFFERENCE_OF_RESIDUE_CLASSES",
function ( cl1, cl2 )
local cls, r1, m1, r2, m2, r3, m3, divs, d, p, r, inc, i;
r1 := cl1[1]; m1 := cl1[2];
r2 := cl2[1]; m2 := cl2[2];
if (r1-r2) mod Gcd(m1,m2) <> 0 then return [cl1]; fi; # disjoint
m3 := Lcm(m1,m2);
if m3 = m1 then return []; fi; # second cl. is a superset of first cl.
r3 := ChineseRem([m1,m2],[r1,r2]);
divs := []; d := 1;
for p in Factors(m3/m1) do
d := d * p;
Add(divs,d);
od;
cls := [];
for i in [1..Length(divs)] do
d := divs[i];
if i > 1 then inc := divs[i-1]; else inc := 1; fi;
for r in [inc,2*inc..d-inc] do
Add(cls,[r,d]);
od;
od;
for i in [1..Length(cls)] do # get moduli and residues right
cls[i][2] := cls[i][2] * m1;
cls[i][1] := (cls[i][1] * m1 + r3) mod cls[i][2];
od;
SortParallel( List( cls, Reversed ), cls );
return cls;
end );
#############################################################################
##
#M AllResidues( <R>, <m> ) . . . . . . . . . . . . for Z, Z_pi and GF(q)[x]
##
InstallMethod( AllResidues,
"for Z, Z_pi and GF(q)[x] (ResClasses)", ReturnTrue,
[ IsRing, IsRingElement ], 0,
function ( R, m )
local q, d, x;
if IsIntegers(R) or IsZ_pi(R)
then return [0..StandardAssociate(R,m)-1]; fi;
if IsUnivariatePolynomialRing(R) and Characteristic(R) <> 0 then
q := Size(CoefficientsRing(R));
d := DegreeOfLaurentPolynomial(m);
x := IndeterminatesOfPolynomialRing(R)[1];
return AllGFqPolynomialsModDegree(q,d,x);
fi;
TryNextMethod();
end );
#############################################################################
##
#M AllResidues( Integers^2, <L> ) . . . . . . . . . . . . for lattice in Z^2
##
InstallOtherMethod( AllResidues,
"for lattice in Z^2 (ResClasses)", true,
[ IsRowModule, IsMatrix ], 0,
function ( ZxZ, L )
if not IsZxZ(ZxZ) or not IsSubset(ZxZ,L) then TryNextMethod(); fi;
L := HermiteNormalFormIntegerMat(L);
return Cartesian([0..L[1][1]-1],[0..L[2][2]-1]);
end );
#############################################################################
##
#M NumberOfResidues( <R>, <m> ) . . . . . . . . . . for Z, Z_pi and GF(q)[x]
##
InstallMethod( NumberOfResidues,
"for Z, Z_pi and GF(q)[x] (ResClasses)", ReturnTrue,
[ IsRing, IsRingElement ], 0,
function ( R, m )
local q, d, x;
if IsIntegers(R) or IsZ_pi(R) then return StandardAssociate(R,m); fi;
if IsUnivariatePolynomialRing(R) and Characteristic(R) <> 0 then
q := Size(CoefficientsRing(R));
d := DegreeOfLaurentPolynomial(m);
return q^d;
fi;
TryNextMethod();
end );
#############################################################################
##
#M NumberOfResidues( Integers^2, <L> ) . . . . . . . . . for lattice in Z^2
##
InstallOtherMethod( NumberOfResidues,
"for lattice in Z^2 (ResClasses)", ReturnTrue,
[ IsRowModule, IsMatrix ], 0,
function ( ZxZ, L )
if not IsZxZ(ZxZ) or not IsSubset(ZxZ,L) then TryNextMethod(); fi;
return AbsInt(DeterminantMat(L));
end );
#############################################################################
##
#F AllResidueClassesModulo( [ <R>, ] <m> ) . . the residue classes (mod <m>)
##
InstallGlobalFunction( AllResidueClassesModulo,
function ( arg )
local R, m;
if Length(arg) = 2
then R := arg[1]; m := arg[2];
else m := arg[1]; R := DefaultRing(m); fi;
if IsRing(R) and (IsZero(m) or not m in R) then return fail; fi;
return List(AllResidues(R,m),r->ResidueClass(R,m,r));
end );
#############################################################################
##
#F All2x2IntegerMatricesInHNFWithDeterminantUpTo( <maxdet> )
##
InstallGlobalFunction( All2x2IntegerMatricesInHNFWithDeterminantUpTo,
function ( maxdet )
local mods, det, diags, diag;
mods := [];
for det in [1..maxdet] do
diags := List(DivisorsInt(det),d->[d,det/d]);
for diag in diags do
Append(mods,List([0..diag[2]-1],k->[[diag[1],k],[0,diag[2]]]));
od;
od;
return mods;
end );
#############################################################################
##
#M SizeOfSmallestResidueClassRing( <R> ) . . . . . for Z, Z_pi and GF(q)[x]
##
InstallMethod( SizeOfSmallestResidueClassRing,
"for Z, Z_pi and GF(q)[x] (ResClasses)", true, [ IsRing ], 0,
function ( R )
if IsIntegers(R) then return 2;
elif IsZ_pi(R) then return Minimum(NoninvertiblePrimes(R));
elif IsFiniteFieldPolynomialRing(R) then return Characteristic(R);
else TryNextMethod(); fi;
end );
#############################################################################
##
#M SizeOfSmallestResidueClassRing( Integers^2 ) . . . . . . . . . . for Z^2
##
InstallOtherMethod( SizeOfSmallestResidueClassRing,
"for Z^2 (ResClasses)", true, [ IsRowModule ], 0,
function ( ZxZ )
if IsZxZ(ZxZ) then return 2; else TryNextMethod(); fi;
end );
#############################################################################
##
#S Basic functionality for lattices in Z^n. ////////////////////////////////
##
#############################################################################
#############################################################################
##
#M StandardAssociate( <R>, <mat> ) . . . . . . . HNF of n x n integer matrix
##
InstallOtherMethod( StandardAssociate,
"HNF of n x n integer matrix (ResClasses)", IsCollsElms,
[ IsRing and IsFullMatrixModule, IsMatrix ], 0,
function ( R, mat )
if not IsIntegers(LeftActingDomain(R))
or Length(Set(DimensionOfVectors(R))) <> 1 or not mat in R
then TryNextMethod(); fi;
return HermiteNormalFormIntegerMat(mat);
end );
#############################################################################
##
#M \mod . . . . . . . . . . . . . . . . . . . . . for a vector and a lattice
##
if not IsReadOnlyGlobal( "VectorModLattice" ) # not protected in polycyclic
then MakeReadOnlyGlobal( "VectorModLattice" ); fi;
InstallMethod( \mod, "for a vector and a lattice (ResClasses)", IsElmsColls,
[ IsRowVector, IsMatrix ], 0,
function ( v, L ) return VectorModLattice( v, L ); end );
#############################################################################
##
#M LcmOp( <R>, <mat1>, <mat2> ) . . . . . . . . lattice intersection in Z^n
##
InstallOtherMethod( LcmOp, "lattice intersection in Z^n (ResClasses)",
IsCollsElmsElms,
[ IsRing and IsFullMatrixModule, IsMatrix, IsMatrix ], 0,
function ( R, mat1, mat2 )
local n;
if not IsIntegers(LeftActingDomain(R))
or Length(Set(DimensionOfVectors(R))) <> 1
or not mat1 in R or not mat2 in R
then TryNextMethod(); fi;
n := DimensionOfVectors(R)[1];
if n = 2 then # Check whether matrices are already in HNF.
if mat1[2][1] <> 0 or ForAny(Flat(mat1),n->n<0)
or mat1[1][2] >= mat1[2][2]
then mat1 := HermiteNormalFormIntegerMat(mat1); fi;
if mat2[2][1] <> 0 or ForAny(Flat(mat2),n->n<0)
or mat2[1][2] >= mat2[2][2]
then mat2 := HermiteNormalFormIntegerMat(mat2); fi;
else
mat1 := HermiteNormalFormIntegerMat(mat1);
mat2 := HermiteNormalFormIntegerMat(mat2);
fi;
return LatticeIntersection( mat1, mat2 );
end );
#############################################################################
##
#M IsSublattice( <L1>, <L2> ) . . . . . . . . . . . . . for lattices in Z^n
##
InstallMethod( IsSublattice,
"for lattices in Z^n (ResClasses)", IsIdenticalObj,
[ IsMatrix, IsMatrix ], 0,
function ( L1, L2 )
return ForAll( Flat( L2 / L1 ), IsInt );
end );
#############################################################################
##
#M Superlattices( <L> ) . . . . . . . . . . . . . . . . for a lattice in Z^2
##
SetupCache( "RESCLASSES_SUPERLATTICES_CACHE", 100 );
InstallMethod( Superlattices,
"for a lattice in Z^2 (ResClasses)", true, [ IsMatrix ], 0,
function ( L )
local lattices, sup, divx, divy, x, y, dx;
if Set(DimensionsMat(L)) <> [2] or not ForAll(Flat(L),IsInt)
or DeterminantMat(L) = 0
then TryNextMethod(); fi;
if IsOne(L) then return [[[1,0],[0,1]]]; fi;
lattices := FetchFromCache( "RESCLASSES_SUPERLATTICES_CACHE", L );
if lattices <> fail then return lattices; fi;
divx := DivisorsInt(L[2][2]); divy := DivisorsInt(L[1][1]);
lattices := [];
for x in divx do for y in divy do for dx in [0..x-1] do
sup := [[y,dx],[0,x]];
if ForAll(Flat(L/sup),IsInt) then Add(lattices,sup); fi;
od; od; od;
lattices := Set(lattices,HermiteNormalFormIntegerMat);
SortParallel(List(lattices,Li->[DeterminantMat(Li),Li]),lattices);
PutIntoCache( "RESCLASSES_SUPERLATTICES_CACHE", L, lattices );
return lattices;
end );
#############################################################################
##
#F ModulusAsFormattedString( <m> ) . format lattice etc. for output purposes
##
BindGlobal( "ModulusAsFormattedString",
function ( m )
if not IsMatrix(m) then return ViewString(m); fi;
return Filtered(Concatenation(List(["(",m[1][1],",",m[1][2],")Z+(",
m[2][1],",",m[2][2],")Z"],
String)),ch->ch<>' ');
end );
#############################################################################
##
#S Construction of residue class unions. ///////////////////////////////////
##
#############################################################################
#############################################################################
##
#M ResidueClassUnionCons( <filter>, <R>, <m>, <r>, <included>, <excluded> )
##
InstallMethod( ResidueClassUnionCons,
"residue list rep., for Z, Z_pi and GF(q)[x] (ResClasses)",
ReturnTrue, [ IsResidueClassUnion, IsRing, IsRingElement,
IsList, IsList, IsList ], 0,
function ( filter, R, m, r, included, excluded )
local ReduceResidueClassUnion, result, both, fam, type, rep, pos;
ReduceResidueClassUnion := function ( U )
local R, m, r, mRed, mRedBuf, rRed, rRedBuf, valid, fact, p;
R := UnderlyingRing(FamilyObj(U));
m := StandardAssociate(R,U!.m); mRed := m;
r := Set( U!.r, n -> n mod m ); rRed := r;
fact := Set(Factors(R,m));
for p in fact do
repeat
mRedBuf := mRed; rRedBuf := ShallowCopy(rRed);
mRed := mRed/p;
rRed := Set(rRedBuf,n->n mod mRed);
if IsIntegers(R) or IsZ_pi(R)
then valid := Length(rRed) = Length(rRedBuf)/p;
else valid := Length(rRed) = Length(rRedBuf)/
Size(CoefficientsRing(R))^DegreeOfLaurentPolynomial(p);
fi;
until not valid or not IsZero(mRed mod p) or IsOne(mRed);
if not valid then mRed := mRedBuf; rRed := rRedBuf; fi;
od;
U!.m := mRed; U!.r := Immutable(rRed);
U!.included := Immutable(Set(Filtered(U!.included,
n -> not (n mod mRed in rRed))));
U!.excluded := Immutable(Set(Filtered(U!.excluded,
n -> n mod mRed in rRed)));
if rRed = [] then U := Difference(U!.included,U!.excluded); fi;
end;
if not ( IsIntegers( R ) or IsZ_pi( R )
or ( IsFiniteFieldPolynomialRing( R )
and IsUnivariatePolynomialRing( R ) ) )
then TryNextMethod( ); fi;
m := StandardAssociate( R, m );
r := Set( r, n -> n mod m );
both := Intersection( included, excluded );
included := Difference( included, both );
excluded := Difference( excluded, both );
if r = [] then return Difference(included,excluded); fi;
fam := ResidueClassUnionsFamily( R );
if IsIntegers( R ) then type := IsResidueClassUnionOfZ;
elif IsZ_pi( R ) then type := IsResidueClassUnionOfZ_pi;
elif IsPolynomialRing( R ) then type := IsResidueClassUnionOfGFqx;
fi;
result := Objectify( NewType( fam, type and
IsResidueClassUnionResidueListRep ),
rec( m := m, r := r,
included := included, excluded := excluded ) );
SetSize( result, infinity ); SetIsFinite( result, false );
SetIsEmpty( result, false );
rep := r[1]; pos := 1;
while rep in excluded do
pos := pos + 1;
rep := r[pos mod Length(r) + 1] + Int(pos/Length(r)) * m;
od;
if included <> [ ] and rep > Minimum( included )
then rep := Minimum( included ); fi;
SetRepresentative( result, rep );
ReduceResidueClassUnion( result );
if Length( result!.r ) = 1 then SetIsResidueClass( result, true ); fi;
if IsOne( result!.m ) and result!.r = [ Zero( R ) ]
and [ result!.included, result!.excluded ] = [ [ ], [ ] ]
then return R; else return result; fi;
end );
#############################################################################
##
#M ResidueClassUnionCons( <filter>, <R>, <cls>, <included>, <excluded> )
##
InstallMethod( ResidueClassUnionCons,
"class list rep., for Z (ResClasses)",
ReturnTrue, [ IsResidueClassUnionOfZInClassListRep,
IsIntegers, IsList, IsList, IsList ], 0,
function ( filter, R, cls, included, excluded )
local ReduceResidueClassUnion, result, m, both, rep, pos;
ReduceResidueClassUnion := function ( U )
local R, cls, clsRed, m, ndpair, d1, d2, density, divs, d, i,
partdens, cl, int, res, r, both;
cls := U!.cls;
cls := Set( cls, c -> [ c[1] mod c[2], AbsInt( c[2] ) ] );
SortParallel( List( cls, Reversed ), cls );
repeat
ndpair := First(Combinations(cls,2),
c->(c[1][1]-c[2][1]) mod Gcd(c[1][2],c[2][2]) = 0);
if ndpair <> fail then
cls := Difference(cls,ndpair);
d1 := DIFFERENCE_OF_RESIDUE_CLASSES(ndpair[1],ndpair[2]);
d2 := DIFFERENCE_OF_RESIDUE_CLASSES(ndpair[2],ndpair[1]);
if Length(d1) <= Length(d2) then
Append(cls,d1); Add(cls,ndpair[2]);
else
Append(cls,d2); Add(cls,ndpair[1]);
fi;
cls := Filtered(cls,cl->cl<>[]);
fi;
until ndpair = fail;
SortParallel( List( cls, Reversed ), cls );
clsRed := [];
m := U!.m;
divs := DivisorsInt(m);
density := Sum(List(cls,cl->1/cl[2]));
for d in divs do
if 1/d > density then continue; fi;
res := Set(cls,cl->cl[1] mod d);
for r in res do
partdens := 0;
for cl in cls do
if (r - cl[1]) mod Gcd(d,cl[2]) = 0
then partdens := partdens + 1/Lcm(d,cl[2]); fi;
od;
if partdens = 1/d then
Add(clsRed,[r,d]);
cls := List(cls,cl->DIFFERENCE_OF_RESIDUE_CLASSES(cl,[r,d]));
cls := Filtered(Concatenation(cls),cl->cl<>[]);
if cls = [] then break; fi;
SortParallel( List( cls, Reversed ), cls );
density := Sum(List(cls,cl->1/cl[2]));
elif partdens > 1/d then Error("internal error"); fi;
od;
if cls = [] then break; fi;
od;
m := Lcm(List(clsRed,c->c[2]));
SortParallel( List( clsRed, Reversed ), clsRed );
U!.cls := Immutable(clsRed); U!.m := m;
both := Intersection( U!.included, U!.excluded );
U!.included := Difference( U!.included, both );
U!.excluded := Difference( U!.excluded, both );
U!.included := Immutable(Set(Filtered(U!.included,
n -> not ForAny(clsRed,c -> n mod c[2] = c[1]))));
U!.excluded := Immutable(Set(Filtered(U!.excluded,
n -> ForAny(clsRed,c -> n mod c[2] = c[1]))));
if clsRed = [] then U := U!.included; fi;
end;
if not IsIntegers(R) then TryNextMethod(); fi;
if cls = [] then return Difference(included,excluded); fi;
result := Objectify( NewType( ResidueClassUnionsFamily( Integers ),
IsResidueClassUnionOfZ and
IsResidueClassUnionClassListRep ),
rec( cls := cls, m := Lcm(List(cls,c->c[2])),
included := included, excluded := excluded ) );
SetSize( result, infinity ); SetIsFinite( result, false );
SetIsEmpty( result, false );
if ValueOption("RCU_AlreadyReduced") <> true then
ReduceResidueClassUnion( result );
cls := result!.cls; m := result!.m;
included := result!.included; excluded := result!.excluded;
fi;
rep := cls[1][1]; pos := 1;
while rep in excluded do
pos := pos + 1;
rep := cls[pos mod Length(cls) + 1][1]
+ Int(pos/Length(cls)) * cls[pos mod Length(cls) + 1][2];
od;
if included <> [ ] and rep > Minimum( included )
then rep := Minimum( included ); fi;
SetRepresentative( result, rep );
if Length(result!.cls) = 1 then SetIsResidueClass(result,true); fi;
if result!.m = 1 and result!.cls = [[0,1]]
and [result!.included,result!.excluded] = [[],[]]
then return Integers; else return result; fi;
end );
#############################################################################
##
#M ResidueClassUnionCons( <filter>, Integers^2,
## <L>, <r>, <included>, <excluded> )
##
InstallMethod( ResidueClassUnionCons,
"residue list representation, for Z^2 (ResClasses)",
ReturnTrue, [ IsResidueClassUnion, IsRowModule,
IsMatrix, IsList, IsList, IsList ], 0,
function ( filter, ZxZ, L, r, included, excluded )
local ReduceResidueClassUnion, result, both, rep, pos;
ReduceResidueClassUnion := function ( U )
local L, r, LRed, rRed, divs, d;
L := HermiteNormalFormIntegerMat(U!.m); LRed := L;
r := List(U!.r,v->v mod L); rRed := r;
divs := Superlattices(L);
for d in divs do
if DeterminantMat(L)/DeterminantMat(d) > Length(r) then continue; fi;
rRed := Set(r,v->v mod d);
if Length(rRed) = Length(r)*DeterminantMat(d)/DeterminantMat(L)
then LRed := d; break; fi;
od;
U!.m := LRed; U!.r := Immutable(rRed);
U!.included := Immutable(Set(Filtered(U!.included,
v->not v mod LRed in rRed)));
U!.excluded := Immutable(Set(Filtered(U!.excluded,
v->v mod LRed in rRed)));
end;
if not IsZxZ( ZxZ ) then TryNextMethod( ); fi;
L := HermiteNormalFormIntegerMat( L );
r := Set( r, v -> v mod L );
both := Intersection( included, excluded );
included := Difference( included, both );
excluded := Difference( excluded, both );
if r = [] then L := [[1,0],[0,1]]; excluded := []; fi;
result := Objectify( NewType( ResidueClassUnionsFamily( ZxZ ),
IsResidueClassUnionOfZxZ and
IsResidueClassUnionResidueListRep ),
rec( m := L, r := r,
included := included, excluded := excluded ) );
if r <> [] then
SetSize( result, infinity ); SetIsFinite( result, false );
SetIsEmpty( result, false );
else
SetSize( result, Length( included ) );
SetIsEmpty( result, IsEmpty( included ) );
fi;
if not IsEmpty( result ) then
if included <> [ ] then rep := included[ 1 ]; else
rep := r[1]; pos := 1;
while rep in excluded do
pos := pos + 1;
rep := r[pos mod Length(r) + 1] + Int(pos/Length(r)) * L[1];
od;
fi;
SetRepresentative( result, rep );
fi;
if r <> [] then ReduceResidueClassUnion( result ); else
MakeImmutable( result!.included ); MakeImmutable( result!.excluded );
fi;
if Length( result!.r ) = 1 then SetIsResidueClass( result, true ); fi;
if AbsInt( DeterminantMat( result!.m ) ) = 1
and result!.r = [ [ 0, 0 ] ]
and [ result!.included, result!.excluded ] = [ [ ], [ ] ]
then return ZxZ; else return result; fi;
end );
#############################################################################
##
#M ResidueClassUnionCons( <filter>, Integers^2, ("modulus L as vector")
## <L>, <r>, <included>, <excluded> )
##
InstallOtherMethod( ResidueClassUnionCons,
"residue list rep, mod. as vector, for Z^2 (ResClasses)",
ReturnTrue, [ IsResidueClassUnion, IsRowModule,
IsRowVector, IsList, IsList, IsList ], 0,
function ( filter, ZxZ, L, r, included, excluded )
return ResidueClassUnionCons( filter, ZxZ,
DiagonalMat(L), r, included, excluded );
end );
#############################################################################
##
#F ResidueClassUnion( <R>, <m>, <r> ) . . . . . . . union of residue classes
#F ResidueClassUnion( <R>, <m>, <r>, <included>, <excluded> )
#F ResidueClassUnion( <R>, <cls> )
#F ResidueClassUnion( <R>, <cls>, <included>, <excluded> )
##
InstallGlobalFunction( ResidueClassUnion,
function ( arg )
if not ( Length(arg) in [3,5]
and ( IsRing(arg[1]) and arg[2] in arg[1]
or IsRowModule(arg[1]) and IsMatrix(arg[2])
and IsSubset(arg[1],arg[2])
and not IsZero(DeterminantMat(arg[2])) )
and IsList(arg[3]) and IsSubset(arg[1],arg[3])
and ( Length(arg) = 3 or IsList(arg[4]) and IsList(arg[5])
and IsSubset(arg[1],arg[4])
and IsSubset(arg[1],arg[5])) )
and not ( Length(arg) in [2,4]
and (IsRing(arg[1]) and IsList(arg[2])
and ForAll(arg[2],l->IsList(l) and Length(l) = 2
and IsSubset(arg[1],l) and not IsZero(l[2])))
and ( Length(arg) = 2 or IsList(arg[3]) and IsList(arg[4])
and IsSubset(arg[1],arg[3])
and IsSubset(arg[1],arg[4])) )
then Error("usage: ResidueClassUnion( <R>, <m>, <r> [, <included>",
", <excluded> ] )\nor ResidueClassUnion( <R>, <cls> ",
"[, <included>, <excluded> ] ), for details see manual.\n");
return fail;
fi;
return CallFuncList( ResidueClassUnionNC, arg );
end );
#############################################################################
##
#F ResidueClassUnionNC( <R>, <m>, <r> ) . . . . . . union of residue classes
#F ResidueClassUnionNC( <R>, <m>, <r>, <included>, <excluded> )
#F ResidueClassUnionNC( <R>, <cls> )
#F ResidueClassUnionNC( <R>, <cls>, <included>, <excluded> )
##
InstallGlobalFunction( ResidueClassUnionNC,
function ( arg )
local R, m, r, cls, included, excluded;
if Length(arg) in [2,4] then
R := arg[1]; cls := arg[2];
if Length(arg) = 4
then included := Set(arg[3]); excluded := Set(arg[4]);
else included := []; excluded := []; fi;
return ResidueClassUnionCons( IsResidueClassUnionOfZInClassListRep,
R, cls, included, excluded );
elif Length(arg) in [3,5] then
R := arg[1]; m := arg[2]; r := Set(arg[3]);
if Length(arg) = 5
then included := Set(arg[4]); excluded := Set(arg[5]);
else included := []; excluded := []; fi;
return ResidueClassUnionCons( IsResidueClassUnion, R, m, r,
included, excluded );
fi;
end );
#############################################################################
##
#F ResidueClass( <R>, <m>, <r> ) . . . . . . . . . . . residue class of <R>
#F ResidueClass( <m>, <r> ) . residue class of the default ring of <m>, <r>
#F ResidueClass( <r>, <m> ) . . . . . . . . . . . . . . . . . . . ( dito )
##
InstallGlobalFunction( ResidueClass,
function ( arg )
local R, m, r, d, cl, usage;
usage := "usage: see ?ResidueClass\n";
if Length( arg ) = 3 then
R := arg[1]; m := arg[2]; r := arg[3];
if not ( IsRing(R) and m in R and r in R and not IsZero(m)
or IsRowModule(R) and IsMatrix(m) and IsSubset(R,m)
and not IsZero(DeterminantMat(m)) )
then Error( usage ); return fail; fi;
elif Length( arg ) = 2 then
if ForAll( arg, IsRingElement ) then
if IsPolynomial(arg[1])
then R := DefaultRing(arg[1]); arg[2] := arg[2] * One(R);
elif IsPolynomial(arg[2])
then R := DefaultRing(arg[2]); arg[1] := arg[1] * One(R);
else R := DefaultRing(arg); fi;
m := Maximum( arg ); r := Minimum( arg );
if IsZero( m ) then Error( usage ); return fail; fi;
else
if IsMatrix( arg[1] ) then m := arg[1]; r := arg[2];
else m := arg[2]; r := arg[1]; fi;
if not ( IsMatrix(m) and IsVector(r) )
then Error( usage ); return fail; fi;
d := Length(r);
R := DefaultRing(r)^d;
if not ( DimensionsMat(m) = [d,d] and IsSubset(R,m)
and RankMat(m) = d and r in R )
then Error( usage ); return fail; fi;
fi;
elif Length( arg ) = 1 then
if IsList( arg[1] )
then return CallFuncList( ResidueClass, arg[1] );
elif IsResidueClass( arg[1] )
then return arg[1];
else Error( usage ); return fail; fi;
else
Error( usage ); return fail;
fi;
cl := ResidueClassUnionNC( R, m, [ r ] );
SetIsResidueClass( cl, true );
return cl;
end );
#############################################################################
##
#F ResidueClassNC( <R>, <m>, <r> ) . . . . . . . . . . residue class of <R>
#F ResidueClassNC( <m>, <r> ) residue class of the default ring of <m>, <r>
#F ResidueClassNC( <r>, <m> ) . . . . . . . . . . . . . . . . . . ( dito )
##
InstallGlobalFunction( ResidueClassNC,
function ( arg )
local R, m, r, d, cl;
if Length( arg ) = 3 then
R := arg[1]; m := arg[2]; r := arg[3];
elif Length( arg ) = 2 then
if ForAll(arg,IsRingElement) then
R := DefaultRing( arg );
m := Maximum( arg ); r := Minimum( arg );
else
if IsMatrix(arg[1]) then m := arg[1]; r := arg[2];
else m := arg[2]; r := arg[1]; fi;
d := Length(r);
R := DefaultRing(r)^d;
fi;
elif Length( arg ) = 1 then return CallFuncList(ResidueClassNC,arg[1]);
else return fail; fi;
cl := ResidueClassUnionNC( R, m, [ r ] );
SetIsResidueClass( cl, true );
return cl;
end );
#############################################################################
##
#M IsResidueClass( <obj> ) . . . . . . . . . . . . . . . . . general method
##
InstallMethod( IsResidueClass,
"general method (ResClasses)", true, [ IsObject ], 0,
function ( obj )
if IsRing(obj) then return true; fi;
if IsResidueClassUnionInResidueListRep(obj)
and Length(obj!.r) = 1 and obj!.included = [] and obj!.excluded = []
then return true; fi;
if IsResidueClassUnionInClassListRep(obj)
and Length(obj!.cls) = 1 and obj!.included = [] and obj!.excluded = []
then return true; fi;
return false;
end );
#############################################################################
##
#S ExtRepOfObj / ObjByExtRep for residue class unions. /////////////////////
##
#############################################################################
#############################################################################
##
#M ExtRepOfObj( <U> ) . . . . . . . . . . . . . . . for residue class unions
##
InstallMethod( ExtRepOfObj,
"for residue class unions (ResClasses)",
true, [ IsResidueClassUnion ], 0,
U -> [ Modulus( U ), ShallowCopy( Residues( U ) ),
ShallowCopy( IncludedElements( U ) ),
ShallowCopy( ExcludedElements( U ) ) ] );
#############################################################################
##
#M ExtRepOfObj( <U> ) . . . . . . . . . . . . . . . for residue class unions
##
InstallMethod( ExtRepOfObj,
"for residue class unions in standard rep. (ResClasses)",
true, [ IsResidueClassUnionInResidueListRep ], 0,
U -> [U!.m, ShallowCopy( U!.r ),
ShallowCopy(U!.included), ShallowCopy(U!.excluded)] );
#############################################################################
##
#M ObjByExtRep( <fam>, <l> ) . . . . . . . reconstruct a residue class union
##
InstallMethod( ObjByExtRep,
"reconstruct a residue class union (ResClasses)",
ReturnTrue, [ IsFamily, IsList ], 0,
function ( fam, l )
local R;
if not HasUnderlyingRing(fam) or Length(l) <> 4 then TryNextMethod(); fi;
R := UnderlyingRing(fam);
if fam <> ResidueClassUnionsFamily(R) then TryNextMethod(); fi;
return ResidueClassUnion(R,l[1],l[2],l[3],l[4]);
end );
#############################################################################
##
#S Accessing the components of a residue class union object. ///////////////
##
#############################################################################
#############################################################################
##
#M Modulus( <U> ) . . . . . . . . . . . . . . . . . for residue class unions
#M Modulus( <R> ) . . . . . . . . . . . . . . . for the base ring / -module
#M Modulus( <l> ) . . . . . . . . . . . . . . . . . . . . . for finite sets
##
## Since the empty list carries no information about the objects it does
## not contain, the method for that case silently assumes that these are
## supposed to be integers, and returns 0.
##
InstallMethod( Modulus,
"for residue class unions, standard rep. (ResClasses)", true,
[ IsResidueClassUnionInResidueListRep ], 0, U -> U!.m );
InstallMethod( Modulus,
"for residue class unions, sparse rep. (ResClasses)", true,
[ IsResidueClassUnionInClassListRep ], 0, U -> U!.m );
InstallOtherMethod( Modulus, "for the base ring (ResClasses)", true,
[ IsRing ], 0, One );
InstallOtherMethod( Modulus, "for the base module (ResClasses)", true,
[ IsRowModule ], 0, R -> AsList( Basis( R ) ) );
InstallOtherMethod( Modulus, "for finite sets (ResClasses)", true,
[ IsList ], 0, l -> Zero( l[ 1 ] ) );
InstallOtherMethod( Modulus, "for the empty set (ResClasses)", true,
[ IsList and IsEmpty ], 0, empty -> 0 );
#############################################################################
##
#M Residue( <cl> ) . . . . . . . . . . . . . . . . . . . for residue classes
#M Residue( <R> ) . . . . . . . . . . . . . . . for the base ring / -module
##
InstallMethod( Residue, "for residue classes (ResClasses)", true,
[ IsResidueClass ], 0, cl -> Residues(cl)[1] );
InstallOtherMethod( Residue, "for the base ring (ResClasses)", true,
[ IsRing ], 0, Zero );
InstallOtherMethod( Residue, "for the base module (ResClasses)", true,
[ IsRowModule ], 0, Zero );
#############################################################################
##
#M Residues( <U> ) . . . . . . . . . . . . . . . . for residue class unions
#M Residues( <R> ) . . . . . . . . . . . . . . . for the base ring / -module
#M Residues( <l> ) . . . . . . . . . . . . . . . . . . . . . for finite sets
##
InstallMethod( Residues,
"for residue class unions of Z in sparse rep (ResClasses)",
true, [ IsResidueClassUnionOfZInClassListRep ], 0,
function ( U )
local res, cls, m, cl, i;
cls := U!.cls; m := U!.m; res := [];
for cl in cls do
for i in [0..m/cl[2]-1] do
Add(res,i*cl[2]+cl[1]);
od;
od;
res := Set(res);
return res;
end );
InstallMethod( Residues, "for residue class unions (ResClasses)", true,
[ IsResidueClassUnionInResidueListRep ], 0, U -> U!.r );
InstallOtherMethod( Residues, "for the base ring (ResClasses)", true,
[ IsRing ], 0, R -> [ Zero( R ) ] );
InstallOtherMethod( Residues, "for the base module (ResClasses)", true,
[ IsRowModule ], 0, R -> [ Zero( R ) ] );
InstallOtherMethod( Residues, "for finite sets (ResClasses)", true,
[ IsList ], 0, l -> [ ] );
#############################################################################
##
#M Classes( <U> ) . . . . . . . . . . . . . . . . . for residue class unions
##
InstallMethod( Classes, "for residue class unions, sparse rep. (ResClasses)",
true, [ IsResidueClassUnionInClassListRep ], 0, U -> U!.cls );
InstallMethod( Classes, "for residue class unions, std. rep. (ResClasses)",
true, [ IsResidueClassUnionInResidueListRep ], 0,
U -> List(AsUnionOfFewClasses(U),
cl->[Residue(cl),Modulus(cl)]) );
InstallOtherMethod( Classes, "for the base ring (ResClasses)",
true, [ IsRing ], 0, R -> [ [ Zero(R), One(R) ] ] );
InstallOtherMethod( Classes, "for finite sets (ResClasses)",
true, [ IsList ], 0, R -> [ ] );
#############################################################################
##
#M IncludedElements( <U> ) . . . . . . . . . . . . for residue class unions
#M IncludedElements( <R> ) . . . . . . . . . . . for the base ring / -module
#M IncludedElements( <l> ) . . . . . . . . . . . . . . . . . for finite sets
##
InstallMethod( IncludedElements, "for residue class unions (ResClasses)",
true, [ IsResidueClassUnionInResidueListRep ], 0,
U -> U!.included );
InstallMethod( IncludedElements, "for residue class unions (ResClasses)",
true, [ IsResidueClassUnionInClassListRep ], 0,
U -> U!.included );
InstallOtherMethod( IncludedElements, "for the base ring (ResClasses)",
true, [ IsRing ], 0, R -> [ ] );
InstallOtherMethod( IncludedElements, "for the base module (ResClasses)",
true, [ IsRowModule ], 0, R -> [ ] );
InstallOtherMethod( IncludedElements, "for finite sets (ResClasses)",
true, [ IsList ], 0, l -> l );
#############################################################################
##
#M ExcludedElements( <U> ) . . . . . . . . . . . . for residue class unions
#M ExcludedElements( <R> ) . . . . . . . . . . . for the base ring / -module
#M ExcludedElements( <l> ) . . . . . . . . . . . . . . . . . for finite sets
##
InstallMethod( ExcludedElements, "for residue class unions (ResClasses)",
true, [ IsResidueClassUnionInResidueListRep ], 0,
U -> U!.excluded );
InstallMethod( ExcludedElements, "for residue class unions (ResClasses)",
true, [ IsResidueClassUnionInClassListRep ], 0,
U -> U!.excluded );
InstallOtherMethod( ExcludedElements, "for the base ring (ResClasses)",
true, [ IsRing ], 0, R -> [ ] );
InstallOtherMethod( ExcludedElements, "for the base module (ResClasses)",
true, [ IsRowModule ], 0, R -> [ ] );
InstallOtherMethod( ExcludedElements, "for finite sets (ResClasses)",
true, [ IsList ], 0, l -> [ ] );
#############################################################################
##
#M SparseRep( <U> ) . . . conversion to class list ("sparse") representation
##
InstallMethod( SparseRep,
"for residue class unions in standard rep. (ResClasses)",
true, [ IsResidueClassUnionInResidueListRep ], 0,
U -> ResidueClassUnionNC(UnderlyingRing(FamilyObj(U)),
List(AsUnionOfFewClasses(U),
cl->[Residue(cl),Modulus(cl)]),
U!.included,U!.excluded) );
InstallMethod( SparseRep,
"for residue class unions in sparse rep (ResClasses)",
true, [ IsResidueClassUnionInClassListRep ], 0, U -> U );
InstallMethod( SparseRep,
"for finite sets (ResClasses)",
true, [ IsList ], 0, l -> l );
InstallMethod( SparseRep,
"for the base ring (ResClasses)",
true, [ IsRing ], 0, R -> R );
InstallMethod( SparseRep,
"for the base module (ResClasses)",
true, [ IsRowModule ], 0, R -> R );
#############################################################################
##
#M StandardRep( <U> ) . . . . . conversion to residue list ("standard") rep.
##
InstallMethod( StandardRep,
"for residue class unions in sparse rep. (ResClasses)",
true, [ IsResidueClassUnionInClassListRep ], 0,
U -> ResidueClassUnionNC(UnderlyingRing(FamilyObj(U)),
Modulus(U),Residues(U),
U!.included,U!.excluded) );
InstallMethod( StandardRep,
"for residue class unions in standard rep. (ResClasses)",
true, [ IsResidueClassUnionInResidueListRep ], 0, U -> U );
InstallMethod( StandardRep,
"for finite sets (ResClasses)",
true, [ IsList ], 0, l -> l );
InstallMethod( StandardRep,
"for the base ring (ResClasses)",
true, [ IsRing ], 0, R -> R );
InstallMethod( StandardRep,
"for the base module (ResClasses)",
true, [ IsRowModule ], 0, R -> R );
#############################################################################
##
#S Testing residue class unions for equality. //////////////////////////////
##
#############################################################################
#############################################################################
##
#M \=( <U1>, <U2> ) . . . . . . . . . . . . . . . . for residue class unions
##
InstallMethod( \=,
"for two residue class unions in standard rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInResidueListRep,
IsResidueClassUnionInResidueListRep ], 0,
function ( U1, U2 )
return U1!.m = U2!.m and U1!.r = U2!.r
and U1!.included = U2!.included and U1!.excluded = U2!.excluded;
end );
InstallMethod( \=,
"for two residue class unions in sparse rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInClassListRep,
IsResidueClassUnionInClassListRep ], 0,
function ( U1, U2 )
return U1!.m = U2!.m and U1!.cls = U2!.cls
and U1!.included = U2!.included and U1!.excluded = U2!.excluded;
end );
InstallMethod( \=,
"for two residue class unions in different rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInResidueListRep,
IsResidueClassUnionInClassListRep ], 0,
function ( U1, U2 ) return SparseRep(U1) = U2; end );
InstallMethod( \=,
"for two residue class unions in different rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInClassListRep,
IsResidueClassUnionInResidueListRep ], 0,
function ( U1, U2 ) return U1 = SparseRep(U2); end );
#############################################################################
##
#M \=( <U>, <l> ) . . . . . . . . . . . for a residue class union and a list
#M \=( <l>, <U> ) . . . . . . . . . . . for a list and a residue class union
##
InstallMethod( \=, "for a residue class union and a list (ResClasses)",
ReturnTrue, [ IsResidueClassUnionInResidueListRep, IsList ],
SUM_FLAGS,
function ( U, l )
return IsOne(U!.m) and U!.r = [] and U!.included = l;
end );
InstallMethod( \=, "for a list and a residue class union (ResClasses)",
ReturnTrue, [ IsList, IsResidueClassUnionInResidueListRep ],
SUM_FLAGS, function ( l, U ) return U = l; end );
#############################################################################
##
#M \=( <D>, <l> ) . . . . . . for an infinite domain and a list of elements
#M \=( <l>, <D> ) . . . . . . for a list of elements and an infinite domain
##
InstallMethod( \=,
"for an infinite domain and a list of elements (ResClasses)",
IsIdenticalObj, [ IsDomain, IsList and IsFinite ], 0,
function ( D, l )
if not IsFinite( D ) then return false;
else TryNextMethod( ); fi;
end );
InstallMethod( \=,
"for a list of elements and an infinite domain (ResClasses)",
IsIdenticalObj, [ IsList and IsFinite, IsDomain ], 0,
function ( l, D ) return D = l; end );
#############################################################################
##
#M \<( <U1>, <U2> ) . . . . . . . . . . . . . . . . for residue class unions
##
## A total ordering of residue class unions - we want to be able to form
## sorted lists and sets of these objects.
##
InstallMethod( \<,
"for two residue class unions in standard rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInResidueListRep,
IsResidueClassUnionInResidueListRep ], 0,
function ( U1, U2 )
if U1!.r = [] and U2!.r <> [] then return false;
elif U1!.r <> [] and U2!.r = [] then return true;
elif U1!.m <> U2!.m then return U1!.m < U2!.m;
elif U1!.r <> U2!.r then return U1!.r < U2!.r;
elif U1!.included <> U2!.included
then return U1!.included < U2!.included;
else return U1!.excluded < U2!.excluded; fi;
end );
InstallMethod( \<,
"for two residue class unions in sparse rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInClassListRep,
IsResidueClassUnionInClassListRep ], 0,
function ( U1, U2 )
if U1!.m <> U2!.m then return U1!.m < U2!.m;
elif List(U1!.cls,cl->cl[2]) <> List(U2!.cls,cl->cl[2])
then return List(U1!.cls,cl->cl[2]) < List(U2!.cls,cl->cl[2]);
elif U1!.cls <> U2!.cls then return U1!.cls < U2!.cls;
elif U1!.included <> U2!.included
then return U1!.included < U2!.included;
else return U1!.excluded < U2!.excluded; fi;
end );
InstallMethod( \<,
"for two residue class unions, mixed rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInResidueListRep,
IsResidueClassUnionInClassListRep ], 0,
function ( U1, U2 )
Error("residue class unions in different representations ",
"cannot be sorted\n-- convert to same representation first");
return fail;
end );
InstallMethod( \<,
"for two residue class unions, mixed rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInClassListRep,
IsResidueClassUnionInResidueListRep ], 0,
function ( U1, U2 )
Error("residue class unions in different representations ",
"cannot be sorted\n-- convert to same representation first");
return fail;
end );
#############################################################################
##
#M \<( <U>, <R> ) . . . . . . for a residue class union and a ring / module
#M \<( <R>, <U> ) . . . . . . for a ring / module and a residue class union
#M \<( <l>, <R> ) . . . . for a finite list of elements and a ring / module
#M \<( <R>, <l> ) . . . . for a ring / module and a finite list of elements
#M \<( <l>, <U> ) . for a finite list of elements and a residue class union
#M \<( <U>, <l> ) . for a residue class union and a finite list of elements
##
InstallMethod( \<, "for a residue class union and a ring (ResClasses)",
ReturnTrue, [ IsResidueClassUnion, IsRing ], 0, ReturnFalse );
InstallMethod( \<, "for a residue class union and a module (ResClasses)",
ReturnTrue, [ IsResidueClassUnion, IsRowModule ], 0,
ReturnFalse );
InstallMethod( \<, "for a ring and a residue class union (ResClasses)",
ReturnTrue, [ IsRing, IsResidueClassUnion ], 0, ReturnTrue );
InstallMethod( \<, "for a module and a residue class union (ResClasses)",
ReturnTrue, [ IsRowModule, IsResidueClassUnion ], 0,
ReturnTrue );
InstallMethod( \<, "for a list of elements and a ring (ResClasses)",
IsIdenticalObj, [ IsList, IsRing ], 0,
function ( list, R )
if not IsIntegers(R) and not IsZ_pi(R)
and not ( IsUnivariatePolynomialRing(R)
and IsFiniteFieldPolynomialRing(R))
then TryNextMethod(); fi;
return false;
end );
InstallMethod( \<, "for a list of elements and a module (ResClasses)",
IsIdenticalObj, [ IsList, IsRowModule ], 0, ReturnFalse );
InstallMethod( \<, "for a ring and a list of elements (ResClasses)",
IsIdenticalObj, [ IsRing, IsList ], 0,
function ( R, list )
if not IsIntegers(R) and not IsZ_pi(R)
and not ( IsUnivariatePolynomialRing(R)
and IsFiniteFieldPolynomialRing(R))
then TryNextMethod(); fi;
return true;
end );
InstallMethod( \<, "for a module and a list of elements (ResClasses)",
IsIdenticalObj, [ IsRowModule, IsList ], 0, ReturnTrue );
InstallMethod( \<, "for a list and a residue class union (ResClasses)",
ReturnTrue, [ IsList, IsResidueClassUnion ], 0, ReturnFalse );
InstallMethod( \<, "for a residue class union and a list (ResClasses)",
ReturnTrue, [ IsResidueClassUnion, IsList ], 0,
function ( U, l )
if IsFinite(U) then return AsList(U) < l;
else return true; fi;
end );
#############################################################################
##
#S Testing for membership in a residue class union. ////////////////////////
##
#############################################################################
#############################################################################
##
#M \in( <n>, <U> ) . . . . . . for a ring element and a residue class union
##
InstallMethod( \in,
Concatenation("for a ring element and a residue class union ",
"in standard rep. (ResClasses)"),
ReturnTrue,
[ IsObject, IsResidueClassUnionInResidueListRep ], 0,
function ( n, U )
if not n in UnderlyingRing(FamilyObj(U)) then return false; fi;
if n in U!.included then return true;
elif n in U!.excluded then return false;
else return n mod U!.m in U!.r; fi;
end );
InstallMethod( \in,
Concatenation("for a ring element and a residue class union ",
"in sparse rep. (ResClasses)"),
ReturnTrue,
[ IsObject, IsResidueClassUnionInClassListRep ], 0,
function ( n, U )
if not n in UnderlyingRing(FamilyObj(U)) then return false; fi;
if n in U!.included then return true;
elif n in U!.excluded then return false;
else return ForAny(U!.cls,cl->n mod cl[2] = cl[1]); fi;
end );
#############################################################################
##
#S Density and subset relations. ///////////////////////////////////////////
##
#############################################################################
#############################################################################
##
#M Density( <U> ) . . . . . . . . . . . . . . . . . for residue class unions
#M Density( <R> ) . . . . . . . . . . . . for the whole base ring / -module
#M Density( <l> ) . . . . . . . . . . . . . . . . . . . . . for finite sets
##
InstallMethod( Density,
"for residue class unions in standard rep. (ResClasses)",
true, [ IsResidueClassUnionInResidueListRep ], 0,
U -> Length(Residues(U))/
NumberOfResidues(UnderlyingRing(FamilyObj(U)),
Modulus(U)) );
InstallMethod( Density,
"for residue class unions in sparse rep. (ResClasses)",
true, [ IsResidueClassUnionOfZInClassListRep ], 0,
U -> Sum(List(U!.cls,cl->1/cl[2])) );
InstallOtherMethod( Density, "for the whole base ring (ResClasses)", true,
[ IsRing ], 0, R -> 1 );
InstallOtherMethod( Density, "for the whole base module (ResClasses)", true,
[ IsRowModule ], 0, R -> 1 );
InstallOtherMethod( Density, "for finite sets (ResClasses)", true,
[ IsList and IsCollection ], 0,
function ( l )
if not IsFinite(DefaultRing(l[1]))
then return 0; else TryNextMethod(); fi;
end );
InstallOtherMethod( Density, "for the empty set (ResClasses)", true,
[ IsList and IsEmpty ], 0, l -> 0 );
#############################################################################
##
#M IsSubset( <U>, <l> ) . . . for a residue class union and an element list
##
InstallMethod( IsSubset,
"for residue class union and element list (ResClasses)",
ReturnTrue, [ IsResidueClassUnion, IsList ], 0,
function ( U, l )
return ForAll( Set( l ), n -> n in U );
end );
#############################################################################
##
#M IsSubset( <U1>, <U2> ) . . for two residue class unions in standard rep.
##
InstallMethod( IsSubset,
"for two residue class unions in standard rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInResidueListRep,
IsResidueClassUnionInResidueListRep ], 0,
function ( U1, U2 )
local R, m1, m2, m, r1, r2, r, allres1, allres2, allres;
R := UnderlyingRing(FamilyObj(U1));
m1 := U1!.m; m2 := U2!.m;
r1 := U1!.r; r2 := U2!.r;
if not IsSubset(U1,U2!.included) or Intersection(U1!.excluded,U2) <> []
then return false; fi;
if IsRing(R) then m := Lcm(R,m1,m2);
elif IsRowModule(R) then m := LatticeIntersection(m1,m2); fi;
allres := AllResidues(R,m);
allres1 := Filtered(allres,n->n mod m1 in r1);
allres2 := Filtered(allres,n->n mod m2 in r2);
return IsSubset(allres1,allres2);
end );
#############################################################################
##
#M IsSubset( <U1>, <U2> ) . . . for two residue class unions in sparse rep.
##
InstallMethod( IsSubset,
"for two residue class unions in sparse rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInClassListRep,
IsResidueClassUnionInClassListRep ], 0,
function ( U1, U2 )
if Density(U2) > Density(U1) then return false; fi;
if not IsSubset(U1,U2!.included) or Intersection(U1!.excluded,U2) <> []
then return false; fi;
return Difference(U2,U1) = [];
end );
#############################################################################
##
#M IsSubset( <U1>, <U2> ) . . for two residue class unions in different rep.
##
InstallMethod( IsSubset,
"for two residue class unions in different rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInResidueListRep,
IsResidueClassUnionInClassListRep ], 0,
function ( U1, U2 ) return IsSubset(SparseRep(U1),U2); end );
InstallMethod( IsSubset,
"for two residue class unions in different rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInClassListRep,
IsResidueClassUnionInResidueListRep ], 0,
function ( U1, U2 ) return IsSubset(U1,SparseRep(U2)); end );
#############################################################################
##
#M IsSubset( <R>, <U> ) . . . . for the base ring and a residue class union
#M IsSubset( <U>, <R> ) . . . . for a residue class union and the base ring
##
InstallMethod( IsSubset,
"for the base ring and a residue class union (ResClasses)",
ReturnTrue, [ IsDomain, IsResidueClassUnion ], 0,
function ( R, U )
if R = UnderlyingRing(FamilyObj(U))
then return true; else TryNextMethod(); fi;
end );
InstallMethod( IsSubset,
"for a residue class union and the base ring (ResClasses)",
ReturnTrue, [ IsResidueClassUnion, IsDomain ], 0,
function ( U, R )
if R = UnderlyingRing(FamilyObj(U))
then return U = R; else TryNextMethod(); fi;
end );
#############################################################################
##
#M IsSubset( Z_pi( <pi> ), Rationals ) . . . . . . . . . . . for Z_pi and Q
##
InstallMethod( IsSubset, "for Z_pi and Rationals (ResClasses)",
ReturnTrue, [ IsZ_pi, IsRationals ], 0, ReturnFalse );
#############################################################################
##
#S Computing unions, intersections and differences. ////////////////////////
##
#############################################################################
#############################################################################
##
#M Union2( <U1>, <U2> ) . . . . . for residue class unions in standard rep.
##
InstallMethod( Union2,
"for two residue class unions in standard rep. (ResClasses)",
IsIdenticalObj,
[ IsResidueClassUnionInResidueListRep,
IsResidueClassUnionInResidueListRep ], 0,
function ( U1, U2 )
local R, m1, m2, m, r1, r2, r, included, excluded,
r1exp, r2exp, allres;
R := UnderlyingRing(FamilyObj(U1));
m1 := U1!.m; m2 := U2!.m;
r1 := U1!.r; r2 := U2!.r;
if IsRing(R) then m := Lcm(R,m1,m2);
elif IsRowModule(R) then m := LatticeIntersection(m1,m2); fi;
included := Union(U1!.included,U2!.included);
excluded := Difference(Union(Difference(U1!.excluded,U2),
Difference(U2!.excluded,U1)),included);
if IsIntegers(R) then
r1exp := Concatenation(List([0..m/m1-1],i->i*m1+r1));
r2exp := Concatenation(List([0..m/m2-1],i->i*m2+r2));
r := Union(r1exp,r2exp);
else
allres := AllResidues(R,m);
r := Filtered(allres,n->n mod m1 in r1 or n mod m2 in r2);
fi;
return ResidueClassUnionNC(R,m,r,included,excluded);
end );
#############################################################################
##
#M Union2( <U1>, <U2> ) . . . . . . for residue class unions in sparse rep.
##
InstallMethod( Union2,
"for two residue class unions in sparse rep. (ResClasses)",
IsIdenticalObj,
--> --------------------
--> maximum size reached
--> --------------------
[ Verzeichnis aufwärts0.12unsichere Verbindung
Übersetzung europäischer Sprachen durch Browser
]
|
