|
#############################################################################
##
## This file is part of GAP, a system for computational discrete algebra.
## This file's authors include Thomas Breuer, Götz Pfeiffer.
##
## Copyright of GAP belongs to its developers, whose names are too numerous
## to list here. Please refer to the COPYRIGHT file for details.
##
## SPDX-License-Identifier: GPL-2.0-or-later
##
## This file contains the methods for those functions that are needed to
## compute and test possible permutation characters.
##
#############################################################################
##
#F TestPerm1( <tbl>, <char> ) . . . . . . . . . . . . . . . . test permchar
##
InstallGlobalFunction( TestPerm1, function(tbl, char)
local i, pm;
# TEST 1:
for i in char do
if i < 0 then
return 1;
fi;
od;
# TEST 2:
for pm in ComputedPowerMaps( tbl ) do
for i in [2..Length(char)] do
if char[i] > char[pm[i]] then return 2; fi;
od;
od;
return 0;
end );
#############################################################################
##
#F TestPerm2( <tbl>, <char> ) . . . . . . . . . . . . . . . . test permchar
##
InstallGlobalFunction( TestPerm2, function(tbl, char)
local i, j, nccl, subord, tbl_orders, subclass, tbl_classes, subfak,
prime, sum;
char:= ValuesOfClassFunction( char );
subord:= Size( tbl ) / char[1];
if not IsInt(subord) then
Info( InfoCharacterTable, 2, "-" );
return 1;
fi;
nccl:= Length(char);
# TEST 3:
tbl_orders:= OrdersClassRepresentatives( tbl );
for i in [2..nccl] do
if char[i] <> 0 and subord mod tbl_orders[i] <> 0 then
Info( InfoCharacterTable, 2, "=" );
return 3;
fi;
od;
# TEST 4:
subclass:= [1];
tbl_classes:= SizesConjugacyClasses( tbl );
for i in [2..nccl] do
subclass[i]:= (char[i] * tbl_classes[i]) / char[1];
if not IsInt(subclass[i]) then
Info( InfoCharacterTable, 2, "#" );
return 4;
fi;
od;
# TEST 5:
subfak:= PrimeDivisors(subord);
for prime in subfak do
if subord mod prime^2 <> 0 then
# Compute the number of elements of order $p$ in the
# (hypothetical) subgroup $H$.
sum:= 0;
for j in [2..nccl] do
if tbl_orders[j] = prime then
sum:= sum + subclass[j];
fi;
od;
# Check that the number of Sylow $s$ subgroups is an integer
# that is congruent to $1$ modulo $p$.
if (sum - prime + 1) mod (prime * (prime - 1)) <> 0 then
Info( InfoCharacterTable, 2, ":" );
return 5;
fi;
# Check that the number of Sylow $p$ subgroups in $H$ divides $|H|$.
if subord mod (sum / (prime - 1)) <> 0 then
Info( InfoCharacterTable, 2, ";" );
return 5;
fi;
fi;
od;
return 0;
end );
#############################################################################
##
#F TestPerm3( <tbl>, <permch> ) . . . . . . . . . . . . . . . test permchar
##
InstallGlobalFunction( TestPerm3, function( tbl, permch )
local i, j, nccl, fb, corbs, lc, phii, pi, orders, classes, good;
fb := [];
lc := [];
phii := [];
orders := OrdersClassRepresentatives( tbl );
classes := SizesConjugacyClasses( tbl );
nccl := Length( orders );
# Compute the values $`phii[i]' = [ N_G(g_i) : C_G(g_i) ]$,
# store them only for one representative of each Galois family.
for i in [ 1 .. nccl ] do
if not IsBound( lc[i] ) then
corbs:= ClassOrbit( tbl, i );
lc[i]:= Length( corbs );
for j in corbs do
lc[j]:= lc[i];
od;
phii[i]:= Phi( orders[i] ) / lc[i];
fi;
od;
# Check condition (h) for all characters $\pi$ in `permch',
# i.e., $\pi(1) |N_G(g)|$ divides $\pi(g) |G|$ for all $g \in G$.
for pi in permch do
good:= true;
for j in [ 2 .. nccl ] do
if 2 < orders[j] and IsBound( phii[j] )
and ( pi[j] * classes[j] ) mod ( pi[1] * phii[j] ) <> 0 then
good:= false;
break;
fi;
od;
if good then
AddSet( fb, pi );
fi;
od;
# Return the list of characters that satisfy condition (h).
return fb;
end );
##############################################################################
##
## TestPerm4( <tbl>, <chars> )
##
## Check whether the projections of <chars> to $p$-blocks of <tbl> satisfy
## $|\pi_B(g)| \leq \pi_B(g^n) \leq \pi(g^n)$, for all $g\in G$ and positive
## integers $n$ such that $g^n$ is a $p$-element of $G$.
##
## In the case of defect $1$, it is also tried to identify the projective
## cover $1_G + \lambda_p$ of the trivial character;
## in this case it is checked whether $\lambda_p$ is a constituent of the
## candidate $\pi$.
## We use that $\lambda_p$ is a sum of irreducibles in the principal block
## that coincide on $p$-regular classes,
## and that $\lambda$ has the properties $\lambda_p(1) \equiv -1 \pmod{p}$
## and $\lambda_p(g) = -1$ for each $p$-singular element $g \in G$.
## (If $\lambda_p$ is not uniquely determined by these conditions then it is
## checked whether at least one character with these properties is a
## constituent of $\pi$.
##
InstallGlobalFunction( TestPerm4, function( tbl, chars )
local nccl,
irr,
len,
good,
size,
orders,
p,
bl,
B,
except,
lambda,
i,
exp,
n,
j, k,
proj,
image;
nccl:= NrConjugacyClasses( tbl );
irr:= Irr( tbl );
len:= Length( chars );
good:= BlistList( [ 1 .. len ], [ 1 .. len ] );
size:= Size( tbl );
orders:= OrdersClassRepresentatives( tbl );
for p in PrimeDivisors( Size( tbl ) ) do
# Compute the distribution of characters to blocks.
bl:= PrimeBlocks( tbl, p );
# Apply (T8).
if size mod p^2 <> 0 then
# Get the rational irreducible characters in the principal block.
B:= bl.block[ Position( irr, TrivialCharacter( tbl ) ) ];
B:= irr{ Filtered( [ 1 .. nccl ], j -> bl.block[j] = B ) };
# Try to identify the character $\lambda_p$
# with the property that $1_G + \lambda_p$ is projective.
# First form the orbit sums from which lambda is to be chosen.
# (There is at most one nontrivial orbit of exceptional characters.)
except:= Filtered( B, chi -> Conductor( chi ) mod p = 0 );
if not IsEmpty( except ) then
B:= Difference( B, except );
Add( B, Sum( except ) );
fi;
lambda:= Filtered( B, chi -> ( chi[1] + 1 ) mod p = 0 );
if 1 < Length( lambda ) then
lambda:= Filtered( lambda, chi ->
ForAll( [ 1 .. nccl ],
i -> orders[i] mod p <> 0 or chi[i] = -1 ) );
fi;
# Check whether $\lambda_p$ is a constituent.
for i in [ 1 .. Length( chars ) ] do
if good[i]
and chars[i][1] mod p = 0
and ForAll( lambda,
chi -> ScalarProduct( tbl, chi, chars[i] ) = 0 ) then
Info( InfoCharacterTable, 1,
"TestPerm4: degree ", chars[i][1],
" fails to have lambda_",p," as a constituent" );
good[i]:= false;
fi;
od;
fi;
# Now apply (T9).
# `exp[i]' is either `false' (for `p'-regular elements)
# or the smallest number s.t. the `exp[i]'-th power of an element
# in class `i' is a `p'-element.
exp:= [];
for i in [ 1 .. nccl ] do
n:= orders[i];
if n mod p <> 0 then
exp[i]:= false;
else
while n mod p = 0 do
n:= n/p;
od;
exp[i]:= n;
fi;
od;
for k in [ 1 .. Length( bl.defect ) ] do
# Compute the projections $\pi_B$.
B:= irr{ Filtered( [ 1 .. nccl ], j -> bl.block[j] = k ) };
proj:= MatScalarProducts( tbl, B, chars ) * B;
for i in [ 1 .. Length( chars ) ] do
if good[i] then
for j in [ 1 .. nccl ] do
if exp[j] <> false and good[i] then
if exp[j] = 1 then
image:= j;
else
image:= PowerMap( tbl, exp[j], j );
fi;
while image <> 1 and good[i] do
if ( not IsInt( proj[i][ image ] ) )
or proj[i][ image ] < 0 then
# $\pi_B(g^n)$ must be a nonnegative integer.
Info( InfoCharacterTable, 1,
"TestPerm4: degree ", chars[i][1],
" violates integrality for p = ", p,
", class ", j );
good[i]:= false;
elif proj[i][ image ] > chars[i][ image ] then
# $\pi_B(g^n) \leq \pi(g^n)$ must hold.
Info( InfoCharacterTable, 1,
"TestPerm4: degree ", chars[i][1],
" violates 2nd ineq. for p = ", p,
", class ", j );
good[i]:= false;
elif IsInt( proj[i][j] )
and AbsInt( proj[i][j] ) > proj[i][ image ] then
# $|\pi_B(g)| \leq \pi_B(g^n)$ must hold.
Info( InfoCharacterTable, 1,
"TestPerm4: degree ", chars[i][1],
" violates 1st ineq. for p = ", p,
", class ", j );
good[i]:= false;
fi;
image:= PowerMap( tbl, p, image );
od;
fi;
od;
fi;
od;
od;
od;
# Return the characters that satisfy the condition.
return ListBlist( chars, good );
end );
##############################################################################
##
## TestPerm5( <tbl>, <chars>, <modtbl> )
##
## Check whether characters of degree divisible by the $p$-part of
## the order of <tbl> are linear combinations of the projective
## indecomposables.
##
InstallGlobalFunction( TestPerm5, function( tbl, chars, modtbl )
local size,
p,
nccl,
cand,
irr,
bl,
pims,
k,
B,
sol;
size:= Size( tbl );
p:= UnderlyingCharacteristic( modtbl );
cand:= Filtered( chars, pi -> ( size / pi[1] ) mod p <> 0 );
if IsEmpty( cand ) then
return chars;
fi;
nccl:= NrConjugacyClasses( tbl );
irr:= Irr( tbl );
bl:= PrimeBlocks( tbl, p );
pims:= [];
for k in [ 1 .. Length( bl.defect ) ] do
B:= irr{ Filtered( [ 1 .. nccl ], j -> bl.block[j] = k ) };
Append( pims, TransposedMat( DecompositionMatrix( modtbl, k ) ) * B );
od;
# Decompose the candidates.
sol:= Decomposition( pims, cand, "nonnegative" );
sol:= Filtered( [ 1 .. Length( sol ) ], i -> sol[i] = fail );
if not IsEmpty( sol ) then
Info( InfoCharacterTable, 1,
"TestPerm5: ",
Length( sol ), " character(s) not decomposable into PIMs (p = ",
p, ")" );
sol:= cand{ sol };
chars:= Filtered( chars, pi -> not pi in sol );
fi;
return chars;
end );
#############################################################################
##
#M Inequalities( <tbl>, <chars>[, <option>] ) . . .
#M projected system of inequalities
##
## Supported for <option>: `"small"'
##
InstallMethod( Inequalities,
[ IsOrdinaryTable, IsList ],
function( tbl, chars )
return Inequalities( tbl, chars, "" );
end );
InstallMethod( Inequalities,
[ IsOrdinaryTable, IsList, IsObject ],
function( tbl, chars, option )
local i, j, h, o, dim, nccl, ncha, c, X, dir, root, ineq, tuete,
Conditor, Kombinat, other, mini, con, conO, conU, pos,
proform, project;
# local functions
proform:= function(tuete, s, dir)
local i, lo, lu, conO, conU, komO, komU, res;
conO:= []; conU:= [];
res:= 0;
for i in [1..Length(tuete)] do
if tuete[i][dir] < 0 then
Add(conO, Kombinat[i]);
elif tuete[i][dir] > 0 then
Add(conU, Kombinat[i]);
else
res:= res + 1;
fi;
od;
lo:= Length(conO); lu:= Length(conU);
if s = dim+1 then
return res + lo * lu;
fi;
for komO in conO do
if Length(komO) = 1 then
res:= res + lu;
else
for komU in conU do
if Length(Union(komO, komU)) <= dim+3 - s then
res:= res + 1;
fi;
od;
fi;
od;
return res;
end;
project:= function(tuete, dir)
local i, C, sum, com, lo, lu, conO, conU,
lineO, lineU, lc, kombi, res;
Info( InfoCharacterTable, 2, "project(", dir, ")" );
conO:= []; conU:= [];
res:= []; kombi:= [];
for i in [1..Length(tuete)] do
if tuete[i][dir] < 0 then
Add(conO, rec(con:= tuete[i], kom:= Kombinat[i]));
Add(Conditor[dir], tuete[i]);
elif tuete[i][dir] > 0 then
Add(conU, rec(con:= tuete[i], kom:= Kombinat[i]));
Add(Conditor[dir], tuete[i]);
else
Add(res, tuete[i]); Add(kombi, Kombinat[i]);
fi;
od;
lo:= Length(conO); lu:= Length(conU);
Info( InfoCharacterTable, 2, lo, " ", lu );
for lineO in conO do
for lineU in conU do
com:= Union(lineO.kom, lineU.kom);
lc:= Length(com);
if lc <= dim+3 - dir then
sum:= lineU.con[dir] * lineO.con - lineO.con[dir] * lineU.con;
sum:= Gcd(sum)^-1 * sum;
if lc - Length(lineO.kom) = 1 or lc - Length(lineU.kom) = 1 then
Add(res, sum); Add(kombi, com);
else
C:= List( ineq{ com }, x -> x{ [ dir .. dim+1 ] } );
if RankMat(C) = lc-1 then
Add(res, sum); Add(kombi, com);
fi;
fi;
fi;
od;
od;
Kombinat:= kombi;
return res;
end;
nccl:= NrConjugacyClasses( tbl );
X:= RationalizedMat( List( chars, ValuesOfClassFunction ) );
c:= TransposedMat(X);
# determine power conditions
# ie: for each class find a root and replace column by difference.
root:= ClassRoots(tbl);
ineq:= []; other:= []; pos:= [];
for i in [2..nccl] do
if not c[i] in ineq then
AddSet(ineq, c[i]); Add(pos, i);
fi;
od;
ineq:= [];
for i in pos do
if root[i] = [] then
AddSet(ineq, c[i]);
AddSet(other, c[i]);
else
AddSet(ineq, c[i] - c[root[i][1]]);
for j in root[i] do
AddSet(other, c[i] - c[j]);
od;
fi;
od;
ineq:= List(ineq, x->Gcd(x)^-1*x);
other:= List(other, x->Gcd(x)^-1*x);
ncha:= Length(X);
dim:= Length(ineq);
if dim <> Length(ineq[1])-1 then
Error("nonregular problem");
fi;
Conditor:= List([1..dim+1], x->[]);
Kombinat:= List([1..dim+1], x->[x]);
tuete:= ineq;
for i in Reversed([2..dim+1]) do
dir:= 0;
if option = "small" then
# find optimal direction
for j in [2..i] do
o:= proform(tuete, i, j);
if dir = 0 or o <= mini then
mini:= o; dir:= j;
fi;
od;
# make it the current one
if dir <> i then
for j in [i..ncha] do
for con in Conditor[j] do
h:= con[dir]; con[dir]:= con[i]; con[i]:= h;
od;
od;
for con in tuete do
h:= con[dir]; con[dir]:= con[i]; con[i]:= h;
od;
for con in other do
h:= con[dir]; con[dir]:= con[i]; con[i]:= h;
od;
h:= X[dir]; X[dir]:= X[i]; X[i]:= h;
fi;
fi;
# perform projection
tuete:= project(tuete, i);
# if regular, reinstall reference
if Length(tuete) = i-2 then
ineq:= tuete;
dim:= i-2;
Kombinat:= List([1..i-1], x->[x]);
Info( InfoCharacterTable, 2, "REGULAR !!!" );
fi;
od;
# don't use too many inequalities
for i in [2..ncha] do
if Length(Conditor[i]) > 1 then
conO:= Filtered(Conditor[i], x->x[i] < 0);
conU:= Filtered(Conditor[i], x->x[i] > 0);
if Length(conO) > i then
conO:= conO{ [1..i] };
fi;
if Length(conU) > i then
conU:= conU{ [1..i] };
fi;
Conditor[i]:= Union(conO, conU);
fi;
od;
# but don't forget original conditions
for con in other do
i:= ncha;
while con[i] = 0 do i:= i-1; od;
AddSet(Conditor[i], con);
od;
return rec(obj:= X, Conditor:= Conditor);
end );
#############################################################################
##
#F Permut( <tbl>, <arec> )
##
## The properties (g), (h), and (j) are checked explicitly for each
## candidate that is produced,
## the properties (a)--(e) are forced by the construction of the
## candidates,
## and the properties (f) and (i) are consequences of (b) and (e).
##
InstallGlobalFunction( Permut, function( tbl, arec )
local tbl_size, permel, sortedchars,
a, amin, amax, c, ncha, i, j, permch,
Conditor, cond, X, minR, maxR,
s,
total, free, const, lowerBound, upperBound,
solveKnot, nextLevel, insertValue, suche;
# Check the arguments.
if not IsOrdinaryTable( tbl ) then
Error( "<tbl> must be complete character table" );
fi;
tbl_size:= Size( tbl );
if IsBound(arec.ineq) then
permel:= arec.ineq;
else
sortedchars:= SortedCharacters( tbl, Irr( tbl ), "degree" );
permel:= Inequalities( tbl, sortedchars );
fi;
# local functions
lowerBound:= function(cond, const, free, s)
local j, unten;
unten:= -const;
for j in [2..s-1] do
if free[j] then
if cond[j] < 0 then
unten:= unten - amin[j]*cond[j];
elif cond[j] > 0 then
unten:= unten - amax[j]*cond[j];
fi;
fi;
od;
if unten <= 0 then return 0;
else return QuoInt(unten-1, cond[s])+1;
fi;
end;
upperBound:= function(cond, const, free, s)
local j, oben;
oben:= const;
for j in [2..s-1] do if free[j] then
if cond[j] < 0 then
oben:= oben + amin[j]*cond[j];
elif cond[j] > 0 then
oben:= oben + amax[j]*cond[j];
fi;
fi;od;
if oben < 0 then return -1;
else return QuoInt(oben, -cond[s]);
fi;
end;
nextLevel:= function(const, free)
local h, i, c, con, cond, unten, oben, maxu, mino,
unique, first, mindeg, maxdeg;
unique:= [];
for h in [2..ncha] do
cond:= Conditor[h];
c:= const[h];
if free[h] then
# compute amin, amax
if not IsBound(first) then
first:= h;
fi;
maxu:= 0;
mino:= tbl_size;
for i in [1..Length(cond)] do
if cond[i][h] > 0 then
maxu:= Maximum(maxu, lowerBound(cond[i], const[h][i], free, h));
else
mino:= Minimum(mino, upperBound(cond[i], const[h][i], free, h));
fi;
od;
amin[h]:= maxu;
amax[h]:= mino;
if mino < maxu then
return h;
fi;
if mino = maxu then AddSet(unique, h); fi;
else
if IsBound(first) then
# interpret inequalities for lower steps !
for i in [1..Length(cond)] do
con:= cond[i];
s:= h-1;
while s > 1 and (not free[s] or con[s] = 0) do
s:= s-1;
od;
if s > 1 then
if con[s] > 0 then
unten:= lowerBound(con, c[i], free, s);
amin[s]:= Maximum(amin[s], unten);
else
oben:= upperBound(con, c[i], free, s);
amax[s]:= Minimum(amax[s], oben);
fi;
if amin[s] > amax[s] then return s;
elif amin[s] = amax[s] then AddSet(unique, s);
fi;
fi;
od;
fi;
fi;
od;
maxdeg:= 1;
mindeg:= 1;
for i in [2..ncha] do
maxdeg:= maxdeg + amax[i] * X[i][1];
mindeg:= mindeg + amin[i] * X[i][1];
od;
if minR > maxdeg or maxR < mindeg then
return 0;
fi;
if unique <> [] then return unique;
else return first; fi;
end;
insertValue:= function(const, s)
local i, j, c;
const:= List( const, ShallowCopy );
for i in [s..ncha] do
c:= const[i];
for j in [1..Length(c)] do
c[j]:= c[j] + a[s]*Conditor[i][j][s];
od;
od;
return const;
end;
solveKnot:= function(const, free)
local i, s, char;
free:= ShallowCopy(free);
if Set(free) = [false] then
total:= total+1;
char:= X[1];
for j in [2..ncha] do
char:= char + a[j] * X[j];
od;
if TestPerm2(tbl, char) = 0 then
Add(permch, char);
Info( InfoCharacterTable, 2, Length(permch), a, "\n", char );
fi;
else
s:= nextLevel(const, free);
if IsList(s) then
for i in s do
free[i]:= false;
a[i]:= amin[i];
const:= insertValue(const, i);
od;
solveKnot(const, free);
elif s > 0 then
for i in [amin[s]..amax[s]] do
a[s]:= i;
amin[s]:= i;
amax[s]:= i;
free[s]:= false;
solveKnot(insertValue(const, s), free);
od;
fi;
fi;
end;
total:= 0;
X:= permel.obj;
permch:= [];
ncha:= Length(X);
a:= [1];
if IsBound(arec.degree) then
minR:= Minimum(arec.degree); maxR:= Maximum(arec.degree);
amax:= [1]; amin:= [1];
Conditor:= permel.Conditor;
free:= List(Conditor, ReturnTrue);
free[1]:= false;
const:= List(Conditor, x-> List(x, y->y[1]));
solveKnot(const, free);
# The result list may contain also some characters of degree
# different from the desired ones.
# We remove these characters.
permch:= Filtered( permch, x -> x[1] in arec.degree );
else
suche:= function(s)
local unten, oben, i, j, char,
maxu, mino;
unten:= [];
oben:= [];
maxu:= 0;
for i in [1..Length(Conditor[s].u)] do
unten:= 0;
for j in [1..s-1] do
unten:= unten - a[j]*Conditor[s].u[i][j];
od;
if unten <= 0 then
unten:= 0;
else
unten:= QuoInt(unten-1, Conditor[s].u[i][s]) + 1;
fi;
maxu:= Maximum(maxu, unten);
od;
for i in [1..Length(Conditor[s].o)] do
oben:= 0;
for j in [1..s-1] do
oben:= oben + a[j]*Conditor[s].o[i][j];
od;
if oben < 0 then
oben:= -1;
else
oben:= QuoInt(oben, -Conditor[s].o[i][s]);
fi;
if not IsBound(mino) then
mino:= oben;
else
mino:= Minimum(mino, oben);
fi;
od;
for i in [maxu..mino] do
a[s]:= i;
if s < ncha then
suche(s+1);
else
total:= total+1;
char:= a * X;
if TestPerm2(tbl, char) = 0 then
Add(permch, char);
Info( InfoCharacterTable, 2, Length(permch), a, "\n", char );
fi;
fi;
od;
a[s]:= 0;
end;
Conditor:= [];
for i in [1..ncha] do
Conditor[i]:= rec(o:= Filtered(permel.Conditor[i], x->x[i] < 0),
u:= Filtered(permel.Conditor[i], x->x[i] > 0));
od;
suche(2);
fi;
# Check condition (h).
permch:= TestPerm3( tbl, permch );
Info( InfoCharacterTable, 2,"Total number of tested Characters:", total );
Info( InfoCharacterTable, 2,"Surviving: ", Length(permch) );
return List( permch, vals -> Character( tbl, vals ) );;
end );
#############################################################################
##
#F PermBounds( <tbl>, <degree>[, <ratirr>] ) . boundary points for simplex
##
InstallGlobalFunction( PermBounds, function( arg )
local tbl, degree, X, irreds, i, j, dim, nccl, ncha, c, root,
ineq, other, rho, pos, vec, deglist, point;
tbl:= arg[1];
degree:= arg[2];
if IsBound( arg[3] ) then
X:= arg[3];
else
# The trivial character is expected to be the first one.
# So sort the irreducibles, if necessary.
irreds:= List( Irr( tbl ), ValuesOfClassFunction );
if not ForAll( irreds[1], x -> x = 1 ) then
irreds:= SortedCharacters( tbl, irreds, "degree" );
fi;
X:= RationalizedMat( irreds );
fi;
nccl:= NrConjugacyClasses( tbl );
c:= TransposedMat(X);
# determine power conditions
# i.e.: for each class find a root and replace column by difference.
root:= ClassRoots(tbl);
ineq:= []; other:= []; pos:= [];
for i in [2..nccl] do
if not c[i] in ineq then
AddSet(ineq, c[i]); Add(pos, i);
fi;
od;
ineq:= [];
for i in pos do
if root[i] = [] then
AddSet(ineq, c[i]);
AddSet(other, c[i]);
else
AddSet(ineq, c[i] - c[root[i][1]]);
for j in root[i] do
AddSet(other, c[i] - c[j]);
od;
fi;
od;
ineq:= List(ineq, x->Gcd(x)^-1*x);
other:= List(other, x->Gcd(x)^-1*x);
ncha:= Length(X);
dim:= Length(ineq);
if dim <> Length(ineq[1])-1 then
Error("nonregular problem");
fi;
# now correct inequalities ?
vec:= List(ineq, x->-x[1]);
ineq:= List(ineq, x-> x{ [2..dim+1] } );
# determine boundary points
deglist:= List( X{ [2..ncha] }, x->x[1]);
Add(ineq, deglist);
Add(vec, degree-1);
point:= MutableTransposedMat(ineq);
Add(point, -vec);
point:= point^-1;
dim:= Length(point[1]);
rho:= point[dim][dim]^-1 * point[dim]{ [1..dim-1] };
point:= List( point, x-> x[dim]^-1 * x{ [1..dim-1] } ){ [1..dim-1] };
#T ?
return rec(obj:= X, point:= point, rho:= rho, other:= other);
end );
#############################################################################
##
#F PermComb( <tbl>, <arec> ) . . . . . . . . . . . . permutation characters
##
## The properties (b), (d), (g), (h), and (j) are checked explicitly for
## each candidate that is produced,
## the properties (a), (c), and (e) are forced by the construction of the
## candidates,
## and the properties (f) and (i) are consequences of (b) and (e).
##
InstallGlobalFunction( PermComb, function( tbl, arec )
local irreds, # irreducible characters of `tbl'
newirreds, # shallow copy of `irreds'
perm, # permutation of constituents
mindeg, # list of minimal multiplicities of constituents
maxdeg, # list of maximal multiplicities of constituents
lincom, # local function, backtrack
prep,
X, # possible constituents
xdegrees, # degrees of the characters in `X'
point,
rho,
permch,
Constituent,
maxList,
minList;
# The trivial character is expected to be the first one.
# So sort the irreducibles, if necessary.
irreds:= List( Irr( tbl ), ValuesOfClassFunction );
if not ForAll( irreds[1], x -> x = 1 ) then
newirreds:= SortedCharacters( tbl, irreds, "degree" );
perm:= Sortex( ShallowCopy( irreds ) )
/ Sortex( ShallowCopy( newirreds ) );
irreds:= newirreds;
if IsBound( arec.bounds ) and IsList( arec.bounds ) then
arec:= ShallowCopy( arec );
arec.bounds:= Permuted( arec.bounds, perm );
fi;
fi;
maxList:= function(list)
local i, col, max;
max:= [];
for i in [1..Length(list[1])] do
col:= Maximum(List(list, x->x[i]));
Add(max, Int(col));
od;
return max;
end;
minList:= function(list)
local i, col, min;
min:= [];
for i in [1..Length(list[1])] do
col:= Minimum(List(list, x->x[i]));
if col <= 0 then
Add(min, 0);
elif IsInt(col) then
Add(min, col);
else
Add(min, Int(col)+1);
fi;
od;
return min;
end;
lincom:= function()
local i, j, k, a, d, ncha, comb, mdeg, maxb, searching, char;
ncha:= Length(xdegrees);
mdeg:= List([1..ncha], x->0);
comb:= List([1..ncha], x->0);
maxb:= [];
for i in [1..ncha-1] do
maxb[i]:= 0;
for j in [2..i] do
maxb[i]:= maxb[i] + xdegrees[j] * maxdeg[j];
od;
#T improve! (maxb[i]:= maxb[i-1] + xdegrees[j] * maxdeg[j];)
od;
d:= arec.degree - Constituent[1];
k:= ncha - 1;
searching:= true;
while searching do
for j in Reversed([1..k]) do
a:= d - mdeg[j+1] - maxb[j];
if a <= 0 then
comb[j+1]:= 0;
else
comb[j+1]:= Minimum(QuoInt(a-1, xdegrees[j+1])+1, maxdeg[j+1]);
fi;
mdeg[j]:= mdeg[j+1] + comb[j+1] * xdegrees[j+1];
od;
if mdeg[1] = d then
char:= Constituent + comb * X;
if TestPerm1( tbl, char ) = 0 and TestPerm2( tbl, char ) = 0 then
Add( permch, char );
Info( InfoCharacterTable, 2, Length(permch), comb, "\n", char );
#T ??
else
Info( InfoCharacterTable, 2, "-" );
#T ??
fi;
fi;
i:= 3;
while i <= ncha and
(comb[i] >= maxdeg[i] or mdeg[i-1]+ xdegrees[i] > d) do
i:= i+1;
od;
if i <= ncha then
mdeg[i-1]:= mdeg[i-1] + xdegrees[i];
comb[i]:= comb[i] + 1;
k:= i-2;
else
searching:= false;
#T just return, leave out `searching'!
fi;
od;
end;
if IsBound(arec.bounds) then
prep:= arec.bounds;
if prep = false then
X:= RationalizedMat( irreds );
else
X:= prep.obj;
rho:= Size( tbl ) ^-1 * (List(prep.point, x->prep.rho) - prep.point);
fi;
else
X:= RationalizedMat( irreds );
prep:= PermBounds( tbl, 0, X );
rho:= Size( tbl ) ^-1 * (List(prep.point, x->prep.rho) - prep.point);
fi;
xdegrees:= List(X, x->x[1]);
permch:= [];
# Compute bounds for the multiplicities of the constituents.
# (The trivial character *must* have multiplicity $1$.)
if IsRecord( prep ) then
# Compute minimal and maximal multiplicities from the info in `prep'.
point:= prep.point + arec.degree * rho;
maxdeg:= [1];
Append(maxdeg, maxList(point));
mindeg:= [1];
Append(mindeg, minList(point));
else
# The maximal multiplicity of $\psi$ in $\pi$ is bounded
# by $\psi(1)/[\psi,\psi]$ and by $(\pi(1)-1)/\psi(1)$.
maxdeg:= List( [ 1 .. Length( xdegrees ) ],
i -> Minimum( xdegrees[i],
QuoInt( arec.degree - 1, xdegrees[i] ) ) );
maxdeg[1]:= 1;
mindeg:= List( X, x -> 0 );
mindeg[1]:= 1;
fi;
# Explicit upper bounds for the maximal multiplicities are prescribed.
if IsBound( arec.maxmult ) then
if Length( maxdeg ) <> Length( arec.maxmult ) then
Error( "<arec>.maxmult corresponds to the rat. irred. characters" );
fi;
maxdeg:= List( [ 1 .. Length( maxdeg ) ],
i -> Minimum( maxdeg[i], arec.maxmult[i] ) );
fi;
# `mindeg' prescribes a constituent.
Constituent:= mindeg * X;
maxdeg:= maxdeg - mindeg;
lincom();
# Check condition (h).
permch:= TestPerm3( tbl, permch );
Sort( permch );
return List( permch, values -> Character( tbl, values ) );
end );
#############################################################################
##
#F PermCandidates( <tbl>, <characters>, <torso>, <all> )
##
## The properties (a) and (j) are checked explicitly for each candidate that
## is produced,
## the properties (b), (c), (e), (g), (h), and (i) are forced by the
## construction of the candidates,
## the property (f) --as well as (i)-- is a consequence of (b) and (e),
#T and property (d) could and should in principle be forced by construction,
#T but is checked afterwards.
##
InstallGlobalFunction( PermCandidates,
function( tbl, characters, torso, all )
local tbl_classes, # attribute of `tbl'
tbl_size, # attribute of `tbl'
ratchars, # list of all rational irreducible characters
consider_candidate, # function to check each candidate
orders, # list of representative orders of `tbl'
tbl_centralizers, # attribute of `tbl'
i, chi, matrix, fusion, moduls, divs, normindex, candidate,
classes, nonzerocol,
possibilities, # list of candidates already found
rest, images, uniques,
nccl, min_anzahl, min_class, erase_uniques, impossible,
evaluate, first, localstep,
remain, ncha, pos, fusionperm, newimages, oldrows, newmatrix,
step, erster, descendclass, j, row;
tbl_classes:= SizesConjugacyClasses( tbl );
tbl_size:= Size( tbl );
if all = true then
ratchars:= List( characters, ValuesOfClassFunction );
else
ratchars:= RationalizedMat( List( Irr( tbl ), ValuesOfClassFunction ) );
fi;
# We know that `genchar' is a generalized character,
# since it is in the span of `characters', modulo the generalized
# characters that are nonzero on exactly one Galois family of classes.
consider_candidate:= function( genchar )
local i, chi, cand;
# Check condition (a),
# i.e., the scalar products with `ratchars' are nonnegative.
cand:= [];
for i in [ 1 .. Length( genchar ) ] do
cand[i]:= genchar[i] * tbl_classes[i];
od;
#T better: once multiply all in `ratchars' with the class lengths!
for chi in ratchars do
if cand * chi < 0 then
return false;
fi;
od;
# Check the properties (d) and (j) of possible permutation characters,
# which are not guaranteed by the construction.
#T some others are guaranteed but are tested here again ...
if TestPerm1( tbl, genchar ) = 0 and TestPerm2( tbl, genchar ) = 0 then
Add( possibilities, genchar );
fi;
end;
# step 1: check and improve input
if not IsInt( torso[1] ) or torso[1] <= 0 then # degree
Error( "degree must be positive integer" );
elif tbl_size mod torso[1] <> 0 then
return [];
fi;
# Force property (g) of possible permutation characters.
# ($\pi(g) = 0$ if the order of $g$ does not divide $|G|/\pi(1)$.)
orders:= OrdersClassRepresentatives( tbl );
for i in [ 1 .. Length( characters[1] ) ] do
if ( tbl_size / torso[1] ) mod orders[i] <> 0 then
if IsBound( torso[i] ) and IsInt( torso[i] ) and torso[i] <> 0 then
Error( "value must be zero at class ", i );
fi;
torso[i]:= 0;
fi;
od;
# In all cases except one,
# only constituents of degree less than the desired degree are allowed.
matrix:= [];
for chi in characters do
if chi[1] < torso[1] then
AddSet( matrix, chi );
fi;
od;
# (Of course the trivial character itself is the exception.)
if IsEmpty( matrix ) then
if ForAll( torso, x -> x = 1 ) then
return [ TrivialCharacter( tbl ) ];
else
return [];
fi;
fi;
# The computations in each column are done modulo the centralizer
# order of this column.
# More precisely, we may choose the largest centralizer order for
# all those columns of the character table that correspond to the
# given column of `matrix'.
tbl_centralizers:= SizesCentralizers( tbl );
matrix:= CollapsedMat( matrix, [ ] );
fusion:= matrix.fusion;
matrix:= matrix.mat;
moduls:= [];
for i in [ 1 .. Length( fusion ) ] do
if IsBound( moduls[ fusion[i] ] ) then
moduls[ fusion[i] ]:= Maximum( moduls[ fusion[i] ],
tbl_centralizers[i] );
#T Would Lcm be allowed?
else
moduls[ fusion[i] ]:= tbl_centralizers[i];
fi;
od;
# Force property (h) of possible permutation characters,
# i.e., $\pi(1) |N_G(g)|$ divides $\pi(g) |G|$ for all $g \in G$.
# (This is equivalent to the condition that
# $\pi(1) / \gcd( \pi(1), [ G : N_G(g) ] )$ divides $\pi(g)$.)
divs:= [ torso[1] ];
for i in [ 2 .. Length( fusion ) ] do
normindex:= ( tbl_classes[i] * Length( ClassOrbit( tbl, i ) ) )
/ Phi( orders[i] );
if IsBound( divs[ fusion[i] ] ) then
divs[ fusion[i] ]:= Lcm( divs[ fusion[i] ],
torso[1] / GcdInt( torso[1], normindex ) );
else
divs[ fusion[i] ]:= torso[1] / GcdInt( torso[1], normindex );
fi;
od;
candidate:= [];
nonzerocol:= [];
classes:= [];
for i in [ 1 .. Length( moduls ) ] do
candidate[i]:= 0;
nonzerocol[i]:= true;
classes[i]:= 0;
od;
for i in [ 1 .. Length( fusion ) ] do
classes[ fusion[i] ]:= classes[ fusion[i] ] + tbl_classes[i];
od;
# Initialize the global list of all possible permutation characters.
possibilities:= [];
# The scalar product of the trivial character with a transitive
# permutation character is $1$,
# this yields an upper bound on the values that are not yet known.
# We subtract the known values from `Size( tbl )'.
# (If there is a contradiction, we return an empty list.)
rest:= tbl_size;
images:= [];
uniques:= [];
for i in [ 1 .. Length( fusion ) ] do
if IsBound( torso[i] ) and IsInt( torso[i] ) then
if IsBound( images[ fusion[i] ] ) then
if torso[i] <> images[ fusion[i] ] then
# Different values are prescribed for identified columns.
return [];
fi;
else
images[ fusion[i] ]:= torso[i];
AddSet( uniques, fusion[i] );
rest:= rest - classes[ fusion[i] ] * torso[i];
if rest < 0 then
return [];
fi;
fi;
fi;
od;
nccl:= Length( moduls );
Info( InfoCharacterTable, 2, "PermCandidates: input checked" );
# step 2: first elimination before backtrack:
erase_uniques:= function( uniques, nonzerocol, candidate, rest )
# eliminate all unique columns, adapt nonzerocol;
# then look if other columns become unique or if a contradiction occurs;
# also look at which column the least number of values is left
local i, j, extracted, col, row, quot, val, ggt, a, b, k, u, anzahl,
firstallowed, step, gencharacter, shrink;
extracted:= [];
while uniques <> [] do
for col in uniques do
if col < 0 then # nonzero entries in `col' already eliminated
col:= -col;
candidate[ col ]:= ( candidate[ col ] + images[ col ] )
mod moduls[ col ];
row:= fail;
else # eliminate nonzero entries in `col'
candidate[ col ]:= ( candidate[ col ] + images[ col ] )
mod moduls[ col ];
row:= StepModGauss( matrix, moduls, nonzerocol, col );
# delete zero rows:
shrink:= [];
for i in matrix do
if PositionNonZero( i ) <= Length( i ) then
#T better call IsZero?
Add( shrink, i );
fi;
od;
matrix:= shrink;
fi;
if row <> fail then
Add( extracted, row );
quot:= candidate[ col ] / row[ col ];
if not IsInt( quot ) then
impossible:= true;
return extracted;
fi;
for j in [ 1 .. nccl ] do
if nonzerocol[j] then
candidate[j]:= ( candidate[j] - quot * row[j] ) mod moduls[j];
fi;
od;
elif candidate[col] <> 0 then
impossible:= true;
return extracted;
fi;
nonzerocol[col]:= false;
od;
min_anzahl:= infinity;
uniques:= [];
# compute the number of possible values `x' for each class `i'.
# `x' must be smaller or equal `Minimum( rest / classes[i], torso[1] )',
# divisible by `divs[i]' and
# congruent `-candidate[i]' modulo the Gcd of column `i'.
for i in [ 1 .. nccl ] do
if nonzerocol[i] then
val:= moduls[i];
for j in matrix do val:= GcdInt( val, j[i]); od; # the Gcd of `i'
# zerocol iff val = moduls[i]
first:= ( - candidate[i] ) mod val; # the first possible value
# in the case `divs[i] = 1'
if divs[i] = 1 then
localstep:= val; # all values are
# `first, first + val, first + 2*val ..'
else
ggt:= Gcdex( divs[i], val );
a:= ggt.coeff1;
ggt:= ggt.gcd;
if first mod ggt <> 0 then # ggt divides `divs[i]' and hence `x';
# since ggt divides `val', which must
# divide `( x + candidate[i] )',
# we must have ggt dividing `first'
impossible:= true;
return extracted;
fi;
localstep:= Lcm( divs[i], val );
first:= ( first * a * divs[i] / ggt ) mod localstep;
# satisfies the required congruences
# (and that is enough here)
fi;
anzahl:= Int( ( Minimum( Int( rest[1] / classes[i] ), torso[1] )
- first + localstep ) / localstep );
if anzahl <= 0 then # contradiction
impossible:= true;
return extracted;
elif anzahl = 1 then # unique
images[i]:= first;
if val = moduls[i] then # no elimination necessary
# (the column consists of zeroes)
Add( uniques, -i );
else
Add( uniques, i );
fi;
rest[1]:= rest[1] - classes[i] * images[i];
elif anzahl < min_anzahl then
min_anzahl:= anzahl;
step:= localstep;
firstallowed:= first;
min_class:= i;
fi;
fi;
od;
od;
if min_anzahl = infinity then
if rest[1] = 0 then
consider_candidate( images{ fusion } );
fi;
impossible:= true;
else
images[ min_class ]:= rec( firstallowed:= firstallowed, # first value
step:= step, # step
anzahl:= min_anzahl ); # no. of values
impossible:= false;
fi;
return extracted;
# impossible = true: calling function will return from backtrack
# impossible = false: then min_class < infinity, and images[ min_class ]
# contains the information for descending at min_class
end;
rest:= [ rest ];
erase_uniques( uniques, nonzerocol, candidate, rest );
# Here we may forget the extracted rows,
# later in the backtrack they must be appended after each return.
rest:= rest[1];
if impossible then
return List( possibilities, vals -> Character( tbl, vals ) );
fi;
Info( InfoCharacterTable, 2,
"PermCandidates: unique columns erased, there are ",
Number( nonzerocol, x -> x ), " columns left,\n",
"#I the number of constituents is ", Length( matrix ), "." );
# step 3: collapse
remain:= Filtered( [ 1 .. nccl ], x -> nonzerocol[x] );
for i in [ 1 .. Length( matrix ) ] do
matrix[i]:= matrix[i]{ remain };
od;
candidate:= candidate{ remain };
divs:= divs{ remain };
nonzerocol:= nonzerocol{ remain };
moduls:= moduls{ remain };
classes:= classes{ remain };
matrix:= ModGauss( matrix, moduls );
ncha:= Length( matrix );
pos:= 1;
fusionperm:= [];
newimages:= [];
for i in remain do
fusionperm[i]:= pos;
if IsBound( images[i] ) then
newimages[ pos ]:= images[i];
fi;
pos:= pos + 1;
od;
min_class:= fusionperm[ min_class ];
for i in Difference( [ 1 .. nccl ], remain ) do
fusionperm[i]:= pos;
newimages[ pos ]:= images[i];
pos:= pos + 1;
od;
images:= newimages;
fusion:= CompositionMaps( fusionperm, fusion );
nccl:= Length( nonzerocol );
Info( InfoCharacterTable, 2,
"PermCandidates: known columns physically deleted,\n",
"#I a backtrack search will be needed" );
# step 4: backtrack
evaluate:= function( candidate, rest, nonzerocol, uniques )
local i, j, row, extracted, step, erster, descendclass;
rest:= [ rest ];
extracted:= erase_uniques( [ uniques ], nonzerocol, candidate, rest );
rest:= rest[1];
if impossible then
return extracted;
fi;
descendclass:= min_class;
step:= images[ descendclass ].step; # spalten-ggt
erster:= images[ descendclass ].firstallowed;
rest:= rest + ( step - erster ) * classes[ descendclass ];
for i in [ 1 .. min_anzahl ] do
images[ descendclass ]:= erster + (i-1) * step;
rest:= rest - step * classes[ descendclass ];
oldrows:= evaluate( ShallowCopy( candidate ), rest,
ShallowCopy( nonzerocol ), descendclass );
Append( matrix, oldrows );
if Length( matrix ) > ( 3 * ncha ) / 2 then
newmatrix:= []; # matrix:= ModGauss( matrix, moduls );
for j in [ 1 .. Length( matrix[1] ) ] do
if nonzerocol[j] then
row:= StepModGauss( matrix, moduls, nonzerocol, j );
if row <> fail then Add( newmatrix, row ); fi;
fi;
od;
matrix:= newmatrix;
fi;
od;
return extracted;
end;
#
step:= images[min_class].step; # spalten-ggt
erster:= images[min_class].firstallowed;
descendclass:= min_class;
rest:= rest + ( step - erster ) * classes[ descendclass ];
for i in [ 1 .. min_anzahl ] do
images[ descendclass ]:= erster + (i-1) * step;
rest:= rest - step * classes[ descendclass ];
oldrows:= evaluate( ShallowCopy( candidate ), rest,
ShallowCopy( nonzerocol ), descendclass );
Append( matrix, oldrows );
if Length( matrix ) > ( 3 * ncha ) / 2 then
newmatrix:= []; # matrix:= ModGauss( matrix, moduls );
for j in [ 1 .. Length( matrix[1] ) ] do
if nonzerocol[j] then
row:= StepModGauss( matrix, moduls, nonzerocol, j );
if row <> fail then Add( newmatrix, row ); fi;
fi;
od;
matrix:= newmatrix;
fi;
od;
return List( possibilities, values -> Character( tbl, values ) );
end );
#############################################################################
##
#F PermCandidatesFaithful( <tbl>, <chars>, <norm\_subgrp>, <nonfaithful>,
#F <lower>, <upper>, <torso>[, <all>] )
##
# `PermCandidatesFaithful'\\
# ` ( tbl, chars, norm\_subgrp, nonfaithful, lower, upper, torso )'
#
# reference of variables\:
# \begin{itemize}
# \item `tbl'\: a character table which must contain field `order'
# \item `chars'\: *rational* characters of `tbl'
# \item `nonfaithful'\: $(1_{UN})^G$
# \item `lower'\: lower bounds for $(1_U)^G$
# (may be unspecified, i.e. 0)
# \item `upper'\: upper bounds for $(1_U)^G$
# (may be unspecified, i.e. 0)
# \item `torso'\: $(1_U)^G$ (at known positions)
# \item `faithful'\: `torso' - `nonfaithful'
# \item `divs'\: `divs[i]' divides $(1_U)^G[i]$
# \end{itemize}
#
# The algorithm proceeds in 5 steps\:
#
# *step 1*\: Try to improve the input data
# \begin{enumerate}
# \item Check if `torso[1]' divides $\|G\|$, `nonfaithful[1]' divides
# `torso[1]'.
# \item If `orders[i]' does not divide $U$
# or if $'nonfaithful[i]' = 0$, `torso[i]' must be 0.
# \item Transfer `upper' and `lower' to upper bounds and lower bounds for
# the values of `faithful' and try to improve them\:
# \begin{enumerate}
# \item \['lower[i]'\:= \max\{'lower[i]',0\} - `nonfaithful[i]';\]
# If $UN$ has only one galois family of classes for a prime
# representative order $p$, and $p$ divides $\|G\|/'torso[1]'$,
# or if $g_i$ is a $p$-element and $p$ does not divide $[UN\:U]$,
# then necessarily these elements lie in $U$, and we have
# \['lower[i]'\:= \max\{'lower[i]',1\} - `nonfaithful[i]';\]
# \item \begin{eqnarray*}
# `upper[i]' & \:= & \min\{'upper[i]','torso[1]',
# `tbl_centralizers[i]'-1,\\
# & & `torso[1]' \cdot `nonfaithful[i]'/'nonfaithful[1]'\}
# -'nonfaithful[i]'.
# \end{eqnarray*}
# \end{enumerate}
# \item Compute divisors of the values of $(1_U)^G$\:
# \['divs[i]'\:= `torso[1]'/\gcd\{'torso[1]',\|G\|/\|N_G[i]\|\}
# \mbox{\rm \ divides} (1_U)^G[i].\]
# ($\|N_G[i]\|$ denotes the normalizer order of $\langle g_i \rangle$.)
#
# If $g_i$ generates a Sylow $p$ subgroup of $UN$ and $p$ does not
# divide $[UN\:U]$ then $(1_{UN})^G(g_i)$ divides $(1_U)^G(g_i)$,
# and we have \['divs[i]'\:= `Lcm( divs[i], nonfaithful[i] )'.\]
# \item Compute `roots' and `powers' for later improvements of local bounds\:
# $j$ is in `roots[i]' iff there exists a prime $p$ with powermap
# stored on `tbl' and $g_j^p = g_i$,
# $j$ is in `powers[i]' iff there exists a prime $p$ with powermap
# stored on `tbl' and $g_i^p = g_j$.
# \item Compute the list `matrix' of possible constituents of `faithful'\:
# (If `torso[1]' = 1, we have none.)
# Every constituent $\chi$ must have degree $\chi(1)$ lower than
# $'torso[1]' - `nonfaithful[1]'$, and $N \not\subseteq \ker(\chi)$;
# also, for all i, we must have
# $\chi[i] \geq \chi[1] - `faithful[1]' - `nonfaithful[i]'$.
# \end{enumerate}
#
# *step 2*\: Collapse classes which are equal for all possible constituents
#
# (*Note*\: We only needed the fusion of classes, but we also have to make
# a copy.)
#
# After that, `fusion' induces an equivalence relation of conjugacy classes,
# `matrix' is the new list of constituents. Let $C \:= \{i_1,\ldots,i_n\}$
# be an equivalence class; for further computation, we have to adjust the
# other information\:
#
# \begin{enumerate}
# \item Collapse `faithful'; the values that are not yet known later will be
# filled in using the decomposability test (see "ContainedCharacters");
# the equality
# \['torso' = `nonfaithful' + `Indirection'('faithful','fusion')\]
# holds, so later we have
# \[(1_U)^G = (1_{UN})^G + `Indirection( faithful , fusion )'.\]
# \item Adjust the old structures\:
# \begin{enumerate}
# \item Define as new roots \[ `roots[C]'\:=
# \bigcup_{1 \leq j \leq n} `set(Indirection(fusion,roots[i_j]))', \]
# \item as new powers \[ `powers[C]'\:=
# \bigcup_{1 \leq j \leq n} `set(Indirection(fusion,powers[i_j]))',\]
# \item as new upper bound \['upper[C]'\:=
# \min_{1 \leq j \leq n}('upper[i_j]'), \]
# try to improve the bound using the fact that for each j in
# `roots[C]' we have
# \['nonfaithful[j]'+'faithful[j]' \leq
# `nonfaithful[C]'+'faithful[C]',\]
# \item as new lower bound \['lower[C]'\:=
# \max_{1 \leq j \leq n}('lower[i_j]'),\]
# try to improve the bound using the fact that for each j in
# `powers[C]' we have
# \['nonfaithful[j]'+'faithful[j]' \geq
# `nonfaithful[C]'+'faithful[C]',\]
# \item as new divisors \['divs[C]'\:=
# `Lcm'( `divs'[i_1],\ldots, `divs'[i_n] ).\]
# \end{enumerate}
# \item Define some new structures\:
# \begin{enumerate}
# \item the moduls for the basechange \['moduls[C]'\:=
# \max_{1 \leq j \leq n}('tbl_centralizers[i_j]'),\]
# \item new classes \['classes[C]'\:=
# \sum_{1 \leq j \leq n} `tbl_classes[i_j]',\]
# \item \['nonfaithsum[C]'\:= \sum_{1 \leq j \leq n} `tbl_classes[i_j]'
# \cdot `nonfaithful[i_j]',\]
# \item a variable `rest', preset with $\|G\|$\: We know that
# $\sum_{g \in G} (1_U)^G(g) = \|G\|$.
# Let the values of $(1_U)^G$ be known for a subset
# $\tilde{G} \subseteq G$, and define
# $'rest'\:= \sum_{g \in \tilde{G}} (1_U)^G(g)$;
# then for $g \in G \setminus \tilde{G}$, we
# have $(1_U)^G(g) \leq `rest'/\|Cl_G(g)\|$.
# In our situation, this means
# \[\sum_{1 \leq j \leq n} \|Cl_G(g_j)\| \cdot (1_U)^G(g_j)
# \leq `rest',\]
# or equivalently
# $'nonfaithsum[C]' + `faithful[C]' \cdot `classes[C]' \leq `rest'$.
# (*Note* that `faithful' necessarily is constant on `C'.).
# So `rest' is used to update local upper bounds.
# \end{enumerate}
# \item (possible acceleration\: If we allow to collapse classes on which
# `nonfaithful' takes different values, the situation is a little
# more difficult. The new upper and lower bounds will be others,
# and the new divisors will become moduls in a congruence relation
# that has nothing to do with the values of torso or faithful.)
# \end{enumerate}
#
# *step 3*\: Eliminate classes for which the values of `faithful' are known
#
# The subroutine `erase' successively eliminates the columns of `matrix'
# listed up in `uniques'; at most one row remains with a nonzero entry `val'
# in that column `col', this is the gcd of the former column values.
# If we can eliminate `difference[ col ]', we proceed with the next column,
# else there is a contradiction (i.e. no generalized character exists that
# satisfies our conditions), and we set `impossible' true and then return
# all extracted rows which must be used at lower levels of a backtrack
# which may have called `erase'.
# Having erased all uniques without finding a contradiction, `erase' looks
# if other columns have become unique, i.e. the bounds and divisors allow
# just one value; those columns are erased, too.
# `erase' also updates the (local) upper and lower bounds using `roots',
# `powers' and `rest'.
# If no further elimination is possible, there can be two reasons\:
# If all columns are erased, `faithful' is complete, and if it is really a
# character, it will be appended to `possibilities'; then `impossible' is
# set true to indicate that this branch of the backtrack search tree has
# ended here.
# Otherwise `erase' looks for that column where the number of possible
# values is minimal, and puts a record with information about first
# possible value, step (of the arithmetic progression) and number of
# values into that column of `faithful';
# the number of the column is written to `min\_class',
# `impossible' is set false, and the extracted rows are returned.
#
# And this way `erase' computes the lists of possible values\:
#
# Let $d\:= `divs[ i ]', z\:= `val', c\:= `difference[ i ]',
# n\:= `nonfaithful[ i ]', low\:= `local\_lower[ i ]',
# upp\:= `local\_upper[ i ]', g\:= \gcd\{d,z\} = ad + bz$.
#
# Then the set of allowed values is
# \[ M\:= \{x; low \leq x \leq upp; x \equiv -c \pmod{z};
# x \equiv -n \pmod{d} \}.\]
# If $g$ does not divide $c-n$, we have a contradiction, else
# $y\:= -n -ad \frac{c-n}{g}$ defines the correct arithmetic progression\:
# \[ M = \{x;low \leq x \leq upp; x \equiv y \pmod{'Lcm'(d,z)} \} \]
# The minimum of $M$ is then given by
# \[ L\:= low + (( y - low ) \bmod `Lcm'(d,z)).\]
#
# (*Note* that for the usual case $d=1$ we have $a=1, b=0, y=-c$.)
#
# Therefore the number of values is
# $'Int( `( upp - L ) ` / Lcm'(d,z) ` )' +1$.
#
# In step 3, `erase' is called with the list of known values of `faithful'
# as `uniques'.
# Afterwards, if `InfoCharTable2 = Print' and a backtrack search is necessary,
# a message about the found improvements and the expected expense
# for the backtrack search is printed.
# (*Note* that we are allowed to forget the rows which we have extracted in
# this first elimination.)
#
# *step 4*\: Delete eliminated columns physically before the backtrack search
#
# The eliminated columns (those with `nonzerocol[i] = false') of `matrix'
# are deleted, and the other objects are adjusted\:
# \begin{enumerate}
# \item In `differences', `divs', `nonzerocol', `moduls', `classes',
# `nonfaithsum', `upper', `lower', the columns are simply deleted.
# \item For adjusting `fusion', first a permutation `fusionperm' is
# constructed that maps the eliminated columns behind the remaining
# columns; after `faithful\:= Indirection( faithful, fusionperm )' and
# `fusion\:= Indirection( fusionperm, fusion )', we have again
# \[ (1_U)^G = (1_{UN})^G + `Indirection( faithful, fusion )'. \]
# \item adjust `roots' and `powers'.
# \end{enumerate}
#
# *step 5*\: The backtrack search
#
# The subroutine `evaluate' is called with a column `unique'; this (and other
# uniques, if possible) is eliminated. If there was an inconsistence, the
# extracted rows are returned; otherwise the column `min\_class' subsequently
# will be set to all possible values and `evaluate' is called with
# `unique = min\_class'.
# After each return from `evaluate', the returned rows are appended to matrix
# again; if matrix becomes too long, a call of `ModGauss' will shrink it.
# Note that `erase' must be able to update the value of `rest', but any call
# of `evaluate' must not change `rest'; so `rest' is a parameter of
# `evaluate', but for `erase' it is global (realized as `[ rest ]').
##
InstallGlobalFunction( PermCandidatesFaithful,
function( tbl, chars, norm_subgrp, nonfaithful, upper, lower, torso,
arg... )
local ratirr,
tbl_classes, # attribute of `tbl'
tbl_size, # attribute of `tbl'
tbl_orders, # attribute of `tbl'
tbl_centralizers, # attribute of `tbl'
tbl_powermap, # attribute of `tbl'
i, x, N, nccl, faithful, families, j, primes, orbits, factors,
pparts, cyclics, divs, roots, powers, matrix, fusion, inverse,
moduls, classes, nonfaithsum, rest, uniques, collfaithful,
orig_nonfaithful, difference, nonzerocol, possibilities,
ischaracter, erase, min_number, impossible, remain,
ncha, pos, fusionperm, shrink, ppart, myset, newfaithful,
min_class, evaluate, step, first, descendclass, oldrows, newmatrix,
row;
chars:= List( chars, ValuesOfClassFunction );
if Length( arg ) = 1 and arg[1] = true then
# The given list contains all rational irreducible characters.
ratirr:= chars;
else
# The given list is not known to be complete.
ratirr:= RationalizedMat( List( Irr( tbl ), ValuesOfClassFunction ) );
fi;
#
# step 1: Try to improve the input data
#
lower:= ShallowCopy( lower );
upper:= ShallowCopy( upper );
torso:= ShallowCopy( torso );
# order of normal subgroup
tbl_classes:= SizesConjugacyClasses( tbl );
N := Sum( tbl_classes{ norm_subgrp } );
nccl:= Length( nonfaithful );
tbl_size:= Size( tbl );
if not IsBound( torso[1] ) or not IsPosInt( torso[1] ) then
Error( "degree must be positive integer" );
elif tbl_size mod torso[1] <> 0 or torso[1] mod nonfaithful[1] <> 0
or torso[1] = 1 then
return [];
fi;
tbl_orders:= OrdersClassRepresentatives( tbl );
for i in [ 1 .. nccl ] do
if ( tbl_size / torso[1] ) mod tbl_orders[i] <> 0
or nonfaithful[i] = 0 then
if IsBound( torso[i] ) and IsInt( torso[i] ) and torso[i] <> 0 then
return [];
fi;
torso[i]:= 0;
fi;
od;
faithful:= [];
for i in [ 1 .. Length( torso ) ] do
if IsBound( torso[i] ) and IsInt( torso[i] ) then
faithful[i]:= torso[i] - nonfaithful[i];
fi;
od;
# compute a list of Galois families for `tbl':
families:= [];
for i in [ 1 .. nccl ] do
if not IsBound( families[i] ) then
families[i]:= ClassOrbit( tbl, i );
for j in families[i] do
families[j]:= families[i];
od;
fi;
od;
# `primes': prime divisors of $|U|$ for which there is only one $G$-family
# of that element order in $UN$:
factors:= Factors(Integers, tbl_size / torso[1] );
primes:= Set( factors );
orbits:= List( primes, p -> [] );
for i in [ 1 .. nccl ] do
if tbl_orders[i] in primes and nonfaithful[i] <> 0 then
AddSet( orbits[ Position( primes, tbl_orders[i] ) ], families[i] );
fi;
od;
for i in [ 1 .. Length( primes ) ] do
if Length( orbits[i] ) <> 1 then
Unbind( primes[i] );
fi;
od;
primes:= Compacted( primes );
# which Sylow subgroups of $UN$ are contained in $U$:
pparts:= [];
for i in Set( factors ) do
if ( torso[1] / nonfaithful[1] ) mod i <> 0 then
# i is a prime divisor of $\|U\|$ not dividing
# $|UN|/|U| = `torso[1] / nonfaithful[1]'$:
ppart:= 1;
for j in factors do
if j = i then ppart:= ppart * i; fi;
od;
Add( pparts, ppart );
fi;
od;
cyclics:= []; # cyclic Sylow subgroups
for i in [ 1 .. nccl ] do
if tbl_orders[i] in pparts and nonfaithful[i] <> 0 then
Add( cyclics, i );
fi;
od;
# transfer bounds:
if lower = 0 then
lower:= ListWithIdenticalEntries( nccl, 0 );
lower[1]:= torso[1];
fi;
if upper = 0 then
upper:= ListWithIdenticalEntries( nccl, torso[1] );
fi;
upper[1]:= upper[1] - nonfaithful[1];
lower[1]:= lower[1] - nonfaithful[1];
tbl_centralizers:= SizesCentralizers( tbl );
for i in [ 2 .. nccl ] do
if nonfaithful[i] <> 0 and
( tbl_orders[i] in primes
or 0 in List( pparts, x -> x mod tbl_orders[i] ) ) then
lower[i]:= Maximum( lower[i], 1 ) - nonfaithful[i];
else
lower[i]:= Maximum( lower[i], 0 ) - nonfaithful[i];
fi;
if i in norm_subgrp then
upper[i]:= Minimum( upper[i], torso[1], tbl_centralizers[i] - 1,
Int( ( N * nonfaithful[1] - torso[1] ) / tbl_classes[i] ),
Int( torso[1] * nonfaithful[i] / nonfaithful[1] ) )
- nonfaithful[i];
else
upper[i]:= Minimum( upper[i], torso[1], tbl_centralizers[i] - 1,
Int( torso[1] * nonfaithful[i] / nonfaithful[1] ) )
- nonfaithful[i];
fi;
od;
for i in [ 1 .. nccl ] do
if IsBound( faithful[i] ) then
if faithful[i] >= lower[i] then
lower[i]:= faithful[i];
else
return [];
fi;
if faithful[i] <= upper[i] then
upper[i]:= faithful[i];
else
return [];
fi;
elif lower[i] = upper[i] then
faithful[i]:= lower[i];
fi;
od;
# compute divs:
divs:= [ torso[1] ];
for i in [ 2 .. nccl ] do
divs[i]:= torso[1] / GcdInt( torso[1],
tbl_classes[i] * Length( families[i] )
/ Phi( tbl_orders[i] ) );
if i in cyclics then
divs[i]:= Lcm( divs[i], nonfaithful[i] );
fi;
od;
# compute roots and powers:
roots:= [];
powers:= [];
for i in [ 1 .. Length( nonfaithful ) ] do
roots[i]:= [];
powers[i]:= [];
od;
tbl_powermap:= ComputedPowerMaps( tbl );
for i in [ 2 .. Length( tbl_powermap ) ] do
if IsBound( tbl_powermap[i] ) then
for j in [ 1 .. Length( nonfaithful ) ] do
if IsInt( tbl_powermap[i][j] ) then
AddSet( powers[j], tbl_powermap[i][j] );
AddSet( roots[ tbl_powermap[i][j] ], j );
fi;
od;
fi;
od;
# matrix of constituents:
matrix:= []; # delete impossibles
for i in chars do
if i[1] <= faithful[1]
and Difference( norm_subgrp, ClassPositionsOfKernel( i ) ) <> [] then
j:= 1;
while j <= Length( i )
--> --------------------
--> maximum size reached
--> --------------------
[ Dauer der Verarbeitung: 0.76 Sekunden
(vorverarbeitet)
]
|
