gap-table-of-marks 1r2p5-2 / usr / share / gap / pkg / tomlib / gap / tmadmin.tmi

#############################################################################
##
#W  tmadmin.tmi         GAP table of marks library           Thomas Merkwitz
##
#H  @(#)$Id: tmadmin.tmi,v 1.10 2008/01/08 10:48:38 gap Exp $
##
#Y  Copyright (C)  1997,  Lehrstuhl D fuer Mathematik,  RWTH Aachen,  Germany
##
##  This file contains the implementation part of all functions to
##  handle the table of marks library
##
Revision.( "tomlib/gap/tmadmin_tmi" ) :=
    "@(#)$Id: tmadmin.tmi,v 1.10 2008/01/08 10:48:38 gap Exp $";


#############################################################################
##
#F  ReadTom( <name> ) . . . . . . . . . . . . . . . . . tables of marks files
##
##  This function is used to read data files of the tables of marks library.
##
BindGlobal( "ReadTom",
    name -> ReadPackage( "tomlib", Concatenation( "data/", name ) ) );


#############################################################################
##
#V  LIBTOMLIST
##
##  <Ref Var="LIBTOMLIST"/> provides all necessary information about the
##  library of table of marks.
##  It is a record with the following components.
##  <P/>
##  <List>
##  <Mark><C>files</C></Mark>
##  <Item>
##     list of data filenames, relative to the directory
##     <F>pkg/tomlib/data</F> and without the suffix <C>.tom</C>,
##  </Item>
##  <Mark><C>namelist</C></Mark>
##  <Item>
##     list whose <M>i</M>-th entry corresponds to the <M>i</M>-th entry
##     of the <C>files</C> component and is itself a list of identifier
##     information about the tables of marks stored in this file;
##     for each table of marks, the list of admissible identifiers is stored,
##     with first entry the identifier that is used in the data file;
##     note that some tables may be not actually installed, see the component
##     <C>noninstalled</C> below,
##  </Item>
##  <Mark><C>names</C></Mark>
##  <Item>
##     list of admissible identifiers of tables of marks that are stored
##     in files that are actually available,
##  </Item>
##  <Mark><C>noninstalled</C></Mark>
##  <Item>
##     list of admissible identifiers of tables of marks that are stored
##     in files that are not available,
##  </Item>
##  <Mark><C>positions</C></Mark>
##  <Item>
##     list of pairs, the value <M>[ i, j ]</M> at position <M>k</M> means
##     that the table of marks with admissible identifier the <M>k</M>-th
##     entry of the <C>names</C> component is the <M>j</M>-th table in the
##     <M>i</M>-th data file,
##  </Item>
##  <Mark><C>fusions</C></Mark>
##  <Item>
##     list whose <M>i</M>-th entry corresponds to the <M>i</M>-th entry
##     of the <C>files</C> component and is itself a list of fusion
##     information about the tables of marks stored in this file;
##     for each table of marks,
##     the list of pairs <C>[ <A>id</A>, <A>nr</A> ]</C> is stored,
##     where <A>id</A> is the identifiers of a table of marks of a subgroup
##     such that the fusion into the current table of marks is known
##     (in the sense of a calls of <Ref Func="ALFT"/>),
##     and <A>nr</A> is the number of the class of these subgroups in the
##     current table of marks.
##  </Item>
##  <List>
##  <P/>
##  The record is stored in the file <F>data/tmprimar.tom</F>.
##  The function <C>MakeLIBTOMLIST</C> creates its final version at runtime.
##
DeclareAutoreadableVariables( "tomlib", "data/tmprimar.tom",
    [ "LIBTOMLIST" ] );


#############################################################################
##
#F  IsNameOfNoninstalledTableOfMarks( <string> )
##
BindGlobal( "IsNameOfNoninstalledTableOfMarks", function( string )
    if LowercaseString( string ) in LIBTOMLIST.noninstalled then
      Info( InfoTom, 1,
            "The table of marks for ", string , " is not installed",
            " on your system!" );
      return true;
    fi;
    return false;
    end );


