Quellcode-Bibliothek straight.gi Sprache: unbekannt

#############################################################################
##
##  This file is part of GAP, a system for computational discrete algebra.
##  This file's authors include Thomas Breuer, Alexander Hulpke, Max Neunhöffer.
##
##  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 implementations of methods and functions
##  for straight line programs.
##
##  1. Functions for straight line programs
##  2. Functions for elements represented by straight line programs
##

#############################################################################
##
##  1. Functions for straight line programs
##

#############################################################################
##
#V  StraightLineProgramsFamily
#V  StraightLineProgramsDefaultType
##
BindGlobal( "StraightLineProgramsFamily",
    NewFamily( "StraightLineProgramsFamily", IsStraightLineProgram ) );

BindGlobal( "StraightLineProgramsDefaultType",
    NewType( StraightLineProgramsFamily,
             IsStraightLineProgram and IsAttributeStoringRep
                                   and HasLinesOfStraightLineProgram ) );

#############################################################################
##
#F  StraightLineProgram( <lines>[, <nrgens>] )
#F  StraightLineProgram( <string>, <gens> )
#F  StraightLineProgramNC( <lines>[, <nrgens>] )
#F  StraightLineProgramNC( <string>, <gens> )
##
InstallGlobalFunction( StraightLineProgram, function( arg )
    local result;
    result:= CallFuncList( StraightLineProgramNC, arg );
    if     not IsStraightLineProgram( result )
       or not IsInternallyConsistent( result ) then
      result:= fail;
    fi;
    return result;
end );

InstallGlobalFunction( StraightLineProgramNC, function( arg )

    local lines, nrgens, prog;

    # Get the arguments.
    if   Length( arg ) = 1 and not IsString( arg[1] ) then
      lines  := arg[1];
    elif Length( arg ) = 2 and IsString( arg[1] )
                           and IsList( arg[2] ) then
      lines:= [];
      if not StringToStraightLineProgram( arg[1], arg[2], lines ) then
        return fail;
      fi;
      nrgens:= Length( arg[2] );
    elif Length( arg ) = 2 then
      lines  := arg[1];
      nrgens := arg[2];
    else
      Error( "usage: StraightLineProgramNC( <lines>[, <nrgens>] )" );
    fi;

    prog:= rec();
    ObjectifyWithAttributes( prog, StraightLineProgramsDefaultType,
                             LinesOfStraightLineProgram, lines );
    if IsBound( nrgens ) and IsPosInt( nrgens ) then
      SetNrInputsOfStraightLineProgram( prog, nrgens );
    fi;

    return prog;
end );

#############################################################################
##
#F  StringToStraightLineProgram( <string>, <gens>, <script> )
##
InstallGlobalFunction( StringToStraightLineProgram,
    function( string, gens, script )
    local pos,
          extrep,
          len,
          ppos,
          exp,
          sign,
          slen,
          open,
          i, j;

    # If the string contains `*' signs then remove them.
    if '*' in string then
      string:= Filtered( string, char -> char <> '*' );
    fi;

    # Split the string according to brackets `(' and `)'
    pos:= Position( string, '(' );
    if pos = fail then

      # Simply create a word.
      extrep:= [];
      while not IsEmpty( string ) do
        len:= Length( string );
        pos:= First( [ 1 .. len ], i -> string{ [ 1 .. i ] } in gens );
        if pos = fail then return false; fi;
        ppos:= Position( gens, string{ [ 1 .. pos ] } );
        pos:= pos + 1;
        if pos < len and string[ pos ] = '^' then
          exp:= 0;
          sign:= 1;
          pos:= pos + 1;
          if pos <=len and string[ pos ] = '-' then
            sign:= -1;
            pos:= pos + 1;
          fi;
          while pos <= len and IsDigitChar( string[ pos ] ) do
            exp:= 10 * exp + Position( "0123456789", string[ pos ] ) - 1;
            pos:= pos + 1;
          od;
          exp:= sign * exp;
        else
          exp:= 1;
        fi;
        Append( extrep, [ ppos, exp ] );
        string:= string{ [ pos .. len ] };
      od;

      if not IsEmpty( extrep ) then
        Add( script, [ extrep, Length( script ) + Length( gens ) + 1 ] );
      fi;
      return true;

    elif 1 < pos then

      # Split before the bracket.
      if not StringToStraightLineProgram(
                 string{ [ 1 .. pos-1 ] }, gens, script ) then
        return false;
      fi;
      j:= Length( script ) + Length( gens );
      if not StringToStraightLineProgram(
                 string{ [ pos .. Length( string ) ] }, gens, script ) then
        return false;
      fi;
      slen:= Length( script ) + Length( gens );
      if j < slen then
        Add( script, [ [ j, 1, slen, 1 ], slen + 1 ] );
      fi;
      return true;

    else

      # Find the corresponding closing bracket.
      open:= 0;
      len:= Length( string );
      for i in [ 2 .. len ] do
        if string[i] = '(' then
          open:= open+1;
        elif string[i] = ')' then
          if 0 < open then
            open:= open-1;
          else

            # The bracket may be powered or be multiplied.
            if i+1 < len and string[ i+1 ] = '^' then

              exp:= 0;
              j:= i+2;
              sign:= 1;
              if string[j] = '-' then
                sign:= -1;
                j:= j+1;
              fi;
              while j <= len and IsDigitChar( string[j] ) do
                exp:= 10 * exp + Position( "0123456789", string[j] ) - 1;
                j:= j + 1;
              od;
              if not StringToStraightLineProgram(
                         string{ [ 2 .. i-1 ] }, gens, script ) then
                return false;
              fi;
              slen:= Length( script ) + Length( gens ) + 1;
              Add( script, [ [ slen - 1, sign * exp ], slen ] );
              if j <= len then
                if not StringToStraightLineProgram(
                           string{ [ j .. len ] }, gens, script ) then
                  return false;
                fi;
                j:= Length( script ) + Length( gens );
                Add( script, [ [ slen, 1, j, 1 ], j + 1 ] );
              fi;

            else

              if not StringToStraightLineProgram(
                         string{ [ 2 .. i-1 ] }, gens, script ) then
                return false;
              fi;
              j:= Length( script ) + Length( gens );
              if not StringToStraightLineProgram(
                         string{ [ i+1 .. len ] }, gens, script ) then
                return false;
              fi;
              slen:= Length( script ) + Length( gens );
              if j < slen then
                Add( script, [ [ j, 1, slen, 1 ], slen + 1 ] );
              fi;
            fi;
            return true;

          fi;
        fi;
      od;
      return false;

    fi;
end );

#############################################################################
##
#M  NrInputsOfStraightLineProgram( <prog> )
##
##  If no lines of type 1. occur then the number of generators can be
##  read off from the lines;
##  it is equal to the maximum of positions such that in a step of the
##  program the entry is accessed but the position has not been assigned
##  before.
##
InstallMethod( NrInputsOfStraightLineProgram,
    "for a straight line program",
    [ IsStraightLineProgram ],
    function( prog )

    local defined,    # list of currently assigned positions
          maxinput,   # current maximum of input needed
          lines,      # lines of `prog'
          len,        # length of `lines'
          adjust,     # local function to  increase the number
          line,       # one line of the program
          i, j;       # loop over the lines

    defined:= [];
    maxinput:= 0;
    lines:= LinesOfStraightLineProgram( prog );
    len:= Length( lines );

    adjust:= function( line )
      local needed;
      needed:= Difference( line{ [ 1, 3 .. Length( line ) - 1 ] },
                           defined );
      if not IsEmpty( needed ) then
        needed:= MaximumList( needed );
        if maxinput < needed then
          maxinput:= needed;
        fi;
      fi;
    end;

    # Inspect the lines.
    for i in [ 1 .. len ] do

      line:= lines[i];
      if ForAll( line, IsInt ) then

        if i = len then
          adjust( line );
        else
          Error( "<prog> contains a line of kind 1." );
        fi;

      elif Length( line ) = 2 and IsInt( line[2] ) then

        adjust( line[1] );
        AddSet( defined, line[2] );

      elif i = len and ForAll( line, IsList ) then

        for j in line do
          adjust( j );
        od;

      fi;

    od;

    return maxinput;
end );

