Quelle allowable.gi Sprache: unbekannt

#############################################################################
##
#W  allowable.gi             Sophus package                   Csaba Schneider
##
#W  The functions in this file implement the procedures that find the orbits
#W  on the set of allowable subgroups. Each subgroup is represented by a label
#W  as explained by O'Brien. Then we compute the orbits on the set of labels.
#W  The algorithm is not explained here, see [O'Brien, J. Symbolic Comput.
#W  vol. 9, pp. 677-698].
##

#############################################################################
##
#F ReduceGenSet( <G> )
##
##  Tries to reduce a generating set for a group G. This function is there
##  only for experimenting. If FIND_MIN_GEN_SET is set 'true' then this
##  function is called before the orbit computation. The generating set
##  it returns is not necessarily minimal!

BindGlobal( "ReduceGenSet", function( G )
    local i, E, gens, newgens, PG, f, min, x, y;

    Info( LieInfo, 1, "Computing minimal set of generators." );

    E := Elements( DefaultFieldOfMatrixGroup( G )^DimensionOfMatrixGroup( G ));

    gens := GeneratorsOfGroup( G );

    newgens := List( gens, x->PermList( List( E, y->Position( E, y*x ))));

    PG := Group( newgens );

    f := GroupHomomorphismByImagesNC( PG, G, newgens, gens );


    if IsSolvable( PG ) then
        min := List( MinimalGeneratingSet( PG ), x->x^f );
    else
Info( LieInfo, 1, "G not soluble... Trying random search." );
        repeat
            x := Random( PG );
            y := Random( PG );
        until Group( x, y ) = PG;
        min := [x^f,y^f];
    fi;


    Info( LieInfo, 1, "Min gen set found with ", Length( min ), " generators." );

    return Group( min );
end );

#############################################################################
##
#F ReduceGenSet2( <G> )
##
##  A different function to do pretty much the same as the previous one.
##  It is used for experimenting.

BindGlobal( "ReduceGenSet2", function( G )
    local i, gens, newgens, length, maxel, newsize, maxsize;

    Info( LieInfo, 1, "Computing small set of generators." );

    gens := [ Random( G )];
    newgens := ShallowCopy( gens );

    repeat
  length := Length( newgens );
  maxsize := 1;
  for i in [1..20] do
             newgens[length+1] := Random( G );
             if Size( Group( newgens )) = Size( G ) then
  Info( LieInfo, 1, "Small gen set found with ", Length( newgens ), " generators." );
  return Group( newgens );
      fi;
      newsize := Size( Group( newgens ));
      if newsize > maxsize then
  maxsize := newsize;
  maxel := newgens[length+1];
      fi;
  od;
  newgens[length+1] := maxel;
    until false;

    Info( LieInfo, 1, "Min gen set found with ", Length( gens ), " generators." );

    return Group( gens );
end );

#############################################################################
##
#F HeadVector( <v> )
##

BindGlobal( "HeadVector", function( v )
    local i;

    for i in [1..Length( v )] do
        if v[i] <> 0*v[1] then
            return i;
        fi;
    od;

    return fail;
end );

#############################################################################
##
#F DefinitionSet( <M>, <N> )
##
##  Returns the set of definitions with respect to a vectorspace M and its
##  subspace N.

BindGlobal( "DefinitionSet", function( M, N )
    local dim, F, R, U, basU, basN, defset, eqset, coeffs, i;

    dim := Length( Basis( M )[1] );

    if Dimension( M ) + Dimension( N ) - Dimension( Intersection( M, N )) <>
       dim then
        Error( "M is not an allowable subgroup" );
    fi;

    F := LeftActingDomain( M );
    R := F^dim;

    U := M;
    basU := ShallowCopy( BasisVectors( Basis( U )));
    basN := Basis( N );
    defset := [];
    eqset := [];

    for i in [1..Length( basN )] do
        if basN[i] in U then
            coeffs := Coefficients( RelativeBasis( Basis( U ), basU ),
                              basN[i] );
            Add( eqset, coeffs{[Dimension( M )+1..Length( coeffs )]});
        else
            Add( defset, basN[i] );
            Add( basU, basN[i] );
            U := Subspace( R, basU, "basis" );
        fi;
    od;

    return rec( defset := defset, eqset := eqset );
end );

#############################################################################
##
#F NrOfAllowablePositions( <comb>, <dim2> )
##
##  Computes the number of allowable positions.

BindGlobal( "NrOfAllowablePositions", function( comb, dim2 )

    return Sum( List( comb, x->dim2-x ))-Sum( [1..Length( comb )-1], x->x );
end );

