Quelle  Singular.gi   Sprache: unbekannt

# SPDX-License-Identifier: GPL-2.0-or-later
# RingsForHomalg: Dictionaries of external rings
#
# Implementations
#

##  Implementation stuff for the external computer algebra system Singular.

####################################
#
# global variables:
#
####################################

BindGlobal( "HOMALG_IO_Singular",
        rec(
            cas := "singular", ## normalized name on which the user should have no control
            name := "Singular",
            executable := [ "Singular" ], ## this list is processed from left to right
            options := [ "-t", "--ticks-per-sec", "1000", "--echo=0", "--no-warn", "--cntrlc=a" ], ## the option "-q" causes IO to believe that Singular has died!
            BUFSIZE := 1024,
            READY := "!$%&/(",
            CUT_POS_BEGIN := 1, ## these are the most
            CUT_POS_END := 2,   ## delicate values!
            eoc_verbose := ";",
            eoc_quiet := ";",
            nolistlist := true, ## a Singular specific
            break_lists := true, ## a Singular specific
            handle_output := true, ## a Singular specific
#            original_lines := true, ## a Singular specific
            check_output := true, ## a Singular specific looks for newlines without commas
            setring := _Singular_SetRing, ## a Singular specific
            ## prints polynomials in a format compatible with other CASs
            setring_post := [ "short=0;", "option(redTail);" ], ## a Singular specific
            setinvol := _Singular_SetInvolution,## a Singular specific
            define := "=",
            delete := function( var, stream ) homalgSendBlocking( [ "kill ", var ], "need_command", stream, "delete" ); end,
            multiple_delete := _Singular_multiple_delete,
            prompt := "\033[01msingular>\033[0m ",
            output_prompt := "\033[1;30;43m<singular\033[0m ",
            display_color := "\033[0;30;47m",
            ## matrix.lib loads: LIB \"nctools.lib\";LIB \"poly.lib\";LIB \"random.lib\";
            init_string := "option(noredefine);option(redSB);LIB \"matrix.lib\";LIB \"primdec.lib\";LIB \"primdecint.lib\";LIB \"involut.lib\";LIB \"finvar.lib\";LIB \"latex.lib\";",
            InitializeCASMacros := InitializeSingularMacros,
            time := function( stream, t ) return Int( homalgSendBlocking( [ "timer" ], "need_output", stream, "time" ) ) - t; end,
            memory_usage := function( stream, o ) return Int( homalgSendBlocking( [ "memory(", o, ")" ], "need_output", stream, "memory" ) ); end,
            version_getter := function( stream ) return Int( homalgSendBlocking( [ "system(\"version\")" ], "need_output", stream, "version" ) ); end,
           )
);

HOMALG_IO_Singular.READY_LENGTH := Length( HOMALG_IO_Singular.READY );

####################################
#
# families and types:
#
####################################

# a new type:
BindGlobal( "TheTypeHomalgExternalRingObjectInSingular",
        NewType( TheFamilyOfHomalgRings,
                IsHomalgExternalRingObjectInSingularRep ) );

# a new type:
BindGlobal( "TheTypeHomalgExternalRingInSingular",
        NewType( TheFamilyOfHomalgRings,
                IsHomalgExternalRingInSingularRep ) );

####################################
#
# global functions and variables:
#
####################################

## will be automatically invoked in homalgSendBlocking once stream.active_ring is set;
## so there is no need to invoke it explicitly for a ring which can never be
## created as the first ring in the stream!
InstallGlobalFunction( _Singular_SetRing,
  function( R )
    local stream;
    
    stream := homalgStream( R );
    
    ## since _Singular_SetRing might be called from homalgSendBlocking,
    ## we first set the new active ring to avoid infinite loops:
    stream.active_ring := R;
    
    homalgSendBlocking( [ "setring ", R ], "need_command", "initialize" );
    
    if IsBound( HOMALG_IO_Singular.setring_post ) then
        homalgSendBlocking( HOMALG_IO_Singular.setring_post, "need_command", stream, "initialize" );
    fi;
    
    ## never use imapall here
    
end );

##
InstallGlobalFunction( _Singular_SetInvolution,
  function( R )
    local RP;
    
    RP := homalgTable( R );
    
    if IsBound( RP!.SetInvolution ) then
        RP!.SetInvolution( R );
    fi;
    
end );

##
InstallGlobalFunction( _Singular_multiple_delete,
  function( var_list, stream )
    local str, var;
    
    str:="";
    
    for var in var_list do
      str := Concatenation( str, "kill ", String ( var ) , ";" );
    od;
    
    homalgSendBlocking( str, "need_command", stream, "multiple_delete" );
    
end );