#############################################################################
##
#F  MakeLIBTOMLIST
##
##  adds additional components to LIBTOMLIST to make things easier.
##
InstallGlobalFunction( MakeLIBTOMLIST, function()
    local name, i, j, dir, nonexisting;

    # Check which files exist and are readable.
    dir:= DirectoriesPackageLibrary( "tomlib", "data" );
    nonexisting:= [];
    for i in [ 1 .. Length( LIBTOMLIST.files ) ] do
      name:= Filename( dir, Concatenation( LIBTOMLIST.files[i], ".tom" ) );
      if name = fail or IsReadableFile( name ) <> true then
        Add( nonexisting, i );
      fi;
    od;

    LIBTOMLIST.names:=[];
    if not IsBound(LIBTOMLIST.noninstalled) then
        LIBTOMLIST.noninstalled := [];
    fi;
    LIBTOMLIST.positions:=[];

    for i in [1..Length(LIBTOMLIST.namelist)] do
        for j in [1..Length(LIBTOMLIST.namelist[i])] do
            for name in LIBTOMLIST.namelist[i][j] do
                if i in nonexisting then
                    Add( LIBTOMLIST.noninstalled , name );
#T Better turn names to lower case here,
#T instead of expecting that the lower case version is in the list!
                else
                    Add(LIBTOMLIST.positions,[i,j]);
                    Add(LIBTOMLIST.names,name);
                fi;
            od;
        od;
    od;

    LIBTOMLIST.namelist{ nonexisting } := List( nonexisting, x -> [] );
    LIBTOMLIST.fusions{ nonexisting }  := List( nonexisting, x -> [] );
end );


#############################################################################
##
#F  TableOfMarksFromLibrary( <string> )
##
InstallGlobalFunction( TableOfMarksFromLibrary, function( string )
    local pos, name, file, number, filenumber;

    # first get the correct file
    name:=LowercaseString(string);
    pos:=Position(LIBTOMLIST.names,name);
    if pos = fail then
      if IsNameOfNoninstalledTableOfMarks( string ) then
        return fail;
      else
        Info( InfoTom, 1,
              "no table of marks with name ", string, " found" );
        return fail;
      fi;
    fi;

    filenumber:=LIBTOMLIST.positions[pos][1];
    file:=LIBTOMLIST.files[filenumber];
    number:=LIBTOMLIST.positions[pos][2];

    # is it necessary to read a new file?
    if not IsBound(LIBTOMKNOWN.(file)) or LIBTOMKNOWN.LOADSTATUS.(file)[1] =
                                      "unloaded" then
      # change the loadstatus of the files and remove one if necessary
      # and allowed
      if  LIBTOMKNOWN.UNLOAD then
        # find the oldest file which is not userloaded and remove it
        for name in RecNames(LIBTOMKNOWN.LOADSTATUS) do
          LIBTOMKNOWN.LOADSTATUS.(name)[2]:=
                            LIBTOMKNOWN.LOADSTATUS.(name)[2]-1;
          if LIBTOMKNOWN.LOADSTATUS.(name)[2] = 0 then
            LIBTOMKNOWN.(name):=rec();
            LIBTOMKNOWN.LOADSTATUS.(name)[1]:="unloaded";
          fi;
        od;
      fi;

      # read it
      ReadTom( Concatenation( file, ".tom" ) );
#T get rid of ReadTom?

      # reset the load status
      if LIBTOMKNOWN.UNLOAD then
        LIBTOMKNOWN.LOADSTATUS.(file):=["loaded",LIBTOMKNOWN.MAX];
      fi;
    fi;

    return LIBTOMKNOWN.(file)[number];
    end );


#############################################################################
##
#F  ConvertToLibTom( <record> )
##
InstallGlobalFunction( ConvertToLibTom, function( record )
    local   names;
    
    names:= RecNames( record );
    ConvertToTableOfMarks( record );
    
    # StandardGeneratorsInfo is not listed in TableOfMarksComponents
    if "StandardGeneratorsInfo" in names then
        Setter( StandardGeneratorsInfo )( record,
                record!.( "StandardGeneratorsInfo" ) );
    fi;
    
    SetFilterObj( record, IsLibTomRep );
    return record;
end );