#############################################################################
##
#F IsAllowablePositions( <comb>, <pos> )
##
##  returns true if <pos> is allowable with respect to <comb>.

BindGlobal( "IsAllowablePosition", function( comb, pos )

    if pos[2] <= comb[pos[1]] or pos[2] in comb then
        return false;
    else
        return true;
    fi;
end );

#############################################################################
##
#F NrsWithDefsets( <dim1>, <dim2>, <dimN>, <p> )
##

BindGlobal( "NrsWithDefsets", function( dim1, dim2, dimN, p )

    local combs, list, comb;

    combs := Combinations( [1..dimN], dim1 );

    list := [];
    for comb in combs do
        Add( list, p^NrOfAllowablePositions( comb, dim2 ));
    od;

    return list;

end );

#############################################################################
##
#F ComputeAllowableInfo( <dim1>, <dim2>, <dimN>, <p> )
##
##  Computes the information that is necessary for the computation of
##  the orbits on the set of allowable subgroups.
##

BindGlobal( "ComputeAllowableInfo", function( dim1, dim2, dimN, p )

    local allowablepositions, list, comb, i, j,
          combinations, nrswithdefsets, nrsofallowablepositions;

    combinations := Combinations( [1..dimN], dim1 );
    nrswithdefsets := NrsWithDefsets( dim1, dim2, dimN, p );

    allowablepositions := [];

    for comb in combinations do
        list := [];
        for i in [1..dim1] do
            for j in [1..dim2] do
                if IsAllowablePosition( comb, [i,j] ) then
                    Add( list, [i,j] );
                fi;
            od;
        od;
        Add( allowablepositions, list );
    od;

    return rec( dim1 := dim1,
                dim2 := dim2,
                p := p,
                combinations := combinations,
                nrswithdefsets := nrswithdefsets,
                nrsofallowablepositions := List( allowablepositions, Length ),
                allowablepositions := allowablepositions );
end );

#############################################################################
##
#F StandardMatrix( <M>, <N> )
##
##  Computes the standard matrix of the subspace <M> with respect to the
##  nucleus <N>.
##

BindGlobal( "StandardMatrix", function( M, N )
    local dim, F, R, Defspace, eqset, gens, imgs, count, basM, theta,
          i, defset, defs;

    basM := Basis( M );
    dim := Length( basM[1] );

    if Dimension( M ) + Dimension( N ) - Dimension( Intersection( M, N )) <>
       dim then
        Error( "M is not an allowable subgroup" );
    fi;

    F := LeftActingDomain( M );
    R := F^dim;

    defset := DefinitionSet( M, N );
    defs := defset.defset;
    Defspace := Subspace( R, defs, "basis" );

    eqset := defset.eqset;

    gens := DifferenceLists( Basis( N ), defs );
    imgs := List( [1..Length( gens )], x -> LinearCombination(
                    RelativeBasis( Basis( Defspace ), defs ), eqset[x] ));

    Append( gens, defs );
    Append( imgs, defs );

    count := 1;
    repeat
        if not basM[count] in Subspace( R, gens ) then
            Add( gens, basM[count] );
        fi;
        count := count + 1;
    until Length( gens ) = dim;

    for i in [1..dim - Length( imgs )] do
        Add( imgs, Zero( R));
    od;

    theta := LeftModuleHomomorphismByImages( R,
                     Subspace( R, Defspace ), gens, imgs );

    return TransposedMat( List( [1..dim], x-> Coefficients( Basis( Defspace ),
                   Basis( R )[x]^theta )));
end );

#############################################################################
##
#F LabelOfMatrix( <M>, <info> )
##
##  Computes the label of the matrix <M>. <info> contains the the information
##  necessary for the computation of the label.
##

BindGlobal( "LabelOfMatrix", function( M, info )
    local p, defset, defsetpos, list, i, j, number, offset;

    p := info.p;
    defset := List( M, x->HeadVector( x ));
    defsetpos := Position( info.combinations, defset );

    list := [];

    for i in info.allowablepositions[defsetpos] do
        Add( list, IntFFE( M[i[1]][i[2]] ));
    od;

    number := 0;
    for i in [0..Length( list )-1] do
        number := number + list[i+1]*p^i;
    od;

    offset := Sum( info.nrswithdefsets{[1..defsetpos-1]});

    return offset + number;
end );

#############################################################################
##
#F MatrixOfLabel( <label>, <info> )
##
##  Computes the matrix of the label <label>. <info> contains the the
##  information necessary for the computation of the matrix.
##