#############################################################################
##
#M  ResultOfStraightLineProgram( <prog>, <gens> )
##
BindGlobal( "ResultOfLineOfStraightLineProgram",
    function( line, r )

    local new, i;

    new:= r[ line[1] ];
    if line[2] <> 1 then
      new:= new^line[2];
    fi;
    for i in [ 4, 6 .. Length( line ) ] do
      if line[i] = 1 then
        new:= new * r[ line[ i-1 ] ];
      else
        new:= new * r[ line[ i-1 ] ]^line[i];
      fi;
    od;
    return new;
end );

InstallMethod( ResultOfStraightLineProgram,
    "for a straight line program, and a homogeneous list",
    [ IsStraightLineProgram, IsHomogeneousList ],
    function( prog, gens )

    local r,         # list of intermediate results
          respos,    # position of the current intermediate result of `prog'
          line;      # loop over the lines

    # Initialize the list of intermediate results.
    r:= ShallowCopy( gens );
    respos:= false;

    # Loop over the program.
    for line in LinesOfStraightLineProgram( prog ) do

      if   not IsEmpty( line ) and IsInt( line[1] ) then

        # The line describes a word to be appended.
        Add( r, ResultOfLineOfStraightLineProgram( line, r ) );
        respos:= Length( r );

      elif 2 <= Length( line ) and IsInt( line[2] ) then

        # The line describes a word that shall replace.
        r[ line[2] ]:= ResultOfLineOfStraightLineProgram( line[1], r );
        respos:= line[2];

      else

        # The line describes a list of words to be returned.
        return List( line, l -> ResultOfLineOfStraightLineProgram( l, r ) );

      fi;

    od;

    # Return the result.
    return r[ respos ];
    end );

#############################################################################
##
#M  Display( <prog> )
#M  Display( <prog>, <record> )
##
InstallMethod( Display,
    "for a straight line program",
    [ IsStraightLineProgram ],
    function( prog )
    Display( prog, rec() );
    end );

InstallOtherMethod( Display,
    "for a straight line program, and a record",
    [ IsStraightLineProgram, IsRecord ],
    function( prog, record )
    local gensnames,
          listname,
          PrintLine,
          i,
          lines,
          len,
          line,
          j;

    # Get and check the arguments.
    if IsBound( record.gensnames ) then
      gensnames:= record.gensnames;
    else
      gensnames:= List( [ 1 ..  NrInputsOfStraightLineProgram( prog ) ],
                        i -> Concatenation( "g", String( i ) ) );
    fi;
    if IsBound( record.listname ) then
      listname:= record.listname;
    else
      listname:= "r";
    fi;

    PrintLine := function( line )
      local j;
      for j in [ 2, 4 .. Length( line )-2 ] do
        Print( "r[", line[ j-1 ], "]" );
        if line[j] <> 1 then
          Print( "^", line[j] );
        fi;
        Print( "*" );
      od;
      j:= Length( line );
      if 0 < j then
        Print( "r[", line[ j-1 ], "]" );
        if line[j] <> 1 then
          Print( "^", line[j] );
        fi;
      fi;
    end;

    # Print the initialisation.
    Print( "# input:\n" );
    Print( listname, ":= [ " );
    if not IsEmpty( gensnames ) then
      Print( gensnames[1] );
    fi;
    for i in [ 2 .. Length( gensnames ) ] do
      Print( ", ", gensnames[i] );
    od;
    Print( " ];\n" );

    # Loop over the lines.
    lines:= LinesOfStraightLineProgram( prog );
    len:= Length( gensnames );
    Print( "# program:\n" );
    for i in [ 1 .. Length( lines ) ] do

      line:= lines[i];
      if   Length( line ) = 2 and IsList( line[1] )
                              and IsPosInt( line[2] ) then

        Print( "r[", line[2], "]:= " );
        PrintLine( line[1] );
        Print( ";\n" );
        if len < line[2] or i = Length( lines ) then
          len:= line[2];
        fi;

      elif not IsEmpty( line ) and ForAll( line, IsInt ) then

        len:= len + 1;
        Print( "r[", len, "]:= " );
        PrintLine( line );
        Print( ";\n" );

      elif ForAll( line, IsList ) and i = Length( lines ) then

        Print( "# return values:\n[ " );
        len:= Length( line );
        for j in [ 1 .. len - 1 ] do
          PrintLine( line[j] );
          Print( ", " );
        od;
        if 0 < len then
          PrintLine( line[ len ] );
        fi;
        Print( " ]\n" );
        return;

      fi;

    od;

    Print( "# return value:\nr[", len, "]\n" );
    end );

#############################################################################
##
#M  IsInternallyConsistent( <prog> )
##
InstallMethod( IsInternallyConsistent,
    "for a straight line program",
    [ IsStraightLineProgram ],
    function( prog )

    local lines,
          nrgens,
          defined,
          testline,
          len,
          i,
          line;

    lines:= LinesOfStraightLineProgram( prog );
    if not IsList( lines ) or IsEmpty( lines ) then
      return false;
    fi;

    if HasNrInputsOfStraightLineProgram( prog ) then
      nrgens:= NrInputsOfStraightLineProgram( prog );
      defined:= [ 1 .. nrgens ];
    else
      defined:= [];
    fi;

    testline:= function( line )
      local len, gens;

      # The external representation of an associative word has even length,
      len:= Length( line );
      if len mod 2 <> 0 then
        return false;
      fi;

      # and the generator numbers are stored at odd positions.
      gens:= line{ [ 1, 3 .. len-1 ] };
      if not ForAll( gens, IsPosInt ) then
        return false;
      fi;

      # If the number of generators is stored then check
      # that only defined positions are accessed.
      return not IsBound( nrgens ) or IsSubset( defined, gens );
    end;

    len:= Length( lines );
    for i in [ 1 .. len ] do

      line:= lines[i];

      if   not IsList( line ) then

        return false;

      elif not IsEmpty( line ) and ForAll( line, IsInt ) then

        if not testline( line ) or ( i < len and not IsBound( nrgens ) )then
          return false;
        fi;
        AddSet( defined, Length( defined ) + 1 );

      elif Length( line ) = 2 and IsPosInt( line[2] ) then

        if not ( IsList( line[1] ) and ForAll( line[1], IsInt ) ) then
          return false;
        fi;
        if not testline( line[1] ) then
          return false;
        fi;
        AddSet( defined, line[2] );

      elif i = len and ForAll( line, x -> IsList( x )
                                          and ForAll( x, IsInt ) ) then

        return ForAll( line, testline );

      else

        # The syntax of the line is not correct.
        return false;

      fi;

    od;

    return true;
    end );

#############################################################################
##
#M  PrintObj( <prog> )
##
InstallMethod( PrintObj,
    "for a straight line program",
    [ IsStraightLineProgram ],
    function( prog )
    Print( "StraightLineProgram( ",
           LinesOfStraightLineProgram( prog ) );
    if HasNrInputsOfStraightLineProgram( prog ) then
      Print( ", ", NrInputsOfStraightLineProgram( prog ) );
    fi;
    Print( " )" );
    end );

#############################################################################
##
#M  ViewObj( <prog> )
##
InstallMethod( ViewObj,
    "for a straight line program",
    [ IsStraightLineProgram ],
    function( prog )
    Print( "<straight line program>" );
    end );

#############################################################################
##
#F  StringOfResultOfStraightLineProgram( <prog>, <gensnames>[, \"LaTeX\"] )
##
BindGlobal( "StringOfResultOfLineOfStraightLineProgram",
    function( line, r, isatomic, LaTeX )

    local new, i;

    new:= "";
    for i in [ 2, 4 .. Length( line ) ] do
      if line[i] = 1 then
        Append( new, r[ line[ i-1 ] ] );
      else
        if not isatomic[ line[ i-1 ] ] then
          Add( new, '(' );
        fi;
        Append( new, r[ line[ i-1 ] ] );
        if not isatomic[ line[ i-1 ] ] then
          Add( new, ')' );
        fi;
        Add( new, '^' );
        if LaTeX then
          Add( new, '{' );
        fi;
        Append( new, String( line[i] ) );
        if LaTeX then
          Add( new, '}' );
        fi;
      fi;
    od;
    return new;
end );