##
BindGlobal( "SingularMacros",
        rec(
            
    IsMemberOfList := "\n\
proc IsMemberOfList (int i, list l)\n\
{\n\
  int k = size(l);\n\
  \n\
  for (int p=1; p<=k; p++)\n\
  {\n\
    if (l[p]==i)\n\
    {\n\
      return(1); // this is not a mistake\n\
    }\n\
  }\n\
  return(0);\n\
}\n\n",
    
    Difference := "\n\
proc Difference (list a, list b)\n\
{\n\
  list c;\n\
  int s=size(a);\n\
  int l = 1;\n\
  \n\
  for (int p=1; p<=s; p++)\n\
  {\n\
    if (IsMemberOfList(a[p],b)==0)\n\
    {\n\
      c[l] = a[p]; l++;\n\
    }\n\
  }\n\
  return(c);\n\
}\n\n",
    
    GetSparseListOfHomalgMatrixAsString := "\n\
proc GetSparseListOfHomalgMatrixAsString (M)\n\
{\n\
  list l;int k;\n\
  k = 1;\n\
  for(int i=1; i<=ncols(M); i++){\n\
    for(int j=1; j<=nrows(M); j++){\n\
      def p=M[j,i]; // remark: matrices are saved transposed in Singular\n\
      if(p!=0){l[k]=list(i,j,p); k++;};\n\
    };\n\
  };\n\
  return(string(l));\n\
}\n\n",
    
    CreateListListOfIntegers := "\n\
proc CreateListListOfIntegers (degrees,m,n)\n\
{\n\
  list l;\n\
  for (int i=m; i>=1; i--)\n\
  {\n\
    l[i]=intvec(degrees[(i-1)*n+1..i*n]);\n\
  }\n\
  return(l);\n\
}\n\n",
    
    IsZeroMatrix := "\n\
proc IsZeroMatrix (matrix m)\n\
{\n\
  matrix z[nrows(m)][ncols(m)];\n\
  return(m==z);\n\
}\n\n",
    
    IsIdentityMatrix := "\n\
proc IsIdentityMatrix (matrix m)\n\
{\n\
  return(m==unitmat(nrows(m)));\n\
}\n\n",
    
    IsDiagonalMatrix := "\n\
proc IsDiagonalMatrix (matrix m)\n\
{\n\
  int min=nrows(m);\n\
  if (min>ncols(m))\n\
  {\n\
    min=ncols(m);\n\
  }\n\
  matrix z[nrows(m)][ncols(m)];\n\
  matrix c = m;\n\
  for (int i=1; i<=min; i++)\n\
  {\n\
    c[i,i]=0;\n\
  }\n\
  return(c==z);\n\
}\n\n",
    
    ZeroRows := "\n\
proc ZeroRows (module m)\n\
{\n\
  list l;\n\
  int s = 1;\n\
  for (int i=1;i<=ncols(m);i++)\n\
  {\n\
    if (m[i]==0)\n\
    {\n\
      l[s]=i; s++;\n\
    }\n\
  }\n\
  if (size(l)==0)\n\
  {\n\
    return(\"[]\"));\n\
  }\n\
  return(string(l));\n\
}\n\n",
    
    ZeroColumns := "\n\
proc ZeroColumns (matrix n)\n\
{\n\
  matrix m=module(transpose(n));\n\
  list l;\n\
  int s = 1;\n\
  for (int i=1;i<=ncols(m);i++)\n\
  {\n\
    if (m[i]==0)\n\
    {\n\
      l[s]=i; s++;\n\
    }\n\
  }\n\
  if (size(l)==0)\n\
  {\n\
    return(\"[]\"));\n\
  }\n\
  return(string(l));\n\
}\n\n",

    ConvertMatrixToRow := "\n\
proc ConvertMatrixToRow (matrix m)\n\
{\n\
  int r = ncols(m);\n\
  int c = nrows(m);\n\
  matrix row[c][1] = m[1];\n\
  matrix tmp;\n\
  for (int i=2;i<=r;i++)\n\
  {\n\
    matrix tmp[i*c][1]=row,m[i];\n\
    row = tmp;\n\
  }\n\
  return(row);\n\
}\n\n",

    ConvertRowToMatrix := "\n\
proc ConvertRowToMatrix (matrix row, int r, int c)\n\
{\n\
  matrix m[c][1] = submat(row,1..c,1..1);\n\
  matrix tmp;\n\
  for (int j=2;j<=nrows(row)/c;j++)\n\
  {\n\
    matrix tmp[c][j]=concat(m,submat(row,(j-1)*c+1..j*c,1..1));\n\
    m = tmp;\n\
  }\n\
  return(m);\n\
}\n\n",

    GetColumnIndependentUnitPositions := "\n\
proc GetColumnIndependentUnitPositions (matrix M, list pos_list)\n\
{\n\
  int m = nrows(M);\n\
  int n = ncols(M);\n\
  \n\
  list rest;\n\
  intvec tmp = 1..m;\n\
  rest = tmp[1..m];\n\
  int r = m;\n\
  list rest2;\n\
  list pos;\n\
  int i; int k; int a; int s = 1; int s2;\n\
  \n\
  for (int j=1; j<=n; j++)\n\
  {\n\
    for (i=r; i>0; i--)\n\
    {\n\
      k = rest[i];\n\
      if (deg(M[k,j]) == 0) //IsUnit\n\
      {\n\
        rest2 = list();\n\
        s2 = 1;\n\
        pos[s] = list(j,k); s++;\n\
        for (a=1; a<=r; a++)\n\
        {\n\
          if (M[rest[a],j] == 0)\n\
          {\n\
            rest2[s2] = rest[a]; s2++;\n\
          }\n\
        }\n\
        rest = rest2;\n\
        r = size(rest);\n\
        break;\n\
      }\n\
    }\n\
  }\n\
  return(string(pos));\n\
}\n\n",
    
    GetColumnIndependentUnitPositions_Z := "\n\
proc GetColumnIndependentUnitPositions_Z (matrix M, list pos_list)\n\
{\n\
  int m = nrows(M);\n\
  int n = ncols(M);\n\
  \n\
  list rest;\n\
  for (int o=m; o>=1; o--)\n\
  {\n\
    rest[o] = o;\n\
  }\n\
  int r = m;\n\
  list e;\n\
  list rest2;\n\
  list pos;\n\
  int i; int k; int a; int s = 1;\n\
  \n\
  for (int j=1; j<=n; j++)\n\
  {\n\
    for (i=1; i<=r; i++)\n\
    {\n\
      k = rest[r-i+1];\n\
      if (M[k,j] == 1 || M[k,j] == -1) //IsUnit\n\
      {\n\
        rest2 = e;\n\
        pos[s] = list(j,k); s++;\n\
        for (a=1; a<=r; a++)\n\
        {\n\
          if (M[rest[a],j] == 0)\n\
          {\n\
            rest2[size(rest2)+1] = rest[a];\n\
          }\n\
        }\n\
        rest = rest2;\n\
        r = size(rest);\n\
        break;\n\
      }\n\
    }\n\
  }\n\
  return(string(pos));\n\
}\n\n",
    
    GetRowIndependentUnitPositions := "\n\
proc GetRowIndependentUnitPositions (matrix M, list pos_list)\n\
{\n\
  int m = nrows(M);\n\
  int n = ncols(M);\n\
  \n\
  list rest;\n\
  for (int o=n; o>=1; o--)\n\
  {\n\
    rest[o] = o;\n\
  }\n\
  int r = n;\n\
  list e;\n\
  list rest2;\n\
  list pos;\n\
  int j; int k; int a; int s = 1;\n\
  \n\
  for (int i=1; i<=m; i++)\n\
  {\n\
    for (j=1; j<=r; j++)\n\
    {\n\
      k = rest[r-j+1];\n\
      if (deg(M[i,k]) == 0) //IsUnit\n\
      {\n\
        rest2 = e;\n\
        pos[s] = list(i,k); s++;\n\
        for (a=1; a<=r; a++)\n\
        {\n\
          if (M[i,rest[a]] == 0)\n\
          {\n\
            rest2[size(rest2)+1] = rest[a];\n\
          }\n\
        }\n\
        rest = rest2;\n\
        r = size(rest);\n\
        break;\n\
      }\n\
    }\n\
  }\n\
  return(string(pos));\n\
}\n\n",
    
    GetRowIndependentUnitPositions_Z := "\n\
proc GetRowIndependentUnitPositions_Z (matrix M, list pos_list)\n\
{\n\
  int m = nrows(M);\n\
  int n = ncols(M);\n\
  \n\
  list rest;\n\
  for (int o=n; o>=1; o--)\n\
  {\n\
    rest[o] = o;\n\
  }\n\
  int r = n;\n\
  list e;\n\
  list rest2;\n\
  list pos;\n\
  int j; int k; int a; int s = 1;\n\
  \n\
  for (int i=1; i<=m; i++)\n\
  {\n\
    for (j=1; j<=r; j++)\n\
    {\n\
      k = rest[r-j+1];\n\
      if (M[i,k] == 1 || M[i,k] == -1) //IsUnit\n\
      {\n\
        rest2 = e;\n\
        pos[s] = list(i,k); s++;\n\
        for (a=1; a<=r; a++)\n\
        {\n\
          if (M[i,rest[a]] == 0)\n\
          {\n\
            rest2[size(rest2)+1] = rest[a];\n\
          }\n\
        }\n\
        rest = rest2;\n\
        r = size(rest);\n\
        break;\n\
      }\n\
    }\n\
  }\n\
  return(string(pos));\n\
}\n\n",
    
    GetUnitPosition := "\n\
proc GetUnitPosition (matrix M, list pos_list)\n\
{\n\
  int m = nrows(M);\n\
  int n = ncols(M);\n\
  int r;\n\
  list rest;\n\
  for (int o=m; o>=1; o--)\n\
  {\n\
    rest[o] = o;\n\
  }\n\
  rest=Difference(rest,pos_list);\n\
  r=size(rest);\n\
  for (int j=1; j<=n; j++)\n\
  {\n\
    for (int i=1; i<=r; i++)\n\
    {\n\
      if (deg(M[rest[i],j]) == 0) //IsUnit\n\
      {\n\
        return(string(j,\",\",rest[i])); // this is not a mistake\n\
      }\n\
    }\n\
  }\n\
  return(\"fail\");\n\
}\n\n",
    
    GetUnitPosition_Z := "\n\
proc GetUnitPosition_Z (matrix M, list pos_list)\n\
{\n\
  int m = nrows(M);\n\
  int n = ncols(M);\n\
  int r;\n\
  list rest;\n\
  for (int o=m; o>=1; o--)\n\
  {\n\
    rest[o] = o;\n\
  }\n\
  rest=Difference(rest,pos_list);\n\
  r=size(rest);\n\
  for (int j=1; j<=n; j++)\n\
  {\n\
    for (int i=1; i<=r; i++)\n\
    {\n\
      if (M[rest[i],j] == 1 || M[rest[i],j] == -1) //IsUnit\n\
      {\n\
        return(string(j,\",\",rest[i])); // this is not a mistake\n\
      }\n\
    }\n\
  }\n\
  return(\"fail\");\n\
}\n\n",
    
    GetCleanRowsPositions := "\n\
proc GetCleanRowsPositions (matrix m, list l)\n\
{\n\
  list rows;\n\
  int s = 1;\n\
  for (int i=1;i<=size(l);i++)\n\
  {\n\
    for (int j=1;j<=ncols(m);j++)\n\
    {\n\
      if (m[l[i],j]==1)\n\
      {\n\
        rows[s] = j; s++;\n\
        break;\n\
      }\n\
    }\n\
  }\n\
  if (s==0)\n\
  {\n\
    return(\"[]\"));\n\
  }\n\
  return(string(rows));\n\
}\n\n",
    
    PositionOfFirstNonZeroEntryPerRow := "\n\
proc PositionOfFirstNonZeroEntryPerRow (matrix M)\n\
{\n\
  int b = 1;\n\
  intmat m[1][ncols(M)];\n\
  for (int i=1; i<=ncols(M); i++)\n\
  {\n\
    for (int j=1; j<=nrows(M); j++)\n\
    {\n\
      if ( M[j,i] <> 0 ) { m[1,i] = j; break; }\n\
    }\n\
    if ( b && i > 1 ) { if ( m[1,i] <> m[1,i-1] ) { b = 0; } } // Singular is strange\n\
  }\n\
  if ( b ) { return(m[1,1]); } else { return(m); }\n\
}\n\n",
    
    PositionOfFirstNonZeroEntryPerColumn := "\n\
proc PositionOfFirstNonZeroEntryPerColumn (matrix M)\n\
{\n\
  int b = 1;\n\
  intmat m[1][nrows(M)];\n\
  for (int j=1; j<=nrows(M); j++)\n\
  {\n\
    for (int i=1; i<=ncols(M); i++)\n\
    {\n\
      if ( M[j,i] <> 0 ) { m[1,j] = i; break; }\n\
    }\n\
    if ( b && j > 1 ) { if ( m[1,j] <> m[1,j-1] ) { b = 0; } } // Singular is strange\n\
  }\n\
  if ( b ) { return(m[1,1]); } else { return(m); }\n\
}\n\n",
    
    IndicatorMatrixOfNonZeroEntries := "\n\
proc IndicatorMatrixOfNonZeroEntries(matrix M)\n\
{\n\
  intmat m[ncols(M)][nrows(M)];\n\
  for (int i=1; i<=ncols(M); i++)\n\
  {\n\
    for (int j=1; j<=nrows(M); j++)\n\
    {\n\
      m[i,j] = ( M[j,i] <> 0 );\n\
    }\n\
  }\n\
  return(m);\n\
}\n\n",
    
##  <#GAPDoc Label="BasisOfRowModule:SingularMacro">
##  <ManSection>
##    <Func Arg="M" Name="BasisOfRowModule" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    BasisOfRowModule := "\n\
proc BasisOfRowModule (matrix M)\n\
{\n\
  return(std(M));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>
    
##  <#GAPDoc Label="BasisOfColumnModule:SingularMacro">
##  <ManSection>
##    <Func Arg="M" Name="BasisOfColumnModule" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    BasisOfColumnModule := "\n\
proc BasisOfColumnModule (matrix M)\n\
{\n\
  return(Involution(BasisOfRowModule(Involution(M))));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>
    
    PartiallyReducedBasisOfRowModule := "\n\
proc PartiallyReducedBasisOfRowModule (matrix M)\n\
{\n\
  return(mstd(M)[2]);\n\
}\n\n",
    
    PartiallyReducedBasisOfColumnModule := "\n\
proc PartiallyReducedBasisOfColumnModule (matrix M)\n\
{\n\
  return(Involution(PartiallyReducedBasisOfRowModule(Involution(M))));\n\
}\n\n",
    
#    ## according to the documentation B=M*T in the commutative case, but it somehow does not work :(
#    ## and for plural to work one would need to define B=transpose(transpose(T)*transpose(M)), which is expensive!!
#    BasisOfRowsCoeff := "\n\
#proc BasisOfRowsCoeff (matrix M)\n\
#{\n\
#  matrix T;\n\
#  matrix B = matrix(liftstd(M,T));\n\
#  list l = transpose(transpose(T)*transpose(M)),T;\n\
#  return(l)\n\
#}\n\n",

#never use stdlift, also because it might differ from std!!!
##  <#GAPDoc Label="BasisOfRowsCoeff:SingularMacro">
##  <ManSection>
##    <Func Arg="M, T" Name="BasisOfRowsCoeff" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    BasisOfRowsCoeff := """
proc BasisOfRowsCoeff (matrix M)
{
  matrix B = BasisOfRowModule(M);
  option(noredSB);
  matrix T = lift(M,B);
  option(redSB);
  return(B,T);
}

 """,
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>

##  <#GAPDoc Label="BasisOfColumnsCoeff:SingularMacro">
##  <ManSection>
##    <Func Arg="M, T" Name="BasisOfColumnsCoeff" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    BasisOfColumnsCoeff := """
proc BasisOfColumnsCoeff (matrix M)
{
  matrix B,T = BasisOfRowsCoeff(Involution(M));
  return(Involution(B),Involution(T));
}

 """,
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>
    
##  <#GAPDoc Label="DecideZeroRows:SingularMacro">
##  <ManSection>
##    <Func Arg="A, B" Name="DecideZeroRows" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    DecideZeroRows := "\n\
proc DecideZeroRows (matrix A, module B)\n\
{\n\
  attrib(B,\"isSB\",1);\n\
  return(reduce(A,B));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>

##  <#GAPDoc Label="DecideZeroColumns:SingularMacro">
##  <ManSection>
##    <Func Arg="A, B" Name="DecideZeroColumns" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    DecideZeroColumns := "\n\
proc DecideZeroColumns (matrix A, matrix B)\n\
{\n\
  return(Involution(DecideZeroRows(Involution(A),Involution(B))));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>
    
# division(A^t,B^t) returns (TT^t, M^t, U^t) with
#                A^t*U^t = B^t*TT^t + M^t
# <=> (ignore U) M^t = A^t - B^t*TT^tr
# <=>            M   = A   + (-TT) * B
# <=> (T:=-TT)   M   = A   + T * B
#M^t=A^t-T^t*B^t

##  <#GAPDoc Label="DecideZeroRowsEffectively:SingularMacro">
##  <ManSection>
##    <Func Arg="A, B, T" Name="DecideZeroRowsEffectively" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    DecideZeroRowsEffectively := """
proc DecideZeroRowsEffectively (matrix A, module B)
{
  attrib(B,"isSB",1);
  matrix M = reduce(A,B);
  matrix T = lift(B,M-A);
  return(M,T);
}

 """,
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>

##  <#GAPDoc Label="DecideZeroColumnsEffectively:SingularMacro">
##  <ManSection>
##    <Func Arg="A, B, T" Name="DecideZeroColumnsEffectively" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    DecideZeroColumnsEffectively := """
proc DecideZeroColumnsEffectively (matrix A, matrix B)
{
  matrix M,T = DecideZeroRowsEffectively(Involution(A),Involution(B));
  return(Involution(M),Involution(T));
}

 """,
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>
    
    SyzForHomalg := "\n\
proc SyzForHomalg (matrix M)\n\
{\n\
  return(syz(M));\n\
}\n\n",

##  <#GAPDoc Label="SyzygiesGeneratorsOfRows:SingularMacro">
##  <ManSection>
##    <Func Arg="M" Name="SyzygiesGeneratorsOfRows" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    SyzygiesGeneratorsOfRows := "\n\
proc SyzygiesGeneratorsOfRows (matrix M)\n\
{\n\
  return(SyzForHomalg(M));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>

##  <#GAPDoc Label="SyzygiesGeneratorsOfColumns:SingularMacro">
##  <ManSection>
##    <Func Arg="M" Name="SyzygiesGeneratorsOfColumns" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    SyzygiesGeneratorsOfColumns := "\n\
proc SyzygiesGeneratorsOfColumns (matrix M)\n\
{\n\
  return(Involution(SyzForHomalg(Involution(M))));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>

##  <#GAPDoc Label="RelativeSyzygiesGeneratorsOfRows:SingularMacro">
##  <ManSection>
##    <Func Arg="M, M2" Name="RelativeSyzygiesGeneratorsOfRows" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    RelativeSyzygiesGeneratorsOfRows := "\n\
proc RelativeSyzygiesGeneratorsOfRows (matrix M1, matrix M2)\n\
{\n\
  return(modulo(M1, M2));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>

##  <#GAPDoc Label="RelativeSyzygiesGeneratorsOfColumns:SingularMacro">
##  <ManSection>
##    <Func Arg="M, M2" Name="RelativeSyzygiesGeneratorsOfColumns" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    RelativeSyzygiesGeneratorsOfColumns := "\n\
proc RelativeSyzygiesGeneratorsOfColumns (matrix M1, matrix M2)\n\
{\n\
  return(Involution(RelativeSyzygiesGeneratorsOfRows(Involution(M1),Involution(M2))));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>

##  <#GAPDoc Label="ReducedSyzygiesGeneratorsOfRows:SingularMacro">
##  <ManSection>
##    <Func Arg="M" Name="ReducedSyzygiesGeneratorsOfRows" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    ReducedSyzForHomalg := "\n\
proc ReducedSyzForHomalg (matrix M)\n\
{\n\
  return(matrix(nres(M,2)[2]));\n\
}\n\n",
    ReducedSyzygiesGeneratorsOfRows := "\n\
proc ReducedSyzygiesGeneratorsOfRows (matrix M)\n\
{\n\
  return(ReducedSyzForHomalg(M));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>
    
##  <#GAPDoc Label="ReducedSyzygiesGeneratorsOfColumns:SingularMacro">
##  <ManSection>
##    <Func Arg="M" Name="ReducedSyzygiesGeneratorsOfColumns" Label="Singular macro"/>
##    <Returns></Returns>
##    <Description>
##    
##      <Listing Type="Code"><![CDATA[
    ReducedSyzygiesGeneratorsOfColumns := "\n\
proc ReducedSyzygiesGeneratorsOfColumns (matrix M)\n\
{\n\
  return(Involution(ReducedSyzForHomalg(Involution(M))));\n\
}\n\n",
##  ]]></Listing>
##    </Description>
##  </ManSection>
##  <#/GAPDoc>
    
    ("#superCommutative_ForHomalg") := "\n\
if ( defined(superCommutative) == 1 ) // the new name of the SCA constructor\n\
{ proc superCommutative_ForHomalg = superCommutative; }\n\
else\n\
{ \n\
  if ( defined(SuperCommutative) == 1 ) // the old name of the SCA constructor\n\
  { proc superCommutative_ForHomalg = SuperCommutative; }\n\
}\n\
\n\n",
    
    CoefficientsOfUnreducedNumeratorOfWeightedHilbertPoincareSeries := "\n\
proc CoefficientsOfUnreducedNumeratorOfWeightedHilbertPoincareSeries (module m,weights,degrees)\n\
{\n\
  module M = std(m);\n\
  attrib(M,\"isHomog\",degrees);\n\
  return(hilb(M,1,weights));\n\
}\n\n",

    PrimaryDecomposition := "\n\
proc PrimaryDecomposition (matrix m)\n\
{\n\
  return(primdecSY(m))\n\
}\n\n",

    PrimaryDecomposition_Z := "\n\
proc PrimaryDecomposition_Z (matrix m)\n\
{\n\
  return(primdecZ(m))\n\
}\n\n",

    RadicalSubobject := "\n\
proc RadicalSubobject (matrix m)\n\
{\n\
  return(matrix(radical(m)))\n\
}\n\n",

    RadicalSubobject_Z := "\n\
proc RadicalSubobject_Z (matrix m)\n\
{\n\
  return(matrix(radicalZ(m)))\n\
}\n\n",

    RadicalDecomposition := "\n\
proc RadicalDecomposition (matrix m)\n\
{\n\
  return(minAssGTZ(m))\n\
}\n\n",

    RadicalDecomposition_Z := "\n\
proc RadicalDecomposition_Z (matrix m)\n\
{\n\
  return(minAssZ(m))\n\
}\n\n",

    Deg := "\n\
// start: a workaround for a bug in the 64 bit versions of Singular 3-0-4\n\
if ( defined( basering ) != 0 )\n\
{\n\
  def homalg_variable_basering = basering;\n\
}\n\
ring r;\n\
if ( deg(0,(1,1,1)) > 0 )\n\
{ proc Deg (pol,weights)\n\
  {\n\
    if ( pol == 0 )\n\
    {\n\
      return(deg(0));\n\
    }\n\
    return(deg(pol,weights));\n\
  }\n\
}\n\
else\n\
{ proc Deg (pol,weights)\n\
  {\n\
    return(deg(pol,weights));\n\
  }\n\
}\n\
kill r;\n\
if ( defined( homalg_variable_basering ) != 0 )\n\
{\n\
  setring homalg_variable_basering;\n\
}\n\
// end: a workaround for a bug in the 64 bit versions of Singular 3-0-4\n\
\n\n",
    
    MatrixOfSymbols := "\n\
proc MatrixOfSymbols (matrix m)\n\
{\n\
  int i; int j; poly e;\n\
  int r=nrows(m);\n\
  int c=ncols(m);\n\
  matrix n[r][c]=0;\n\
  for(i=1;i<=r;i++)\n\
  {\n\
    for(j=1;j<=c;j++)\n\
    {\n\
      e=m[i,j];\n\
      if(e!=0)\n\
      { n[i,j]=e-jet(e,deg(e)-1); }\n\
    }\n\
  }\n\
  return(n);\n\
}\n\n",

    homalg_Symbol := "\n\
// deg(lead()) instead of deg() below works around a bug\n\
proc homalg_Symbol (poly e)\n\
{\n\
  if(e==0) {return(e);}\n\
  poly l=lead(e);\n\
  int d=deg(l);\n\
  poly s=l;\n\
  poly r=e-l;\n\
  l=lead(r);\n\
  while(deg(l)==d)\n\
  {\n\
    s=s+l;\n\
    r=r-l;\n\
    l=lead(r);\n\
  }\n\
  return(s);\n\
}\n\n",

    MatrixOfSymbols_workaround := "\n\
proc MatrixOfSymbols_workaround (matrix m)\n\
{\n\
  int i; int j; poly e;\n\
  int r=nrows(m);\n\
  int c=ncols(m);\n\
  matrix n[r][c]=0;\n\
  for(i=1;i<=r;i++)\n\
  {\n\
    for(j=1;j<=c;j++)\n\
    {\n\
      e=m[i,j];\n\
      if(e!=0)\n\
      { n[i,j]=homalg_Symbol(e); }\n\
    }\n\
  }\n\
  return(n);\n\
}\n\n",

    NumeratorAndDenominatorOfPolynomial := "\n\
proc NumeratorAndDenominatorOfPolynomial( poly f )\n\
{\n\
    poly numer, denom;\n\
    \n\
    denom = coeffs( cleardenom ( var(1)*f+1 ), var(1) )[ 1, 1 ];\n\
    numer = f * denom;\n\
    \n\
    return( numer, denom );\n\
}\n\n",
      
    NumeratorAndDenominatorOfRational := "\n\
proc NumeratorAndDenominatorOfRational( poly f )\n\
{\n\
    number r = number(f);\n\
    return( numerator(r), denominator(r) );\n\
}\n\n",
      
      EvaluateMatrix := "\n\
proc EvaluateMatrix( matrix M, list l )\n\
{\n\
    int r, c, i, j;\n\
    r = nrows( M );\n\
    c = ncols( M );\n\
    matrix N[ r ][ c ];\n\
    for ( i = 1; i <= r; i++ ){\n\
        for ( j = 1; j <= c; j++ ){\n\
            N[ i, j ] = subst( M[ i, j ], l[ 1 .. size( l ) ] );}}\n\
    return ( N );\n\
}\n\n",
      
      PolynomialExponentsAndCoefficients :="\n\
proc PolynomialExponentsAndCoefficients (poly p)\n\
{\n\
  int len = size( p );\n\
  list ret_array = list();\n\
  list exponents = list();\n\
  list coefficients = list();\n\
  \n\
  for(int i = 1; i <= len; i=i+1 )\n\
  {\n\
    exponents[ i ] = leadexp( p[ i ] );\n\
    coefficients[ i ] = leadcoef( p[ i ] );\n\
  }\n\
  ret_array[ 1 ] = exponents;\n\
  ret_array[ 2 ] = coefficients;\n\
  \n\
  return(ret_array);\n\
}\n\n",

    Diff := "\n\
proc Diff (matrix m, matrix n) // following the Macaulay2 convention \n\
{\n\
  int f = nrows(m);\n\
  int p = ncols(m);\n\
  int g = nrows(n);\n\
  int q = ncols(n);\n\
  matrix h[f*g][p*q]=0;\n\
  for (int i=1; i<=f; i=i+1)\n\
    {\n\
    for (int j=1; j<=g; j=j+1)\n\
      {\n\
      for (int k=1; k<=p; k=k+1)\n\
        {\n\
        for (int l=1; l<=q; l=l+1)\n\
          {\n\
            h[g*(i-1)+j,q*(k-1)+l] = diff( ideal(m[i,k]), ideal(n[j,l]) )[1,1];\n\
          }\n\
        }\n\
      }\n\
    }\n\
  return(h)\n\
}\n\n",
    
      MaximalDegreePart :="\n\
proc MaximalDegreePart (poly p, weights)\n\
{\n\
  int d = Deg(p,weights);\n\
  return(p - jet(p,d-1,weights));\n\
}\n\n",

      DualKroneckerMat := """
proc DualKroneckerMat(matrix A, matrix B)
{
  if(isCommutative())
  {
    return(tensor(B,A));
  }
  else
  {
    def old_ring = basering;
    def op_ring = opposite(old_ring);
    setring op_ring;
    matrix A = oppose(old_ring, A);
    matrix B = oppose(old_ring, B);
    matrix result = tensor(B,A);
    setring old_ring;
    matrix result = oppose(op_ring, result);
    return(result);
  }
}

 """,

    )

);

##
InstallGlobalFunction( InitializeSingularMacros,
  function( stream )
    local v;
    
    v := stream.variable_name;
    
    homalgSendBlocking( [ "int ", v, "i; int ", v, "j; int ", v, "k; list ", v, "l; string ", v, "s;\n\n" ], "need_command", stream, "initialize" );
    
    return InitializeMacros( SingularMacros, stream );
    
end );

####################################
#
# constructor functions and methods:
#
####################################

##
InstallGlobalFunction( RingForHomalgInSingular,
  function( arg )
    local finalizers, nargs, ar, R, RP;
    
    finalizers := PositionProperty( arg, i -> IsList( i ) and ForAll( i, IsFunction ) );
    
    if not finalizers = fail then
        finalizers := Remove( arg, finalizers );
    fi;
    
    nargs := Length( arg );
    
    ##this will lead to the call
    ##ring homalg_variable_something = arg[1];
    ar := [ arg[1], [ "ring" ] ];
    
    Add( ar, TheTypeHomalgExternalRingObjectInSingular );
    
    if nargs > 1 then
        Append( ar, arg{[ 2 .. nargs ]} );
    fi;
    
    ar := [ ar, TheTypeHomalgExternalRingInSingular ];
    
    Add( ar, "HOMALG_IO_Singular" );
    
    if not finalizers = fail then
        Add( ar, finalizers );
    fi;
    
    R := CallFuncList( CreateHomalgExternalRing, ar );
    
    _Singular_SetRing( R );
    
    RP := homalgTable( R );
    
    RP!.SetInvolution :=
      function( R )
        homalgSendBlocking( "\nproc Involution (matrix m)\n{\n  return(transpose(m));\n}\n\n", "need_command", R, "define" );
    end;
    
    RP!.NumeratorAndDenominatorOfPolynomial := RP!.NumeratorAndDenominatorOfRational;
    
    homalgStream( R ).setinvol( R );
    
    LetWeakPointerListOnExternalObjectsContainRingCreationNumbers( R );
    
    return R;
    
end );

##
InstallGlobalFunction( HomalgRingOfIntegersInSingular,
  function( arg )
    local nargs, c, d, param, minimal_polynomial, r, R, RP;
    
    nargs := Length( arg );
    
    if nargs > 0 and IsInt( arg[1] ) and arg[1] <> 0 then
        ## characteristic:
        c := AbsInt( arg[1] );
        arg := arg{[ 2 .. nargs ]};
        if nargs > 1 and IsPosInt( arg[1] ) then
            d := arg[1];
            if d > 1 then
                param := Concatenation( "Z", String( c ), "_", String( d ) );
                minimal_polynomial := UnivariatePolynomial( ConwayPol( c, d ), param );
                arg := Concatenation( [ c, param, minimal_polynomial ], arg{[ 2 .. nargs - 1 ]} );
                R := CallFuncList( HomalgRingOfIntegersInSingular, arg );
                SetRingProperties( R, c, d );
                R!.NameOfPrimitiveElement := param;
                SetName( R, Concatenation( "GF(", String( c ), "^", String( d ), ")" ) );
                return R;
            fi;
            arg := arg{[ 2 .. Length( arg ) ]};
        fi;
    else
        ## characteristic:
        c := 0;
        if nargs > 0 and arg[1] = 0 then
            arg := arg{[ 2 .. nargs ]};
        fi;
    fi;
    
    if not ( IsZero( c ) or IsPrime( c ) ) then
        return HomalgRingOfIntegersInSingular( ) / c;
    fi;
    
    ## we create GF(p)[dummy_variable] and feed only expressions without
    ## "dummy_variable" to Singular. Since GAP does not know about
    ## the dummy_variable it will vanish during the next ring extension
    
    nargs := Length( arg );
    
    if nargs > 0 and IsString( arg[1] ) then
        
        param := ParseListOfIndeterminates( SplitString( arg[1], "," ) );
        
        arg := arg{[ 2 .. nargs ]};
        
        if nargs > 1 and IsString( arg[1] ) then
            minimal_polynomial := arg[1];
            arg := arg{[ 2 .. nargs - 1 ]};
        fi;
        
        r := CallFuncList( HomalgRingOfIntegersInSingular, Concatenation( [ c ], arg ) );
        
        if IsZero( c ) then
            R := [ "(integer,", JoinStringsWithSeparator( param ), "),dummy_variable,(dp,c)" ];
        else
            R := [ "(", String( c ), ",", JoinStringsWithSeparator( param ), "),dummy_variable,(dp,c)" ];
        fi;
        
    else
        
        if IsZero( c ) then
            R := [ "(integer)", ",dummy_variable,(dp,c)" ];
        else
            R := [ String( c ), ",dummy_variable,(dp,c)" ];
        fi;
        
    fi;
    
    R := Concatenation( [ R, IsPrincipalIdealRing ], arg );
    
    if IsBound( r ) then
        ## R will be defined in the same instance of Singular as r
        Add( R, r );
    fi;
    
    if IsBound( minimal_polynomial ) then
        ## FIXME: we assume the polynomial is irreducible of degree > 1
        Add( R,
             [ function( R )
                 local name;
                 
                 name := homalgSendBlocking( [ minimal_polynomial ], "need_output", R, "homalgSetName" );
                 if name[1] = '(' and name[Length( name )] = ')' then
                     name := name{[ 2 .. Length( name ) - 1 ]};
                 fi;
                 R!.MinimalPolynomialOfPrimitiveElement := name;
                 homalgSendBlocking( [ "minpoly=", minimal_polynomial ], "need_command", R, "define" );
               end ] );
    fi;
    
    R := CallFuncList( RingForHomalgInSingular, R );
    
    if IsBound( param ) then
        
        param := List( param, function( a ) local r; r := HomalgExternalRingElement( a, R ); SetName( r, a ); return r; end );
        
        SetRationalParameters( R, param );
        
        SetIsResidueClassRingOfTheIntegers( R, false );
        
        if IsPrime( c ) then
            SetIsFieldForHomalg( R, true );
            ## FIXME: we assume the polynomial is irreducible of degree > 1
            if not IsBound( minimal_polynomial ) then
                SetCoefficientsRing( R, r );
            fi;
        else
            SetCoefficientsRing( R, r );
            SetIsFieldForHomalg( R, false );
            SetIsPrincipalIdealRing( R, true );
            SetIsCommutative( R, true );
        fi;
        
    else
        
        SetIsResidueClassRingOfTheIntegers( R, true );
        
    fi;
    
    SetRingProperties( R, c );
    
    if HasIsIntegersForHomalg( R ) and IsIntegersForHomalg( R ) then
        RP := homalgTable( R );
        RP!.IsUnit := RP!.IsUnit_Z;
        RP!.GetColumnIndependentUnitPositions := RP!.GetColumnIndependentUnitPositions_Z;
        RP!.GetRowIndependentUnitPositions := RP!.GetRowIndependentUnitPositions_Z;
        RP!.GetUnitPosition := RP!.GetUnitPosition_Z;
        RP!.PrimaryDecomposition := RP!.PrimaryDecomposition_Z;
        RP!.RadicalSubobject := RP!.RadicalSubobject_Z;
        RP!.RadicalDecomposition := RP!.RadicalDecomposition_Z;
        Unbind( RP!.CoefficientsOfUnreducedNumeratorOfWeightedHilbertPoincareSeries );
        Unbind( RP!.MaximalDegreePart );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfRows );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfColumns );
    fi;
    
    return R;
    
end );

##
InstallMethod( HomalgRingOfIntegersInUnderlyingCAS,
        "for an integer and homalg ring in Singular",
        [ IsInt, IsHomalgExternalRingInSingularRep ],
        
  HomalgRingOfIntegersInSingular );

##
InstallGlobalFunction( HomalgFieldOfRationalsInSingular,
  function( arg )
    local nargs, param, minimal_polynomial, Q, R;
    
    ## we create Q[dummy_variable] and feed only expressions without
    ## "dummy_variable" to Singular. Since GAP does not know about
    ## the dummy_variable it will vanish during the next ring extension
    
    nargs := Length( arg );
    
    if nargs > 0 and IsString( arg[1] ) then
        
        param := ParseListOfIndeterminates( SplitString( arg[1], "," ) );
        
        arg := arg{[ 2 .. nargs ]};
        
        if nargs > 1 and IsString( arg[1] ) then
            minimal_polynomial := arg[1];
            arg := arg{[ 2 .. nargs - 1 ]};
        fi;
        
        Q := CallFuncList( HomalgFieldOfRationalsInSingular, arg );

        if param = [ ] then
            R := "0,dummy_variable,(dp,c)";
        else
            R := [ "(0,", JoinStringsWithSeparator( param ), "),dummy_variable,(dp,c)" ];
        fi;
        
    else
        
        R := "0,dummy_variable,(dp,c)";
        
    fi;
    
    R := Concatenation( [ R ], [ IsPrincipalIdealRing ], arg );
    
    if IsBound( Q ) then
        ## R will be defined in the same instance of Singular as Q
        Add( R, Q );
    fi;
    
    if IsBound( minimal_polynomial ) then
        ## FIXME: we assume the polynomial is irreducible of degree > 1
        Add( R,
             [ function( R )
                 local name;
                 
                 name := homalgSendBlocking( [ minimal_polynomial ], "need_output", R, "homalgSetName" );
                 if name[1] = '(' and name[Length( name )] = ')' then
                     name := name{[ 2 .. Length( name ) - 1 ]};
                 fi;
                 R!.MinimalPolynomialOfPrimitiveElement := name;
                 homalgSendBlocking( [ "minpoly=", minimal_polynomial ], "need_command", R, "define" );
               end ] );
    fi;
    
    R := CallFuncList( RingForHomalgInSingular, R );
    
    if IsBound( param ) and not IsEmpty( param ) then
        
        param := List( param, function( a ) local r; r := HomalgExternalRingElement( a, R ); SetName( r, a ); return r; end );
        
        SetRationalParameters( R, param );
        
        SetIsFieldForHomalg( R, true );
        
        SetCoefficientsRing( R, Q );
        
    else
        
        SetIsRationalsForHomalg( R, true );
        
    fi;
    
    SetRingProperties( R, 0 );
    
    return R;
    
end );

##
InstallMethod( HomalgFieldOfRationalsInUnderlyingCAS,
        "for a homalg ring in Singular",
        [ IsHomalgExternalRingInSingularRep ],
        
  HomalgFieldOfRationalsInSingular );

##
InstallMethod( FieldOfFractions,
        "for homalg rings in Singular",
        [ IsHomalgExternalRingInSingularRep and IsIntegersForHomalg ],
        
  function( zz )
    
    return HomalgFieldOfRationalsInSingular( zz );
    
end );

##
InstallMethod( PolynomialRing,
        "for homalg rings in Singular",
        [ IsHomalgExternalRingInSingularRep, IsList ],
        
  function( R, indets )
    local order, ar, r, var, nr_var, properties, param, l, var_base, var_fibr, ext_obj, S, weights, P, L, W, RP;
    
    order := ValueOption( "order" );
    
    ar := _PrepareInputForPolynomialRing( R, indets );
    
    r := ar[1];
    var := ar[2];    ## all indeterminates, relative and base
    nr_var := ar[3]; ## the number of relative indeterminates
    properties := ar[4];
    param := ar[5];
    
    l := Length( var );
    
    ## create the new ring
    if IsString( order ) and Length( order ) >= 3 and order{[ 1 .. 3 ]} = "lex" then
        
        var_base := var{[ 1 .. l - nr_var ]};
        var_fibr := var{[ l - nr_var + 1 .. l ]};
        
        ## lex order
        if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
            ext_obj := homalgSendBlocking( [ "(integer", param, "),(", Concatenation( var_fibr, var_base ), "),(lp,c)" ], [ "ring" ], TheTypeHomalgExternalRingObjectInSingular, properties, R, "CreateHomalgRing" );
        else
            ext_obj := homalgSendBlocking( [ "(", Characteristic( R ), param, "),(", Concatenation( var_fibr, var_base ), "),(lp,c)" ], [ "ring" ], TheTypeHomalgExternalRingObjectInSingular, properties, R, "CreateHomalgRing" );
        fi;
        
    elif IsRecord( order ) and IsBound( order.weights ) then
        
        ## weighted degrevlex order
        if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
            ext_obj := homalgSendBlocking( [ "(integer", param, "),(", var, "),(wp(", order.weights, "),c)" ], [ "ring" ], TheTypeHomalgExternalRingObjectInSingular, properties, R, "CreateHomalgRing" );
        else
            ext_obj := homalgSendBlocking( [ "(", Characteristic( R ), param, "),(", var, "),(wp(", order.weights, "),c)" ], [ "ring" ], TheTypeHomalgExternalRingObjectInSingular, properties, R, "CreateHomalgRing" );
        fi;
        
    elif order = "product" or order = "block" then
        
        var_base := var{[ 1 .. l - nr_var ]};
        var_fibr := var{[ l - nr_var + 1 .. l ]};
        
        ## block order
        weights := Concatenation( Concatenation( List( [ 1 .. Length( var_base ) ], a -> "0," ) ), Concatenation( List( [ 1 .. Length( var_fibr ) ], a -> "1," ) ) );
        weights := weights{[ 1 .. Length( weights ) - 1 ]}; # remove trailing comma
        if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
            ext_obj := homalgSendBlocking( [ "(integer", param, "),(", var_base, var_fibr, "),(a(", weights, "),dp,c)" ], [ "ring" ], TheTypeHomalgExternalRingObjectInSingular, properties, R, "CreateHomalgRing" );
        else
            ext_obj := homalgSendBlocking( [ "(", Characteristic( R ), param, "),(", var_base, var_fibr, "),(a(", weights, "),dp,c)" ], [ "ring" ], TheTypeHomalgExternalRingObjectInSingular, properties, R, "CreateHomalgRing" );
        fi;
        
    else
        
        ## degrevlex order
        if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
            ext_obj := homalgSendBlocking( [ "(integer", param, "),(", var, "),(dp,c)" ], [ "ring" ], TheTypeHomalgExternalRingObjectInSingular, properties, R, "CreateHomalgRing" );
        else
            ext_obj := homalgSendBlocking( [ "(", Characteristic( R ), param, "),(", var, "),(dp,c)" ], [ "ring" ], TheTypeHomalgExternalRingObjectInSingular, properties, R, "CreateHomalgRing" );
        fi;
        
    fi;
    
    ## this must precede CreateHomalgExternalRing as otherwise
    ## the definition of 0,1,-1 would precede "minpoly=";
    ## causing an error in the new Singular
    if IsBound( r!.MinimalPolynomialOfPrimitiveElement ) then
        homalgSendBlocking( [ "minpoly=", r!.MinimalPolynomialOfPrimitiveElement ], "need_command", ext_obj, "define" );
    fi;
    
    S := CreateHomalgExternalRing( ext_obj, TheTypeHomalgExternalRingInSingular );
    
    S!.order := order;
    
    var := List( var, a -> HomalgExternalRingElement( a, S ) );
    
    Perform( var, Name );
    
    SetIsFreePolynomialRing( S, true );
    
    if HasIndeterminatesOfPolynomialRing( R ) and IndeterminatesOfPolynomialRing( R ) <> [ ] then
        
        SetBaseRing( S, R );
        SetRelativeIndeterminatesOfPolynomialRing( S, var{[ l - nr_var + 1 .. l ]} );
        
        if order = fail then
            
            P := PolynomialRingWithProductOrdering( R, indets );
            
            weights := Concatenation( ListWithIdenticalEntries( l - nr_var, 0 ), ListWithIdenticalEntries( nr_var, 1 ) );
            W := PolynomialRing( R, indets : order := rec( weights := weights ) );
            
            SetPolynomialRingWithDegRevLexOrdering( S, S );
            SetPolynomialRingWithDegRevLexOrdering( P, S );
            SetPolynomialRingWithDegRevLexOrdering( W, S );
            
            SetPolynomialRingWithProductOrdering( S, P );
            SetPolynomialRingWithProductOrdering( P, P );
            SetPolynomialRingWithProductOrdering( W, P );
            
            SetPolynomialRingWithWeightedOrdering( S, W );
            SetPolynomialRingWithWeightedOrdering( P, W );
            SetPolynomialRingWithWeightedOrdering( W, W );
            
        fi;
        
    else
        
        if order = fail then
            
            SetPolynomialRingWithDegRevLexOrdering( S, S );
            
        fi;
        
    fi;
    
    SetRingProperties( S, r, var );
    
    RP := homalgTable( S );
    
    RP!.SetInvolution :=
      function( R )
        homalgSendBlocking( "\nproc Involution (matrix m)\n{\n  return(transpose(m));\n}\n\n", "need_command", R, "define" );
    end;
    
    homalgStream( S ).setinvol( S );
    
    if not ( HasIsFieldForHomalg( r ) and IsFieldForHomalg( r ) ) then
        Unbind( RP!.IsUnit );
        Unbind( RP!.GetColumnIndependentUnitPositions );
        Unbind( RP!.GetRowIndependentUnitPositions );
        Unbind( RP!.GetUnitPosition );
    fi;
    
    if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
        RP!.IsUnit := RP!.IsUnit_Z;
        RP!.GetColumnIndependentUnitPositions := RP!.GetColumnIndependentUnitPositions_Z;
        RP!.GetRowIndependentUnitPositions := RP!.GetRowIndependentUnitPositions_Z;
        RP!.GetUnitPosition := RP!.GetUnitPosition_Z;
        RP!.PrimaryDecomposition := RP!.PrimaryDecomposition_Z;
        RP!.RadicalSubobject := RP!.RadicalSubobject_Z;
        RP!.RadicalDecomposition := RP!.RadicalDecomposition_Z;
        Unbind( RP!.CoefficientsOfUnreducedNumeratorOfWeightedHilbertPoincareSeries );
        Unbind( RP!.MaximalDegreePart );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfRows );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfColumns );
    fi;
    
    return S;
    
end );

##
InstallMethod( PolynomialRing,
        "for a homalg ring in Singular",
        [ IsHomalgExternalQRingInSingularRep and HasAmbientRing, IsList ],
        
  function( R, indets )
    local S;
    
    S := PolynomialRing( AmbientRing( R ), indets );
    
    return HomalgQRingInSingular( S, S * RingRelations( R ) );
    
end );

##
InstallMethod( PolynomialRingWithProductOrdering,
        "for homalg rings in Singular",
        [ IsHomalgExternalRingInSingularRep, IsList ],
        
  function( R, indets )
    
    return PolynomialRing( R, indets : order := "product" );
    
end );

##
InstallMethod( PolynomialRingWithLexicographicOrdering,
        "for homalg rings in Singular",
        [ IsHomalgExternalRingInSingularRep, IsList ],
        
  function( R, indets )
    
    return PolynomialRing( R, indets : order := "lex" );
    
end );

##
InstallMethod( RingOfDerivations,
        "for homalg rings in Singular",
        [ IsHomalgExternalRingInSingularRep, IsList ],
        
  function( R, indets )
    local ar, r, var, der, param, base, stream, display_color, ext_obj, b, n, S, RP;
    
    ar := _PrepareInputForRingOfDerivations( R, indets );
    
    r := ar[1];
    var := ar[2];
    der := ar[3];
    param := ar[4];
    base := ar[5];
    
    stream := homalgStream( R );
    
    if ( not ( IsBound( HOMALG_IO.show_banners ) and HOMALG_IO.show_banners = false )
         and not ( IsBound( stream.show_banner ) and stream.show_banner = false )
         and not ( IsBound( stream.show_banner_PLURAL ) and stream.show_banner_PLURAL = false ) ) then
        
        if IsBound( stream.color_display ) then
            display_color := stream.color_display;
        else
            display_color := "";
        fi;
        
        Print( "================================================================\n" );
        
        ## leave the below indentation untouched!
        Print( display_color, "\
                     SINGULAR::PLURAL\n\
The SINGULAR Subsystem for Non-commutative Polynomial Computations\n\
     by: G.-M. Greuel, V. Levandovskyy, H. Schoenemann\n\
FB Mathematik der Universitaet, D-67653 Kaiserslautern\033[0m\n\
================================================================\n" );
        
        stream.show_banner_PLURAL := false;
        
    fi;
    
    ## create the new ring in 2 steps: expand polynomial ring with derivatives and then
    ## add the Weyl-structure
    ## todo: this creates a block ordering with a new "dp"-block
    if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
        if base <> "" then
            ext_obj := homalgSendBlocking( [ "(integer", param,  "),(", base, var, der, "),(dp(", Length( base ), "),dp,c)" ], [ "ring" ], R, "initialize" );
        else
            ext_obj := homalgSendBlocking( [ "(integer", param,  "),(", var, der, "),(dp,c)" ], [ "ring" ], R, "initialize" );
        fi;
    else
        if base <> "" then
            ext_obj := homalgSendBlocking( [ "(", Characteristic( R ), param, "),(", base, var, der, "),(dp(", Length( base ), "),dp,c)" ], [ "ring" ], R, "initialize" );
        else
            ext_obj := homalgSendBlocking( [ "(", Characteristic( R ), param, "),(", var, der, "),(dp,c)" ], [ "ring" ], R, "initialize" );
        fi;
    fi;
    
    ## as we are not yet done we cannot call CreateHomalgExternalRing
    ## to create a HomalgRing, and only then would homalgSendBlocking call stream.setring,
    ## so till then we have to prevent the garbage collector from stepping in
    stream.DeletePeriod_save := stream.DeletePeriod;
    stream.DeletePeriod := false;
    
    if base <> "" then
        b := Length( base );
        n := b + Length( var ) + Length( der );
        homalgSendBlocking( [ "matrix @M[", n, "][", n, "]" ], "need_command", ext_obj, "initialize" );
        n := Length( der );
        b := List( [ 1 .. Length( der ) ], i -> Concatenation( "@M[", String( b + i ), ",", String( b + n + i ), "] = 1;" ) );
        homalgSendBlocking( Concatenation( b ), "need_command", ext_obj, "initialize" );
        ext_obj := homalgSendBlocking( [ "nc_algebra(1,@M)" ], [ "def" ], TheTypeHomalgExternalRingObjectInSingular, ext_obj, "CreateHomalgRing" );
    else
        ext_obj := homalgSendBlocking( [ "Weyl()" ], [ "def" ], TheTypeHomalgExternalRingObjectInSingular, ext_obj, "CreateHomalgRing" );
    fi;
    
    ## this must precede CreateHomalgExternalRing as otherwise
    ## the definition of 0,1,-1 would precede "minpoly=";
    ## causing an error in the new Singular
    if IsBound( r!.MinimalPolynomialOfPrimitiveElement ) then
        homalgSendBlocking( [ "minpoly=", r!.MinimalPolynomialOfPrimitiveElement ], "need_command", ext_obj, "define" );
    fi;
    
    S := CreateHomalgExternalRing( ext_obj, TheTypeHomalgExternalRingInSingular );
    
    ## now it is safe to call the garbage collector
    stream.DeletePeriod := stream.DeletePeriod_save;
    Unbind( stream.DeletePeriod_save );
    
    der := List( der , a -> HomalgExternalRingElement( a, S ) );
    
    Perform( der, Name );
    
    SetIsWeylRing( S, true );
    
    SetBaseRing( S, R );
    
    SetRingProperties( S, R, der );
    
    RP := homalgTable( S );
    
    RP!.SetInvolution :=
      function( R )
        homalgSendBlocking( Concatenation(
                [ "\nproc Involution (matrix M)\n{\n" ],
                [ "  map F = ", R, ", " ],
                [ JoinStringsWithSeparator( List( IndeterminateCoordinatesOfRingOfDerivations( R ), String ) ) ],
                Concatenation( List( IndeterminateDerivationsOfRingOfDerivations( R ), a -> [ ", -" , String( a ) ] ) ),
                [ ";\n  return( transpose( involution( M, F ) ) );\n}\n\n" ]
                ), "need_command", "define" );
    end;
    
    homalgStream( S ).setinvol( S );
    
    RP!.Compose :=
      function( A, B )
        
        # fix the broken design of Plural
        return homalgSendBlocking( [ "transpose( transpose(", A, ") * transpose(", B, ") )" ], [ "matrix" ], "Compose" );
        
    end;
    
    ## there exists a bug in Plural (3-0-4,3-1-0) that occurs with nres(M,2)[2];
    if homalgSendBlocking( "\n\
// start: check the nres-isHomog-bug in Plural:\n\
ring homalg_Weyl_1 = 0,(x,y,z,Dx,Dy,Dz),dp;\n\
def homalg_Weyl_2 = Weyl();\n\
setring homalg_Weyl_2;\n\
option(redTail);short=0;\n\
matrix homalg_Weyl_3[1][3] = 3*Dy-Dz,2*x,3*Dx+3*Dz;\n\
matrix homalg_Weyl_4 = nres(homalg_Weyl_3,2)[2];\n\
ncols(homalg_Weyl_4) == 2; kill homalg_Weyl_4; kill homalg_Weyl_3; kill homalg_Weyl_2; kill homalg_Weyl_1;\n\
// end: check the nres-isHomog-bug in Plural."
    , "need_output", S, "initialize" ) = "1" then;
    
        Unbind( RP!.ReducedSyzygiesGeneratorsOfRows );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfColumns );
    fi;
    
    _Singular_SetRing( S );
    
    ## there seems to exists a bug in Plural that occurs with mres(M,1)[1];
    Unbind( RP!.ReducedBasisOfRowModule );
    Unbind( RP!.ReducedBasisOfColumnModule );
    
    if not ( HasIsFieldForHomalg( r ) and IsFieldForHomalg( r ) ) then
        Unbind( RP!.IsUnit );
        Unbind( RP!.GetColumnIndependentUnitPositions );
        Unbind( RP!.GetRowIndependentUnitPositions );
        Unbind( RP!.GetUnitPosition );
    fi;
    
    if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
        RP!.IsUnit := RP!.IsUnit_Z;
        RP!.GetColumnIndependentUnitPositions := RP!.GetColumnIndependentUnitPositions_Z;
        RP!.GetRowIndependentUnitPositions := RP!.GetRowIndependentUnitPositions_Z;
        RP!.GetUnitPosition := RP!.GetUnitPosition_Z;
        RP!.PrimaryDecomposition := RP!.PrimaryDecomposition_Z;
        RP!.RadicalSubobject := RP!.RadicalSubobject_Z;
        RP!.RadicalDecomposition := RP!.RadicalDecomposition_Z;
        Unbind( RP!.CoefficientsOfUnreducedNumeratorOfWeightedHilbertPoincareSeries );
        Unbind( RP!.MaximalDegreePart );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfRows );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfColumns );
    fi;
    
    return S;
    
end );

##
InstallMethod( RingOfDerivations,
        "for homalg rings in Singular",
        [ IsHomalgExternalRingInSingularRep, IsList, IsList ],
        
  function( R, indets, weights )
    local ar, r, var, der, param, stream, display_color, ext_obj, S, RP;
    
    ar := _PrepareInputForRingOfDerivations( R, indets );
    
    r := ar[1];
    var := ar[2];
    der := ar[3];
    param := ar[4];
    
    stream := homalgStream( R );
    
    if ( not ( IsBound( HOMALG_IO.show_banners ) and HOMALG_IO.show_banners = false )
         and not ( IsBound( stream.show_banner ) and stream.show_banner = false )
         and not ( IsBound( stream.show_banner_PLURAL ) and stream.show_banner_PLURAL = false ) ) then
        
        if IsBound( stream.color_display ) then
            display_color := stream.color_display;
        else
            display_color := "";
        fi;
        
        Print( "================================================================\n" );
        
        ## leave the below indentation untouched!
        Print( display_color, "\
                     SINGULAR::PLURAL\n\
The SINGULAR Subsystem for Non-commutative Polynomial Computations\n\
     by: G.-M. Greuel, V. Levandovskyy, H. Schoenemann\n\
FB Mathematik der Universitaet, D-67653 Kaiserslautern\033[0m\n\
================================================================\n" );
        
        stream.show_banner_PLURAL := false;
        
    fi;
    
    ## create the new ring in 2 steps: expand polynomial ring with derivatives and then
    ## add the Weyl-structure
    ## todo: this creates a block ordering with a new "dp"-block
    if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
        ext_obj := homalgSendBlocking( [ "(integer", param,  "),(", var, der, "),(wp(", weights, "),c)" ], [ "ring" ], R, "initialize" );
    else
        ext_obj := homalgSendBlocking( [ "(", Characteristic( R ), param, "),(", var, der, "),(wp(", weights, "),c)" ], [ "ring" ], R, "initialize" );
    fi;
    
    ## as we are not yet done we cannot call CreateHomalgExternalRing
    ## to create a HomalgRing, and only then would homalgSendBlocking call stream.setring,
    ## so till then we have to prevent the garbage collector from stepping in
    stream.DeletePeriod_save := stream.DeletePeriod;
    stream.DeletePeriod := false;
    
    ext_obj := homalgSendBlocking( [ "Weyl();" ], [ "def" ], TheTypeHomalgExternalRingObjectInSingular, ext_obj, "CreateHomalgRing" );
    
    ## this must precede CreateHomalgExternalRing as otherwise
    ## the definition of 0,1,-1 would precede "minpoly=";
    ## causing an error in the new Singular
    if IsBound( r!.MinimalPolynomialOfPrimitiveElement ) then
        homalgSendBlocking( [ "minpoly=", r!.MinimalPolynomialOfPrimitiveElement ], "need_command", ext_obj, "define" );
    fi;
    
    S := CreateHomalgExternalRing( ext_obj, TheTypeHomalgExternalRingInSingular );
    
    ## now it is safe to call the garbage collector
    stream.DeletePeriod := stream.DeletePeriod_save;
    Unbind( stream.DeletePeriod_save );
    
    der := List( der , a -> HomalgExternalRingElement( a, S ) );
    
    Perform( der, Name );
    
    SetIsWeylRing( S, true );
    
    SetBaseRing( S, R );
    
    SetRingProperties( S, R, der );
    
    RP := homalgTable( S );
    
    RP!.SetInvolution :=
      function( R )
        homalgSendBlocking( Concatenation(
                [ "\nproc Involution (matrix M)\n{\n" ],
                [ "  map F = ", R, ", " ],
                [ JoinStringsWithSeparator( List( IndeterminateCoordinatesOfRingOfDerivations( R ), String ) ) ],
                Concatenation( List( IndeterminateDerivationsOfRingOfDerivations( R ), a -> [ ", -" , String( a ) ] ) ),
                [ ";\n  return( transpose( involution( M, F ) ) );\n}\n\n" ]
                ), "need_command", "define" );
    end;
    
    homalgStream( S ).setinvol( S );
    
    RP!.Compose :=
      function( A, B )
        
        # fix the broken design of Plural
        return homalgSendBlocking( [ "transpose( transpose(", A, ") * transpose(", B, ") )" ], [ "matrix" ], "Compose" );
        
    end;
    
    ## there exists a bug in Plural (3-0-4,3-1-0) that occurs with nres(M,2)[2];
    if homalgSendBlocking( "\n\
// start: check the nres-isHomog-bug in Plural:\n\
ring homalg_Weyl_1 = 0,(x,y,z,Dx,Dy,Dz),dp;\n\
def homalg_Weyl_2 = Weyl();\n\
setring homalg_Weyl_2;\n\
option(redTail);short=0;\n\
matrix homalg_Weyl_3[1][3] = 3*Dy-Dz,2*x,3*Dx+3*Dz;\n\
matrix homalg_Weyl_4 = nres(homalg_Weyl_3,2)[2];\n\
ncols(homalg_Weyl_4) == 2; kill homalg_Weyl_4; kill homalg_Weyl_3; kill homalg_Weyl_2; kill homalg_Weyl_1;\n\
// end: check the nres-isHomog-bug in Plural."
    , "need_output", S, "initialize" ) = "1" then;
    
        Unbind( RP!.ReducedSyzygiesGeneratorsOfRows );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfColumns );
    fi;
    
    _Singular_SetRing( S );
    
    ## there seems to exists a bug in Plural that occurs with mres(M,1)[1];
    Unbind( RP!.ReducedBasisOfRowModule );
    Unbind( RP!.ReducedBasisOfColumnModule );
    
    if not ( HasIsFieldForHomalg( r ) and IsFieldForHomalg( r ) ) then
        Unbind( RP!.IsUnit );
        Unbind( RP!.GetColumnIndependentUnitPositions );
        Unbind( RP!.GetRowIndependentUnitPositions );
        Unbind( RP!.GetUnitPosition );
    fi;
    
    if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
        RP!.IsUnit := RP!.IsUnit_Z;
        RP!.GetColumnIndependentUnitPositions := RP!.GetColumnIndependentUnitPositions_Z;
        RP!.GetRowIndependentUnitPositions := RP!.GetRowIndependentUnitPositions_Z;
        RP!.GetUnitPosition := RP!.GetUnitPosition_Z;
        RP!.PrimaryDecomposition := RP!.PrimaryDecomposition_Z;
        RP!.RadicalSubobject := RP!.RadicalSubobject_Z;
        RP!.RadicalDecomposition := RP!.RadicalDecomposition_Z;
        Unbind( RP!.CoefficientsOfUnreducedNumeratorOfWeightedHilbertPoincareSeries );
        Unbind( RP!.MaximalDegreePart );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfRows );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfColumns );
    fi;
    
    if 0 in weights then
        Unbind( RP!.IsUnit );
        Unbind( RP!.GetColumnIndependentUnitPositions );
        Unbind( RP!.GetRowIndependentUnitPositions );
        Unbind( RP!.GetUnitPosition );
    fi;
    
    RP!.MatrixOfSymbols := RP!.MatrixOfSymbols_workaround;
    
    return S;
    
end );

##
InstallMethod( ExteriorRing,
        "for homalg rings in Singular",
        [ IsHomalgExternalRingInSingularRep, IsHomalgExternalRingInSingularRep, IsHomalgExternalRingInSingularRep, IsList ],
        
  function( R, Coeff, Base, indets )
    local ar, r, param, var, anti, comm, stream, display_color, ext_obj, S, RP;
    
    ar := _PrepareInputForExteriorRing( R, Base, indets );
    
    r := ar[1];
    param := ar[2];
    var := ar[3];
    anti := ar[4];
    comm := ar[5];
    
    stream := homalgStream( R );
    
    if ( not ( IsBound( HOMALG_IO.show_banners ) and HOMALG_IO.show_banners = false )
         and not ( IsBound( stream.show_banner ) and stream.show_banner = false )
         and not ( IsBound( stream.show_banner_SCA ) and stream.show_banner_SCA = false ) ) then
        
        if IsBound( stream.color_display ) then
            display_color := stream.color_display;
        else
            display_color := "";
        fi;
        
        Print( "================================================================\n" );
        
        ## leave the below indentation untouched!
        Print( display_color, "\
                     SINGULAR::SCA\n\
The SINGULAR Subsystem for Super-Commutative Algebras\n\
     by: G.-M. Greuel, O. Motsak, H. Schoenemann\n\
FB Mathematik der Universitaet, D-67653 Kaiserslautern\033[0m\n\
================================================================\n" );
        
        stream.show_banner_SCA := false;
        
    fi;
    
    ## create the new ring in 2 steps: create a polynomial ring with anti commuting and commuting variables and then
    ## add the exterior structure
    ext_obj := homalgSendBlocking( [ "(", Characteristic( R ), param, "),(", Concatenation( comm, anti ), "),(dp,c)" ], [ "ring" ], R, "initialize" );
    
    ## as we are not yet done we cannot call CreateHomalgExternalRing
    ## to create a HomalgRing, and only then would homalgSendBlocking call stream.setring,
    ## so till then we have to prevent the garbage collector from stepping in
    stream.DeletePeriod_save := stream.DeletePeriod;
    stream.DeletePeriod := false;
    
    ext_obj := homalgSendBlocking( [ "superCommutative_ForHomalg(", Length( comm ) + 1, ");" ], [ "def" ], TheTypeHomalgExternalRingObjectInSingular, ext_obj, "CreateHomalgRing" );
    
    ## this must precede CreateHomalgExternalRing as otherwise
    ## the definition of 0,1,-1 would precede "minpoly=";
    ## causing an error in the new Singular
    if IsBound( r!.MinimalPolynomialOfPrimitiveElement ) then
        homalgSendBlocking( [ "minpoly=", r!.MinimalPolynomialOfPrimitiveElement ], "need_command", ext_obj, "define" );
    fi;
    
    S := CreateHomalgExternalRing( ext_obj, TheTypeHomalgExternalRingInSingular );
    
    ## now it is safe to call the garbage collector
    stream.DeletePeriod := stream.DeletePeriod_save;
    Unbind( stream.DeletePeriod_save );
    
    anti := List( anti , a -> HomalgExternalRingElement( a, S ) );
    
    Perform( anti, Name );
    
    comm := List( comm , a -> HomalgExternalRingElement( a, S ) );
    
    Perform( comm, Name );
    
    SetIsExteriorRing( S, true );
    
    SetBaseRing( S, Base );
    
    SetRingProperties( S, R, anti );
    
    homalgSendBlocking( "option(redTail);option(redSB);", "need_command", stream, "initialize" );
    
    RP := homalgTable( S );
    
    RP!.SetInvolution :=
      function( R )
        homalgSendBlocking( Concatenation(
                [ "\nproc Involution (matrix M)\n{\n" ],
                [ "  map F = ", R ],
                Concatenation( List( IndeterminatesOfExteriorRing( R ), a -> [ ", ", String( a ) ] ) ),
                [ ";\n  return( transpose( involution( M, F ) ) );\n}\n\n" ]
                ), "need_command", "define" );
    end;
    
    homalgStream( S ).setinvol( S );
    
    RP!.Compose :=
      function( A, B )
        
        # fix the broken design of SCA
        return homalgSendBlocking( [ "transpose( transpose(", A, ") * transpose(", B, ") )" ], [ "matrix" ], "Compose" );
        
    end;
    
    if not ( HasIsFieldForHomalg( r ) and IsFieldForHomalg( r ) ) then
        Unbind( RP!.IsUnit );
        Unbind( RP!.GetColumnIndependentUnitPositions );
        Unbind( RP!.GetRowIndependentUnitPositions );
        Unbind( RP!.GetUnitPosition );
    fi;
    
    if HasIsIntegersForHomalg( r ) and IsIntegersForHomalg( r ) then
        RP!.IsUnit := RP!.IsUnit_Z;
        RP!.GetColumnIndependentUnitPositions := RP!.GetColumnIndependentUnitPositions_Z;
        RP!.GetRowIndependentUnitPositions := RP!.GetRowIndependentUnitPositions_Z;
        RP!.GetUnitPosition := RP!.GetUnitPosition_Z;
        RP!.PrimaryDecomposition := RP!.PrimaryDecomposition_Z;
        RP!.RadicalSubobject := RP!.RadicalSubobject_Z;
        RP!.RadicalDecomposition := RP!.RadicalDecomposition_Z;
        Unbind( RP!.CoefficientsOfUnreducedNumeratorOfWeightedHilbertPoincareSeries );
        Unbind( RP!.MaximalDegreePart );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfRows );
        Unbind( RP!.ReducedSyzygiesGeneratorsOfColumns );
    fi;
    
    return S;
    
end );

##
InstallMethod( PseudoDoubleShiftAlgebra,
        "for homalg rings in Singular",
        [ IsHomalgExternalRingInSingularRep, IsList ],
        
  function( R, indets )
    local ar, r, var, shift, param, base, stream, display_color, switch, ext_obj,
          b, n, steps, pairs, d, P, RP, Ds, D_s, S, B, T, Y;
    
    ar := _PrepareInputForPseudoDoubleShiftAlgebra( R, indets );
    
    r := ar[1];
    var := ar[2];
    shift := ar[3];
    param := ar[4];
    base := ar[5];
    
    stream := homalgStream( R );
    
    if ( not ( IsBound( HOMALG_IO.show_banners ) and HOMALG_IO.show_banners = false )
         and not ( IsBound( stream.show_banner ) and stream.show_banner = false )
         and not ( IsBound( stream.show_banner_PLURAL ) and stream.show_banner_PLURAL = false ) ) then
        
        if IsBound( stream.color_display ) then
            display_color := stream.color_display;
        else
            display_color := "";
        fi;
        
        Print( "================================================================\n" );
        
        ## leave the below indentation untouched!
        Print( display_color, "\
                     SINGULAR::PLURAL\n\
The SINGULAR Subsystem for Non-commutative Polynomial Computations\n\
     by: G.-M. Greuel, V. Levandovskyy, H. Schoenemann\n\
FB Mathematik der Universitaet, D-67653 Kaiserslautern\033[0m\n\
================================================================\n" );
        
        stream.show_banner_PLURAL := false;
        
    fi;
    
--> --------------------

--> maximum size reached

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