|
#############################################################################
##
#F FindNiceRowOneNorm
#F FindNiceRowTwoNorm
#F FindNiceRowInfinityNorm
##
## Functions that select during an HNF computation a row from a matrix <M>
## such that the row is minimal with respect to a chosen norm and can
## function as pivot entry in position i,j.
##
#F FindNiceRowInfinityNormRowOps
##
## Does the same as FindNiceRowInfinityNorm() but records the row
## operations.
##
BindGlobal( "FindNiceRowOneNorm", function( M, i, j )
local m, n, k, a, r;
m := Length( M ); n := Length( M[1] );
for k in [i+1..m] do
a := AbsInt( M[k][j] );
if a <> 0 and
(a < AbsInt( M[i][j] )
or (a = AbsInt( M[i][j] )
and Sum( M[k], AbsInt ) < Sum( M[i], AbsInt ) ) ) then
r := M[i]; M[i] := M[k]; M[k] := r;
fi;
od;
return;
end );
BindGlobal( "FindNiceRowTwoNorm", function( M, i, j )
local m, n, k, a, r;
m := Length( M ); n := Length( M[1] );
for k in [i+1..m] do
a := AbsInt( M[k][j] );
if a <> 0 and
(a < AbsInt( M[i][j] )
or (a = AbsInt( M[i][j] )
and M[k]*M[k] < M[i]*M[i] ) ) then
r := M[i]; M[i] := M[k]; M[k] := r;
fi;
od;
return;
end );
BindGlobal( "FindNiceRowInfinityNorm", function( M, i, j )
local m, n, k, a, r;
m := Length( M ); n := Length( M[1] );
for k in [i+1..m] do
a := AbsInt( M[k][j] );
if a <> 0 and
(a < AbsInt( M[i][j] )
or (a = AbsInt( M[i][j] )
and Number( M[k], x->x<>0 ) < Number( M[i], x->x<>0 ) ) ) then
r := M[i]; M[i] := M[k]; M[k] := r;
fi;
od;
return;
end );
BindGlobal( "FindNiceRowInfinityNormRowOps", function( M, Q, i, j )
local m, n, k, a, r;
m := Length( M ); n := Length( M[1] );
for k in [i+1..m] do
a := AbsInt( M[k][j] );
if a <> 0 and
(a < AbsInt( M[i][j] )
or (a = AbsInt( M[i][j] )
and Number( M[k], x->x<>0 ) < Number( M[i], x->x<>0 ) ) ) then
r := M[i]; M[i] := M[k]; M[k] := r;
r := Q[i]; Q[i] := Q[k]; Q[k] := r;
fi;
od;
return;
end );
#############################################################################
##
#F HNFIntMat . . . . . . . . . . . . Hermite Normalform of an integer matrix
##
BindGlobal( "HNFIntMat", function( M )
local MM, m, n, i, j, k, r, Cleared, a;
if M = [] then return []; fi;
MM := M;
M := List( M, ShallowCopy );
m := Length( M ); n := Length( M[1] );
i := 1; j := 1;
while i <= m and j <= n do
# find first k with M[k][j] non-zero
k := i; while k <= m and M[k][j] = 0 do k := k+1; od;
if k <= m then
# swap rows
r := M[i]; M[i] := M[k]; M[k] := r;
# find nicest row with M[k][j] non-zero
FindNiceRowInfinityNorm( M, i, j );
if M[i][j] < 0 then M[i] := -1 * M[i]; fi;
# reduce all other entries in this columns with the pivot entry
Cleared := true;
for k in [i+1..m] do
a := QuoInt(M[k][j],M[i][j]);
if a <> 0 then
AddRowVector( M[k], M[i], -a, i, n );
fi;
if M[k][j] <> 0 then Cleared := false; fi;
od;
# if all entries below the pivot are zero, reduce above the
# pivot and then move on along the diagonal
if Cleared then
for k in [1..i-1] do
a := QuoInt(M[k][j],M[i][j]);
if M[k][j] < 0 and M[k][j] mod M[i][j] <> 0 then
a := a-1;
fi;
if a <> 0 then
AddRowVector( M[k], M[i], -a, 1, n );
fi;
od;
i := i+1; j := j+1;
fi;
else
# increase column counter if column has only zeroes
j := j+1;
fi;
od;
return M{[1..i-1]};
end );
#############################################################################
##
#F HNFIntMat . . . . . . . . . . . . Hermite Normal Form plus row operations
##
BindGlobal( "HNFIntMatRowOps", function( M )
local MM, m, n, Q, i, j, k, r, Cleared, a;
if M = [] then return []; fi;
MM := M;
M := List( M, ShallowCopy );
m := Length( M ); n := Length( M[1] );
Q := IdentityMat( Length(M) );
i := 1; j := 1;
while i <= m and j <= n do
# find first k with M[k][j] non-zero
k := i; while k <= m and M[k][j] = 0 do k := k+1; od;
if k <= m then
# swap rows
r := M[i]; M[i] := M[k]; M[k] := r;
r := Q[i]; Q[i] := Q[k]; Q[k] := r;
# find nicest row with M[k][j] non-zero
FindNiceRowInfinityNormRowOps( M, Q, i, j );
if M[i][j] < 0 then M[i] := -1 * M[i]; Q[i] := -1 * Q[i]; fi;
# reduce all other entries in this columns with the pivot entry
Cleared := true;
for k in [i+1..m] do
a := QuoInt(M[k][j],M[i][j]);
if a <> 0 then
AddRowVector( M[k], M[i], -a, i, n );
AddRowVector( Q[k], Q[i], -a, 1, m );
fi;
if M[k][j] <> 0 then Cleared := false; fi;
od;
# if all entries below the pivot are zero, reduce above the
# pivot and then move on along the diagonal
if Cleared then
for k in [1..i-1] do
a := QuoInt(M[k][j],M[i][j]);
if M[k][j] < 0 and M[k][j] mod M[i][j] <> 0 then
a := a-1;
fi;
if a <> 0 then
AddRowVector( M[k], M[i], -a, 1, n );
AddRowVector( Q[k], Q[i], -a, 1, m );
fi;
od;
i := i+1; j := j+1;
fi;
else
# increase column counter if column has only zeroes
j := j+1;
fi;
od;
return [ M, Q ];
end );
#############################################################################
##
#F DiagonalFormIntMat . . . . diagonal form of an integer matrix plus column
#F operations
##
BindGlobal( "DiagonalFormIntMat", function( M )
local Q, pair;
M := HNFIntMat( M );
Q := IdentityMat( Length(M[1]) );
while not IsDiagonalMat( M ) do
M := TransposedMat( M );
pair := HNFIntMatRowOps( M );
Q := Q * TransposedMat( pair[2] );
M := TransposedMat( pair[1] );
if not IsDiagonalMat( M ) then
M := HNFIntMat( M );
fi;
od;
return [ M, Q ];
end );
##
## This function takes a matrix M in HNF and eliminates for each row whose
## leading entry is 1 the remaining entries of the row. This corresponds
## to a sequence of column operations. Note that all entries above and
## below the 1 are 0 since the matrix is in HNF.
##
## The function returns the transformed matrix M' together with the
## transforming matrix Q such that
## M * Q = M'
##
BindGlobal( "ClearOutWithOnes", function( M )
local Q, i, k, j, l;
M := List( M, ShallowCopy );
Q := IdentityMat( Length(M[1]) );
for i in [1..Length(M)] do
k := First( [1..Length(M[i])], e -> M[i][e] <> 0 );
if M[i][k] = 1 then
for j in [k+1..Length(M[i])] do
if M[i][j] <> 0 then
Q[j] := Q[j] - M[i][j] * Q[k];
M[i][j] := 0;
fi;
od;
fi;
od;
return [M, TransposedMat(Q)];
end );
##
## After we have cleared out those rows of the HNF whose leading entry is 1,
## we need to compute a diagonal form of the rest of the matrix. This
## routines cuts out the relevant part, computes a diagonal form of it, puts
## that back into the matrix and returns the performed columns operations.
##
BindGlobal( "CutOutNonOnes", function( M )
local rows, cols, nf, Q, i;
# Find all rows whose leading entry is 1
rows := Filtered( [1..Length(M)], i->First( M[i], e->e <> 0 ) = 1 );
if rows = [1..Length(M)] then
return IdentityMat( Length(M[1]) );
fi;
# Find those colums where the leading entry is
cols := List( rows, i->Position( M[i], 1 ) );
# The complement are those rows whose leading entry is not one and those
# colums that do not have a 1 in a leading position.
rows := Difference( [1..Length(M)], rows );
cols := Difference( [1..Length(M[1])], cols );
# skip leading zeroes
i := 1; while M[rows[1]][cols[i]] = 0 do i := i+1; od;
cols := cols{[i..Length(cols)]};
nf := DiagonalFormIntMat( M{rows}{cols} );
Q := IdentityMat( Length(M[1]) );
for i in cols do Q[i][i] := 0; od;
Q{cols}{cols} := nf[2];
M{rows}{cols} := nf[1];
return Q;
end );
##
## The HNF of a matrix that comes out of the consistency test for a
## central extension tends to have a lot of rows whose leading entry is 1.
## In particular, if we do not have an efficient strategy for computing
## tails, we have many generators which can be expressed by others.
##
## This is a simple consequence of the fact that we add about n^2/2 new
## generators to the polycyclic presentation if the the group has n
## generators. But it is clear that the rank of R/[R,F] is bounded from
## above by n. Therefore, about n^2/2 generators will be expressed by
## others.
##
## We return a diagonal form of M and the matrix of column operations in
## the same format as NormalFormIntMat()
##
## An example where this performs much better than NormalFormIntMat is
## given by
## G:=HeisenbergPcpGroup(2);
## NonAbelianTensorSquarePlusEpimorphism(G);
## Timing the call to NormalFormConsistencyRelations and comparing it to
## an equivalent NormalFormIntMat call yielded 50 msec vs. 1000 msec,
## i.e. a speedup by factor 20.
##
BindGlobal( "NormalFormConsistencyRelations", function( M )
local nf, Q, rows, cols, small, nfim, QQ;
M := HNFIntMat( M );
nf := ClearOutWithOnes( M );
M := nf[1];
Q := nf[2];
Q := Q * CutOutNonOnes( M );
return rec( normal := M, coltrans := Q );
end );
[ Dauer der Verarbeitung: 0.30 Sekunden
(vorverarbeitet)
]
|