InstallGlobalFunction( StringOfResultOfStraightLineProgram, function( arg )

    local prog,
          gensnames,
          LaTeX,
          r,
          a,
          respos,
          line,
          result,
          l;

    # Get and check the arguments.
    if   Length( arg ) = 2 and IsStraightLineProgram( arg[1] )
                           and IsList( arg[2] ) then

      prog:= arg[1];
      gensnames:= arg[2];
      LaTeX:= false;

    elif Length( arg ) = 3 and IsStraightLineProgram( arg[1] )
                           and IsList( arg[2] )
                           and IsString( arg[3] )
                           and LowercaseString( arg[3] ) = "latex" then

      prog:= arg[1];
      gensnames:= arg[2];
      LaTeX:= true;

    else
      Error( "usage: StringOfResultOfStraightLineProgram( <prog>, ",
             "<gensnames>[, \"LaTeX\"] )" );
    fi;

    # Initialize the list of intermediate results.
    r:= ShallowCopy( gensnames );
    a:= ListWithIdenticalEntries( Length( r ), true );
    respos:= false;

    # Loop over the program.
    for line in LinesOfStraightLineProgram( prog ) do

      if   not IsEmpty( line ) and IsInt( line[1] ) then

        # The line describes a word to be appended.
        Add( r, StringOfResultOfLineOfStraightLineProgram( line,
                    r, a, LaTeX ) );
        respos:= Length( r );
        a[ respos ]:= false;

      elif 2 <= Length( line ) and IsInt( line[2] ) then

        # The line describes a word that shall replace.
        respos:= line[2];
        r[ respos ]:= StringOfResultOfLineOfStraightLineProgram( line[1],
                          r, a, LaTeX );
        a[ respos ]:= false;

      else

        # The line describes a list of words to be returned.
        result:= "[ ";
        for l in line do
          Append( result,
                  StringOfResultOfLineOfStraightLineProgram( l,
                      r, a, LaTeX ) );
          Append( result, ", " );
        od;
        if not IsEmpty( line ) then
          Remove( result );
          Remove( result );
        fi;
        Append( result, " ]" );
        return result;

      fi;

    od;

    return r[ respos ];
end );

#############################################################################
##
#F  CompositionOfStraightLinePrograms( <prog2>, <prog1> )
##
InstallGlobalFunction( CompositionOfStraightLinePrograms,
    function( prog2, prog1 )

    local lines, len, lastline, inp2, max, i, pos, line;

    lines:= ShallowCopy( LinesOfStraightLineProgram( prog1 ) );
    len:= Length( lines );
    lastline:= lines[ len ];
    inp2:= NrInputsOfStraightLineProgram( prog2 );

    if ForAll( lastline, IsList ) then

      # Check that the programs fit together.
      if inp2 <> Length( lastline ) then
        Error( "outputs of <prog1> incompatible with inputs of <prog2>" );
      fi;

      # The last line is a list of external representations of assoc. words.
      # Copy them first to safe positions, then to the first positions.
      max:= NrInputsOfStraightLineProgram( prog1 );
      for i in [ 1 .. len-1 ] do
        if IsList( lines[i][1] ) then
          max:= Maximum( max, lines[i][2] );
        else
          max:= max + 1;
        fi;
      od;
      Unbind( lines[ len ] );
      pos:= max;
      for i in lastline do
        max:= max + 1;
        Add( lines, [ i, max ] );
      od;
      for i in [ 1 .. Length( lastline ) ] do
        Add( lines, [ [ pos + i, 1 ], i ] );
      od;

    else

      # Check that the programs fit together.
      if inp2 <> 1 then
        Error( "outputs of <prog1> incompatible with inputs of <prog2>" );
      fi;

      if Length( lastline ) = 2 and IsList( lastline[1] ) then

        # The last line is a pair of the external representation of an assoc.
        # word and a positive integer.
        # Copy the word to position 1 if necessary.
        if lastline[2] <> 1 then
          Add( lines, [ [ lastline[2], 1 ], 1 ] );
        fi;

      else

        # The last line is the external representation of an assoc. word.
        # Store it at position 1.
        lines[ Length( lines ) ]:= [ lastline, 1 ];

      fi;

    fi;

    # Append the lines of `prog2'.
    # (Rewrite lines of type 1.)
    max:= inp2;
    for line in LinesOfStraightLineProgram( prog2 ) do
      if ForAll( line, IsList ) then
        Add( lines, line );
      elif ForAll( line, IsInt ) then
        max:= max + 1;
        Add( lines, [ line, max ] );
      else
        max:= Maximum( max, line[2] );
        Add( lines, line );
      fi;
    od;

    # Construct and return the new program.
    return StraightLineProgramNC( lines,
                                  NrInputsOfStraightLineProgram( prog1 ) );
    end );

#############################################################################
##
#F  IntegratedStraightLineProgram( <listofprogs> )
##
##  The idea is to concatenate the lists of lines of the programs in the list
##  <listofprogs> after shifting the positions they refer to.
##  If a program overwrites some of the original generators then we first
##  copy the generators.
##
InstallGlobalFunction( "IntegratedStraightLineProgram",
    function( listofprogs )

    local n,          # number of inputs of all in `listofprogs'
          lines,      # list of lines of the result program
          results,    # results line of the result program
          nextoffset, # maximal position used up to now
          prog,       # loop over `listofprogs'
          proglines,  # list of lines of `prog'
          offset,     # maximal position used before the current program
          shiftgens,  # use a copy of the original generators
          i, line,    # loop over `proglines'
          newline,    # line with shifted source positions
          j;          # loop over the odd positions in `newline'

    # Check the input.
    if    not IsDenseList( listofprogs )
       or IsEmpty( listofprogs )
       or not ForAll( listofprogs, IsStraightLineProgram ) then
      Error( "<listofprogs> must be a nonempty list ",
             "of straight line programs" );
    fi;
    n:= NrInputsOfStraightLineProgram( listofprogs[1] );
    if not ForAll( listofprogs,
                   prog -> NrInputsOfStraightLineProgram( prog ) = n ) then
      Error( "all in <listofprogs> must have the same number of inputs" );
    fi;

    # Initialize the list of lines, the results line, and the offset.
    lines:= [];
    results:= [];
    nextoffset:= n;

    # Loop over the programs, and add the results to `results'.
    for prog in listofprogs do

      proglines:= LinesOfStraightLineProgram( prog );

      # Set the positions used up to here.
      offset:= nextoffset;

      # If necessary protect the original generators from being replaced,
      # and work with a shifted copy.
      shiftgens:= false;
      if ForAny( proglines, line ->     Length( line ) = 2
                                    and IsList( line[1] )
                                    and line[2] in [ 1 .. n ] ) then
        Append( lines, List( [ 1 .. n ], i -> [ [ i, 1 ], i + offset ] ) );
        nextoffset:= offset + n;
        shiftgens:= true;
      else
        offset:= offset - n;
      fi;

      # Loop over the program.
      for i in [ 1 .. Length( proglines ) ] do

        line:= proglines[i];

        if   not IsEmpty( line ) and IsInt( line[1] ) then

          # The line describes a word to be appended.
          # (Increase the positions by `offset'.)
          newline:= ShallowCopy( line );
          for j in [ 1, 3 .. Length( newline )-1 ] do
            if shiftgens or n < newline[j] then
              newline[j]:= newline[j] + offset;
            fi;
          od;
          if i = Length( proglines ) then
            Add( results, newline );
          else
            Add( lines, newline );
            nextoffset:= nextoffset + 1;
          fi;

        elif 2 = Length( line ) and IsInt( line[2] ) then

          # The line describes a word that shall replace.
          # (Increase the positions and the destination by `offset'.)
          newline:= ShallowCopy( line[1] );
          for j in [ 1, 3 .. Length( newline )-1 ] do
            if shiftgens or n < newline[j] then
              newline[j]:= newline[j] + offset;
            fi;
          od;
          if i = Length( proglines ) then
            Add( results, newline );
          else
            newline:= [ newline, line[2] + offset ];
            Add( lines, newline );
            if nextoffset < newline[2] then
              nextoffset:= newline[2];
            fi;
          fi;

        else

          # The line describes a list of words to be returned.
          line:= List( line, ShallowCopy );
          for newline in line do
            for j in [ 1, 3 .. Length( newline )-1 ] do
              if shiftgens or n < newline[j] then
                newline[j]:= newline[j] + offset;
              fi;
            od;
          od;
          Append( results, line );

        fi;

      od;

    od;

    # Add the results line.
    Add( lines, results );

    # Construct and return the new program.
    return StraightLineProgramNC( lines, n );
    end );

#############################################################################
##
##  2. Functions for elements represented by straight line programs
##

#############################################################################
##
#M  StraightLineProgElmType(<fam>)
##
InstallMethod(StraightLineProgElmType,"generic",true,[IsFamily],0,
function(fam)
  return NewType(fam,IsStraightLineProgElm);
end);