#############################################################################
##
#F  SetActualLibFileName( <string> )
##
InstallGlobalFunction( SetActualLibFileName, function( file )
    LIBTOMKNOWN.(file):= [];
    LIBTOMKNOWN.ACTUAL:= file;
    LIBTOMKNOWN.LOADSTATUS.(file):= [ "userloaded", 0 ];
end );

#############################################################################
##
#F  LIBTOM( <arg> )
##
MakeReadWriteGlobal( "LIBTOM" );
UnbindGlobal( "LIBTOM" );
DeclareGlobalFunction( "LIBTOM" );

InstallGlobalFunction( LIBTOM, function( arg )
    local record, entry, nrgens, i, name;

    # Make the components.
    record:= rec( Identifier                  := arg[1],
                  SubsTom                     := arg[2],
                  MarksTom                    := arg[3],
                  NrSubsTom                   := arg[4],
                  OrdersTom                   := arg[5],
                  NormalizersTom              := arg[6],
                  DerivedSubgroupsTomUnique   := arg[7],
                  UnderlyingGroup             := arg[8],
                  StraightLineProgramsTom     := arg[9] );

    if Length( arg ) = 11 then
      record.GeneratorsSubgroupsTom:= [ arg[10], arg[11] ];
    fi;

    if IsList( record.UnderlyingGroup ) then

      # Store the underlying group if it is known.
      record.UnderlyingGroup:= GroupWithGenerators( record.UnderlyingGroup );

      # If standard generators are known then store them in the table.
      for entry in LIBTOMKNOWN.STDGEN do
        if record.Identifier = entry[1] then
          record.StandardGeneratorsInfo:= [ rec(
              generators  := entry[3],
              description := entry[4],
              script      := ScriptFromString( entry[4] ),
              ATLAS       := ( entry[2] <> "N" ) ) ];
          if IsInt( entry[2] ) then
            record.StandardGeneratorsInfo[1].standardization:= entry[2];
          fi;
          if 4 < Length( entry ) then
            # Store two straight line programs for standardizing.
            record.StandardGeneratorsInfo[1].ATLASFromTom:= CallFuncList(
                StraightLineProgram, entry[5] );
            record.StandardGeneratorsInfo[1].TomFromATLAS:= CallFuncList(
                StraightLineProgram, entry[6] );
          fi;
          break;
        fi;
      od;

    fi;

    # Construct the straight line programs.
    if record.StraightLineProgramsTom <> 0 then
      nrgens:= Length( GeneratorsOfGroup( record.UnderlyingGroup ) );
      for i in [ 1 .. Length( record.StraightLineProgramsTom ) ] do
        if arg[9][i] = [[[]]] then
          # special case for the trivial subgroup
          record.StraightLineProgramsTom[i]:=
              StraightLineProgram( [[]], nrgens );
        else
          record.StraightLineProgramsTom[i]:= List( arg[9][i],
              x -> StraightLineProgram( x, nrgens ) );
        fi;
      od;
    fi;

    # Remove superfluous components.
    for name in RecNames( record ) do
      if record.( name ) = 0 then
        Unbind( record.( name ) );
      fi;
    od;

    # Make the table of marks object.
    record:= ConvertToLibTom( record );

    # Set some attribute values.
    SetSize( UnderlyingGroup( record ),
             OrdersTom( record )[ Length( OrdersTom( record ) ) ] );
    SetTableOfMarks( UnderlyingGroup( record ), record );

    Add( LIBTOMKNOWN.( LIBTOMKNOWN.ACTUAL ), record );
end );