BindGlobal( "MatrixOfLabel", function( label, info )
    local number, defset, positions, entries, i, M, j, count,
          nodefset, sum, nrs, offset, dim1, dim2, p, e, z;

    nrs := info.nrswithdefsets;
    p := info.p; dim1 := info.dim1; dim2 := info.dim2;
    e := Z(p)^0; z := 0*Z(p);


    sum := 0;
    i := 1;
    repeat
        sum := sum + nrs[i];
        i := i+1;
    until sum > label;

    nodefset := i-1;

    defset := info.combinations[nodefset];
    offset := Sum( info.nrswithdefsets{[1..nodefset-1]});
    number := label-offset;

    entries := List( CoefficientsQadic( number, p ),
                       x->x*Z(p)^0 );


    Append( entries, List( [1..info.nrsofallowablepositions[nodefset]-
            Length( entries )], x->0*Z(p)));
    count := 1;


    M := e*NullMat( dim1, dim2 );
    for i in [1..dim1] do
        M[i][defset[i]] := e;
    od;

    count := 1;
    for i in info.allowablepositions[nodefset] do
        M[i[1]][i[2]] := entries[count];
        count := count + 1;
    od;

    return M;
end );

#############################################################################
##
#F PermutationOnAllowableSubgroups( <g>, <info> )
##
##  <g> is a matrix acting on the multiplicator. <g> permutes the allowable
##  subgroups, and this function computes the permutation corresponding to.
##  <g>. <info> contains information necessary for this computation.
##

BindGlobal( "PermutationOnAllowableSubgroups", function( g, info )
    local els, remaining, first, list, lists, i, mat;

    els := [0..Sum( info.nrswithdefsets )-1];

    list := [];

   for i in els do
       mat := MatrixOfLabel( i, info )*g;
       TriangulizeMat( mat );
       mat := LabelOfMatrix( mat, info );
       Add( list, mat );
       if i mod 10000  = 0 then Print( i, "\n" ); fi;
   od;
   return list;
end );

BindGlobal( "AllowableSubgroupByMatrix", function( mat )
    local dim_dom, dim_im, p, domain, image, basis_domain, ims;

    dim_dom := Length( mat[1] );
    dim_im  := Length( mat );
    p := Characteristic( FieldOfMatrixList( [mat] ));
    domain := GF(p)^dim_dom;
    image  := GF(p)^dim_im;
    basis_domain := Basis( domain );
    ims := List( basis_domain, x->mat*x );

    return Kernel( LeftModuleHomomorphismByImages( domain, image,
                   basis_domain, ims ));
end );

#############################################################################
##
#F OrbitsOfAllowableSubgroups( <dim1>, <dim2>, <dimN>, <p>, <G> )
##
##  <dim1> is the dimension of the multiplicator, <dim2> is the stepsize,
##  <dimN> is the dimension of the nucleus, <p> is the prime, <G> is
##  the matrix group that correspond to the action of Aut L on the
##  multiplicator. Returns the orbits on the allowable subgroups.
##

BindGlobal( "OrbitsOfAllowableSubgroups", function( dim1, dim2, dimN, p, G )
    local positions, els, act, info, orbs, gens, p_gens, PG, f, stabs;


    info := ComputeAllowableInfo( dim1, dim2, dimN, p );

    els :=  [0..Sum( info.nrswithdefsets )-1];

    Info( LieInfo, 1, "Degree of action: ", Length( els ));

    act := function( l, g )
        local y, x;


        x := MatrixOfLabel( l, info );
        y := x*TransposedMat( g );
        TriangulizeMat( y );

        return LabelOfMatrix( y, info );
    end;

    if FIND_MIN_GEN_SET then
        G := ReduceGenSet2( G );
    fi;

    orbs := OrbitsDomain( G, els, act );

    return List( orbs, x -> AllowableSubgroupByMatrix(
                   MatrixOfLabel( x[1], info )));
end );

#############################################################################
##
#F LabelOfDescendant( <L>, <K> )
##
##  <K> must be a descendant of <L>. Computes the label of the standard
##  matrix that correspond to <K>. Only used for testing and experimenting.
##