#############################################################################
##
#F  StraightLineProgElm(<seed>,<prog>)
##
InstallGlobalFunction(StraightLineProgElm,function(seeds,prog)
local sr;

  if IsRecord(seeds) then
    sr:=seeds;
    seeds:=sr.seeds;
  else
    sr:=rec(seeds:=seeds);
  fi;
  return Objectify(StraightLineProgElmType(FamilyObj(seeds[1])),[sr,prog]);
end);

#############################################################################
##
#F  EvalStraightLineProgElm(<slpel>)
##
InstallGlobalFunction(EvalStraightLineProgElm,function(slp)
  return ResultOfStraightLineProgram(slp![2],slp![1].seeds);
end);

#############################################################################
##
#F  StraightLineProgGens(<gens>)
##
InstallGlobalFunction(StraightLineProgGens,function(arg)
local gens,sgens,seed;
  gens:=arg[1];
  sgens:=Set(gens);
  seed:=rec(seeds:=sgens);
  if Length(arg)>1 and IsList(arg[2]) then
    seed.base:=arg[2];
  fi;
  return List([1..Length(gens)],i->StraightLineProgElm(seed,
     StraightLineProgramNC([[Position(sgens,gens[i]),1]],Length(sgens))));
end);

#############################################################################
##
#M  ViewObj(<slpel>)
##
InstallMethod(ViewObj,"straight line program elements",true,
  [IsStraightLineProgElm],0,
function(slp)
  Print("<");
  ViewObj(LinesOfStraightLineProgram(slp![2]));
  if Sum(LinesOfStraightLineProgram(slp![2]),Length)<50 then
    Print("|");
    ViewObj(EvalStraightLineProgElm(slp));
  fi;
  Print(">");
end);

#############################################################################
##
#M  OneOp(<slpel>)
##
InstallMethod(OneOp,"straight line program elements",true,
  [IsStraightLineProgElm],0,
function(slp)
  return One(FamilyObj(slp));
end);

#############################################################################
##
#M  InverseOp(<slpel>)
##
BindGlobal( "InverseSLPElm", function(slp)
local l,n;
  l:=LinesOfStraightLineProgram(slp![2]);
  l:=ShallowCopy(l);
  n:=Length(l);
  # invert last
  l[n]:=ERepAssWorInv(l[n]);

  return StraightLineProgElm(slp![1],
           StraightLineProgramNC(l,Length(slp![1].seeds)));
end );

# words in fp elements have separate methods for `Inverse' and `InverseOp'
# -- so we must duplicate the installation here as well
InstallMethod(Inverse,"straight line program elements",true,
  [IsStraightLineProgElm],0,InverseSLPElm);

InstallMethod(InverseOp,"straight line program elements",true,
  [IsStraightLineProgElm],0,InverseSLPElm);

#############################################################################
##
#M  Order(<slpel>)
##
InstallMethod(Order,"straight line program elements",true,
  [IsStraightLineProgElm],
  # we have to be better than specialized methods
  10,
function(slp)
  return Order(EvalStraightLineProgElm(slp));
end);

#############################################################################
##
#M  \*
##
InstallMethod(\*,"straight line program element with x",true,
  [IsStraightLineProgElm,IsMultiplicativeElement],0,
function(slp,x)
  if IsOne(x) then return slp;fi;
  return EvalStraightLineProgElm(slp)*x;
end);

InstallMethod(\*,"x with straight line program element",true,
  [IsMultiplicativeElement,IsStraightLineProgElm],0,
function(x,slp)
  if IsOne(x) then return slp;fi;
  return x*EvalStraightLineProgElm(slp);
end);

#T this would be better recoded as variant of the substring algorithm in
#T steps of 2
BindGlobal("PosSublOdd",function(a,b)
local p;
  p:=PositionSublist(a,b);
  while IsInt(p) and IsInt(p/2) do
    p:=PositionSublist(a,b,p);
  od;
  return p;
end);