#############################################################################
##
#F  ACLT( <name>, <component>, <value> )
##
InstallGlobalFunction( ACLT, function( name, component, value )
    local pos, tom, nrgens, newvalue, i;

    # Get the table of marks with name <name>.
    pos:= Position( LIBTOMLIST.names, name );
    if pos = fail then
      Error( "no table of marks with name ", name, " known" );
    fi;
    pos:= LIBTOMLIST.positions[ pos ][2];
    tom:= LIBTOMKNOWN.( LIBTOMKNOWN.ACTUAL )[ pos ];

    # Handle special components.
    if component = "sortperm" then
#T what is this `sortperm' really good for??
      return;
    elif component = "otherwords" then
      nrgens:= Length( GeneratorsOfGroup( tom!.UnderlyingGroup ) );
      newvalue:= [];
      for i in [ 1 .. Length( value ) ] do
        if IsBound( value[i] ) then
          newvalue[i]:= List( value[i],
                              x -> StraightLineProgram( x, nrgens ) );
        fi;
      od;
      value:= newvalue;
    fi;

    # Set the additional component.
    tom!.( component ):= value;
end );


#############################################################################
##
#F  AFLT( <source>, <destination>, <fusion> )
##
InstallGlobalFunction( AFLT, function( source, destination, fusion )
    local pos, fus, tom;

    # get the table of marks with name <source>
    pos:=Position(LIBTOMLIST.names,source);
    if pos = fail then
         Error("no table of marks with name ",source," known\n");
    fi;
    if LIBTOMKNOWN.ACTUAL <> LIBTOMLIST.files[LIBTOMLIST.positions[pos][1]] then
         Error("source \"",source,"\" is not stored in file ",
                          Concatenation(LIBTOMKNOWN.ACTUAL,".tom"));
    fi;
    pos:=LIBTOMLIST.positions[pos][2];
    tom:=LIBTOMKNOWN.(LIBTOMKNOWN.ACTUAL)[pos];

    # do some tests
    for fus in FusionsTom(tom) do
        if fus = [destination,fusion] then
             return;
        elif fus[1]  = destination and fus[2][Length(fus[2])] =
                      fusion[Length(fusion)] then
             Error("there is already another fusion from \"",source,
                   "\" to \"",destination,"\" stored on \"",source,"\"\n");
        fi;
    od;

    # add the fusion
    Add(FusionsTom(LIBTOMKNOWN.(LIBTOMKNOWN.ACTUAL)[pos]),
           [destination,fusion]);
end );


#############################################################################
##
#F  AllLibTomNames()
##
InstallGlobalFunction( AllLibTomNames, function()
    local result, file;

    result:=[];
    for file in LIBTOMLIST.namelist do
        Append(result,List(file,x->x[1]));
    od;
    return result;
end );


#############################################################################
##
#F  NamesLibTom( <tom> )
#F  NamesLibTom( <string> )
##
InstallMethod( NamesLibTom,
    [ IsTableOfMarks and IsLibTomRep ],
    x -> NamesLibTom( Identifier( x ) ) );

InstallMethod( NamesLibTom,
    [ IsString ],
    function( string )
    local pos;

    if IsNameOfNoninstalledTableOfMarks( string ) then
      return fail;
    fi;
    pos:=Position(LIBTOMLIST.names,LowercaseString(string));
    if pos = fail then
      Info( InfoTom, 1,
            "no library table of marks whith name \"", string, "\" found" );
      return fail;
    else
      pos:= LIBTOMLIST.positions[ pos ];
      return LIBTOMLIST.namelist[ pos[1] ][ pos[2] ];
    fi;
    end );


#############################################################################
##
#M  NotifiedFusionsOfLibTom( <tom> )
#M  NotifiedFusionsOfLibTom( <string> )
#M  FusionsOfLibTom( <tom> )
#M  FusionsOfLibTom( <string> )
##
InstallMethod( FusionsOfLibTom,
    [ IsTableOfMarks and IsLibTomRep ],
    tom -> Filtered( FusionsTom( tom ),
                     x -> not x[1] in LIBTOMLIST.noninstalled ) );