BindGlobal( "LabelOfDescendant", function( L, K )
    local C, d, M, N, p, V, f, bK, bN, posN, order, trans, mat, info;

    C := LieCover( L );

    d := MinimalGeneratorNumber( L );

    M := LieMultiplicator( C );
    N := LieNucleus( C );

    p := Characteristic( LeftActingDomain( L ));
    V := GF( p )^Dimension( M );

    f := AlgebraHomomorphismByImagesNC( C, K, NilpotentBasis( C ){[1..d]},
                 NilpotentBasis( K ){[1..d]});
    K := Kernel( f );

    bK := List( Basis( K ), x->Coefficients( Basis( M ), x ));
    bN := List( Basis( N ), x->Coefficients( Basis( M ), x ));



    posN := List( Basis( M ), x -> x in N );
    order := [1..Dimension( V )];
    SortParallel( posN, order );
    trans := PermutationMat( PermList( order )^-1, Dimension( V ), GF(p));

    mat := StandardMatrix( Subspace( V, bK*trans ), Subspace( V, bN*trans ));
    info := ComputeAllowableInfo( Dimension( M ) - Dimension( K ),
                    Dimension( M ), Dimension( N ), p );

    return LabelOfMatrix( mat, info );

end );

#############################################################################
##
#F OrbitOfDescendant( <L>, <K> )
##
##  <K> must be a descendant of <L>. Computes the labels
##  of the the standard matrices that correspond to
##  the orbit of <K>. Only used for testing and experimenting.
##

BindGlobal( "OrbitOfDescendant", function( L, K )
    local C, d, M, N, p, V, f, bK, bN, posN, order, trans,
          mat, info, label, act, G, gens, i, A, x, y;

    label := LabelOfDescendant( L, K );
    A := AutomorphismGroupOfNilpotentLieAlgebra( L );
    gens := [];

    C := LieCover( L );
    M := LieMultiplicator( C );
    N := LieNucleus( C );
    p := Characteristic( LeftActingDomain( L ));

    for i in A.glAutos do
        LinearActionOnMultiplicator( i );
        Add( gens, i!.mat );
    od;
    for i in A.agAutos do
        LinearActionOnMultiplicator( i );
        Add( gens, i!.mat );
    od;

    V := GF(p)^Dimension( M );
    posN := List( Basis( M ), x -> x in N );
    order := [1..Dimension( V )];
    SortParallel( posN, order );
    trans := PermutationMat( PermList( order )^-1, Dimension( V ), GF(p));

    G := Group( List( gens, x->x^trans ));
    info := ComputeAllowableInfo( Dimension( K ) - Dimension( L ),
                    Dimension( M ), Dimension( N ), p );

    #G := ReduceGenSet( G );

    act := function( l, g )
        local y, x;


        x := MatrixOfLabel( l, info );
        y := x*TransposedMat( g );
        TriangulizeMat( y );

        return LabelOfMatrix( y, info );
    end;

    return Orbit( G, label, act );

end );

#############################################################################
##
#F SameOrbitOfDescendant( <L>, <K1>, <K2> )
##
##  <K1> and <K2> must be descendants of <L>. Returns true of the labels of
##  <K1> and <K2> are in the same orbit under Aut L. Only used for testing
##  and experimenting.
##

BindGlobal( "SameOrbitOfDescendant", function( L, K1, K2 )
    local C, d, M, N, p, V, f, bK, bN, posN, order, trans,
          mat, info, label1, label2, act, G, gens, i, A, x, y;

    label1 := LabelOfDescendant( L, K1 );
    label2 := LabelOfDescendant( L, K2 );
    A := AutomorphismGroupOfNilpotentLieAlgebra( L );
    gens := [];

    C := LieCover( L );
    M := LieMultiplicator( C );
    N := LieNucleus( C );
    p := Characteristic( LeftActingDomain( L ));

    for i in A.glAutos do
        LinearActionOnMultiplicator( i );
        Add( gens, i!.mat );
    od;
    for i in A.agAutos do
        LinearActionOnMultiplicator( i );
        Add( gens, i!.mat );
    od;

    V := GF(p)^Dimension( M );
    posN := List( Basis( M ), x -> x in N );
    order := [1..Dimension( V )];
    SortParallel( posN, order );
    trans := PermutationMat( PermList( order )^-1, Dimension( V ), GF(p));

    G := Group( List( gens, x->x^trans ));
    info := ComputeAllowableInfo( Dimension( K1 ) - Dimension( L ),
                    Dimension( M ), Dimension( N ), p );


    G := ReduceGenSet2( G );

    act := function( l, g )
        local y, x;


        x := MatrixOfLabel( l, info );
        y := x*TransposedMat( g );
        TriangulizeMat( y );

        return LabelOfMatrix( y, info );
    end;

    return RepresentativeAction( G, label1, label2, act );


end );

Quelle allowable.gi Sprache: unbekannt

[ Dauer der Verarbeitung: 0.38 Sekunden (vorverarbeitet) ]