InstallMethod(\*,"straight line program elements",IsIdenticalObj,
  [IsStraightLineProgElm,IsStraightLineProgElm],0,
function(aob,bob)
# this multiplication routine tries to find duplicate patterns. It
# implicitly assumes, however that the input is in some way ``reduced'' as
# an SLP.
local a,b,      # lines of slp
      aep,bep,  # up to this generator index, entries are known.
      ta,tb,    # new indices for old
      tal,tbl,  # up to this index, old and new indices are the same
      la,lb,    # lengths
      laa,lba,  # last entries absolute
      ap,bp,    # processing indices old
      anp,bnp,  # ditto new
      asn,bsn,  # lengths of original seeds
      as,bs,    # subset
      l,        # result list
      ale,ble,  # indices in l of a/b entries
      i,j,k,    # index
      seed,     # seed
      seen,     # nr of seeds in toto
      e,        # entry
      ei,       # inverse
      bpre,     # bs-entries that have been taken earlier
      bleu,     # corresponding ble
      found,    # substring found?
      laro,     # flag when dealing with the last elements.
      p;        # position

  seed:=aob![1];
  asn:=Length(seed.seeds);
  aep:=Length(seed.seeds);
  b:=bob![1];
  bep:=Length(b.seeds);
  bsn:=Length(b.seeds);
  if IsIdenticalObj(seed,b) then
    # identical seeds -- easiest case
    ta:=[1..aep]; # translation of the numbers
    tb:=[1..bep];
  elif IsSubset(seed.seeds,b.seeds) then
    # b is a subset of a
    ta:=[1..aep]; # translation of the numbers
    tb:=List(b.seeds,i->Position(seed.seeds,i));
  elif IsSubset(b.seeds,seed.seeds) then
    # a is a subset of b
    ta:=List(seed.seeds,i->Position(b.seeds,i));
    tb:=[1..bep];
    seed:=b;
  else
    # none is a subset of the other
    a:=seed;
    seed:=rec(seeds:=Union(a.seeds,b.seeds));
    if IsBound(a.lmp) and IsBound(b.lmp) then
      seed.lmp:=Maximum(a.lmp,b.lmp);
    fi;
    if IsBound(a.base) and IsBound(b.base) then
      seed.base:=Union(a.base,b.base);
    fi;
    ta:=List(a.seeds,i->Position(seed.seeds,i));
    tb:=List(b.seeds,i->Position(seed.seeds,i));
  fi;
  seen:=Length(seed.seeds);
  tal:=First([1..Length(ta)],i->ta[i]<>i);
  if tal=fail then
    tal:=Length(ta);
  else
    tal:=tal-1;
  fi;
  tbl:=First([1..Length(tb)],i->tb[i]<>i);
  if tbl=fail then
    tbl:=Length(tb);
  else
    tbl:=tbl-1;
  fi;

  a:=LinesOfStraightLineProgram(aob![2]);
  b:=LinesOfStraightLineProgram(bob![2]);
  l:=[];
  la:=Length(a)-1; # the last entries are treated specially
  lb:=Length(b)-1;

  # special case: Multiplication with generator powers
  if la=0 and Length(a[1])=2 then
    a:=a[1];
    l:=ShallowCopy(b);
    # translate
    Append(tb,seen+[1..Length(b)]);
    for i in [1..Length(l)] do
      e:=ShallowCopy(l[i]);
      for j in [1,3..Length(e)-1] do
        e[j]:=tb[e[j]];
      od;
      l[i]:=e;
    od;
    e:=l[Length(l)];
    if e[1]=ta[a[1]] then
      e[2]:=e[2]+a[2];
      if e[2]=0 then
        e:=e{[3..Length(e)]};
      fi;
    else
      e:=Concatenation([ta[a[1]],a[2]],e);
    fi;
    l[Length(l)]:=e;
  elif lb=0 and Length(b[1])=2 then
    b:=b[1];
    l:=ShallowCopy(a);
    # translate
    Append(ta,seen+[1..Length(a)]);
    for i in [1..Length(l)] do
      e:=ShallowCopy(l[i]);
      for j in [1,3..Length(e)-1] do
        e[j]:=ta[e[j]];
      od;
      l[i]:=e;
    od;
    e:=l[Length(l)];
    if e[Length(e)-1]=tb[b[1]] then
      e[Length(e)]:=e[Length(e)]+b[2];
      if e[Length(e)]=0 then
        e:=e{[1..Length(e)-2]};
      fi;
    else
      e:=Concatenation(e,[tb[b[1]],b[2]]);
    fi;
    l[Length(l)]:=e;
  else

    ap:=1;
    bp:=1;
    ale:=[]; # a-indices in l
    ble:=[]; # b-indices in l

    laro:=false;
    while la<=Length(a) do
#Print("<\n");
      while ap<=la or bp<=lb do
#Print(">",ap,",",bp,"\n");
        # how many ap's do use up to generator aep;
        anp:=ap;
        while anp<=la and ForAll(a[anp]{[1,3..Length(a[anp])-1]},i->i<=aep) do
          anp:=anp+1;
        od;
        as:=a{[ap..anp-1]};

        # translate the generator numbers
        if aep>tal then # otherwise no translation needs to take place
          for i in [1..Length(as)] do
            e:=ShallowCopy(as[i]);
            for j in [1,3..Length(e)-1] do
              e[j]:=ta[e[j]];
              if e[j]<0 then
                # inverse
                e[j]:=-e[j];
                e[j+1]:=-e[j+1];
              fi;
            od;
            as[i]:=e;
          od;
        fi;

        # how many bp's do use up to generator bep;
        bnp:=bp;
        while bnp<=lb and ForAll(b[bnp]{[1,3..Length(b[bnp])-1]},i->i<=bep) do
          bnp:=bnp+1;
        od;
        bs:=b{[bp..bnp-1]};

        # translate the generator numbers
        if bep>tbl then # otherwise no translation needs to take place
          for i in [1..Length(bs)] do
            e:=ShallowCopy(bs[i]);
            for j in [1,3..Length(e)-1] do
              e[j]:=tb[e[j]];
              if e[j]<0 then
                # inverse
                e[j]:=-e[j];
                e[j+1]:=-e[j+1];
              fi;
            od;
            bs[i]:=e;
          od;
        fi;

        bpre:=[];
        bleu:=[];
        # add the as
        for i in [1..Length(as)] do
          e:=as[i];
          repeat
            # search substring in recorded b-parts
            found:=false;
            j:=1;
            while found=false and j<=Length(ble) do
              p:=PosSublOdd(e,l[ble[j]]);
              found:=p<>fail;
              j:=j+1;
            od;
            if found=true then
              j:=ble[j-1]+1; # the other case will always add 1.
            else
              # search substring in bs
              j:=1;
              while found=false and j<=Length(bs) do
                p:=PosSublOdd(e,bs[j]);
                if p<>fail then
                  found:=true;
                  if not j in bpre then
                    # record this bs in l
                    Add(l,bs[j]);
                    AddSet(bleu,Length(l));
                    AddSet(bpre,j); #  this one is taken already
                    tb[bsn+bp+j-1]:=Length(l)+seen; # store the index
                    j:=Length(l); # position of the l-entry that is sub
                  else
                    # we stored it already
                    j:=Position(l,bs[j]);
                  fi;
                fi;
                j:=j+1;
              od;
            fi;
            if found<>false then
              # the subentry starts at index p
              # j is the l-index of the entry which is sub+1
              e:=Concatenation(e{[1..p-1]},[j+seen-1,1],
                              e{[p+Length(l[j-1])..Length(e)]});
            else
              # search substring in recorded b-parts (inverse)
              ei:=ERepAssWorInv(e);
              j:=1;
              while found=false and j<=Length(ble) do
                p:=PosSublOdd(ei,l[ble[j]]);
                found:=p<>fail;
                j:=j+1;
              od;
              if found=true then
                j:=ble[j-1]+1; # the other case will always add 1.
              else
                # search substring in bs
                j:=1;
                while found=false and j<=Length(bs) do
                  p:=PosSublOdd(ei,bs[j]);
                  if p<>fail then
                    found:=true;
                    if not j in bpre then
                      AddSet(bpre,j); #  this one is taken now
                      # record this bs in l
                      if bs[j] in l then
                        # happens to be coincidence.
                        k:=Position(l,bs[j]);
                        tb[bsn+bp+j-1]:=k+seen; # store the index
                        j:=k; # position of the l-entry that is sub
                      else
                        Add(l,bs[j]);
                        AddSet(bleu,Length(l));
                        tb[bsn+bp+j-1]:=Length(l)+seen; # store the index
                        j:=Length(l); # position of the l-entry that is sub
                      fi;
                    else
                      # we stored it already
                      j:=Position(l,bs[j]);
                    fi;
                  fi;
                  j:=j+1;
                od;
              fi;
              if found<>false then
                # the subentry starts at index p in the inverse
                e:=Concatenation(e{[1..Length(e)+1-p-Length(l[j-1])]},
                                 [j+seen-1,-1],
                                 e{[Length(e)-p+2..Length(e)]});

                ei:=ERepAssWorInv(e);
              fi;
            fi;

          until found=false; # several substrings might occur

          # finally store, unless trivial and not the last one
          if Length(e)>2 or AbsInt(e[2])>1 or laro then
            if e in l then
              # the replacement could rarely produce duplicates
              ta[asn+ap+i-1]:=Position(l,e)+seen;
            else
              Add(l,e);
              if not laro then
                # do not add in the last step -- this might confuse b
                AddSet(ale,Length(l));
              fi;
              ta[asn+ap+i-1]:=Length(l)+seen;
            fi;
          else
            # complete replacement
            ta[asn+ap+i-1]:=SignInt(e[2])*e[1];
          fi;
        od;
        ble:=Union(ble,bleu); # the b-indices that were added
        # add the bs
        for i in [1..Length(bs)] do
          if not i in bpre then
            e:=bs[i];
            repeat
              # search substring in recorded a-parts
              found:=false;
              j:=1;
              while found=false and j<=Length(ale) do
                p:=PosSublOdd(e,l[ale[j]]);
                found:=p<>fail;
                j:=j+1;
              od;
              if found<>false then
                # the subentry starts at index p
                # j is the l-index of the entry which is sub+1
                j:=ale[j-1];
                e:=Concatenation(e{[1..p-1]},[j+seen,1],
                                e{[p+Length(l[j])..Length(e)]});
              else
                # search substring in recorded a-parts
                found:=false;
                j:=1;
                ei:=ERepAssWorInv(e);
                while found=false and j<=Length(ale) do
                  p:=PosSublOdd(e,l[ale[j]]);
                  found:=p<>fail;
                  j:=j+1;
                od;
                if found<>false then
                  # the subentry starts at index p in the inverse
                  # j is the l-index of the entry which is sub+1
                  j:=ale[j-1];
                  e:=Concatenation(e{[1..Length(e)+1-p-Length(l[j-1])]},
                                  [j+seen-1,-1],
                                  e{[Length(e)-p+2..Length(e)]});
                  ei:=ERepAssWorInv(e);
                fi;
              fi;
            until found=false; # several substrings might occur
            # finally store
            if Length(e)>2 or AbsInt(e[2])>1 then
              if e in l then
                # the replacement could rarely produce duplicates
                tb[bsn+bp+i-1]:=Position(l,e)+seen;
              else
                Add(l,e);
                AddSet(ble,Length(l));
                tb[bsn+bp+i-1]:=Length(l)+seen;
              fi;
            else
              # complete replacement
              tb[bsn+bp+i-1]:=SignInt(e[2])*e[1];
            fi;
          fi;
        od;

        ap:=anp;
        bp:=bnp;
        aep:=aep+1;
        bep:=bep+1;

      od;
      # this ensures the last two entries are processed last
      la:=la+1;
      lb:=lb+1;
      laro:=true;
    od;

    # finally multiply the last entries.

    # get the indices in l of the corresponding last entries
    # the -1 in the argument only undoes the +1 at the end of the `while' loop
    la:=ta[la+asn-1];
    lb:=tb[lb+bsn-1];
    laa:=AbsInt(la);
    lba:=AbsInt(lb);

    if la=Length(l)+seen-1 then
      # last a is in the but last position
      if lb=Length(l)+seen then
#  Print("case1\n");
        # last b is in the last position: combine last two
        e:=l[Length(l)-1];
        j:=l[Length(l)];

        # does b refer to a?
        if ForAny([1,3..Length(j)-1],k->j[k]=la) then
          Add(l,[la,1,lb,1]);
        else
          l[Length(l)-1]:=ERepAssWorProd(e,j);
          Remove(l);
        fi;
      else
        Error("spurious last entry");
      fi;
    else
      # last a is not in the but last position
      if lb=Length(l)+seen then
#  Print("case2\n");
        # last b is in the last position: Change it
        l[Length(l)]:=ERepAssWorProd([la,1],l[Length(l)]);
      else
        # last b is not in the last position:
        if la=Length(l)+seen then
#  Print("case3\n");
          # but a is: change a in last position
          l[Length(l)]:=ERepAssWorProd(l[Length(l)],[lb,1]);
        else
#  Print("case4\n");
          # last b is not in the last position or inverses used: Add another
          Add(l,[laa,SignInt(la),lba,SignInt(lb)]);
        fi;
      fi;
    fi;

  fi;
  #Error(a,"*",b,"=",l,"\n");
  #if ForAny(l,i->Length(i)=2) then
  #  Error("hui");
  #fi;

  if Length(l[Length(l)])=0 then
    return One(aob);
  else
#if ForAny([2..Length(l)],i->Length(l[i])=2 and AbsInt(l[i][2])=1) then
#  Error();
#fi;
#    Assert(1,not
#    ForAny([1..Length(l)],i->ForAny([1..i-1],j->PositionSublist(l[i],l[j])<>fail)));

    Assert(3,Length(Set(l))=Length(l));
    l:=StraightLineProgElm(seed,StraightLineProgramNC(l,seen));
    Assert(2,EvalStraightLineProgElm(aob)*EvalStraightLineProgElm(bob)=
             EvalStraightLineProgElm(l));
    return l;
  fi;
end);