InstallMethod( FusionsOfLibTom,
    [ IsString ],
    function(string)
    local tom;
    tom:=TableOfMarks(string);
    if tom = fail then
       return fail;
    else
       return Filtered( FusionsTom(tom),
                  x-> not x[1] in LIBTOMLIST.noninstalled);
    fi;
end );

InstallMethod( NotifiedFusionsOfLibTom,
    [ IsTableOfMarks and IsLibTomRep ],
    tom -> List( Filtered( FusionsTom( tom ),
                           x -> not x[1] in LIBTOMLIST.noninstalled ),
                 x -> [ x[1], x[2][ Length( x[2] ) ] ] ) );

InstallMethod( NotifiedFusionsOfLibTom,
    [ IsString ],
    function( string )
    local result, i, j, f;

    if IsNameOfNoninstalledTableOfMarks( string ) then
      return fail;
    elif not LowercaseString(string) in LIBTOMLIST.names then
      Info( InfoTom, 1,
            "no library table of marks with name \"", string, "\" found" );
      return fail;
    fi;

    result:= [];
    for i in [ 1 .. Length( LIBTOMLIST.namelist ) ] do
      for j in [ 1 .. Length( LIBTOMLIST.namelist[i] ) ] do
        for f in LIBTOMLIST.fusions[i][j] do
          if LowercaseString( f[1] ) in NamesLibTom( string ) then
            Add( result, [ LIBTOMLIST.namelist[i][j][1], f[2] ] );
          fi;
        od;
      od;
    od;
    return result;
    end );


#############################################################################
##
#M  NotifiedFusionsToLibTom( <tom> )
#M  NotifiedFusionsToLibTom( <string> )
#M  FusionsToLibTom( <tom> )
#M  FusionsToLibTom( <string> )
##
InstallMethod( FusionsToLibTom,
    [ IsTableOfMarks and IsLibTomRep ],
    x -> FusionsToLibTom( Identifier( x ) ) );

InstallMethod( FusionsToLibTom,
    [ IsString ],
    function(string)
    local result, tom, f, fus, fusions;

    if IsNameOfNoninstalledTableOfMarks( string ) then
      return fail;
    elif not LowercaseString(string) in LIBTOMLIST.names then
      Info( InfoTom, 1,
            "no library table of marks with name \"", string, "\" found" );
      return fail;
    fi;

    result:=[];
    fusions:=NotifiedFusionsToLibTom(string);

    # get the fusion maps
    for fus in fusions do
      tom:=TableOfMarks(fus[1]);
      for f in FusionsTom(tom) do
        if f[1] in NamesLibTom(string) and f[2][Length(f[2])] = fus[2] then
           Add(result,[fus[1],f[2]]);
        fi;
      od;
    od;

    return result;
    end );

InstallMethod( NotifiedFusionsToLibTom,
    [ IsTableOfMarks and IsLibTomRep ],
    x -> NotifiedFusionsToLibTom( Identifier( x ) ) );

InstallMethod( NotifiedFusionsToLibTom,
    [ IsString ],
    function( string )
    local pos;

    if IsNameOfNoninstalledTableOfMarks( string ) then
      return fail;
    fi;
    pos:=Position(LIBTOMLIST.names,LowercaseString(string));
    if pos = fail then
      Info( InfoTom, 1,
            "no library table of marks with name \"", string, "\" found" );
      return fail;
    fi;

    pos:=LIBTOMLIST.positions[pos];
    return Filtered(LIBTOMLIST.fusions[pos[1]][pos[2]], x-> not x[1] in
                     LIBTOMLIST.noninstalled );
end );


#############################################################################
##
#F  UnloadTableOfMarksData()
##
InstallGlobalFunction( UnloadTableOfMarksData, function()
    local name;

    for name in RecNames( LIBTOMKNOWN.LOADSTATUS ) do
      Unbind( LIBTOMKNOWN.LOADSTATUS.( name ) );
      Unbind( LIBTOMKNOWN.( name ) );
    od;
    end );


#############################################################################
##
#E