InstallMethod(\^,"power straight line program elements",true,
  [IsStraightLineProgElm,IsInt],0,
function(a,e)
local l,n;
  if e=0 then
    return One(a);
  elif e=1 then
    return a;
  elif e=-1 then
    return Inverse(a);
  fi;
  l:=LinesOfStraightLineProgram(a![2]);
  n:=Length(a![1].seeds);
  if Length(l)=1 and Length(l[1])=2 then
    # special case: generators
    l:=[[l[1][1],l[1][2]*e]];
  else
    l:=ShallowCopy(l);
    Add(l,[Length(l)+n,e]);
  fi;
  return StraightLineProgElm(a![1],StraightLineProgramNC(l,n));
end);

InstallMethod(\=,"straight line program element with x",IsIdenticalObj,
  [IsStraightLineProgElm,IsMultiplicativeElement],0,
function(slp,x)
  return EvalStraightLineProgElm(slp)=x;
end);

InstallMethod(\<,"straight line program element with x",IsIdenticalObj,
  [IsStraightLineProgElm,IsMultiplicativeElement],0,
function(slp,x)
  return EvalStraightLineProgElm(slp)<x;
end);

InstallMethod(\<,"x with straight line program element",IsIdenticalObj,
  [IsMultiplicativeElement,IsStraightLineProgElm],0,
function(x,slp)
  return x<EvalStraightLineProgElm(slp);
end);

#############################################################################
##
#O  StretchImportantSLPElement(<elm>)
##
InstallMethod(StretchImportantSLPElement,"arbitrary elements: do nothing",true,
  [IsMultiplicativeElementWithInverse],0,
Ignore);

InstallMethod(StretchImportantSLPElement,"straight line program elements",true,
  [IsStraightLineProgElm],0,
function(a)
local e,s,r;
  e:=LinesOfStraightLineProgram(a![2]);
  if Product(e,i->Sum(List(i{[2,4..Length(i)]},AbsInt)))>200 then
    e:=EvalStraightLineProgElm(a);
    s:=Union(a![1].seeds,[e]);
    e:=Position(s,e);
    r:=rec(seeds:=s);
    if IsBound(a![1].lmp) then
      # transfer largest moved point information for perms.
      r.lmp:=a![1].lmp;
    fi;
    if IsBound(a![1].base) then
      # transfer base information for perms.
      r.base:=a![1].base;
    fi;
    a![1]:=r;
    a![2]:=StraightLineProgramNC([[e,1]],Length(s));
  fi;
end);

##
##  special methods for straight line permutations
##

InstallMethod(\=,"x with straight line program element",IsIdenticalObj,
  [IsMultiplicativeElement,IsStraightLineProgElm],0,
function(x,slp)
  return x=EvalStraightLineProgElm(slp);
end);

BindGlobal("ImgElmSLP",function(x,slp,pre)
local s,m,l,trace;
   # trace through
   trace:=function(y,n)
   local e,i,j;
     if n<0 then
      n:=-n;
      if n<=m then
        return y/s[n];
      else
        e:=l[n-m];
        for i in [Length(e)-1,Length(e)-3..1] do
          if e[i+1]<0 then
            for j in [e[i+1]..-1] do
              y:=trace(y,e[i]);
            od;
          else
            for j in [1..e[i+1]] do
              y:=trace(y,-e[i]);
            od;
          fi;
        od;
      fi;

     elif n<=m then
       return y^s[n];
     else
       e:=l[n-m];
       for i in [1,3..Length(e)-1] do
         if e[i+1]<0 then
           for j in [e[i+1]..-1] do
             y:=trace(y,-e[i]);
           od;
         else
           for j in [1..e[i+1]] do
             y:=trace(y,e[i]);
           od;
         fi;
       od;
     fi;

     return y;
   end;

   s:=slp![1].seeds;
   m:=Length(s);
   l:=LinesOfStraightLineProgram(slp![2]);
   if pre then
     # preimage!
     return trace(x,Length(l)+m);
   else
     return trace(x,-(Length(l)+m));
   fi;
end);

# The following function ought to perform better, being nonrecursive.
# In practice the recursion, being executed in the kernel, works out
# better. However this function ought to give the better performance if
# compiled.
BindGlobal("ImgElmSLPNonrecursive",function(x,slp,npre)
local s,m,l,stack,pos,row,ind,step,cnt,v,e,i,sp,ae;
  s:=slp![1].seeds;
  m:=Length(s);
  l:=LinesOfStraightLineProgram(slp![2]);
  stack:=[];
  sp:=0;
  pos:=Length(l);
  row:=l[pos];

  if npre then
    ind:=1;
    step:=2;
  else
    ind:=Length(row)-1;
    step:=-2;
  fi;
  cnt:=0;

  repeat
    v:=row[ind];
    e:=row[ind+1];
    ae:=AbsInt(e);
    if not npre then
      e:=-e;
    fi;
    if v<=m then
      # do the most simple cases themselves
      if e=-1 then
        x:=x/s[v];
      elif e=1 then
        x:=x^s[v];
      elif e>0 then
        for i in [1..e] do
          x:=x^s[v];
        od;
      else
        for i in [1..-e] do
          x:=x/s[v];
        od;
      fi;
      cnt:=ae; # did all
    else
      #push
      sp:=sp+1;
      stack[sp]:=[pos,ind,step,cnt];
      pos:=v-m;
      row:=l[pos];
      npre:=e>0;
      if npre then
        ind:=1;
        step:=2;
      else
        ind:=Length(row)-1;
        step:=-2;
      fi;
      cnt:=0; # we just started

    fi;

    while cnt>=ae do
      ind:=ind+step;
      cnt:=0;
      if ind>Length(row) or ind<1 then
        # pop
        if sp=0 then
          # through!
          return x;
        fi;
        row:=stack[sp];
        sp:=sp-1;
        pos:=row[1];
        ind:=row[2];
        step:=row[3];
        npre:=step>0;
        cnt:=row[4]+1; # +1 since we did one
        row:=l[pos];
        ae:=AbsInt(row[ind+1]);
      fi;
    od;
  until false; # we will stop by returning the result
end);

InstallOtherMethod(\^,"int with straight line perm",true,
  [IsInt,IsStraightLineProgElm and IsPerm],0,
function(x,slp)
  # do not use for straight line elements!
  if IsStraightLineProgElm(x) then
    TryNextMethod();
  fi;
  return ImgElmSLP(x,slp,true);
end);

InstallOtherMethod(\/,"x with straight line perm",true,
  [IsPosInt,IsStraightLineProgElm and IsPerm],0,
function(x,slp)
  return ImgElmSLP(x,slp,false);
end);

# takes a seed record and fetches/adds a largest moved point entry
BindGlobal("LMPSLPSeed",function(r)
  if not IsBound(r.lmp) then
    r.lmp:=LargestMovedPoint(r.seeds);
  fi;
  return r.lmp;
end);

InstallMethod(LargestMovedPoint,"straight line program permutation",true,
  [IsStraightLineProgElm and IsPerm],0,
function(slp)
local p,q;
  p:=LMPSLPSeed(slp![1]);
  if p>1000 then
    q:=p-100;
  else
    q:=0;
  fi;
  while p>q and ImgElmSLP(p,slp,true)=p do
    p:=p-1;
  od;

  if p>q then
    return p;
  elif q=0 then
    return q;
  else
    # catch the () case quickly if base given.
    if IsBound(slp![1].base) and IsOne(slp) then
      return 0;
    fi;
    # the element seems to be the identity. Expand!
    q:=EvalStraightLineProgElm(slp);
    return LargestMovedPoint(q);
  fi;

end);

InstallMethod(\=,"straight line program element with perm",IsIdenticalObj,
  [IsStraightLineProgElm and IsPerm,IsPerm],0,
function(slp,perm)
local r;
  r:=LargestMovedPoint(perm);
  if r=0 then
    return IsOne(slp);
  else
    if r^perm<>ImgElmSLP(r,slp,true) then
      return false;
    fi;
  fi;
  if IsBound(slp![1].base) then
    return ForAll(slp![1].base,i->ImgElmSLP(i,slp,true)=i^perm)
           and r<=LMPSLPSeed(slp![1]);
  fi;
  return EvalStraightLineProgElm(slp)=perm;
end);

InstallMethod(\=,"perm with straight line program element",IsIdenticalObj,
  [IsPerm,IsStraightLineProgElm and IsPerm],0,
function(perm,slp)
local r;
  r:=LargestMovedPoint(perm);
  if r=0 then
    return IsOne(slp);
  else
    if r^perm<>ImgElmSLP(r,slp,true) then
      return false;
    fi;
  fi;
  if IsBound(slp![1].base) then
    return ForAll(slp![1].base,i->ImgElmSLP(i,slp,true)=i^perm)
           and r<=LMPSLPSeed(slp![1]);
  fi;
  return perm=EvalStraightLineProgElm(slp);
end);

InstallMethod(\=,"straight line program perms",IsIdenticalObj,
  [IsStraightLineProgElm and IsPerm,IsStraightLineProgElm and IsPerm],0,
function(a,b)
local l,m;
  if not IsIdenticalObj(a![1],b![1]) then
    l:=Maximum(LMPSLPSeed(a![1]),LMPSLPSeed(b![1]));
  else
    l:=LMPSLPSeed(a![1]);
  fi;
  if IsBound(a![1].base) and IsBound(b![1].base) then
    return
    ForAll(Union(a![1].base,b![1].base),
           i->ImgElmSLP(i,a,true)=ImgElmSLP(i,b,true));
  fi;
  if l<1000 then
    m:=0;
  else
    m:=l-100;
  fi;
  while l>m do
    if ImgElmSLP(l,a,true)<>ImgElmSLP(l,b,true) then
      return false;
    fi;
    l:=l-1;
  od;
  if l=0 then
    return true;
  fi;
  # the elements look very similar, but there are a lot of points.
  return EvalStraightLineProgElm(a)=EvalStraightLineProgElm(b);
end);

InstallMethod(\<,"straight line program perms",IsIdenticalObj,
  [IsStraightLineProgElm and IsPerm,IsStraightLineProgElm and IsPerm],0,
function(a,b)
local l,m,x,y;
  l:=1;
  if not IsIdenticalObj(a![1],b![1]) then
    m:=Maximum(LMPSLPSeed(a![1]),LMPSLPSeed(b![1]));
  else
    m:=LMPSLPSeed(a![1]);
  fi;
  if m>1000 then
    m:=1000;
  fi;
  while l<m do
    x:=ImgElmSLP(l,a,true);
    y:=ImgElmSLP(l,b,true);
    if x<y then return true;
    elif y<x then return false;
    fi;
    l:=l+1;
  od;
  # the elements look very similar, but there are a lot of points.
  return EvalStraightLineProgElm(a)<EvalStraightLineProgElm(b);
end);

InstallMethod(IsOne,"straight line program perms",true,
  [IsStraightLineProgElm and IsPerm],0,
function(slp)
local l,m;
  if IsBound(slp![1].base) then
    return ForAll(slp![1].base,i->ImgElmSLP(i,slp,true)=i);
  fi;
  l:=LMPSLPSeed(slp![1]);
  if l<1000 then
    m:=0;
  else
    m:=l-100;
  fi;
  while l>m do
    if ImgElmSLP(l,slp,true)<>l then
      return false;
    fi;
    l:=l-1;
  od;
  if l=0 then
    return true;
  fi;
  return IsOne( EvalStraightLineProgElm(slp) );
end);

InstallOtherMethod( CycleLengthOp, "straight line program perms", true,
  [ IsPerm and IsStraightLineProgElm, IsInt ],1,
function(p,e)
local i,f;
  i:=0;
  f:=e;
  repeat
    f:=f^p;
    i:=i+1;
  until f=e;
  return i;
end);

InstallOtherMethod( CycleOp, "straight line program perms", true,
  [ IsPerm and IsStraightLineProgElm, IsInt ],1,
function(p,e)
local c,i,f;
  i:=0;
  f:=e;
  c:=[];
  repeat
    Add(c,f);
    f:=f^p;
    i:=i+1;
  until f=e;
  return c;
end);

InstallOtherMethod( CycleStructurePerm, "straight line program perms", true,
  [ IsPerm and IsStraightLineProgElm ],1,
function(p)
  return CycleStructurePerm(EvalStraightLineProgElm(p));
end);

InstallOtherMethod( SignPerm, "straight line program perms", true,
  [ IsPerm and IsStraightLineProgElm ],1,
function(p)
  return SignPerm(EvalStraightLineProgElm(p));
end);

InstallOtherMethod( RestrictedPermNC, "straight line program perms", true,
  [ IsPerm and IsStraightLineProgElm,IsList ],1,
function(p,l)
  return RestrictedPermNC(EvalStraightLineProgElm(p),l);
end);

##
##  special methods for straight line assoc words
##

#############################################################################
##
#M  ExtRepOfObj
##
InstallMethod(ExtRepOfObj,"for a straight line program word",true,
  [IsAssocWord and IsStraightLineProgElm],0,
function(slp)
  return ExtRepOfObj(EvalStraightLineProgElm(slp));
end);

#############################################################################
##
#M  LetterRepAssocWord
##
InstallMethod(LetterRepAssocWord,"for a straight line program word",true,
  [IsAssocWord and IsStraightLineProgElm],0,
function(slp)
  return LetterRepAssocWord(EvalStraightLineProgElm(slp));
end);

#############################################################################
##
#M  NumberSyllables
##
InstallMethod(NumberSyllables,"for a straight line program word",true,
  [IsAssocWord and IsStraightLineProgElm],0,
function(slp)
  return NumberSyllables(EvalStraightLineProgElm(slp));
end);

#############################################################################
##
#M  GeneratorSyllable
##
InstallMethod(GeneratorSyllable,"for a straight line program word",true,
  [IsAssocWord and IsStraightLineProgElm,IsPosInt],0,
function(slp,pos)
  return GeneratorSyllable(EvalStraightLineProgElm(slp),pos);
end);

#############################################################################
##
#M  ExponentSyllable
##
InstallMethod(ExponentSyllable,"for a straight line program word",true,
  [IsAssocWord and IsStraightLineProgElm,IsPosInt],0,
function(slp,pos)
  return ExponentSyllable(EvalStraightLineProgElm(slp),pos);
end);

#############################################################################
##
#M  Length
##
InstallMethod(Length,"for a straight line program word",true,
  [IsAssocWord and IsStraightLineProgElm],0,
function(slp)
  return Length(EvalStraightLineProgElm(slp));
end);

#############################################################################
##
#M  Subword
##
InstallOtherMethod(Subword,"for a straight line program word",true,
  [IsAssocWord and IsStraightLineProgElm,IsInt,IsInt],0,
function(slp,a,b)
  return Subword(EvalStraightLineProgElm(slp),a,b);
end);

#############################################################################
##
#M  MappedWord
##
InstallMethod(MappedWord,"for a straight line program word, and two lists",
  IsElmsCollsX,
  [ IsAssocWord and IsStraightLineProgElm, IsAssocWordCollection, IsList ], 0,
function(slp,gens,imgs)
  # evaluate in mapped generators
  return ResultOfStraightLineProgram(slp![2],List(slp![1].seeds,
    i->MappedWord(i,gens,imgs)) # images of the roots
    );
end);

#############################################################################
##
#M  ExponentSumWord
##
InstallMethod(ExponentSumWord,"for a straight line program word",
  IsIdenticalObj, [IsAssocWord and IsStraightLineProgElm,IsAssocWord],0,
function(slp,e)
  return ExponentSumWord(EvalStraightLineProgElm(slp),
    EvalStraightLineProgElm(e));
end);

# words represented as tree elements (those are useful for decoding subgroup
# presentations)

#############################################################################
##
#F  TreeRepresentedWord( <roots>,<tree>,<nr> )
##
##  these elements are represented as straight line program elements
InstallGlobalFunction(TreeRepresentedWord,function(r,t,n)
local z,d,l,count,b;
  z:=Length(t[1]);
  b:=Length(r);
  if n<=b then
    return StraightLineProgElm(r,StraightLineProgramNC([[n,1]],Length(r)));
  fi;

  # which elements are referred to ? set count negative
  d:=ListWithIdenticalEntries(z,0);
  count:=function(i)
    if i>b then
      if d[i]=0 then
        count(AbsInt(t[1][i]));
        count(AbsInt(t[2][i]));
      fi;
      d[i]:=d[i]-1;
    fi;
  end;

  count(n);

  # now we will collect in d slp entries (or indices in l by positive numbers)
  l:=[];
  d[n]:=-2; # this will force element n to be stored as word (and it will be
            # at the end of l)
  count:=function(i)
  local e,f,x,y,j;
    if i<=b then
      return i;
    elif not (IsInt(d[i]) and d[i]<0) then
      return d[i];
    fi;
    e:=count(AbsInt(t[1][i]));
    f:=count(AbsInt(t[2][i]));
    x:=SignInt(t[1][i]);
    y:=SignInt(t[2][i]);
    # put together
    if IsInt(e) and IsInt(f) then
      if e=f then
        if x+y=0 then
          Error("strange tree element");
        else
          e:=[e,x+y];
        fi;
      else
        e:=[e,x,f,y];
      fi;
    else
      # take care of inverses
      if IsList(e) and x<1 then
        x:=[]; #revert
        for j in [Length(e)-1,Length(e)-3..1] do
          Add(x,j);
          Add(x,j+1);
        od;
        e:=e{x};
        x:=[2,4..Length(e)]; # exponent indices
        e{x}:=-e{x};
      fi;
      if IsList(f) and y<1 then
        y:=[]; #revert
        for j in [Length(f)-1,Length(f)-3..1] do
          Add(y,j);
          Add(y,j+1);
        od;
        f:=f{y};
        y:=[2,4..Length(f)]; # exponent indices
        f{y}:=-f{y};
      fi;

      if IsInt(e) then
        e:=Concatenation([e,x],f);
      elif IsInt(f) then
        e:=Concatenation(e,[f,y]);
      else
        # multiply
        f:=ShallowCopy(f);
        while Length(e)>1 and Length(f)>0 and e[Length(e)-1]=f[1] do
          # same variables: reduce
          f[2]:=f[2]+e[Length(e)];
          if f[2]=0 then
            f:=f{[3..Length(f)]};
          fi;
          e:=e{[1..Length(e)-2]};
        od;
        e:=Concatenation(e,f);
      fi;

    fi;
    if d[i]<-1 then
      # this becomes a new definition
      Add(l,e);
      e:=Length(l)+b; # number of this definition
    fi;
    d[i]:=e; # store
    return e;
  end;
  count(n);

  if Length(l)>0 and Length(l[Length(l)])=0 then
    return One(r[1]);
  fi;
  return StraightLineProgElm(r,StraightLineProgramNC(l,Length(r)));
end);

#############################################################################
##
##  3. Functions for straight line programs, mostly needed for memory objects:
##

##
#F  SLPChangesSlots( <l>, <nrinputs> )
##
##  l must be the lines of an slp, nrinps the number of inputs.
##  This function returns a list with the same length than l, containing
##  at each position the number of the slot that is changed in the
##  corresponding line of the slp. In addition one more number is
##  appended to the list, namely the number of the biggest slot used.
##  For the moment, this function is intentionally left undocumented.
##
InstallGlobalFunction( SLPChangesSlots,
  function(l,nrinps)
    local biggest,changes,i,line;
    changes := [];   # a list of integers for each line of the slp, which
                     # says, which element is changed
    biggest := nrinps;
    for i in [1..Length(l)] do
        line := l[i];
        if IsInt(line[1]) then   # the first case
            biggest := biggest + 1;
            Add(changes,biggest);
        elif Length(line) = 2 and IsInt(line[2]) then
            # the second case, provided that we have not been in the first
            Add(changes,line[2]);
            if line[2] > biggest then
                biggest := line[2];
            fi;
        elif i < Length(l) then
            Error( "Bad line in slp: ",i );
        else
            Add(changes,0);
            # the last line does not change anything in this case
        fi;
    od;
    Add(changes,biggest);
    return changes;
  end);

##
#F  SLPOnlyNeededLinesBackward( <l>,<i>,<nrinps>,<changes>,<needed>,
##                              <slotsused>,<ll> )
##
##  l is a list of lines of an slp, nrinps the number of inputs.
##  i is the number of the last line, that is not a line of type 3 (results).
##  changes is the result of SLPChangesSlots for that slp.
##  needed is a list, where those entries are bound to true that are
##  needed in the end of the slp. slotsused is a list that should be
##  initialized with [1..nrinps] and which contains in the end the set
##  of slots used.
##  ll is any list.
##  This functions goes backwards through the slp and adds exactly those
##  lines of the slp to ll that have to be executed to produce the
##  result (in backward order). All lines are transformed into type 2
##  lines ([assocword,slot]). Note that needed is changed underways.
##  For the moment, this function is intentionally left undocumented.
##
InstallGlobalFunction( SLPOnlyNeededLinesBackward,
  function(l,i,nrinps,changes,needed,slotsused,ll)
    local j,line;
    while i >= 1 do
        if IsBound(needed[changes[i]]) then
            AddSet(slotsused,changes[i]);   # this slot will be used
            Unbind(needed[changes[i]]);     # as this line overwrites it,
                         # the previous result obviously was no longer needed
            line := l[i];
            if IsInt(line[1]) then
                Add(ll,[ShallowCopy(line),changes[i]]);
            else
                Add(ll,[ShallowCopy(line[1]),line[2]]);   # copy the line
                line := line[1];
            fi;
            for j in [1,3..Length(line)-1] do
                needed[line[j]] := true;
            od;
        fi;
        i := i - 1;
    od;
  end);

##
#F  SLPReversedRenumbered( <ll>,<slotsused>,<nrinps>,<invtab> )
##
##  Internally used function.
##
InstallGlobalFunction( SLPReversedRenumbered,
  function(ll,slotsused,nrinps,invtab)
    # invtab must be an empty list and is modified!
    local biggest,i,kk,kl,lll,resultslot;
    for i in [1..Length(slotsused)] do
        invtab[slotsused[i]] := i;
    od;
    lll := [];  # here we collect the final program
    biggest := nrinps;
    for i in [Length(ll),Length(ll)-1 .. 1] do
        resultslot := invtab[ll[i][2]];
        if resultslot = biggest+1 then   # we can use a type 1 line
            kl := [];
            for kk in [1,3..Length(ll[i][1])-1] do
                Add(kl,invtab[ll[i][1][kk]]);
                Add(kl,ll[i][1][kk+1]);
            od;
            Add(lll,kl);
            biggest := biggest + 1;
        else
            kl := [];
            for kk in [1,3..Length(ll[i][1])-1] do
                Add(kl,invtab[ll[i][1][kk]]);
                Add(kl,ll[i][1][kk+1]);
            od;
            Add(lll,[kl,resultslot]);
            if resultslot > biggest then
                biggest := resultslot;
            fi;
        fi;
    od;
    return lll;
  end);

##
#F  RestrictOutputsOfSLP( <slp>, <k> )
##
##  slp must be a straight line program returning a tuple
##  of values. This function
##  returns a new slp that calculates only those outputs specified by
##  k. The argument
##  k may be an integer or a list of integers. If k is an integer,
##  the resulting slp calculates only the result with that number
##  in the original output tuple.
##  If k is a list of integers, the resulting slp calculates those
##  results with indices k in the original output tuple.
##  In both cases the resulting slp
##  does only what is necessary. Obviously, the slp must have a line with
##  enough expressions (lists) for the supplied k as its last line.
##  slp is either an slp or a pair where the first entry are the lines
##  of the slp and the second is the number of inputs.
##
--> --------------------

--> maximum size reached

--> --------------------

Quellcode-Bibliothek straight.gi Sprache: unbekannt

[ 0.66Quellennavigators Projekt ]