----------------------------------------------------------------
-- PrintLn;
-- PrintLn '  MACAULAY.PKG  by Manfred Schulz';
-- PrintLn 'E-mail: Manfred.Schulz@stud.uni-regensburg.de ';
-- PrintLn 'Help_Macaulay(); gives a listing of available functions';
----------------------------------------------------------------

// Date created: 26/8/97
// Last modification: 17/7/98
// Version: 6.4
// CoCoA Version: 3.5
// Author: M. Schulz


Package $cocoa/macaulay

Alias   MC      := $cocoa/macaulay,
        List    := $cocoa/list,
        Mat     := $cocoa/mat,
        GB      := $cocoa/gb,
        IO      := $cocoa/io,
        HP      := $cocoa/hp,
        Misc    := $cocoa/misc,
        HL      := $cocoa/hilop;


Define About()
  Return "
    // Author: M.Schulz
    // Version: 6.4
    // CoCoA Version: 3.5
    // Date created: 26/8/97
    // Last modification: 17/7/98
  "
End;

Define Help(...)
  Help($.PkgName()+"."+ARGV[1]);
End;

Define Help_Macaulay()
  PrintLn 'Functions used in Macaulay.';
  PrintLn 'General Functions: NRows(M), NCols(M), Compress(M), Diag(M),';
  PrintLn 'Flatten(M), Outer(M,N), DSum(M(1),..,M(n)), Tensor(M,N),';
  PrintLn 'Trace(M), Iden(I), Concat(M(1),..,M(n)), MC(M,P,I),';
  PrintLN 'MR(M,P,I), AC(M,I,P,J), AR(M,I,P,J), PC(M,I,J), PR(M,I,J),';
  PrintLn 'Random(I,J), Coef(M,L), Cat(V,L1,L2), Generic_Mat(V,I,J),';
  PrintLn 'Random_Mat(I,J,Ide), Submat(M,L1,L2), Diff(L/Id1,L/Id2),';
  PrintLn 'Contract(Id1,Id2), Adj_Of_Cat(I,J), Permutation(I,L),';
  PrintLn 'Interchange_Permutation(I,J), Interchange(M,N), Power(M,I),';
  PrintLn 'Wedge(M,I), Stack(...), RandomSkewSymMat(N), Pfaff(M),';
  PrintLn 'Adjoint2(M,A,B), Koszul(Id,N), Inverse(M), From_Div_Powers(F),';
  PrintLn 'To_Div_Powers(F), Powers(I,N), Points(M), J_From_Lambda(I).';
  PrintLn 'Imap(...), Fetch(...), Blockmap(I,J), Weightsmap(I,J),';
  PrintLn 'Lmap(S), Fetch2(...), Syz1(M,I), Ann(M), Ann1(M), Ann2(M),';
  PrintLn 'Annihil(I,M), Quotient(M,N), Modulo(M,N), Intersec1-3(M,N),';
  PrintLn 'Intersec4+5(M1,..,Mn), Colona-c(M,F), Colond-f(M,N),';
  PrintLn 'Sat1-3(M,F), Sat4-6(M,I), Kernel(F,G,H), Kernel_And_Map(F,G,H),';
  PrintLn 'Hom(M,N), Lift_Std(M), Reduce(L,M), Lift(L,M), Lift_Std2(M),';
  PrintLn 'Homology(M,N,I,J), Res1(M,I), Ext(I,M,N), Ext_R(I,M), Tor(I,M,N),';
  PrintLn 'Keep(L,M), Inpart(...), Std_Minimal(...), Stdpart(...),';
  PrintLn 'KBasis(S,L,Lo,Hi), Cohomology1(I,M,J), Koszulhomology1(I,M),';
  PrintLn 'Complement(M), Representatives(M,N), Representatives1(M,N),';
  PrintLn 'Prune(A), PruneMap(A), IsZero(M), Rankprobability(M)';
  PrintLn 'RandoMel(F,I), RandomMap(M,N,I), PointsLinear(Id,M),';
  PrintLn 'DoubleDual(M), DoubleDual1(M,A), Pushforward1(...),';
  PrintLn 'Pushforward(S,F,M), Subring(...), Diagonalsubmodule(S,Fu,M,H)';
  PrintLn 'FromBiGraded(I,J,S,M), Scroll(...), Monomial_Curve(...)';
  PrintLn 'OrbitEquality(..), Curoncubic(M), RatSur1(I,M), ProjProd(Id,N)';
  PrintLn 'RationalNormalCurve(P), K3Carpet(M,N), Codim(M), Removlid(I)';
  PrintLn 'Removlow(M), Removlst(M), RatNoros(I,J), Blowup(RI,I)';
  PrintLn 'NormalCone(RI,I), Analytic_Spread(I), DualVariety(I,N)';
  PrintLn 'SortDeg(...), Adjoint_Fraction(R,F,I), X_To_Last(...), NZD(P,M)';
  PrintLn 'Symmetric_Algebra(M), NbynCommuting(I), Putmat(M,S), MinPres(I)';
  PrintLn 'RadicalOfUnmixed1(I), RadicalOfUnmixed(I), RadicalOfUnmixed2(I,L)';
  PrintLn 'Radical(I), WedgeCokernel(M,I), Perp(S,M), SymCokernel(M,I)';
  PrintLn 'PBundle(R,M,M0), LBundleLim(M,Shi), CotanBihom(X,Y,I), Cotan(I)';
  PrintLn 'Normal_Sheaf(I), RegularSequence(I), RegularSequence1(I)';
  PrintLn 'L_Dual0(N), L_Min0(M), L_Min1(M), L_Min(M), L_TangentCone(M)';
  PrintLn 'L_FromDual(I), L_ToDual(I,N), Macrep(D,N), Koszulhomology1(I,M).';
End;

----------------------------------------------------------------
//  General Functions
----------------------------------------------------------------

NRows(M):=Len(M);

Define Help_NRows()
   PrintLn 'NRows ( M : Matrix ) : Int';
   PrintLn 'returns the number of rows of M.';
End;

-------------------------------------------------------------------

Define NCols(M)
  If M=Mat[] Then Return 0 Else Return Len(Transposed(M)) End;
End;

Define Help_NCols()
   PrintLn 'NCols ( M : Matrix ) : Int';
   PrintLn 'returns the number of columns of M';
End;

-------------------------------------------------------------------

Define Compress(M)
  LM:=Len(M);
  If M=Mat[] Then Return M End;
  N:=Transposed(M);
  LN:=Len(N);
  NULLIST:=NewList(LM,0);
  L:=NewList(LN);
  For I:=1 To LN Do
    If N[I]<>NULLIST Then L[I]:=N[I] Else L[I]:=0 End;
  End;
  L:=Diff(L,[0]);
  If Mat(L)=Mat[] Then Return L End;
  M:=Transposed(Mat(L));
  Return M
End;

Define Help_Compress()
   PrintLn 'Compress( M : Matrix ) : Matrix';
   PrintLn 'returns submatrix of M consisting of the non-zero columns of M';
End;

-------------------------------------------------------------------

Define Diag(M)
  LM:=$.NRows(M);
  LN:=$.NCols(M);
  D:=LN*LM;
  H:=NewMat(D,D,0);
  Z:=1;
  For I:=1 To LN Do
    For J:=1 To LM Do
      H[Z,Z]:=M[J,I];
      Z:=Z+1;
    End;
  End;
Return H
End;

Define Help_Diag()
   PrintLn 'Diag( M : Matrix ) : Matrix';
   PrintLn 'returns a mn by mn diagonal matrix, whose diagonal entries';
   PrintLn 'consist of every entry of the original matrix. The entries';
   PrintLn 'are taken from the first column, then the second, ... of M';
   PrintLn '(a m by n matrix)';
End;

-------------------------------------------------------------------

Define Flatten(M)
  M:=Mat(M);
  LM:=Len(M);
  LTM:=$.NCols(M);
  N:=NewMat(1,LM*LTM);
  Z:=1;
  For I:=1 To LTM Do
    For J:=1 To LM Do
      N[1,Z]:=M[J,I];
      Z:=Z+1;
    End;
  End;
Return N;
End;

Define Help_Flatten()
   PrintLn 'Flatten( M : Matrix ) : Matrix';
   PrintLn 'returns the row  vector (1 by m*n) matrix consisting of every';
   PrintLn 'entry of the m by n <matrix>. The entries are taken from the';
   PrintLn 'first column, then the second, and so on.'
End;

-------------------------------------------------------------------

Define Transposed(M)
  If M=Mat[] Then Return M Else Return Transposed(M) End;
End;

-------------------------------------------------------------------

Define Outer(M,N)
  If M=Mat[] Then Return Mat[] End;
  If N=Mat[] Then Return Mat[] End;
  RM:=Len(M);
  RN:=Len(N);
  CM:=$.NCols(M);
  CN:=$.NCols(N);
  H:=NewMat(RM*RN,CM*CN);
  For I:=1 To CM Do
    For J:=1 To RM Do
      For K:=1 To CN Do
        For L:=1 To RN Do
          H[(J-1)*RN+L,(I-1)*CN+K]:=M[J,I]*N[L,K];
        End;
      End;
    End;
  End;
Return H
End;

Define Help_Outer()
   PrintLn 'Outer( M : Matrix , N : Matrix ) : Matrix';
   PrintLn 'returns the outer (or tensor) product of two matrices. If the';
   PrintLn 'matrices have sizes (a by b) and (c by d) respectively, then';
   PrintLn 'the result has size a*c by b*d';
End;

-------------------------------------------------------------------

Define DSum(...)
  A:=Len(ARGV);
  LM:=0;
  LN:=0;
  For I:=1 To A Do
    If Type(ARGV[I])<>MAT Then Return Error('only Matrices expected') End;
    LM:=LM+$.NRows(ARGV[I]);
    LN:=LN+$.NCols(ARGV[I]);
  End;
  H:=NewMat(LM,LN,0);
  Z:=1;
  S:=0;
  For K:=1 To A Do
    For I:=1 To $.NCols(ARGV[K]) Do
      For J:=1 To $.NRows(ARGV[K]) Do
        H[S+J,Z]:=ARGV[K][J,I];
      End;
      Z:=Z+1;
    End;
    S:=S+Len(ARGV[K]);
  End;
Return H
End;

Define Help_DSum()
   PrintLn 'DSum( M(1) : Matrix , ... , M(n) : Matrix ) : Matrix';
   PrintLn 'returns the direct (block diagonal) sum of the given matrices.';
End;

-------------------------------------------------------------------

Define Trace(M)
  H:=0;
  For I:=1 To Min(Len(M),$.NCols(M)) Do
    H:=H+M[I,I];
  End;
Return H
End;

Define Help_Trace()
   PrintLn 'Trace( M : Matrix ) : Poly';
   PrintLn 'returns the sum of the diagonal entries of M.';
End;

-------------------------------------------------------------------

Define Tensor2(M,N)
  LN:=$.NRows(N);
  LM:=$.NRows(M);
  CM:=$.NCols(M);
  CN:=$.NCols(N);
  Z:=1;
  H:=NewMat(LM*LN,CM*LN+LM*CN,0);
  H1:=Mat[];
  H2:=NewMat(LM*LN,CM*LN,0);
  For I:=1 To LM Do H1:=$.DSum(H1,N) End;
  For I:=1 To LM Do
    For J:=1 To LN Do
      For K:=1 To CM Do
        H2[(I-1)*LN+J,Z]:=M[I,K];
        Z:=Z+1;
        If Z>CM*LN Then Z:=1 End;
      End;
    End;
  End;
  H:=$.Concat(H1,H2);
Return H
End;

Tensor(M,N):=$.Concat($.Outer($.Iden($.NRows(M)),N),
                      $.Outer(M,$.Iden($.NRows(N))));

Define Help_Tensor()
   PrintLn 'Tensor( M : Matrix , N : Matrix) : Matrix';
   PrintLn 'returns the tensor product of the modules presented by';
   PrintLn 'the matrices M, N: If M is an a by b matrix, and N is a';
   PrintLn 'c by d matrix, then the result is a matrix with ac rows';
   PrintLn 'and bc+ad columns, which is the matrix which presents';
   PrintLn 'the tensor product of the two modules.';
End;

-------------------------------------------------------------------

Define Iden(I)
  If I=0 Then Return Mat[] End;
  H:=NewMat(I,I,0);
  For J:=1 To I Do H[J,J]:=1 End;
Return H
End;

Define Help_Iden()
   PrintLn 'Iden( I : Int ) : Matrix';
   PrintLn 'returns the I by I Identitymatrix.';
End;

-------------------------------------------------------------------

Define Concat(...)
 A:=Len(ARGV);
-- If A=0 Or Type(ARGV[1])<>MAT Then Return $.Help('Concat') End;
  LM:=$.NRows(ARGV[1]);
  LN:=$.NCols(ARGV[1]);
  For I:=2 To A Do
    If Type(ARGV[I])<>MAT Then Return Error('only Matrices expected') End;
    If $.NRows(ARGV[I])<>LM Then Return
        'Matrices must have the same number of rows.' End;
    LN:=LN+$.NCols(ARGV[I]);
  End;
  If LN=0 Then H:=Mat[] Else H:=NewMat(LM,LN,0) End;
  Z:=0;
  For I:=1 To A Do
    For J:=1 To $.NRows(ARGV[I]) Do
      For K:=1 To $.NCols(ARGV[I]) Do
        H[J,Z+K]:=ARGV[I,J,K];
      End;
    End;
    Z:=Z+$.NCols(ARGV[I]);
  End;
Return H
End;

Define Help_Concat()
   PrintLn 'Concat( M(1) : Matrix , ... , M(n) : Matrix ) : Matrix';
   PrintLn 'returns the concatenation of all n matrices.  Every matrix';
   PrintLn 'should have the same number of rows and the same base ring.';
   PrintLn 'The result matrix has the same number of rows, but it has a';
   PrintLn 'column for each column of each matrix. These columns are';
   PrintLn 'placed into <matrix> in the natural order.';
End;

-------------------------------------------------------------------

Define MC(M,P,I)
  If I>$.NCols(M) Then Return 'Integer too big!' End;
  For J:=1 To $.NRows(M) Do
    M[J,I]:=M[J,I]*P;
  End;
Return M
End;

Define Help_MC()
   PrintLn 'MC( M : Matrix , P : Poly , I : Int ) : Matrix';
   PrintLn 'Multiply the given column I in the matrix M by the given ';
   PrintLn 'polynomial expression.';
End;

-------------------------------------------------------------------

Define MR(M,P,I)
  If I>$.NRows(M) Then Return 'Integer too big!' End;
  M[I]:=M[I]*P;
Return M
End;

Define Help_MR()
   PrintLn 'MR( M : Matrix , P : Poly , I : Int ) : Matrix';
   PrintLn 'Multiply the given row I in the matrix M by the given ';
   PrintLn 'polynomial expression.';
End;

-------------------------------------------------------------------

Define AC(M,I,P,J)
  If I>$.NCols(M) Or J>$.NCols(M) Then Return 'Integer too big!' End;
  For K:=1 To $.NRows(M) Do
    M[K,J]:=M[K,J]+M[K,I]*P;
  End;
Return M
End;

Define Help_AC()
   PrintLn 'AC( M : Matrix , I : Int , P : Poly , J : Int ) : Matrix';
   PrintLn 'Replace the column J in the matrix M with column J +';
   PrintLn 'column I * P';
End;

-------------------------------------------------------------------

Define AR(M,I,P,J)
  If I>$.NRows(M) Or J>$.NRows(M) Then Return 'Integer too big!' End;
  M[J]:=M[J]+M[I]*P;
Return M
End;

Define Help_AR()
   PrintLn 'AR( M : Matrix , I : Int , P : Poly , J : Int ) : Matrix';
   PrintLn 'Replace the row J in the matrix M with row J + row I * P';
End;

-------------------------------------------------------------------

Define PC(M,I,J)
  LM:=$.NCols(M);
  If I>LM Or J>LM Then Return 'Integer too big!' End;
  For K:=1 To LM Do
    H:=M[K,I];
    M[K,I]:=M[K,J];
    M[K,J]:=H;
  End;
Return M
End;

Define Help_PC()
   PrintLn 'PC( M : Matrix , I : Int , J : Int ) : Matrix';
   PrintLn 'Permute the specified columns (I,J) of the matrix M.';
End;

-------------------------------------------------------------------

Define PR(M,I,J)
  LM:=$.NRows(M);
  If I>LM Or J>LM Then Return 'Integer too big!' End;
  H:=M[I];
  M[I]:=M[J];
  M[J]:=H;
Return M
End;

Define Help_PR()
   PrintLn 'PR( M : Matrix , I : Int , J : Int ) : Matrix';
   PrintLn 'Permute the specified rows (I,J) of the matrix M.';
End;

------------------------------------------------------------------
--man kann Ch beliebig waehlen (wie man es gerade braucht)
Define Random(I,J)
  H:=NewMat(I,J);
  Ch:=300;
  For K:=1 To I Do
    For L:=1 To J Do
      Z:=LC(Randomized(DensePoly(0)));
      If Characteristic()=0 Then
        If Type(Z)=RAT Then
          S:=Mod(Z[1],Ch);
          T:=Mod(Z[2],Ch);
          If T=0 Then T:=1 End;
          H[K,L]:=S/T;
        Else
          H[K,L]:=Mod(Z,Ch);
        End;
      Else
        H[K,L]:=Z;
      End;
    End;
  End;
Return H
End;

Define Help_Random()
   PrintLn 'Random( I : Int , J : Int ) : Matrix';
   PrintLn 'returns a I by J matrix with random constant entries';
   PrintLn 'over the current ring.';
End;

------------------------------------------------------------------

Define AllMonoms(M)
  RM:=$.NRows(M);
  CM:=$.NCols(M);
  LM:=NewList(RM*CM);
  Z:=1;
  For J:=1 To CM Do
    For I:=RM To 1 Step -1 Do
      If M[I,J]=0 Then LM[Z]:=[]
        Else LM[Z]:=Support(M[I,J]) End;
      Z:=Z+1;
    End;
  End;
  For I:=1 To CM Do
    LM[I]:=LM[1+(I-1)*RM];
    For J:=1 To RM-1 Do
      LM[I]:=Concat(LM[I],LM[1+(I-1)*RM+J]);
    End;
    LM[I]:=Set(LM[I]);
  End;
Return First(LM,CM)
End;

Define Help_AllMonoms()
   PrintLn 'AllMonoms( M : Matrix ) : List ';
   PrintLn 'returns a list of lists containing the monomials of each';
   PrintLn 'column of M (starting at the bottom of the column).';
End;

-------------------------------------------------------------------

Define Monoms(...)
  LM:=$.AllMonoms(ARGV[1]);
  If Len(ARGV)=1 Then Return LM End;
  A:=ARGV[2];
  For I:=1 To Len(LM) Do
    For J:=1 To Len(LM[I]) Do
      T:=NewList(Len(LM[I]),1);
      For K:=1 To Len(A) Do
        While Mod(LM[I,J],A[K])=0 Do
          T[J]:=T[J]*A[K];
          LM[I,J]:=LM[I,J]/A[K];
        End;
      End;
      LM[I,J]:=T[J];
    End;
    LM[I]:=Set(LM[I]);
  End;
Return LM
End;

Define Help_Monoms()
   PrintLn 'Monoms( M : Matrix , L : List ) : List ';
   PrintLn 'returns a list of the monomials in the given list L,';
   PrintLn 'which occur in M.';
End;

-------------------------------------------------------------------

Define Coef(...)
  LArgv:=Len(ARGV);
  If LArgv<1 Or LArgv>2 Then
    Return 'Bad number of parameters' End;
  If Type(ARGV[1])<>MAT Then Return $.Help('Coef') End;
  If LArgv=2 And Type(ARGV[2])<>LIST Then
    Return $.Help('Coef') End;

  M:=$.Compress(ARGV[1]);
  RM:=$.NRows(M);
  CM:=$.NCols(M);
  Erg:=NewList(2);
  If LArgv=1 Then Erg[1]:=$.Monoms(M) Else Erg[1]:=$.Monoms(M,ARGV[2]) End;
  For I:=1 To Len(Erg[1]) Do Erg[1,I]:=Reversed(Sorted(Erg[1,I])) End;
  Hilf:=0;
  For I:=1 To Len(Erg[1]) Do Hilf:=Hilf+Len(Erg[1,I]) End;
  ErgM:=NewMat(RM,Hilf,0);
  Z:=0;
  For I:=1 To CM Do 
    For J:=RM To 1 Step -1 Do
      Foreach T In Monomials(M[J,I]) Do
        For K:=1 To Len(Erg[1,I]) Do
          If Mod(T,Erg[1,I,K])=0 Then
            ErgM[J,Z+K]:=ErgM[J,Z+K]+T/Erg[1,I,K];
            T:=0;
          End;
        End;
      End;
    End;
    Z:=Z+Len(Erg[1,I]);
  End;
  Erg[2]:=ErgM;
  ErgL:=NewList(Hilf);
  Z:=1;
  For I:=1 To Len(Erg[1]) Do
    Foreach T In Erg[1,I] Do
      ErgL[Z]:=T;
      Z:=Z+1;
    End;
  End;
  Erg[1]:=ErgL;
Return Erg
End;

Define Help_Coef()
   PrintLn 'Coef( M : Matrix , L : List ) : List ';
   PrintLn 'find the monomials in the given variable list which';
   PrintLn 'occur in M, and return a list whose first component is';
   PrintLn 'a list of these monomials, and the second is a matix';
   PrintLn 'consisting of the coefficients of these monomials.';
End;

-------------------------------------------------------------------

Define Cat(V,L1,L2)
  If Type(V)<>INT And Not (V IsIn Indets()) Then Return 'Error' End;
  If Type(L1)<>LIST Or Type(L2)<>LIST Then
    Return Help('Cat')
  End;
  Z:=1;
  If Type(V)=POLY Then
    While Indet(Z)<>V Do Z:=Z+1 End;
    V:=Z;
  End;
  LL1:=Len(L1);
  LL2:=Len(L2);
  M:=NewMat(LL1,LL2,0);
  For I:=1 To LL1 Do
    For J:=1 To LL2 Do
      N:=V+L1[I]+L2[J];
      If 1<=N And N<=NumIndets() Then M[I,J]:=Indet(N) End;
    End;
  End;
Return M
End;

Define Help_Cat()
   PrintLn 'Cat( V : Int or Indet , L1 : List , L2 : List ) : Matrix ';
   PrintLn 'create a matrix consisting of indeterminantes. The first';
   PrintLn 'argument is either a ring indeterminante in the current';
   PrintLn 'ring, or an integer. The second and third argument are';
   PrintLn 'lists of integers (-rows and cols-). The result matrix';
   PrintLn 'whose (i,j) entry is m[rows(i)+cols(j)], where m[k] is';
   PrintLn 'the k th ring indeterminante:';
   PrintLn '1. if the first argument is a ring variable, then m[k] is';
   PrintLn '   the k th variable after the given ring variable.';
   PrintLn '2. if the first argument is an integer, n say, then m[k]';
   PrintLn '   is the n+k th variable of the ring.';
End;

-------------------------------------------------------------------

Define Generic_Mat(V,I,J)
  L1:=NewList(I);
  For K:=0 To I-1 Do
    L1[K+1]:=K*J;
  End;
  L2:=0..(J-1);
  M:=$.Cat(V,L1,L2);
Return M
End;

Define Help_Generic_Mat()
   PrintLn 'Generic_Mat( V/P : Int or Indet , I : Int , J : Int ) : Matrix ';
   PrintLn 'create a generic matrix, whose (1,1) entry is P or the';
   PrintLn 'V-th ring variable. I,J = size of result matrix.';
End;

-------------------------------------------------------------------

Define Random_Mat(I,J,Ide)
  Col:=Transposed(Mat(Ide.Gens));
  Siz:=$.NRows(Col);
  Z:=1;
  M:=NewMat(I,1,0);
  While Z<=J Do
    Z:=Z+1;
    Ran:=$.Random(I,Siz);
    M1:=Ran*Col;
    M:=$.Concat(M,M1);
  End;
  M:=$.Compress(M);
Return M
End;

Define Help_Random_Mat()
   PrintLn 'Random_Mat( I : Int , J : Int , Ide : Ideal ) : Matrix ';
   PrintLn 'defines an I by J matrix whose entries are random linear';
   PrintLn 'combinations of the entries of the 1 by n matrix M';
   PrintLn 'representing the ideal Ide.';
End;

-------------------------------------------------------------------

Define Submat(M,L1,L2)
  If Max(L1)>$.NRows(M) Or Min(L1)<1 Then Return
    'Integers of first list out of range' End;
  If Max(L2)>$.NCols(M) Or Min(L2)<1 Then Return
    'Integers of second list out of range' End;
  H:=NewMat(Len(L1),Len(L2));
  For I:=1 To Len(L1) Do
    For J:=1 To Len(L2) Do
      H[I,J]:=M[L1[I],L2[J]];
    End;
  End;
Return H
End;

Define Help_Submat()
   PrintLn 'Submat( M : Matrix , L1 : List , L2 : List ) : Matrix ';
   PrintLn 'returns a submatrix of M with rows specified in L1 and';
   PrintLn 'columns specified in L2 (lists of integers).';
 End;

-------------------------------------------------------------------

Define FNZ(L)
  For I:=1 To Len(L) Do
    If L[I]<>0 Then Return I End;
  End;
Return 0
End;

-------------------------------------------------------------------

Define Ableit(P,L)
  HL:=NewList(NumIndets(),0);
  While L<>HL And P<>0 Do
    I:=$.FNZ(L);
    L[I]:=L[I]-1;
    P:=Der(P,Indet(I));
  End;
Return P
End;

-------------------------------------------------------------------

Define Diff(Id1,Id2)
  If Type(Id1)=LIST Then L1:=Id1 Else
    L1:=Gens(Id1) End;
  If Type(Id2)=LIST Then L2:=Id2 Else
    L2:=Gens(Id2) End;
  M:=NewMat(Len(L1),Len(L2),0);
  For I:=1 To Len(L1) Do
    Mon:=Monomials(L1[I]);
    LM:=Len(Mon);
    For J:=1 To Len(L2) Do
      Rech:=0;
      For K:=1 To LM Do
        Rech:=Rech+LC(Mon[K])*$.Ableit(L2[J],Log(Mon[K]));
      End;
    M[I,J]:=M[I,J]+Rech;
    End;
  End;
Return M
End;

Define Help_Diff()
   PrintLn 'Diff( Id1 : Ideal , Id2 : Ideal ) : Matrix ';
   PrintLn 'differentiate each element of the ideal Id1 by the';
   PrintLn 'differential operator corresponding to each element';
   PrintLn 'of the ideal Id2, producing a m by n matrix.';
 End;

-------------------------------------------------------------------

Define Ableit2(P,L)
  HL:=NewList(NumIndets(),0);
  Korr:=1;
  While L<>HL And P<>0 Do
    I:=$.FNZ(L);
    Kor:=Log(P);
    Korr:=Korr*Kor[I];
    P:=Der(P,Indet(I));
    L[I]:=L[I]-1;
  End;
If Korr=0 Then Return P Else Return P/Korr End;
End;

-------------------------------------------------------------------

Define Contract(Id1,Id2)
  If Type(Id1)=LIST Then L1:=Id1 Else
    L1:=Gens(Id1) End;
  If Type(Id2)=LIST Then L2:=Id2 Else
    L2:=Gens(Id2) End;
  M:=NewMat(Len(L1),Len(L2),0);
  For I:=1 To Len(L1) Do
    Mon:=Monomials(L1[I]);
    LM:=Len(Mon);
    For J:=1 To Len(L2) Do
      Rech:=0;
      For K:=1 To LM Do
        Rech:=Rech+LC(Mon[K])*$.Ableit2(L2[J],Log(Mon[K]));
      End;
    M[I,J]:=M[I,J]+Rech;
    End;
  End;
Return M
End;

Define Help_Contract()
   PrintLn 'Contract( Id1 : Ideal , Id2 : Ideal ) : Matrix ';
   PrintLn 'This is exactly the same as Diff, except that contraction';
   PrintLn 'is used instead of differentiation. E.g. a^2.a^3=a not 6a.';
 End;

-------------------------------------------------------------------

Define Adj_Of_Cat(I,J)
  M:=NewMat(I,I+J-1,0);
  For K:=1 To I Do
    For L:=1 To J Do
      If L<=NumIndets() Then M[K,K+L-1]:=Indet(L) End;
    End;
  End;
Return M
End;

Define Help_Adj_Of_Cat()
   PrintLn 'Adj_Of_Cat( I : Int , J : Int ) : Matrix ';
   PrintLn 'returns the I by I+J-1 adjoint matrix of a I by J';
   PrintLn 'catalecticant matrix, which is (for I=3, J=2) a matrix of';
   PrintLn 'the form Mat[[x,y,0,0],[0,x,y,0],[0,0,x,y]].';
 End;

-------------------------------------------------------------------

Define Permutation(I,L)
  If Type(L) <> LIST Then
    Return 'Second argument must be a list of indeterminantes.' End;
  M:=NewMat(I,I,0);
  For J:=1 To Len(L) Do
    If Type(L[J]) <> POLY Or Not (L[J] IsIn Indets()) Then
      Return 'List must only contain indeterminantes' End;
  End;
  For J:=1 To Len(L)-1 Do
    For K:=J+1 To Len(L) Do
      If L[J]=L[K] Then
        Return ' ' End;
    End;
  End;
  For J:=1 To Len(L) Do
    If L[J] IsIn First(Indets(),I) Then
      For K:=1 To NumIndets() Do
        If L[J]=Indet(K) Then M[K,J]:=1 End;
      End;
    End;
  End;
Return M
End;

Permutat(I,L):=$.Permutation(I,L);

Define Help_Permutation(I,L)
   PrintLn 'Permutation( I : Int , L : List ) : Matrix ';
   PrintLn 'creates the permutation matrix which expresses L as a';
   PrintLn 'permutation of [Indet(1)..Indet(I)].';
End;

-------------------------------------------------------------

Define Permutation2(L)
  If Type(L) <> LIST Then Return 'list expected.' End;
  M:=NewMat(NumIndets(),Len(L),0);
  For J:=1 To Len(L) Do
    If Type(L[J]) <> POLY Or Not (L[J] IsIn Indets()) Then
      Return 'List must only contain indeterminantes' End;
  End;
  For J:=1 To Len(L) Do
    If L[J] IsIn Indets() Then
      For K:=1 To NumIndets() Do
        If L[J]=Indet(K) Then M[K,J]:=1 End;
      End;
    End;
  End;
Return M
End;

Define Help_Permutation2(L)
   PrintLn 'Permutation2( L : List ) : Matrix ';
   PrintLn 'creates the matrix which expresses the map [Indets] ---> L.';
End;

-------------------------------------------------------------------

Define Interchange_Permutation(I1,I2)
  M:=NewMat(I1*I2,I1*I2,0);
  Z:=1;
  For I:=1 To I1 Do
    H:=I;
    For J:=1 To I2 Do
      M[Z,H]:=1;
      Z:=Z+1;
      H:=H+I1;
    End;
  End;
Return M
End;
InterchP(I1,I2):=$.Interchange_Permutation(I1,I2);

Define Help_Interchange_Permutation()
   PrintLn 'Interchange_Permutation( I : Int , J : Int ) : Matrix ';
   PrintLn 'returns the permutations matrix of the permutation taking';
   PrintLn 'the set A x B (where a,b are the cardinalities of A,B) in';
   PrintLn 'lex order to the same set in the order that corresponds to';
   PrintLn 'the lex order in B x A.';
 End;

-------------------------------------------------------------------

Define Interchange(M,N)
  M1:=$.InterchP($.NCols(M),$.NCols(N));
  M2:=$.InterchP($.NRows(N),$.NRows(M));
  L:=[M1,M2];
Return L
End;

Interch(M,N):=$.Interchange(M,N);

Define Help_Interchange()
   PrintLn 'Interchange( M : Matrix , N : Matrix ) : List ';
   PrintLn 'returns the list [ M1 , M2 ], where M1 and M2 are equal to';
   PrintLn 'the invertible matrices such that M1 (M o N) M2 = N o M,';
   PrintLn 'where we have written M o N for the tensor product of the';
   PrintLn 'matrices M and N.';
 End;

-------------------------------------------------------------------

Define Power(M,I)
  If $.NRows(M)<>1 Then Return '1 by N matrix expected' End;
  Erg:=Ideal(M[1])^I;
  Return Mat(Erg.Gens)
End;

Define Help_Power()
   PrintLn 'Power( M : Matrix , I : Int ) : Matrix';
   PrintLn 'Take a 1 by N matrix and returns a 1 by Bin(N+I-1,N-1)';
   PrintLn 'matrix consisting of all products of these polynomials';
   PrintLn 'taken I at a time.';
End;

-------------------------------------------------------------------

Define Wedge(M,I)
  LM:=$.NRows(M);
  BM:=$.NCols(M);
  If I<=0 Or I>Min([LM,BM]) Then
     Return 'all minors are zero!' End;
  L:=Minors(I,M);
  Z:=1;
  LH:=Bin(LM,I);
  BH:=Bin(BM,I);
  L1:=$.Durchlauf(LM,I);
  L2:=$.Durchlauf(BM,I);
  H:=NewMat(LH,BH,0);
  For J:=1 To LH Do
    For K:=1 To BH Do
      H[J,K]:=H[J,K]+L[Z]*(-1)^(Sum(L1[J])+Sum(L2[K]));
      Z:=Z+1;
    End;
  End;
Return H
End;

Define Help_Wedge()
   PrintLn 'Wedge( M : Matrix , I : Int ) : Matrix ';
   PrintLn 'compute the determinantes of all the I by I minors of the';
   PrintLn 'given m by n matrix. The resulting matrix /\ M has size';
   PrintLn 'Bin(m,I) by Bin(n,I). The signs are chosen so that if';
   PrintLn 'C=A.B, where A and B are matrices, then /\ C=/\ A./\ B .';
End;

-------------------------------------------------------------------

Define Stack(...)
  A:=Len(ARGV);
  RM:=0;
  CM:=0;
  If A=0 Then Return NewMat(0,0) End;
  If A=1 Then Return ARGV[1] End;
  For I:=1 To A Do
    RM:=RM+$.NRows(ARGV[I]);
    CM:=Max([CM,$.NCols(ARGV[I])]);
  End;
  M:=NewMat(RM,CM,0);
  Z:=1;
  For I:=1 To A Do
    For J:=1 To $.NRows(ARGV[I]) Do
      For K:=1 To $.NCols(ARGV[I]) Do
        M[Z,K]:=ARGV[I,J,K];
      End;
      Z:=Z+1;
    End;
  End;
Return M
End;

Define Help_Stack()
  PrintLn 'Stack( M[1] : Matrix , ... , M[n] : Matrix ) : Matrix ';
  PrintLn 'returns a matrix with rows of mat1 ... matn in order.';
End;

-----------------------------------------------------------------

Define RandomSkewSymMat(N)
  NI:=NumIndets();
  M:=NewMat(N,N,0);
  For I:=1 To N Do
    For J:=I+1 To N Do
      M[I,J]:=Indet(Mod(Randomized(7),NI)+1);
      M[J,I]:=-M[I,J];
    End;
  End;
Return M
End;

Rand(N):=$.RandomSkewSymMat(N);

Define Help_RandomSkewSymMat()
   PrintLn 'RandomSkewSymMat( I : Int ) : Matrix ';
   PrintLn 'returns a n by n skew symmetric matrix.';
End;

-----------------------------------------------------------------

Define Pfaff(M)
  If M<>Transposed(-M) Then
    Return 'skew symmetric matrix expected' End;
  LM:=$.NRows(M);
  If LM<4 Then
    Return '(n x n)-matrix expected with n>=4' End;
  BLM:=Bin(LM,4);
  H:=NewMat(1,BLM);
  SubM:=NewMat(4,4);
  Z:=1;
  For I:=1 To LM-3 Do
    For J:=I+1 To LM-2 Do
      For K:=J+1 To LM-1 Do
        For L:=K+1 To LM Do
          LI:=[I,J,K,L];
          SM:=Submat(M,LI,LI);
          H[1,Z]:=SM[1,4]*SM[2,3]-SM[1,3]*SM[2,4]+SM[1,2]*SM[3,4];
          Z:=Z+1;
        End;
      End;
    End;
  End;
Return Ideal(H[1]);
End;

--Folgendes Prg ist schoener programmiert, aber langsamer als Pfaff!
--Durchlauf(L,N) vgl bei Koszul!

Define Pfaff2(M)
  If M<>Transposed(-M) Then
    Return 'skew symmetric matrix expected' End;
  LM:=$.NRows(M);
  If LM<4 Then
    Return '(n x n)-matrix expected with n>=4' End;
  BLM:=Bin(LM,4);
  H:=$.Durchlauf(LM,4);
  For I:=1 To BLM Do
    SM:=Submat(M,H[I],H[I]);
    H[I]:=SM[1,4]*SM[2,3]-SM[1,3]*SM[2,4]+SM[1,2]*SM[3,4];
  End;
Return Ideal(H);
End;

Define Help_Pfaff()
   PrintLn 'Pfaff( M : Matrix ) : Ideal ';
   PrintLn 'Given a n by n skew symmetric matrix, compute the Ideal';
   PrintLn 'generated of all the 4 by 4 Pfaffians of the matrix.';
End;

-------------------------------------------------------------------

Define Adjoint2(M,A,B)
  M:=Cast(M,MAT);
  A:=Cast(A,MAT);
  B:=Cast(B,MAT);
  T:=Transposed($.Flatten(B));
  T:=$.Outer(A,T);
  S:=$.Outer(M,Transposed(B));
  Erg:=S*T;
  Erg:=Cast(Erg,MODULE);
Return Erg
End;

Define Help_Adjoint2()
   PrintLn 'Adjoint2( M : Mod/Mat , A : Mod/Mat , B : Mod/Mat) : Module ';
   PrintLn 'Given a map M: (A tensor B) ---> C and the identity maps';
   PrintLn 'A of A and B of B, where A,B,C are free modules, this script';
   PrintLn 'returns the adjoint map g: A ---> (C tensor B^*).'
End;

-------------------------------------------------------------------

RestList(L,N):=Concat(First(L,N-1),Last(L,Len(L)-N));

Define Posit(E,L)
  For I:=1 To Len(L) Do
    If E=L[I] Then Return I End;
  End;
End;

Define Durchlauf(I,N)
  Entsch:=TRUE;
  L:=NewList(N,1);
  L1:=NewList(Bin(I,N));
  For J:=2 To N Do L[J]:=J End;
  Zaehler:=1;
  While Entsch Do
    If L[1]=I-N+1 Then Entsch:=FALSE End;
    L1[Zaehler]:=L;
    L[N]:=L[N]+1;
    Z:=N-1;
    While Entsch And L[N]>I Do
      L[Z]:=L[Z]+1;
      Foreach J In (Z+1)..N Do L[J]:=L[J-1]+1 End;
      Z:=Z-1;
    End;
    Zaehler:=Zaehler+1;
  End;
Return L1
End;

Define Koszul(Id,N)
  If Type(Id)<>IDEAL And Type(Id)<>INT Then Return
    'First argument must be an ideal or an integer!' End;
  If Type(N)<>INT Then Return
    'Second argument must be an integer!' End;
  If Type(Id)=INT Then Id:=First(Indets(),Id) Else Id:=Id.Gens End;
  I:=Len(Id);
  If N>I Or N<=0 Then Return Mat[] End;
  If N=1 Then Return Mat(Id) End;
  AZ:=Bin(I,N-1);
  AS:=Bin(I,N);
  L1:=$.Durchlauf(I,N);
  L2:=$.Durchlauf(I,N-1);
  M:=NewMat(AZ,AS,0);

  For I:=1 To AS Do
    For J:=1 To Len(L1[I]) Do
      Zei:=$.Posit($.RestList(L1[I],J),L2);
      M[Zei,I]:=(-1)^(J-1)*Id[L1[I,J]];
    End;
  End;
Return M
End;

Define Help_Koszul()
   PrintLn 'Koszul( I : Ideal or Int , N : Int ) : Mat';
   PrintLn 'create a koszul matrix. If the first argument is an integer,';
   PrintLn 'the input ideal is set to the ideal generated by the first I';
   PrintLn 'elements of the current ring. The result matrix is the matrix';
   PrintLn 'corresponding to the map /\^p V ---> /\^p-1 V, where V is free';
   PrintLn 'of rank I, and the map is induced from the input ideal.';
End;

-------------------------------------------------------------------

Define Inverse(M)
  DM:=Det(M);
  If DM=0 Then Return 'matrix not invertible!' End;
Return (1/DM)*Adjoint(M)
End;

Define Help_Inverse()
   PrintLn 'Inverse( M : Matrix ) : Matrix ';
   PrintLn 'returns the inverse of the n x n matrix M.';
End;

-----------------------------------------------------

Define RecFact(X)
  If X<=2 Then Return X Else Return X*$.RecFact(X-1) End;
End;

Define From_Div_Powers(F)
  G:=0;
  MF:=Monomials(F);
  For I:=1 To Len(MF) Do
    N:=1;
    Foreach Y In Log(MF[I]) Do
      If Y>0 Then N:=N*$.RecFact(Y) End;
    End;
    G:=G+1/N*MF[I];
  End;
Return G
End;

FromDivP(F):=$.From_Div_Powers(F);

Define Help_From_Div_Powers()
   PrintLn 'From_Div_Powers ( F : Poly ) : Poly';
   PrintLn 'returns a polynomial f in the divided power algebra in';
   PrintLn 'terms of ordinary powers.';
End;

-------------------------------------------------------------------

Define To_Div_Powers(F)
  G:=0;
  MF:=Monomials(F);
  For I:=1 To Len(MF) Do
    N:=1;
    Foreach Y In Log(MF[I]) Do
      If Y>0 Then N:=N*$.RecFact(Y) End;
    End;
    G:=G+N*MF[I];
  End;
Return G
End;

ToDivP(F):=$.To_Div_Powers(F);

Define Help_To_Div_Powers()
   PrintLn 'To_Div_Powers ( F : Poly ) : Poly';
   PrintLn 'returns a polynomial f in the symmetric algebra in terms';
   PrintLn 'of divided powers.';
End;

-------------------------------------------------------------------

Define Powers(I,N)
  L:=Gens(I);
  For J:=1 To Len(L) Do L[J]:=L[J]^N End;
Return Ideal(L)
End;

Define Help_Powers()
   PrintLn 'Powers ( I : Ideal , N : Int ) : Ideal';
   PrintLn 'returns the ideal whose generators are the n-th powers';
   PrintLn 'of the generators of I.';
End;

-------------------------------------------------------------------
-------------------------------------------------------------------

--The following is taken from Points.coc by M.Kreuzer

Define FindFirstNonzero(L)
   For I:=1 To Len(L) Do
     If L[I]<>0 Then Return I End;
   End;
Return 0
End;

Define Help_FindFirstNonzero()
   PrintLn 'FindFirstNonzero ( L : List ) : Int';
   PrintLn 'returns the index of the first nonzero element of L.';
   PrintLn 'Remark: If all elements of L are zero, it returns zero.';
End;

-------------------------------------------------------------------

Define Idopt(P,Mul)
   L:=NewList(Len(P)-1);
   F:=$.FindFirstNonzero(P);
   If F=0 Then Return Ideal(Poly(0)) End;
   If F>1 Then
      For I:=1 To F-1 Do L[I]:=Indet(I) End;
   End;
   If F<Len(P) Then
      For I:=F+1 To Len(P) Do L[I-1]:=P[I]*Indet(F)-P[F]*Indet(I) End;
   End;
Return Ideal(L)^Mul
End;

Define Help_Idopt()
   PrintLn 'Idopt( P : List ) : Ideal';
   PrintLn 'returns the vanishing ideal of the point P=[P0,...,Pn] in P^n.';
   PrintLn 'Remarks: a) P is given by a list of coordinates,';
   PrintLn '         b) CurrentRing should have at least Len(P) indets.'
End;

-------------------------------------------------------------------

Define Idopts(M,Mu)
  I:=Ideal(Poly(1));
  For J:=1 To Len(M) Do I:=Intersection(I,$.Idopt(M[J],Mu[J])) End;
Return I
End;

Define Help_Idopts()
   PrintLn 'Idopts( M : Mat , Mu : List ) : Ideal';
   PrintLn 'returns the vanishing ideal of the set of points in P^n';
   PrintLn 'given by the rows of the matrix M. Mu are multiplicators.';
   PrintLn 'Remarks:';
   PrintLn '  a) CurrentRing should have at least Len(M[1]) indeterminates,';
   PrintLn '  b) the computation uses the intersection method.';
End;

----------------------------------------------------------------

Define Points(...)
  M:=ARGV[1];
  If Len(ARGV)=2 Then Mu:=ARGV[2] Else
    Mu:=NewList($.NRows(M),1) End;
  If Len(M[1]) > NumIndets() Then Return 'Ring must have at least '+
     +Sprint(Len(M[1]))+' indeterminantes!' End;
  Erg:=$.Idopts(M,Mu);
  Return Minimalized(Erg)
End;

Define Help_Points()
   PrintLn 'Points ( M : Mat ) : Ideal';
   PrintLn 'returns the vanishing ideal of the set of points in P^n';
   PrintLn 'given by the rows of the matrix M. Mu are optional';
   PrintLn 'multipliers of the points.';
   PrintLn 'Remarks:';
   PrintLn '  a) CurrentRing should have at least Len(M[1]) indeterminates,';
   PrintLn '  b) the computation uses the intersection method.';
End;

-------------------------------------------------------------------
-------------------------------------------------------------------

J_From_Lambda(I):= 2^8 * (I^2-I+1)^3 / (I^2 * (I-1)^2);

Define Help_J_From_Lambda()
   PrintLn 'J_From_Lambda ( I : Int ) : Int';
   PrintLn 'returns J=2^8 * (I^2-I+1)^3 / (I^2 * (I-1)^2).';
   PrintLn 'This is the function invariant under lambda:=I -->';
   PrintLn 'I, 1/I, 1-I, 1/(1-I), I/(I-1), (I-1)/I.';
End;

-------------------------------------------------------------------

Define Imap(...)
  If Len(ARGV) <> 1 Then
    Return 'One argument expected.' End;
  If Type(ARGV[1]) <> STRING Then
    Return 'First argument must be a string containing the sourcering.' End;
  If Not (ARGV[1] IsIn RingEnvs()) Then
    Return 'First argument must be a string containing the sourcering.' End;

  F:=ARGV[1];
  Using Var(F) Do
    Fred:=Indets();
    MEMORY.LLIma:=Len(Fred);
    MEMORY.IndexIma:=NewList(MEMORY.LLIma);
  End;
  For I:=1 To MEMORY.LLIma Do
    Using Var(F) Do MEMORY.IndexIma[I]:=IndetInd(Fred[I]) End;
  End;
  For I:=1 To MEMORY.LLIma Do
    Using Var(F) Do Fred[I]:=IndetName(Fred[I]) End;
  End;
  Using Var(F) Do
    MEMORY.FredIma:=Fred;
  End;
  CI:=Indets();
  HList:=NewList(Len(CI));
  For I:=1 To Len(CI) Do HList[I]:=IndetInd(CI[I]) End;
  For I:=1 To Len(CI) Do CI[I]:=IndetName(CI[I]) End;
  Erg:=NewList(MEMORY.LLIma);
  For I:=1 To MEMORY.LLIma Do
    If MEMORY.FredIma[I] IsIn CI Then
      Z:=0;
      For J:=1 To Len(CI) Do
        If MEMORY.FredIma[I]=CI[J] And MEMORY.IndexIma[I]=HList[J] Then
           Z:=J;
        End;
      End;
      If Z=0 Then Erg[I]:=0 Else Erg[I]:=Indet(Z) End;
    Else Erg[I]:=0;
    End;
  End;
Return RMap(Erg)
End;

Define Help_Imap()
   PrintLn 'Imap ( S : String ) : Func';
   PrintLn 'create a ring map whose effect is to map each variable of';
   PrintLn 'S to the variable of the same name in the current ring. If';
   PrintLn 'there is no such variable in the current ring, then it is';
   PrintLn 'mapped to zero.';
End;

-------------------------------------------------------------

Define Fetch(...)
  If Len(ARGV) < 2 Then
    Return 'At least two arguments expected.' End;
  If Len(ARGV) > 3 Then
    Return 'Only two or three arguments expected.' End;
  If Type(ARGV[1]) <> STRING Then
    Return 'First must be a string.' End;
  If Not (ARGV[1] IsIn RingEnvs()) Then
    Return 'First string must name a Ring.' End;

  F:=$.Imap(ARGV[1]);
  If Len(ARGV)=3 Then
    For I:=1 To Len(F) Do
      If F[I]=0 Then F[I]:=1 End;
    End;
  End;
  Return Image(ARGV[2],F);
End;


Define Help_Fetch()
   PrintLn 'Fetch ( S1 : String , O : Object , [Obj] ) : Object';
   PrintLn 'The first string must indicate a ring. The second argument must';
   PrintLn 'be an object of the indicated ring. The function';
   PrintLn 'creates a new object, which is essentially the object O.';
   PrintLn 'Each variable in S1 which also occurs in the current ring';
   PrintLn 'is left unchange, and each variable which does not occur is';
   PrintLn 'set to zero by default (or one, if a optional third argu-';
   PrintLn 'ment is given).';
End;

-----------------------------------------------------------------

Define Blockmap(I,J)
  If Type(I) <> INT Or Type(J) <> INT Then
    Return 'Integers expected.' End;
  F:=NewList(NumIndets());
  For K:=1 To Len(F) Do
    If K>=I And K<=J Then F[K]:=Indet(K) Else F[K]:=0 End;
  End;
Return RMap(F)
End;

Define Help_Blockmap()
   PrintLn 'Blockmap ( I : Int , J : Int ) : Func';
   PrintLn 'create a ring map (over the current ring) which sends';
   PrintLn 'the given range of the variables to themselves, but';
   PrintLn 'sends every other variable to 0. I and J are two ';
   PrintLn 'integers specifying the range of variables. The ';
   PrintLn 'variables are numbered starting at 1.';
End;

-----------------------------------------------------------------

Define Weightsmap(I,J)
  If Type(I) <> INT Or Type(J) <> INT Then
    Return 'Integers expected.' End;
  F:=NewList(NumIndets());
  For K:=1 To Len(F) Do
    If Deg(Indet(K))>=I And Deg(Indet(K))<=J Then F[K]:=Indet(K)
    Else F[K]:=0 End;
  End;
Return RMap(F)
End;

Define Help_Weightsmap()
   PrintLn 'Weightsmap ( I : Int , J : Int ) : Func';
   PrintLn 'create a ring map (over the current ring) which sends';
   PrintLn 'the variables with weights between I and J to themselves';
   PrintLn 'and all other variables to 0.';
End;

-----------------------------------------------------------------

Define Lmap(...)
  If Len(ARGV) <> 1 Then
    Return 'One arguments expected.' End;
  If Type(ARGV[1]) <> STRING Then
    Return 'First argument must be a string containing the sourcering.' End;
  If Not (ARGV[1] IsIn RingEnvs()) Then
    Return 'First argument must be a string containing the sourcering.' End;

  Erg:=NewList(NumIndets(Var(ARGV[1])),0);
  LF:=Len(Erg);
  If LF>NumIndets() Then LF:=NumIndets() End;
  For Zaeh:=1 To LF Do Erg[Zaeh]:=Indet(Zaeh) End;
  Return RMap(Erg)
End;

Define Help_Lmap()
   PrintLn 'Lmap ( S : String ) : Func';
   PrintLn 'create a ring map whose effect is to map the first';
   PrintLn 'variable of the ring S to the first variable of the';
   PrintLn 'current ring, the second variable to the second and';
   PrintLn 'so on. If the ring S have more variables than the';
   PrintLn 'current ring, then these variables are send to 0.';
End;

-----------------------------------------------------------------

Define Fetch2(...)
  If Len(ARGV) < 2 Then
    Return 'At least two arguments expected.' End;
  If Len(ARGV) > 3 Then
    Return 'Only two or three arguments expected.' End;
  If Type(ARGV[1]) <> STRING Then
    Return 'First argument must be strings.' End;
  If Not (ARGV[1] IsIn RingEnvs()) Then
    Return 'First string must name a ring.' End;
  F:=$.Lmap(ARGV[1]);
  If Len(ARGV)=3 Then
    For I:=1 To Len(F) Do
      If F[I]=0 Then F[I]:=1 End;
    End;
  End;
  Erg:=Image(ARGV[2],F);
  Return Erg
End;


Define Help_Fetch2()
   PrintLn 'Fetch ( S1 : String , O : Object , [Obj] ) : Object';
   PrintLn 'The first string must indicate a ring. The second argument';
   PrintLn 'must be an object of the indicated ring. The function';
   PrintLn 'creates a new object, which is essentially the object O.';
   PrintLn 'See Lmap for the used function. If an optional third argu-';
   PrintLn 'ment is given then Lmap will send the last variables to 1';
   PrintLn '(not to 0)!';
End;

-----------------------------------------------------------------

Define Syz1(...)
  M:=ARGV[1];
  I:=ARGV[2];
  If Len(ARGV)=3 Then Return $.Syz2(M,I,ARGV[3]) End;
  SM:=Syz(M);
  If SM=Module() Then Return SM End;
  SSM:=SM.Shifts;
  If SSM<>Null Then ShiSM:=First(SSM,I)
    Else ShiSM:=Null End;
  GM:=SM.Gens;
  For J:=1 To Len(SM) Do
    GM[J]:=Comps(GM[J]);
    GM[J]:=First(GM[J],I);
  End;
  If ShiSM=Null Then SMI:=Module(GM) Else
    SMI:=Module(Shifts(ShiSM),GM) End;
Return SMI
End;

Define Syz2(M,I,J)
  If Type(M)=IDEAL Then
    M:=Ideal(Concat(M.Gens,J.Gens));
    SM:=Syz(M);
  Else
    IM:=$.Iden(NumComps(M));
    IM:=$.Outer(IM,Mat(J.Gens));
    M:=$.Concat($.Transposed(Mat(M.Gens)),IM);
    SM:=Syz(Module($.Transposed(M)));
  End;
  If SM=Module() Then Return SM End;
  SM:=Module(Mat(SM));
  GM:=SM.Gens;
  For J:=1 To Len(SM) Do
    GM[J]:=Comps(GM[J]);
    GM[J]:=First(GM[J],I);
  End;
  If I=1 Then Erg:=Ideal(Module(GM)) Else Erg:=Module(GM) End;
Return Erg
End;

Define Help_Syz1()
   PrintLn 'Syz1 ( Mo : Module , I : Int ) : Module';
   PrintLn 'returns the first I components of the syzygymodule of Mo.';
End;

-------------------------------------------------------------------

Define Cast2(I)
  If Type(I)=MODULE Then Erg:=Cast(I,MAT) End;
  If Type(I)=IDEAL Then
    Erg:=I.Gens;
    Erg:=Cast(Erg,MAT);
    Erg:=Transposed(Erg);
  End;
Return Erg
End;

------------------------------------------------------------------

Define Ann(M)
  M:=Module(M);
  LM:=Len(M);
  If M=Module(0) Then Return Ideal(1) End;
  NCM:=NumComps(M);
  SyW:=NewList(NCM);
  HM:=$.Iden(NCM);
  For I:=1 To NCM Do
    H:=Cast(HM[I],MODULE);
    W:=Module(Concat(H.Gens,M.Gens));
    SyW[I]:=$.Syz1(W,1);
  End;
  Erg:=IntersectionList(SyW);
  If Erg=Module() Then Erg:=Ideal() Else Erg:=Cast(Erg,IDEAL) End;
Return Erg
End;

Define Help_Ann()
   PrintLn 'Ann ( Mo : Module ) : Ideal';
   PrintLn 'returns the annihillator ideal of the quotient module';
   PrintLn 'represented by M.';
End;

-------------------------------------------------------------------

Define Ann1(...)
  M:=ARGV[1];
  If M=Module(0) Then Return Ideal(1) End;
  LM:=Len(M);
  NCM:=NumComps(M);
  Id:=$.Iden(NCM);
  MM:=Cast(M,MAT);

--create auxilliary-matrix

  HM:=NewMat(NCM*LM+1,NCM^2,0);
  Z:=0;
  For I:=1 To NumComps(M) Do
    HM[1,Z+I]:=1;
    Z:=Z+NCM;
  End;
  Z:=1;
  For I:=2 To Len(HM) Step LM Do
    For J:=0 To LM-1 Do
      For K:=0 To NCM-1 Do
        HM[I+J,Z+K]:=MM[J+1,K+1];
      End;
    End;
    Z:=Z+NCM;
  End;

-- end auxilliary-matrix

  If Len(ARGV)=2 Then 
    I:=ARGV[2];
    He2:=$.Iden(NCM^2);
    He2:=$.Outer(He2,$.Transposed(Mat(I)));
    HM:=$.Transposed($.Concat(Transposed(HM),He2));
  End;

  SM:=Cast(HM,MODULE);
  Erg:=$.Syz1(SM,1);
  If Len(ARGV)=2 Then Erg:=$.FetchQring(Minimalized(Erg),I) End;
  If Erg=Module() Then Erg:=Ideal() Else Erg:=Cast(Erg,IDEAL) End;
Return Erg
End;


Define Help_Ann1()
   PrintLn 'Ann1 ( Mo : Module , [I : Ideal]) : Ideal';
   PrintLn 'returns the annihillator ideal of the quotient module';
   PrintLn 'represented by M.';
End;

--------------------------------------------------------

Define Ann2(M)
  If M=Module(0) Then Return Ideal(1) End;
  MEMORY.NI:=NumIndets();
  ColfR::=CoeffRing[x[1..MEMORY.NI],s,t];
  F1:=RMap(Indets());
  Using ColfR Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using ColfR Do L[I]:=x[I] End End;
  Using ColfR Do
    F:=RMap(L);
    U:=Image(M,F);
    L:=NewList(NumComps(U),1);
  End;
  For I:=0 To NumComps(M)-1 Do
    Using ColfR Do L[I+1]:=L[I+1]*s^I*t^(NumComps(U)-1-I) End;
  End;
  Using ColfR Do
    W:=Module(L)+U;
    Erg1:=$.Syz1(W,1);
  End;
  Erg:=Image(Erg1,F1);
  DESTROY ColfR;
  If Erg=Module() Then Erg:=Ideal() Else Erg:=Cast(Erg,IDEAL) End;
  Return Erg;
End;

Define Help_Ann2()
   PrintLn 'Ann2 ( Mo : Module ) : Ideal';
   PrintLn 'returns the annihillator ideal of the quotient module';
   PrintLn 'represented by M.';
End;

----------------------------------------------------------------------

Define Annihil(I,M)
  MM:=$.Iden(NumComps(M));
  IM:=I*Cast(MM,MODULE);
  If IM <= M Then Erg:=1 Else Erg:=0 End;
Return Erg
End;

Define Help_Annihil()
   PrintLn 'Annihil ( I : Ideal , Mo : Module ) : Int';
   PrintLn 'returns 1 if I annihilates the module Mo, else 0.';
End;

-------------------------------------------------------------------

Define Quotient(M,N)
  If Type(N)=POLY Then Return $.Colona(M,N) End;
  If Type(M)<>MODULE And Type(M)<>IDEAL Then
    Return 'First argument must be a module or an ideal' End;
  If Type(N)<>MODULE  And Type(N)<>IDEAL Then
    Return 'Second argument must be a module or an ideal' End;

  If Type(M)=Type(N) Then Return M:N End;

  If Type(M)=IDEAL And Type(N)=MODULE Then Return 0 End;

  Return $.Colone(M,N)
End;

Define Help_Quotient()
   PrintLn 'Quotient ( M/I : Mod or Ideal , M/I : Mod / Ideal) : Ideal';
   PrintLn 'compute the ideal or submodule quotient (I:J).';
End;

-------------------------------------------------------------------

Define Modulo(...)
  M:=ARGV[1];
  N:=ARGV[2];
  M:=Cast(M,MODULE);
  N:=Module(N);
  If M=N Then 
    NR:=Len(M);
    If NR=1 Then Return Ideal(1) 
      Else Return Module($.Iden(NR))
    End;
  End;
  If N=Module([]) Then Return Cast(Syz(M),Type(M)) End;
  If M=Module([]) Then Return M End;
  If Len(ARGV)=3 Then 
    I:=ARGV[3];
    He2:=$.Iden(NumComps(M));
    He2:=$.Outer(He2,$.Transposed(Mat(I)));
  End;
  LM:=Len(M);
  HE:=M.Gens;
  HE:=Concat(HE,N.Gens);
  HE:=Module(HE);
  HE:=Mat(HE);
  If Len(ARGV)=3 Then $.Concat(HE,He2) End;
  HE:=$.Syz1(Module(HE),LM);
  HE:=Interreduced(HE.Gens);
  If LM=1 Then Erg:=Cast(HE,IDEAL)
    Else Erg:=Module(HE) End;
Return Erg
End;

Define Help_Modulo()
   PrintLn 'Modulo ( MI1 : Mod/Ide , MI2 : Mod/Ide , [ I : Ide ]) : Ideal';
   PrintLn 'compute a presentation for MI1+MI2/MI2.';
End;

-------------------------------------------------------

Define Intersec1(M,N)
  M:=Minimalized(M);
  N:=Minimalized(N);
  GM:=M.Gens;
  LM:=Len(M);
  MPlusN:=Concat(GM,N.Gens);
  Syzm:=$.Syz1(MPlusN,LM);
  SyzmList:=Syzm.Gens;
  For I:=1 To Len(SyzmList) Do
    SyzmList[I]:=Comps(SyzmList[I]);
  End;
  LS:=Len(Syzm);
  If Type(M)=IDEAL Then NullVect:=0 Else
    NullVect:=Cast(NewList(NumComps(GM[1]),0),VECTOR) End;
  LS1:=Len(SyzmList[1]);
  HilfsListe:=NewList(LS,NullVect);
  For I:=1 To LS Do
    For J:=1 To LS1 Do
      HilfsListe[I]:=HilfsListe[I]+SyzmList[I,J]*GM[J];
    End;
  End;
  HilfsListe:=Diff(HilfsListe,[NullVect]);
  Erg:=Cast(HilfsListe,Type(M));
Return Erg
End;

Define Help_Intersec1()
   PrintLn 'Intersec1( M1 : Mod/Ide , M2 : Mod/Ide ) : Mod/Ide';
   PrintLn 'returns the intersection of Mo1 and Mo2.';
End;

-------------------------------------------------------------------

Define Intersec2(M,N)
  TM:=Type(M);
  M:=Minimalized(M);
  N:=Minimalized(N);
  If TM=IDEAL Then NCM:=1 Else NCM:=NumComps(M) End;
  LM:=Len(M);
  LN:=Len(N);
  MM:=$.Cast2(M);
  NN:=$.Cast2(N);
  HM:=NewMat(LM+LN+NCM,2*NCM,0);

  For I:=1 To NCM Do
    HM[I,I]:=1;
    HM[I,I+NCM]:=1;
  End;

  For I:=NCM+1 To NCM+LM Do
    For J:=1 To Len(MM[1]) Do
      HM[I,J]:=MM[I-NCM,J];
    End;
  End;

  For I:=NCM+Len(MM)+1 To NCM+Len(MM)+Len(NN) Do
    For J:=1 To Len(NN[1]) Do
      HM[I,NCM+J]:=NN[I-NCM-Len(MM),J];
    End;
  End;

  HM:=Cast(HM,MODULE);
  Erg:=Mat($.Syz1(HM,NCM));
  Erg:=Cast(Erg,TM);
  If Type(Erg)=IDEAL Then Erg:=Ideal(Diff(Erg.Gens,[0])) End;
  Return Erg
End;

Define Help_Intersec2()
   PrintLn 'Intersec2 ( M1 : Mod/Ide , M2 : Mod/Ide ) : Mod/Ide';
   PrintLn 'returns the intersection of Mo1 and Mo2.';
End;

--------------------------------------------------------

Define Intersec3(M,N)
  M:=Minimalized(M);
  N:=Minimalized(N);
  MEMORY.NInt3:=NumIndets();
  Fred::=CoeffRing[x[1..MEMORY.NInt3],t];
  F1:=RMap(Indets());
  Using Fred Do L:=NewList(MEMORY.NInt3) End;
  For I:=1 To MEMORY.NInt3 Do Using Fred Do L[I]:=x[I] End End;
  Using Fred Do
    F:=RMap(L);
    U:=Image(M,F);
    V:=Image(N,F);
    U:=t*U;
    V:=(1-t)V;
    W:=U.Gens;
    W:=Cast(Concat(W,V.Gens),Type(U));
    Erg1:=Elim(t,W);
  End;
  Erg:=Image(Erg1,F1);
  DESTROY Fred;
  Return Erg
End;

Define Help_Intersec3()
   PrintLn 'Intersec3( M1 : Mod/Ide , M2 : Mod/Ide ) : Mod/Ide';
   PrintLn 'returns the intersection of Mo1 and Mo2.';
End;

---------------------------------------------------------------

Define Intersec4(...)
  If Type(ARGV[1])=LIST Then L:=ARGV[1] Else L:=ARGV End;
  LL:=Len(L);
  Erg:=L[1];
  For I:=2 To LL Do
    Erg:=Intersection(Erg,L[I]);
  End;
Return Erg
End;

Define Help_Intersec4()
   PrintLn 'Intersec4 ( Mo1 : Module ,.., Mo(n) : Module ) : Module';
   PrintLn 'returns the intersection of Mo1 .. Mo(n).';
End;

---Alternativprogramm (rekursiv)

Define Intersec4b(...)
  If Type(ARGV[1])=LIST Then L:=ARGV[1] Else L:=ARGV End;
  LL:=Len(L);
  If LL=1 Then Return L[1] Else Return
    Intersection($.Intersec4b(Tail(L)),L[1]) End;
End;

---------------------------------------------------------------

Define Intersec5(...)
  If Type(ARGV[1])=LIST Then L:=ARGV[1] Else L:=ARGV End;
  LL:=Len(L);
  M:=Minimalized(L[1]);
  MEMORY.NInt5:=NumIndets();
  Fred::=CoeffRing[x[1..MEMORY.NInt5],t[1..LL]];
  F1:=RMap(Indets());
  Using Fred Do Li:=NewList(MEMORY.NInt5) End;
  For I:=1 To MEMORY.NInt5 Do Using Fred Do Li[I]:=x[I] End End;
  Using Fred Do
    F:=RMap(Li);
    U:=t[1]*Image(M,F);
  End;
  For I:=2 To LL Do
    M:=Minimalized(L[I]);
    Using Fred Do U:=U+Image(M,F)*t[I] End;
  End;
  Using Fred Do LL:=NumIndets()-MEMORY.NInt5 End;
  If Type(M)=IDEAL Then
    Using Fred Do NCU:=1 End;
  Else
    Using Fred Do NCU:=NumComps(U) End;
  End;
  Using Fred Do T:=1-t[1] End;
  For I:=2 To LL Do Using Fred Do T:=T-t[I] End End;
  If Type(M)=IDEAL Then
    Using Fred Do W:=U+Ideal(T) End;
  Else
    Using Fred Do
      HilfsMat:=$.Iden(NCU)*T;
      V:=Cast(HilfsMat,Type(U));
      W:=U.Gens;
      W:=Cast(Concat(W,V.Gens),Type(U));
    End;
  End;

  Using Fred Do Erg1:=Elim(t[1]..t[LL],W) End;
  Erg:=Image(Erg1,F1);
  DESTROY Fred;
  Return Erg
End;

Define Help_Intersec5()
   PrintLn 'Intersec5 ( Mo1 : Module ,..., Mo(n) : Module ) : Module';
   PrintLn 'returns the intersection of Mo1 ,..., Mo(n).';
End;

---------------------------------------------------------------

Define Colona(M,F)
  If Type(M)=IDEAL Then Return M:F End;
  N:=Ideal(F);
  Erg:=$.Colone(M,N);
Return Erg
End;

Define Help_Colona()
   PrintLn 'Colona ( Mo : Module , F : Poly ) : Module';
   PrintLn 'compute the colonmodule (Mo:F).';
End;

-------------------------------------------------------------------

Define Colonb(M,G)
  If Type(M)=IDEAL Then Return M:G End;
  MEMORY.NI:=NumIndets();
  ColbR::=CoeffRing[x[1..MEMORY.NI],t];
  F1:=RMap(Indets());
  Using ColbR Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using ColbR Do L[I]:=x[I] End End;
  Using ColbR Do
    F:=RMap(L);
    U:=Image(M,F);
    G:=Image(G,F);
    I:=$.Iden(NumComps(U));
    GT:=(G-t)*I;
    UGT:=U+Cast(GT,MODULE);
    Erg1:=$.Colona(UGT,t);
    Erg1:=Elim(t,Erg1);
  End;
  Erg:=Image(Erg1,F1);
  DESTROY(ColbR);
Return Erg
End;

Define Help_Colonb()
   PrintLn 'Colonb ( Mo : Module , F : Poly ) : Module';
   PrintLn 'compute the colonmodule (Mo:F).';
End;

---------------------------------------------------------------------------

Define Colonc(M,F)
  If Type(M)=IDEAL Then Return M:F End;
  E:=$.Iden(NumComps(M));
  FE:=F*E;
  FE:=Cast(FE,MODULE);
  MFE:=Intersection(M,FE);
  GMFE:=Gens(MFE);
  V:=NewList(Len(GMFE));
  For I:=1 To Len(GMFE) Do
    L:=NewList(Len(GMFE[I]));
    For J:=1 To Len(GMFE[I]) Do
      L[J]:=GMFE[I,J]/F;
    End;
    V[I]:=Cast(L,VECTOR);
  End;
  Erg:=Cast(V,MODULE);
Return Erg
End;

Define Help_Colonc()
   PrintLn 'Colonc ( Mo : Module , F : Poly ) : Module';
   PrintLn 'compute the colonmodule (Mo:F).';
End;

---------------------------------------------------------------------------

Define Colond(M,N)
  If Type(M)=IDEAL Then Return M:N End;
  L:=N.Gens;
  LL:=Len(L);
  NL:=NewList(LL);
  NL[1]:=$.Colonc(M,L[1]);
  If NL[1] = M Then Return M End;
  Erg:=NL[1];
  For I:=2 To LL Do
    NL[I]:=$.Colonc(M,L[I]);
    Erg:=Intersection(Erg,NL[I]);
    If Erg = M Then Return M End;
  End;
Return Erg
End;

Define Help_Colond()
   PrintLn 'Colond ( Mo : Module , I : Ideal ) : Module';
   PrintLn 'compute the colonmodule (Mo:I).';
   PrintLn 'If Mo:G[I] IsIn Mo then Mo:G[I]=Mo (because Mo IsIn Mo:I).';
End;

--------------------------------------------------------------------------

Define Colone(...)
  M1:=ARGV[1];
  N1:=ARGV[2];
  LA:=Len(ARGV);

  If Type(M1)=IDEAL Then 
    If LA=2 Then Return $.ColoneIdeal(M1,N1) Else 
      Return $.ColoneIdeal(M1,N1,ARGV[3]) End;
  End;
  If Type(N1)=POLY Then N1:=Ideal(N1) End;
  L:=N1.Gens;
  If LA=3 Then 
    K2:=ARGV[3];
    L:=Concat(L,K2.Gens);
  End;

  NCM:=NumComps(M1);
  MM1:=Mat(M1.Gens);

--Create auxiliary matrix :

  He2:=$.Iden(NCM);
  He2:=$.Outer(Mat(L),He2);
  HM:=NewMat(Len(M1)*Len(L),Len(L)*NCM,0);

  Z:=1;
  For I:=1 To Len(HM) Step Len(M1) Do
    For J:=0 To Len(M1)-1 Do
      For K:=0 To NCM-1 Do
        HM[I+J,Z+K]:=MM1[J+1,K+1];
      End;
    End;
    Z:=Z+NCM;
  End;

-- end auxilliary matrix

  HM:=$.Transposed($.Concat($.Transposed(He2),$.Transposed(HM)));

  SM:=Cast(HM,MODULE);
  If LA=2 Then Erg:=Module(Mat($.Syz1(SM,NCM))) 
    Else Erg:=Module(Mat($.Syz1(SM,NCM,K2))) End;
  Erg:=Module(Interreduced(Erg.Gens));
  If LA=3 Then Erg:=$.FetchQring(Erg,K2) End;
Return Erg
End;

Define ColoneIdeal(...)
  M:=ARGV[1];
  N:=ARGV[2];
  If Type(N)=POLY Then N:=Ideal(N) End;
  L:=N.Gens;
  NCM:=1;

  If Len(ARGV)=3 Then 
    I:=ARGV[3];
    L:=Concat(L,I.Gens);
  End;

  He2:=$.Iden(Len(L));
  He2:=$.Outer(He2,$.Transposed(Mat(M)));
  HM:=$.Concat($.Transposed(Mat(L)),He2);  
 
  HM:=$.Transposed(HM);
  SM:=Cast(HM,MODULE);
  If Len(ARGV)=2 Then Erg:=Module(Mat($.Syz1(SM,NCM))) 
    Else Erg:=Module(Mat($.Syz1(SM,NCM,ARGV[3]))) End;
  Erg:=Ideal(Interreduced(Erg.Gens));
  If Len(ARGV)=3 Then Erg:=$.FetchQring(Erg,ARGV[3]) End;
Return Erg
End;

Define Help_Colone()
   PrintLn 'Colone ( Mo : Module , I : Ideal ) : Module';
   PrintLn 'compute the colonmodule (Mo:I).';
End;

------------------------------------------------------------

Define Colonf(M,I)
  If Type(M)=IDEAL Then Return M:I End;
  MEMORY.NI:=NumIndets();
  ColfR::=CoeffRing[x[1..MEMORY.NI],t];
  F1:=RMap(Indets());
  Using ColfR Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using ColfR Do L[I]:=x[I] End End;
  Using ColfR Do
    F:=RMap(L);
    U:=Image(M,F);
    I:=Image(I,F);
    GI:=I.Gens;
    G:=GI[1];
  End;
  For I:=2 To Len(I) Do Using ColfR Do G:=G+t^(I-1)*GI[I] End End;
  Using ColfR Do
    Erg1:=$.Colonc(U,G);
    Erg1:=Elim(t,Erg1);
  End;
  Erg:=Image(Erg1,F1);
  DESTROY ColfR;
  Return Erg
End;

Define Help_Colonf()
   PrintLn 'Colonf ( Mo : Module , I : Ideal ) : Module';
   PrintLn 'compute the colonmodule (Mo:I).';
End;

---------------------------------------------------------------------

Define Sat(...)
  M:=ARGV[1];
  II:=ARGV[2];
  LA:=Len(ARGV);
  If LA=3 Then K:=ARGV[3] End;
  If Type(II)=POLY Then II:=Ideal(II) End;
  L:=II.Gens;
  LL:=Len(L);
  NL:=NewList(LL);
  If LA=2 Then 
    For I:=1 To LL Do NL[I]:=$.Sat1(M,L[I]); End;
  Else
    For I:=1 To LL Do NL[I]:=$.Sat1(M,L[I],K); End;
  End;
  Erg:=NL[1];
  For I:=2 To LL Do Erg:=Intersection(Erg,NL[I]) End;
  If LA=3 Then Erg:=$.FetchQring(Erg,K) End;
Return Erg
End;

Define Help_Sat()
   PrintLn 'Sat ( Mo : Mod/Ide , I : Ide/Poly , [I : Ide]) : Mod/Ide';
   PrintLn 'compute the saturation (Mo:I^infinity).';
End;

---------------------------------------------------------------

Define Sat1(...)
  M3:=ARGV[1];
  F3:=ARGV[2];
  LA:=Len(ARGV);
  If LA=2 Then 
    ErgS1:=$.Colona(M3,F3);
    Vgl:=M3;
    While ErgS1<>Vgl Do
      Vgl:=ErgS1;
      ErgS1:=$.Colona(ErgS1,F3);
    End;
  Return ErgS1 
  End;

  K1:=ARGV[3];
  Repeat
    Vgl:=M3;
    Erg:=$.Colone(Vgl,Ideal(F3),K1);
    M3:=Erg;
  Until Erg=Vgl;
Return Erg
End;

Define Help_Sat1()
   PrintLn 'Sat1 ( M/I : Mod/Ide , F : Poly , [I : Ide]) : Mod/Ide';
   PrintLn 'compute the saturation (Mo:F^infinity).';
End;

--------------------------------------------------------------------------

Define Sat2(M,G)
  MEMORY.NI:=NumIndets();
  Sat2R::=CoeffRing[x[1..MEMORY.NI],t];
  F1:=RMap(Indets());
  Using Sat2R Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using Sat2R Do L[I]:=x[I] End End;
  Using Sat2R Do
    F:=RMap(L);
    U:=Image(M,F);
    G:=Image(G,F);
  End;
  If Type(M)=MODULE Then
    Using Sat2R Do
      I:=$.Iden(NumComps(U));
      GT:=(G-t)*I;
      UGT:=U+Cast(GT,MODULE);
    End;
  Else
    Using Sat2R Do UGT:=U+Ideal(G-t) End;
  End;
  Using Sat2R Do
    Erg1:=$.Sat3(UGT,t);
    Erg1:=Elim(t,Erg1);
  End;
  Erg:=Image(Erg1,F1);
  DESTROY(Sat2R);
Return Erg
End;

Define Help_Sat2()
   PrintLn 'Sat2 ( M/I : Mod/Ide , F : Poly ) : Mod/Ide';
   PrintLn 'compute the saturation (Mo:F^infinity).';
End;

---------------------------------------------------------------------

Define Sat3(M,G)
  MEMORY.NI:=NumIndets();
  Sat3R::=CoeffRing[x[1..MEMORY.NI],t];
  F1:=RMap(Indets());
  Using Sat3R Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using Sat3R Do L[I]:=x[I] End End;
  Using Sat3R Do
    F:=RMap(L);
    U:=Image(M,F);
    G:=Image(G,F);
  End;
  If Type(M)=MODULE Then
    Using Sat3R Do
      I:=$.Iden(NumComps(U));
      GT:=(1-G*t)*I;
      UGT:=U+Cast(GT,MODULE);
    End;
  Else
    Using Sat3R Do UGT:=U+Ideal(1-G*t) End;
  End;
  Using Sat3R Do Erg1:=Elim(t,UGT) End;
  Erg:=Image(Erg1,F1);
  DESTROY(Sat3R);
Return Erg
End;

Define Help_Sat3()
   PrintLn 'Sat3 ( M/I : Mod/Ide , F : Poly ) : Mod/Ide';
   PrintLn 'compute the saturation (Mo:F^infinity).';
End;

---------------------------------------------------------------------------

Define Sat3N(M,G)
  MEMORY.NI:=NumIndets();
  Sat3R::=CoeffRing[x[1..MEMORY.NI],t];
  F1:=RMap(Indets());
  Using Sat3R Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using Sat3R Do L[I]:=x[I] End End;
  Using Sat3R Do
    F:=RMap(L);
    U:=Image(M,F);
    G:=Image(G,F);
  End;
  If Type(M)=MODULE Then
    Using Sat3R Do
      I:=$.Iden(NumComps(U));
      GT:=(G-t)*I;
      UGT:=U+Cast(GT,MODULE);
    End;
  Else
    Using Sat3R Do UGT:=U+Ideal(G-t) End;
  End;
  Using Sat3R Do Erg1:=Elim(t,UGT) End;
  Erg:=Image(Erg1,F1);
  DESTROY(Sat3R);
Return Erg
End;

Define Help_Sat3N()
   PrintLn 'Sat3 ( M/I : Mod/Ide , F : Poly ) : Mod/Ide';
   PrintLn 'compute the saturation (Mo:F^infinity).';
End;

---------------------------------------------------------------------------

Define Sat4(M,I)
  L:=I.Gens;
  LL:=Len(L);
  NL:=NewList(LL);
  For I:=1 To LL Do NL[I]:=$.Sat3(M,L[I]) End;
  Erg:=NL[1];
  For I:=2 To LL Do Erg:=Intersection(Erg,NL[I]) End;
Return Erg
End;

Define Help_Sat4()
   PrintLn 'Sat4 ( Mo : Module , I : Ideal ) : Module';
   PrintLn 'compute the saturation (Mo:I^infinity).';
End;

---------------------------------------------------------------

Define Sat5(M,I)
  MEMORY.NIS5:=NumIndets();
  Sat5R::=CoeffRing[x[1..MEMORY.NIS5],t];
  F1:=RMap(Indets());
  Using Sat5R Do L:=NewList(MEMORY.NIS5) End;
  For I:=1 To MEMORY.NIS5 Do Using Sat5R Do L[I]:=x[I] End End;
  Using Sat5R Do
    F:=RMap(L);
    U:=Image(M,F);
    I:=Image(I,F);
    G:=I.Gens[1];
  End;
  For J:=2 To Len(I) Do Using Sat5R Do G:=G+t^(J-1)*I.Gens[J] End End;
  Using Sat5R Do
    Erg1:=$.Sat3(U,G);
    Erg1:=Elim(t,Erg1);
  End;
  Erg:=Image(Erg1,F1);
  DESTROY(Sat5R);
Return Erg
End;

Define Help_Sat5()
   PrintLn 'Sat5 ( Mo : Module , I : Ideal ) : Module';
   PrintLn 'compute the saturation (Mo:I^infinity).';
End;

----------------------------------------------------------

--- Kombination von Sat5 mit Sat3 (nur ein Elim) ---

Define Sat6(M,I)
  MEMORY.NIS6:=NumIndets();
  Sat6R::=CoeffRing[x[1..MEMORY.NIS6],s,t];
  F1:=RMap(Indets());
  Using Sat6R Do L:=NewList(MEMORY.NIS6) End;
  For I:=1 To MEMORY.NIS6 Do Using Sat6R Do L[I]:=x[I] End End;
  Using Sat6R Do
    F:=RMap(L);
    U:=Image(M,F);
    I:=Image(I,F);
    G:=I.Gens[1];
  End;
  For J:=2 To Len(I) Do Using Sat6R Do G:=G+t^(J-1)*I.Gens[J] End End;
  If Type(M)=MODULE Then
    Using Sat6R Do
      GT:=(1-G*s)*$.Iden(NumComps(U));
      Erg1:=U+Cast(GT,MODULE);
    End;
  Else
    Using Sat6R Do Erg1:=U+Ideal(1-G*s) End;
  End;
  Using Sat6R Do Erg1:=Elim(s..t,Erg1) End;
  Erg:=Image(Erg1,F1);
  DESTROY(Sat6R);
Return Erg
End;

Define Help_Sat6()
   PrintLn 'Sat6 ( Mo : Module , I : Ideal ) : Module';
   PrintLn 'compute the saturation (Mo:I^infinity).';
End;

--------------------------------------------------------------
--
Define Kernel(...)
  F:=ARGV[1];
  G:=ARGV[2];
  H:=ARGV[3];
  E1:=$.Modulo(F,H);
  E2:=$.Modulo(E1,G);
  Erg:=E2;
Return Erg
End;

Define Help_Kernel()
   PrintLn 'Kernel ( F : Func , M : Mod , N : Mod ) : Module';
   PrintLn 'computes a presentation for the kernel of F.';
End;

---------------------------------------------------------------

Define Quotkern(M,I)
  If Type(M) IsIn [MAT,IDEAL] Then M:=Module(M) End;
  M:=$.FetchQring(M,I);
  If Type(M)=MODULE Then NCM:=NumComps(M)
    Else NCM:=1 End;
  LM:=Len(M);
  TrM:=$.Transposed(Mat(M));
  IdM:=$.Iden(NCM);
  For J:=1 To Len(I) Do
    TrM:=$.Concat(TrM,I.Gens[J]*IdM)
  End;
  A:=Module($.Transposed(TrM));
  K:=$.Syz1(A,LM);
  K:=Module(Mat(K));
  K:=$.FetchQring(K,I);
Return Minimalized(K)
End;

Define Help_Quotkern()
   PrintLn 'Quotkern ( M : Mod/Ide , I : Ideal ) : Module/Ideal';
   PrintLn 'returns the syzygymodule of the P/I-module M.';
End;

----------------------------------------

Define Urbild(M,F)
  If Type(M)=MAT Then M:=Cast(M,MODULE) End;
  If Type(F)=MAT Then F:=Cast(F,MODULE) End;
  If NumComps(M)<>NumComps(F) Then Return
    'M and F must be in P^nu' End;
  LF:=Len(F);
  HE:=F.Gens;
  HE:=Concat(HE,M.Gens);
  HE:=Module(HE);
  HE:=Mat(HE);
  HE:=$.Syz1(Module(HE),LF);
  HE:=Interreduced(HE.Gens);
  If LF=1 Then Erg:=Cast(HE,IDEAL)
    Else Erg:=Module(HE) End;
Return Erg
End;

Define Help_Urbild()
   PrintLn 'Urbild ( M : Module , N : Module ) : Module/Ideal';
   PrintLn 'returns the preimage of M under the map presented by N.';
End;

--------------------------------------

Define Kernel_And_Map(...)
  F:=ARGV[1];
  G:=ARGV[2];
  H:=ARGV[3];
  E1:=$.Modulo(F,H);
  E2:=Mat($.Modulo(E1,G));
  Erg:=[E2,E1];
  If Len(ARGV)=4 Then
    Erg[1]:=$.Quotkern(Erg[1],ARGV[4]);
    Erg[2]:=$.Quotkern(Erg[2],ARGV[4]);
  End;
Return Erg
End;

Kernmap(...):=$.Kernel_And_Map(...);

----------------------------------------------------------------
--
Define Hom(...)
  If Not(Len(ARGV) IsIn [2,3]) Then Return
    'Hom: Two or three arguments expected' End;
  M:=ARGV[1];
  N:=ARGV[2];
  M:=Cast(M,MAT);
  N:=Cast(N,MAT);
  A0:=$.Iden($.NCols(M));
  A1:=$.Iden($.NRows(M));
  B0:=$.Iden($.NCols(N));
  G0:=Cast($.Outer(A0,N),MODULE);
  G1:=Cast($.Outer(A1,N),MODULE);
  F:=Cast($.Outer(Transposed(M),B0),MODULE);
  Erg:=$.Kernel(F,G0,G1);
  If Len(ARGV)=3 Then 
    Erg:=$.FetchQring(Erg);
  End;
  If Type(Erg)=MODULE Then Erg:=Module(Mat(Erg)) End;
Return Erg
End;

Define Help_Hom()
   PrintLn 'Hom ( M : Mod/Ide : N : Mod/Ide , [I:Ide]) : Module/Ideal';
   PrintLn 'returns a presentation of Hom_P(M,N). If a third optional';
   PrintLn 'argument is given, it must be an ideal. The result is then a'; 
   PrintLn 'presentation of Hom_(P/I)(M,N).';
End;

----------------------------------------------------

Define Hom_And_Map(...)
  If Not(Len(ARGV) IsIn [2,3]) Then Return
    'Hommap: Two or three arguments expected' End;
  M:=ARGV[1];
  N:=ARGV[2];
  M:=Cast(M,MAT);
  If M=Mat[] Then M:=Mat[[0]] End;
  N:=Cast(N,MAT);
  If N=Mat[] Then N:=Mat[[0]] End;
  A0:=$.Iden($.NCols(M));
  A1:=$.Iden($.NRows(M));
  B0:=$.Iden($.NCols(N));
  G0:=Cast($.Outer(A0,N),MODULE);
  G1:=Cast($.Outer(A1,N),MODULE);
  F:=Cast($.Outer(Transposed(M),B0),MODULE);
  If Len(ARGV)=2 Then
    Erg:=$.Kernmap(F,G0,G1);
  Else
    Erg:=$.Kernmap(F,G0,G1,ARGV[3])
  End;
Return Erg
End;

Hommap(...):=$.Hom_And_Map(...);

Define Help_Hom_And_Map()
   PrintLn 'Hom_And_Map (M : Mod/Ide : N : Mod/Ide , [I:Ide]) : List';
   PrintLn 'The first entry of the list is a presentation of Hom_P(M,N).';
   PrintLn 'The second entry is the map ff: H0 --> M0^* \tensor N0, where';
   PrintLn 'M1 --M--> M0---> * ---> 0,   N1 --N--> N0---> * ---> 0 and';
   PrintLn 'H1 --H--> H0---> Hom(M,N) ---> 0 are the given presentations.';
   PrintLn 'If a third optional argument is given, it must be an ideal. The';
   PrintLn 'result is then a list, whose first entry is a presentation of'; 
   PrintLn 'Hom_(P/I)(M,N).';
End;


----------------------------------------------------------------
------------ Alles Hilfsprogramme fuer Lift_Std ----------------
----------------------------------------------------------------

Define SNFNeu(V,L)
  N:=Len(L);
  Lt:=NewList(N);
  Pos:=NewList(N);
  Q:=NewList(N,0);
  Q1:=NewList(Len(V),0);
  NullVec:=Vector(Q1);
  K:=1;
  While L[K]=NullVec Do K:=K+1 End;
  For J:=1 To N Do
    X:=LT(L[J]);
    I:=1;
    While X[I]=0 Do I:=I+1 End;
    Lt[J]:=X[I];
    Pos[J]:=I;
  End;

  While TRUE Do
    Zet:=0;
    M:=Poly(0);
    P:=N+1; 
    For I:=K To N Do
      If P>=Pos[I] Then
	If V[Pos[I]]=0 Then S:=[0] Else S:=Support(V[Pos[I]]) End;
	Z:=1;
        V1:=Z<Len(S)+1;
        V2:=Mod(S[Z],Lt[I]);
        V4:=V2<>Poly(0);
        V3:=V4 And V1;
	While V3 Do 
          Z:=Z+1;
          If Z>Len(S) Then V3:=FALSE Else 
	    V3:=Mod(S[Z],Lt[I])<>Poly(0) End;
  	End;

        Vgl2:=FALSE;
	If Z<=Len(S) Then Vgl2:=Not(S[Z]=M) End;
        If Vgl2 Then
          M:=S[Z];
          P:=Pos[I];
          Zet:=Z;
          Gi:=I;
	End;
      End;
    End;
    Erg:=[Q,V];
    If Zet=0 Then Return Erg End;
    Mon:=Monomials(V[Pos[Gi]]);
    Ct:=Mon[Zet];
    V:=V-Ct/(Lt[Gi]*LC(L[Gi][Pos[Gi]]))*L[Gi];
    Q[Gi]:=Q[Gi]+Ct/(Lt[Gi]*LC(L[Gi][Pos[Gi]]));
    If V=NullVec Then Return [Q,V] End;
  End;
End;

Define Help_SNFNeu()
   PrintLn 'SNFNeu ( V : Vector , L : List ) : List';
   PrintLn 'Given a vector V and a list L=[G[1],..,G[s]] the';
   PrintLn 'function returns the list [[Q[1],...,Q[s]],R] such';
   PrintLn 'that V=Q[1]G[1]+..+Q[s]G[s]+R.';
End;

-------------------------------------------------------

Define CompoI(V)
--liefert Leittermkomponente als Poly incl. koeffizient also c * t
-- LT(V)=(0,0,0,LT,0,0)
-- CompoI (V) = c * LT

  J:=1;
  While Comp(LT(V),J)=0 Do
    J:=J+1;
  End;
Return Comp(V,J)
End;

-------------------------------------------------------------

Define IsLambdaEqual(G,H)
-- testet ob lambda gleich ist  ( LT(G) = t * e(Lambda) )
-- uebergabeparameter muessen LEITTERME sein !!!!

  I:= 1;
  LenG:= Len(G);
  While I <= LenG And G[I] = 0 Do
    I := I +1;
  End;
  If I < Len(H)+1 Then
    If H[I] <> 0 Then Return TRUE End;
  End;
Return False
End;

-------------------------------------------------------

Define CompTi(G)
--liefert den term des leitterms des vektors g

  I:= 1;
  VT := LT(G);
  While Comp(VT,I)=0 Do I:=I+1 End;
Return Comp(LT(G), I)
End;

---------------------------------------------------------

Define CompTij( G,I,J)
--liefert Tij fuer den SVektor
--G Liste von Vektoren

  Tj:=$.CompTi(G[J]);
Return Tj/GCD($.CompTi(G[I]),Tj)
End;

---------------------------------------------------------

Define SVector(G,I,J)
--      testen ob I==J
-- testen ob lambda I == lambda J
-- berechne T(ij) und T(ji)
--              LC (G(i)) und LC (G((j))
--              S (ij) =..
-- bei fehler : return 0

  If I = J Then
    PrintLn 'SVector:   Achtung  I=J';
    Return Vector(0);
  End;

  If Not $.IsLambdaEqual(LT(G[I]),LT(G[J])) Then
    PrintLn 'SVector:   Achtung  Lambda ungleich';
    Return Vector(0);
  End;
  Hel:=LC($.CompoI(G[I]));
  If Hel=0 Then Return Vector(0) End;

Return 1/(LC($.CompoI(G[I]))) * $.CompTij(G,I,J) * G[I] -
       1/(LC($.CompoI(G[J]))) * $.CompTij(G,J,I) * G[J];
End;

------------------------------------------------------------

Define SVectorNeu(G,I,J,A1,A2)
  If I = J Then
    PrintLn 'SVector:   Achtung  I=J';
    Return Vector(0);
  End;

  If Not $.IsLambdaEqual(LT(G[I]),LT(G[J])) Then
    PrintLn 'SVector:   Achtung  Lambda ungleich';
    Return Vector(0);
  End;

  Hel:=LC($.CompoI(G[I]));
  If Hel=0 Then Return Vector(0) End;
Return 1/(Hel) * $.CompTij(G,I,J) * A1 -
       1/(LC($.CompoI(G[J]))) * $.CompTij(G,J,I) * A2;
End;

------------------------------------------------------

Define ChooseB( Var B)
--Waehle erstes Element aus B und streiche es

  TB := Head(B);
  B:= Tail(B);
Return TB
End;

-------------------------------------------------------

Define CreateB(G)
--Baue die Liste B bzgl. der Liste von Vektoren G auf
--Rueckgabe B

  B := NewList(0);
  For I := 1 To Len(G) -1 Do
    For J := I+1 To Len(G) Do
      If $.IsLambdaEqual(LT(G[I]),LT(G[J]))  Then
        Append(B, [I,J]);
      End;
    End;
  End;
Return B
End;

--------------------------------------------------------

Define RebuildB(R, Var B, G)
--Ergaenze B um neue Paare (i,r)

  For I := 1 To R-1 Do
   If $.IsLambdaEqual(LT(G[I]),LT(G[R]))  Then
     Append(B, [I,R]);
    End;
  End;
Return;
End;

-------------------------------------------------------------

Define Lift_Std(M)
  M:=Cast(M,MODULE);
  G:=M.Gens;
  R:=Len(G);
  B:=$.CreateB(G);
  NY:=Len(G[1]);
  NULLV:=Vector(NewList(NY,0));
  B1:=[];
  HA:=$.Iden(R);
  A:=NewList(R);
  For I:=1 To R Do A[I]:=Vector(HA[I]) End;
  NFV:=Vector(0);
  While B<>[] Do
    B1:=$.ChooseB(B);
    If Not (NY=1 And (GCD($.CompTi(LT(G[B1[1]])),$.CompTi(LT(G[B1[2]])))=1))
     Then
      SV:=$.SVector(G,B1[1],B1[2]);
      If SV<>NULLV Then
        NFVNeu:=$.SNFNeu(SV,G);
        NFV:=NFVNeu[2];
        If NFV<>NULLV Then
          R:=R+1;
          Append(G,NFV);
          $.RebuildB(R,B,G);
          ANeu:=$.SVectorNeu(G,B1[1],B1[2],A[B1[1]],A[B1[2]]);
          For I:=1 To R-1 Do
            ANeu:=ANeu-A[I]*NFVNeu[1,I];
          End;
          Append(A,ANeu);
        End;
      End;
    End;
  End;
  If Len(G[1])=1 Then 
    For I:=1 To Len(G) Do G[I]:=G[I,1] End;
  End;
  Erg:=[G,A];
Return Erg
End;

Define Help_Lift_Std()
   PrintLn 'Lift_Std (M : Module/Ideal) : List';
   PrintLn 'Let m_1,...,m_r be a generating set for M. The program computes';
   PrintLn 'a groebner-basis [g_1,...,g_s] of M, together with a list [a_1,';
   PrintLn '...,a_r], where a_j=(a_{j1},...,a_{jr}), so that g_i=a_{i1}m_1+';
   PrintLn '...+a_{ir}m_r for i=1,...,s.';
End;

-------------------------------------------------------

Define Lift_Std2(M)
  MEMORY.NI:=NumIndets();
  MEMORY.CurRing:=RingEnv();
  ColfR::=CoeffRing[x[1..MEMORY.NI]],DegRevLex,PosTo;

  Using ColfR Do
    M:=$.Fetch2(MEMORY.CurRing,M);
    GM:=GBasis(M);
    MEMORY.LGM:=Len(GM);
    ML:=M.Gens;
    H:=NewList(MEMORY.LGM);
  End;
  For I:=1 To MEMORY.LGM Do
    Using ColfR Do
      H[I]:=Syz(Concat([GM[I]],ML));
      H[I]:=Gens(H[I]);
      Z:=1;
    End;
    Hilf:=0;
    While Hilf=0 Do
      Using ColfR Do MEMORY.Wahr:=Ideal(H[I,Z,1])=Ideal(1) End;
      If MEMORY.Wahr Then
        Hilf:=1;
        Using ColfR Do H[I]:=-H[I,Z,1]*Tail(Comps(H[I,Z])) End;
      End;
      Using ColfR Do Z:=Z+1 End;
    End;
  End;

  Using ColfR Do
    H:=Cast(H,MAT);
    HM:=Cast(GM,MAT);
  End;
  If Type(M)=IDEAL Then Using ColfR Do HM:=Transposed(HM) End End;

  Erg:=NewList(2);
  Erg[1]:=$.Fetch2('ColfR',HM);
  Erg[1]:=Cast(Erg[1],LIST);
  For I:=1 To Len(Erg[1]) Do Erg[1,I]:=Cast(Erg[1,I],VECTOR) End;

  Erg[2]:=Cast($.Fetch2('ColfR',H),LIST);
  For I:=1 To Len(Erg[2]) Do Erg[2,I]:=Cast(Erg[2,I],VECTOR) End;

  Return Erg
End;

Define Help_Lift_Std2()
   PrintLn 'Lift_Std2 (M : Module/Ideal) : List';
   PrintLn 'Let m_1,...,m_r be a generating set for M. The program computes';
   PrintLn 'a groebner-basis [g_1,...,g_s] of M, together with a list [a_1,';
   PrintLn '...,a_r], where a_j=(a_{j1},...,a_{jr}), so that g_i=a_{i1}m_1+';
   PrintLn '...+a_{ir}m_r for i=1,...,s.';
End;

-------------------------------------------------------
-------------------------------------------------------
--
Define SNFNeu2(V,L)
  If Type(L[1])<>VECTOR Then L:=[Vector(L[I]) | I In 1..Len(L)] End;
  If Type(V)=VECTOR Then Return [Div(V,Module(L)),Mod(V,Module(L))]
    Else Return [Div(V,Ideal(L)),Mod(V,Ideal(L))] End;
End;

Define Reduce(L,M)
  -- L muss Liste sein die mit Lift_Std berechnet wurde
  If L=[[],[]] Then Return M End;
  CM:=Cast(M,MODULE);
  GM:=CM.Gens;
  LGM:=Len(GM);
  B:=NewList(LGM);
  For I:=1 To LGM Do B[I]:=$.SNFNeu2(GM[I],L[1]) End;
  Erg:=NewList(2);
  Erg[2]:=NewList(LGM);
  LB:=Len(B[1,1]);
  For I:=1 To LGM Do
    Skip;
    Erg[2,I]:=B[I,1,1]*L[2,1];
    For J:=2 To LB Do
      Erg[2,I]:=Erg[2,I]+B[I,1,J]*L[2,J];
    End;
  End;
  Erg[2]:=Cast(Erg[2],MODULE);
  
  Erg[1]:=NewList(Len(GM));
  For I:=1 To Len(GM) Do Erg[1,I]:=B[I,2] End;
  If Len(B[1,2])=1 Then
    Erg[1]:=Cast(Cast(Erg[1],LIST),IDEAL);
  Else
    Erg[1]:=Cast(Erg[1],MODULE);
  End;
Return Erg
End;

Define Help_Reduce()
   PrintLn 'Reduce ( GB : GBasis , M : Module/Ideal ) : List';
   PrintLn 'Given a module/ideal M and a G-Basis GM computed with';
   PrintLn 'MC.Lift_Std, then Reduce returns the list [Erg1,Erg2]';
   PrintLn 'such that M=GB*Erg2+Erg1.';
End;

------------------------------------------------------------
--
Define Lift(L,M)
  Erg:=$.Reduce(L,M);
  If Erg[1]<>Ideal(0) Then Return 'Nicht liftbar!' End;
Return Erg[2]
End;

Define Help_Lift()
   PrintLn 'Reduce ( GB : GBasis , M : Mod/Ide ) : Mod/Ide';
   PrintLn 'returns Erg2 from Reduce (look there).';
End;

------------------------------------------------------------
--
Define Inverse1(M)
  G:=$.Lift_Std(Module(M));
  Erg:=Mat($.Lift(G,$.Iden($.NCols(M))));
Return Erg
End;

Define Help_Inverse1()
   PrintLn 'Inverse1( M : Matrix ) : Matrix ';
   PrintLn 'returns the "inverse" of the m x n matrix M over K,';
   PrintLn 'so that M*M^(-1)=Iden(m), but M^(-1)*M<>Iden(n).';
End;

-----------------------------------------------------
--
Define Complement(M)
  If Type(M)=MODULE Then ShiM:=M.Shifts Else ShiM:=Null End;
  SubLi:=Indets();
  For I:=1 To Len(SubLi) Do SubLi[I]:=[SubLi[I],0] End;
  SubM:=Subst(M,SubLi);
  SubM:=Module(Transposed(Mat(SubM)));
  H:=Syz(SubM);
  H:=Mat(H);
  If H=Mat[] Then
    Hel:=NewList(NumComps(M),0);
    Erg:=Module(Hel);
    Return Erg;
  End;
  H:=Transposed(H);
  H:=Module(H);
  Id:=$.Iden(NumComps(H));
  E1:=$.Lift_Std2(H);
  Erg:=$.Lift(E1,Id);
  If ShiM=Null Then Return Erg End;
  Erg:=Module(Shifts(ShiM),Erg.Gens);
  Return Erg
End;

Define Help_Complement()
   PrintLn 'Complement (M : Module) : Module';
   PrintLn 'Given a submodule M of a free module, the script computes a'; 
   PrintLn 'minimal summand of the free module such that with the submodule,';
   PrintLn 'the summand generates the free module.';
End;

----------------------------------------------------
--
Define Representatives(M,N)
  A:=Module(M+N);
  B:=GBasis(A);
  GA:=$.Lift_Std2(Module(B));
  C:=$.Lift(GA,N);
  Compl:=$.Complement(C);
  Erg:=Mat(Compl)*Mat(B);
  Erg:=Module(Erg);
  If NumComps(Erg)=1 Then Erg:=Cast(Erg,IDEAL) End;
Return Erg
End;

Define Help_Representatives()
   PrintLn 'Representatives ( M : Mod/Ide , N : Mod/Ide) : Module/Ideal';
   PrintLn 'computes a minimal set of representatives for the image of M';
   PrintLn 'modulo the image of N. That is, if M and N are regarded as maps';
   PrintLn 'to a free module F, then result is a map to F whose columns';
   PrintLn 'correspond to a minimal set of generators of (im M+im N)/(im N).';
   PrintLn 'N must be a submodule of M.';
End;

----------------------------------------------------
--
Define Representatives1(M,N)
  C:=$.Modulo(M,N);
  Compl:=$.Complement(C);
  Erg:=Mat(Compl)*Mat(M);
  Erg:=Module(Erg);
  Erg:=Ideal(Erg);
Return Erg
End;

Define Help_Representatives1()
   PrintLn 'Representatives1 ( M : Mod/Ide , N : Mod/Ide) : Module/Ideal';
   PrintLn 'computes a minimal set of representatives for the image of M';
   PrintLn 'modulo the image of N. That is, if M and N are regarded as maps';
   PrintLn 'to a free module F, then result is a map to F whose columns';
   PrintLn 'correspond to a minimal set of generators of (im M+im N)/(im N).';
End;

----------------------------------------------------
--
Define Prune(A)
  He:=$.Complement(A);
  Erg:=$.Modulo(He,A);
Return Erg
End;

Define Help_Prune()
   PrintLn 'Prune ( M : Module/Ideal ) : Module/Ideal';
   PrintLn 'finds a minimal presentation for coker M.';
End;

----------------------------------------------------
--
Define PruneMap(A)
  If Type(A)=IDEAL Then A:=Module(A) End;
  H2:=$.Complement(A);
  H1:=$.Modulo(H2,A);
  Erg:=[H1,H2];
Return Erg
End;

Define Help_PruneMap()
   PrintLn 'PruneMap (M : Module ) : List';
   PrintLn 'finds a minimal presentation N for coker M and a map';
   PrintLn 'f: target N --> target M inducing the identity on the cokernel.';
End;

----------------------------------------------------
--
Define Hom_Is_0(M,N)
  M:=Module(M);
  N:=Module(N);
  M:=Cast(M,MAT);
  N:=Cast(N,MAT);
  A0:=$.Iden($.NCols(M));
  A1:=$.Iden($.NRows(M));
  B0:=$.Iden($.NCols(N));
  G0:=Cast($.Outer(A0,N),MODULE);
  G1:=Cast($.Outer(A1,N),MODULE);
  F:=Cast($.Outer(Transposed(M),B0),MODULE);
  Erg:=$.Modulo(F,G1);
  L:=$.Lift_Std2(G0);
  Erg:=$.Reduce(L,Erg);
  If Erg[1]=Ideal(0) Then Return True Else Return False End;
End;

Define Help_Hom_Is_0()
   PrintLn 'Hom_Is_0 ( M : Module , N : Module ) : TRUE/FALSE';
   PrintLn 'The output is TRUE iff Hom is 0.';
End;

--------------------------------------------------------
--
Define Homology(M,N,F,G)
  Ker:=$.Modulo(G,N);
  Ker:=Mat(Ker);
  He:=M.Gens;
  He:=Concat(He,F.Gens);
  Im:=Module(He);
  Im:=Mat(He);
  Erg:=$.Modulo(Ker,Im);
Return Erg
End;

Define Help_Homology()
   PrintLn 'Homology (  ) : ';
   PrintLn 'If M,N are maps presenting modules M1,N1, and F,G are maps';
   PrintLn 'inducing f: A->M1 and g:M1->N1, (for some module A) then a';
   PrintLn 'presentation of the homology is computed.';
End;

---------------------------------------------------------
--
Define Res1(...)
  LA:=Len(ARGV);
  If LA<2 Then Return'At least two arguments expected.' End;
  If LA>3 Then Return'Only two or three arguments expected.' End;
  M1:=ARGV[1];
  I:=ARGV[2];
  L:=NewList(I,0);
  L[1]:=M1;
  If Len(ARGV)=3 Then 
    K:=ARGV[3];
    For J:=2 To I Do 
        If L[J-1]=Module() Then L[J]:=Module() 
      Else
        L[J]:=$.Quotkern(L[J-1],K);
        If L[I]=Null Then L[I]:=Module() End;
      End;
    End;
  Else
    For J:=2 To I Do L[J]:=Syz(L[J-1]) End;
    If L[I]=Null Then L[I]:=Module() End;
  End;
Return L
End;

Define Help_Res1()
   PrintLn 'Res1 ( M : Module , I : Int , [J : Ideal] ) : List';
   PrintLn 'returns a list of lenght I, where L[1] is the module M, and for';
   PrintLn '1<K<=I, L[K]:=Syz(L[K-1]). If a third optional ideal is given,';
   PrintLn 'then you get a free resolution in the case P/J.';
End;

---------------------------------------------------------
--
Define Ext(...)
  LA:=Len(ARGV);
  If Not(LA IsIn [3,4]) Then Return
    'Ext: Three or four arguments expected' End;
  I:=ARGV[1];
  M:=ARGV[2];
  N:=ARGV[3];

  If Type(I)<>INT Then Return
    'First argument must be an integer.' End;
  If Type(M)=RING Then M:=Ideal(Indets()) End;
  If Type(N)=IDEAL Then N:=Module(N) End;
  If Type(M)=IDEAL Then M:=Module(M) End;
  If I=0 Then
    If LA=3 Then Return $.Prune($.Hom(M,N))
      Else Return $.Prune($.Hom(M,N,J)) End;
  End;
  If LA=4 Then 
    J:=ARGV[4];
    N:=$.FetchQring(N,J);
    M:=$.FetchQring(M,J);
    A:=$.Res1(M,I+1,J);
  Else
    A:=$.Res1(M,I+1);
  End;
  AI:=Cast(A[I],MAT);
  AIP1:=Cast(A[I+1],MAT);
  N:=Cast(N,MAT);
  An:=$.Iden($.NRows(AI));
  Anp1:=$.Iden($.NRows(AIP1));
  B0:=$.Iden($.NCols(N));
  TrAn:=$.Transposed(An);
  TrAnp1:=$.Transposed(Anp1);
  Gn:=Cast($.Outer(TrAn,N),MODULE);
  Gnp1:=Cast($.Outer(TrAnp1,N),MODULE);
  Fn:=Cast($.Outer($.Transposed(AI),B0),MODULE);
  Fnp1:=Cast($.Outer($.Transposed(AIP1),B0),MODULE);
  If Gnp1=Module() And Fnp1=Module() Then 
    If Gn<>Module() Or Fn<>Module() Then 
      NCGn:=NumComps(Gn);
      If NCGn=1 Then 
        Return $.Modulo(Ideal(1),Ideal(Concat(Gn.Gens,Fn.Gens)))
      Else 
        Erg:=$.Modulo($.Iden(NCGn),Module(Concat(Gn.Gens,Fn.Gens)));
        Erg:=Mat($.Prune(Erg));
        If $.NCols(Erg)=1 Then Erg:=Ideal(Module(Erg)) 
          Else Erg:=Module(Erg) End;
        Return Erg;
      End;
    Else 
      Return Module()
    End;
  End;
  Erg:=$.Homology(Gn,Gnp1,Fn,Fnp1);
  If Erg=Module() Then Return Module() End;
  Erg:=Mat($.Prune(Erg));
Return Module(Erg)
End;

Define Help_Ext()
   PrintLn 'Ext ( I:Int , M:Mod/Ide , N:Mod/Ide , [Id:Ide]) : Mod/Ide';
   PrintLn 'computes a presentation of the module Ext^I(M,N). If an optional';
   PrintLn 'fourth ideal Id is given, then it is the qring situation.';
End;

--------------------------------------------------------
--
Define Ext_R(I,MM)
  If Type(I)<>INT Then Return
    'First argument must be an integer.' End;
  Merk:=Type(MM);
  M:=Module(MM);

  If I=0 Then Return $.Hom(M,Ideal(0)) End;

  A:=$.Res1(M,I+1);
  AI:=Mat(A[I].Gens);
  AIP1:=Cast(A[I+1],MAT);
  F:=Cast($.Transposed(AIP1),MODULE);
  If F=Module([0]) Then K:=Module([1]) Else K:=Syz(F) End;
  G:=Module($.Transposed(AI));
  Erg:=$.Modulo(Module(Mat(K)),G);
  If Erg=Module() Then Return Module() End;
  Erg:=$.Prune(Erg);
  If Erg=Module() Then Return Module() End;
  If Merk=TAGGED('Quotient') Then Skip Else Erg:=Cast(Erg,Merk) End;
Return Erg
End;

Define Help_Ext_R()
   PrintLn 'Ext_R ( I : Int , M : Module/Ideal ) : Module/Ideal';
   PrintLn 'computes a presentation of the module Ext^I(M,R).';
End;

-------------------------------------------------------
--
Define Tor(...)
  LA:=Len(ARGV);
  If Not(LA IsIn [3,4]) Then Return
    'Tor: Three or four arguments expected' End;
  I:=ARGV[1];
  M:=ARGV[2];
  N:=ARGV[3];
  Merk:=M;

  If Type(I)<>INT Then Return
    'First argument must be an integer.' End;
  If Type(M)=RING Then M:=Ideal(Indets) End;
  If Type(N)=IDEAL Then N:=Module(N) End;
  If Type(M)=IDEAL Then M:=Module(M) End;

  If I=0 Then
    Erg:=$.Tensor(Transposed(Mat(M)),Transposed(Mat(N)));
    Erg:=$.Transposed(Erg);
    If $.NCols(Erg)=1 Then Return Ideal(Module(Erg)) End;
    Erg:=Mat($.Prune(Module(Erg)));
    Return Module(Erg);
  End;

  If LA=4 Then 
    J:=ARGV[4];
    N:=$.FetchQring(N,J);
    M:=$.FetchQring(M,J);
    A:=$.Res1(M,I+1,J);
  Else
    A:=$.Res1(M,I+1);
  End;

  AI:=Cast(A[I],MAT);
  AIP1:=Cast(A[I+1],MAT);
  N:=Cast(N,MAT);
  An:=$.Iden($.NRows(AI));
  Anm1:=$.Iden($.NCols(AI));
  B0:=$.Iden($.NCols(N));
  Gn:=Cast($.Outer(An,N),MODULE);
  Gnm1:=Cast($.Outer(Anm1,N),MODULE);
  Fn:=Cast($.Outer(AI,B0),MODULE);
  Fnp1:=Cast($.Outer(AIP1,B0),MODULE);
  Erg:=$.Homology(Gn,Gnm1,Fnp1,Fn);
  If Erg=Module() Then Return Module() End;
  Erg:=Mat($.Prune(Erg));
  If Erg=Module() Then Return Module() End;
  Erg:=Module(Erg);
  If NumComps(Erg)=1 Then Erg:=Ideal(Erg) End; 
Return Erg
End;

Define Help_Tor()
   PrintLn 'Tor ( N:Int , A:Mod/Ide , B : Mod/Ide , [I:Ide]) : Module/Ideal';
   PrintLn 'computes Tor^N(A,B). If a fourth argument is given, it must be';
   PrintLn 'an ideal. Then the computation is made in CurrentRing/I.';
End;

---------------------------------------------------------
--
Define Keep(L,M)
  If Not (Type(L) IsIn [LIST,POLY]) Then 
    Return 'First argument must be a list or a poly.' End;
  TM:=Type(M);
  GM:=GBasis(M);
  If Type(L)=POLY Then L:=[L] End;
  HeLi:=NewList(NumIndets(),0);
  For I:=1 To Len(L) Do
    If L[I] IsIn Indets() Then
    HeLi[IndetIndex(L[I])]:=L[I];   
    Else Return 'List must contain indeterminantes.' End;
  End;  
  HeLi:=RMap(HeLi);
  Erg:=Image(GM,HeLi);
  Erg:=Cast(Erg,TM);
Return Erg
End;

Define Help_Keep()
   PrintLn 'Keep ( L : List , M : Module/Ideal) : Module/Ideal';
   PrintLn 'The first argument must be a list containing indeterminantes of';
   PrintLn 'the current ring. The programm computes a groebner basis for M';
   PrintLn 'and return the module/ideal of the elements of the groebner basis';
   PrintLn 'which only contains the variables of the given list.';
End;

----------------------------------------------------------
--
--L ist Liste, die Variablen enthaelt, die als Konstante
--angesehen werden.

Define Inpart1(M)
  GS:=Gens(Module(M));
  For I:=1 To Len(GS) Do GS[I]:=LT(GS[I]) End;
  Erg:=Cast(GS,MODULE);
Return Erg
End;

Define Inpart(...)
  LA:=Len(ARGV);
  S:=Module(ARGV[1]);
  If LA>2 Then Return
    'Inpart: only one or two arguments expected.' End;
  If LA=1 Then Return Minimalized($.Inpart1(S)) End;

  SubLi:=ARGV[2];
  S:=$.Inpart1(S);
  For I:=1 To Len(SubLi) Do SubLi[I]:=[SubLi[I],1] End;
  S:=Subst(S,SubLi);
  Erg:=Minimalized(S);
Return Erg
End;

Define Help_Inpart()
   PrintLn 'Inpart ( L : List , M : Module/Ideal) : Module/Ideal';
   PrintLn 'The first argument must be a list containing indeterminantes of';
   PrintLn 'the current ring. The programm computes a minimally generated';
   PrintLn 'monomial module/ideal of initial forms of a groebner basis, where';
   PrintLn 'the variables in the given list L are considered as constants.';
End;

------------------------------------------------------
--
--homogene minimale Groebnerbasis wird erwarted!
--zweite Argument kann Liste sein, die Variablen
--enthaelt, die als konst betrachtet werden.

Define Std_Minimal(...)
  L:=NewList(0);
  S:=$.Inpart1(Module(ARGV[1]));
  If Len(ARGV)=2 Then
    SubLi:=ARGV[2];
    For I:=1 To Len(SubLi) Do SubLi[I]:=[SubLi[I],1] End;
  Else SubLi:=[] End;
  S:=Mat(Subst(S,SubLi));
  TS:=$.Transposed(S);
  For I:=1 To Len(S) Do
    P:=$.FindFirstNonzero(S[I]);
    If S[I,P]=1 Then Append(L,1)
    Else
      If 1 IsIn TS[P] Then Append(L,0) Else Append(L,I) End;
    End;
    Skip;
  End;
  M:=Mat(ARGV[1]);
  Erg:=$.Submat(M,L,1..$.NCols(S));
  If Type(ARGV[1,1])<>VECTOR Then Erg:=$.Transposed(Erg) End;
  Erg:=Module(Erg);
  If NumComps(Erg)=1 Then Erg:=Cast(Erg,IDEAL) End;
Return Erg
End;

Define Help_Std_Minimal()
   PrintLn 'Std_Minimal ( GB : GroebnerBasis , [L:List]) : Module/Ideal';
   PrintLn 'First argument must be a minimal homogeneous groebner basis of a';
   PrintLn 'hom. module/ideal. The second optional argument must be a list';
   PrintLn 'containing indeterminantes of the current ring. The programm find';
   PrintLn 'subset of the given g-basis whose lead monomials are minimal';
   PrintLn 'generators (the variables in the given list are considered to be';
   PrintLn 'constants. It returns the module/ideal of this subset.';
End;

------------------------------------------------------
--
--L ist Liste, die Variablen enthaelt, die als Konstante
--angesehen werden.

Define Stdpart(...)
  LA:=Len(ARGV);
  S:=ARGV[1];
  If Type(S)<>LIST Then S:=S.Gens End;
  If LA>2 Then Return
    'Stdpart: only one or two arguments expected.' End;
  If LA=2 Then L:=ARGV[2] Else L:=[] End;
  SubLi:=L;
  For I:=1 To Len(SubLi) Do SubLi[I]:=[SubLi[I],1] End;
  GS:=Subst(S,SubLi);
  GS:=[LT(GS[K]) | K In 1..Len(GS)];
  If Type(GS[1])=VECTOR Then HS:=Cast(GS,MODULE)
    Else HS:=Ideal(GS) End;
  IStd:=Gens(Minimalized(HS));
  Erg:=NewList(Len(IStd));
  For I:=1 To Len(IStd) Do
    J:=0;
    Repeat
      J:=J+1;
    Until IStd[I]=GS[J];
    Erg[I]:=S[J];
  End;
  If Type(Erg[1])=VECTOR Then Erg:=Cast(Erg,MODULE)
    Else Erg:=Ideal(Erg) End;
Return Erg
End;

Define Help_Stdpart()
   PrintLn 'Stdpart ( M : Module/Ideal , [L : List]) : Mod/Ide';
   PrintLn 'Let g_1,...,g_s be a g-basis of M and let n_i be the leading.';
   PrintLn 'term of g_i. The program finds a minimal generating set {n_{i1},';
   PrintLn '...,n_{ir} } of {n_1,..., n_s} and returns the module generated';
   PrintLn 'by the elements g_{i1},..., g_{ir}.';
End;

------------------------------------------------------------
--
Define ListProd(L1,L2)
  Erg:=[];
  For I:=1 To Len(L1) Do
    Erg:=Concat(Erg,L1[I]*L2);
  End;
Return Erg
End;

Define KBasisId(S,L,Lo,Hi,Shi)
  WaFa:=TRUE;
  SubLi:=Diff(Indets(),L);
  For I:=1 To Len(SubLi) Do SubLi[I]:=[SubLi[I],1] End;
  GS:=LT(Subst(S,SubLi));
  GS:=Ideal(GS);
  If (1 IsIn GS Or Hi<Shi[1]) Then Return [] Else Erg:=[1] End;
  Z:=1;
  Lo:=Lo-Shi[1];
  Hi:=Hi-Shi[1];

  While L<>[] And Z<30 And WaFa Do
    Loesch:=[];
    Neue:=[];
    DNeue:=[];
    For I:=1 To Len(L) Do
      If L[I] IsIn GS Then
        Append(Loesch,L[I]);
      Else
        Append(Neue,L[I]);
        Append(DNeue,Deg(L[I]));
      End;
    End;

    If DNeue=[] Then Vgl:=Hi Else Vgl:=Min(DNeue) End;
    If Vgl>Hi Then WaFa:=FALSE
    Else
      L:=Diff(L,Loesch);
      If Z=1 Then Mul:=L End;
      L:=Set($.ListProd(Neue,Mul));
      Erg:=Concat(Erg,Neue);
      Z:=Z+1;
    End;
  End;

--loesche alle eintraege mit deg > Hi
--mache auch noch mit Lo dasselbe

  ErgKorr:=[];
  Foreach X In Erg Do
    If Deg(X)<=Hi And Deg(X)>=Lo Then Append(ErgKorr,X) End;
  End;
  Erg:=ErgKorr;

  If Z>=30 Then
    PrintLn'K-Basis: Stopped!!!!';
    Return Erg;
  End;

Return Erg
End;


--Alle Variablen, die nicht in L vorkommen, werden als
--Konstante betrachtet!!!

Define KBasis(...)
  If Len(ARGV)<1 Or Len(ARGV)>3 Then
    Return'KBasis: wrong number of arguments' End;
  S:=ARGV[1];
  If Type(S)=MODULE Then 
    ShiS:=S.Shifts;
    If ShiS=Null Then ShiS:=NewList(NumComps(S),0)
      Else ShiS:=[Deg(ShiS[I]) | I In 1..Len(ShiS)] End;
  End;

  If Type(S)<>LIST Then S:=S.Gens End;

  If Len(ARGV)>1 Then L:=ARGV[2] Else L:=[] End;
  If Len(ARGV)>2 Then
    Lo:=ARGV[3,1];
    Hi:=ARGV[3,2];
  Else
    Lo:=-30;
    Hi:=30;
  End;
  If Type(S[1])=POLY Then Return $.KBasisId(S,L,Lo,Hi,[0]) End;

  S:=Module(S);

  SubLi:=Diff(Indets(),L);
  For I:=1 To Len(SubLi) Do SubLi[I]:=[SubLi[I],1] End;
  S:=LT(Subst(S,SubLi));
  S:=S.Gens;
  For I:=1 To Len(S) Do S[I]:=Cast(S[I],LIST) End;
  Erg:=[];
  If S=[] Then NulVecLi:=S
    Else NulVecLi:=NewList(Len(S[1]),0) End;
  For I:=1 To Len(S[1]) Do
    HL:=[];
    Foreach X In S Do Append(HL,X[I]) End;
    HL:=Diff(HL,[0]);
    Erg1:=$.KBasisId(HL,L,Lo,Hi,[ShiS[I]]);
    Foreach X In Erg1 Do
      Li1:=NulVecLi;
      Li1[I]:=X;
      Append(Erg,Vector(Li1));
    End;
  End;
Return Erg
End;

Define Help_KBasis()
   PrintLn 'KBasis ( M : Mod/Ide , [L:List] ) : List';
   PrintLn 'returns a K-Basis for M. If an optional second argument is given';
   PrintLn 'then it must be a list of indeterminantes. All other indets are';
   PrintLn 'considered to be constants. If an optional third argument is';
   PrintLn 'given, it must be a list consisting of two integers lo and hi.';
   PrintLn 'Then the computation is only made between degrees lo and hi.';
End;

----------------------------------------------------------
--
Cotan(I):=Transposed($.Tensor(Transposed(Jacobian(I.Gens)),Mat(I.Gens)));

Define Cotan1(I)
  E1:=Mat(Syz(Ideal(Indets())));
  E2:=Transposed($.Tensor(Transposed(Jacobian(I.Gens)),Mat(I.Gens)));
  Erg:=$.Modulo(E1,E2);
Return Erg
End;

Define Help_Cotan()
   PrintLn 'Cotan ( I : Ideal) : Module';
   PrintLn 'This script returns the graded module representing the cotangent';
   PrintLn 'sheaf of the variety defined by the given ideal.';
End;

----------------------------------------------------------
--
Define Cohomology1(I,M,Shi)
  M:=Mat(M);
  Inde:=Indets();
  For I:=1 To Len(Inde) Do
    Inde[I]:=Inde[I]^Shi;
  End;
  J:=$.Koszul(Ideal(Inde),2);
  J:=$.Transposed(J);
  Erg:=$.Ext(I,Module(J),Module(M));
Return Erg
End;

Define Help_Cohomology1()
   PrintLn 'Cohomology1 ( I : Int , M : Module , I2 : Int) : Mod/Ide';
   PrintLn 'I must be the index of the cohomology group, M must be a module';
   PrintLn 'and J must be a sufficiently large integer (see below.)';
   PrintLn 'Computes the cohomology module H = \sum_{n >= 0} H^I(M(n)) of';
   PrintLn 'the module M , regarded as a coherent sheaf on projective space,';
   PrintLn 'that is Ext^i(J, M), where J is the ideal generated by the I1th';
   PrintLn 'powers of the variables in the base ring of M. The answer';
   PrintLn 'coincides with the cohomology (at least) in degrees >= d -';
   PrintLn 'numvars + 1 - j, where d is the maximum degree of a generator';
   PrintLn 'of a syzygy module of M, and numvars is the number of variables';
   PrintLn 'in the ring.';
End;

----------------------------------------------------------
--
Define Koszulhomology1(I,M)
  ShiM:=M.Shifts;
  If ShiM=Null Then MaShi:=0 
  Else
    If Type(ShiM[1])=INT Then MaShi:=Min(ShiM)
      Else MaShi:=Min([(-1)*Deg(J)|J In ShiM]) End;
  End;
  M:=Mat(M);
  N:=NumIndets();
  KN:=Transposed($.Koszul(N,I));
  A0:=$.Iden($.NCols(M));
  Wedgeminus1:=$.Iden($.NCols(KN));
  Wedgen:=$.Iden($.NRows(KN));
  FN:=$.Outer(A0,KN);
  B:=$.Outer(M,Wedgeminus1);
  KH:=$.Modulo(FN,B);
  KH:=Mat(KH);
  KH:=Module(KH);
  KH.DegTrunc:=MaShi;
  GB.Start_GBasis(KH);
  GB.Complete(KH);
Return Len(KH.GBasis)
End;

Define Help_Koszulhomology1()
   PrintLn 'Koszulhomology1 ( I : Int , M : Module) : Int';
   PrintLn 'The I-th koszul homology group of M is computed up to degree 0,';
   PrintLn 'and displayed. Thus the answer corresponds to the linear part of';
   PrintLn 'the resolution at step k.';
End;

----------------------------------------------------
--
Define Koszulhomology2(I,J)
  N:=NumIndets();
  GJ:=GB.GBasis(J);
  GJ:=Module(GJ);
  KI:=$.Koszul(N,I);
  KI:=$.FetchQring($.Transposed(KI),J);
  Erg1:=$.Quotkern(KI,J);
  Z:=0;
  For H:=1 To Len(Erg1) Do 
    If Deg(Erg1.Gens[H])<2 Then Z:=Z+1 End;
  End;
  Binomi:=Bin(N,I+1);
  Erg:=Z-Binomi;
Return Erg
End;

Define Help_Koszulhomology2()
   PrintLn 'Koszulhomology2 ( I : Int , J : Ideal) : Int';
   PrintLn 'The dimension of the degree I+1 part of the I-th Koszul homology';
   PrintLn 'group of R/J is displayed. This corresponds to the 2-linear part';
   PrintLn 'of the resolution at step I.';
End;

-----------------------------------------------------
--
Define IsZero(M)
  NulList:=RMap(Indets()-Indets());
  MBar:=Image(M,NulList);
  MBar:=Mat(MBar);
  MBar:=Transposed(MBar);
  H:=Syz(Module(MBar));
  Erg:=$.NRows(Mat(H));
Return Erg
End;

Define Help_IsZero()
   PrintLn 'IsZero ( M : Module) : Int';
   PrintLn 'Returns 0 if the module m is zero, something nonzero otherwise.';
   PrintLn 'The module is zero iff it represents a surjective map!).';
End;

----------------------------------------------------
--
Define Rankprobability(M)
  If Type(M)=MAT Then M:=Module(M) End;
  NVars:=NumIndets();
  L:=NewList(NVars);
  For I:=1 To NVars Do
    L[I]:=Randomized(1);
  End;
  L:=RMap(L);
  M:=Image(M,L);
  SyzM:=Mat($.Syz1(M,2));
  Erg:=$.NRows(Mat(M))-$.NRows(SyzM);
Return Erg
End;

Define Help_Rankprobability()
   PrintLn 'Rankprobability ( M : Matrix ) : Int';
   PrintLn 'finds the rank (probably) by evaluating the entries of the matrix';
   PrintLn 'at random numbers and computing the kernel of the matrix.';
End;

----------------------------------------------------
--
Define RandoMel(F,I)
  F:=Module(F);
  ShiF:=F.Shifts;
  Vars:=Indets();
  N:=Len(F);
  NumRows:=NumComps(F);
  E:=NewList(NumRows,0);
  He:=F.Gens;
  While N>0 Do
    Degr:=Deg(He[N]);
    If Degr>I Then Skip
    Else
      H:=He[N];
      Mu:=I-Degr;
      Id:=Ideal(Vars)^Mu;
      Po:=$.Random_Mat(1,1,Id);
      Po:=Po[1,1]*List(H);
      E:=E+Po;
    End;
    N:=N-1;
  End;
  If ShiF<>Null Then E:=Module(Shifts(ShiF),E)
    Else E:=Module(E) End;
Return E
End;

Define Help_RandoMel()
   PrintLn 'RandoMel ( M : Mod/Ide , I : Int ) : Module';
   PrintLn 'mulitply each generator of M having degree <=I by a random form';
   PrintLn 'of appropriated degree, and then add the generators of degree I.';
End;

----------------------------------------------------
--
Define RandomMap(M,N,I)
  M:=Module(M);
  N:=Module(N);
  L:=$.Hommap(M,N);
  F:=$.RandoMel(L[2],I+1);
  A0:=$.Iden($.NCols(Mat(M)));
  F:=$.Outer(A0,Mat(F));
  Taut:=$.Flatten(A0);
  B0:=$.Iden($.NCols(Mat(N)));
  Taut:=$.Outer(Taut,B0);
  Erg1:=F*Taut;
  GN:=GBasis(N);
  GN:=$.Lift_Std2(Module(GN));
  Erg:=$.Reduce(GN,Erg1);
  If Type(Erg[1])=MAT Then Erg[1]:=Module(Erg[1]) End;
Return Erg[1]
End;

---------------------------------------------------
--
Define FetchQring(M,I)
  If I=Ideal(0) Then Return M End;
  If Type(M)=IDEAL Then 
    L:=NewList(Len(M));
    For K:=1 To Len(M) Do L[K]:=Mod(M.Gens[K],I) End;
    Return Ideal(L)
  End;
  M:=Module(M);
  Mi:=$.Iden($.NCols(Mat(M)));
  N:=$.Outer(Mi,Mat(I.Gens));
  He:=Module($.Transposed(N));
  L:=NewList(Len(M));
  For K:=1 To Len(M) Do L[K]:=Mod(M.Gens[K],He) End;
  Erg:=Module(L);
  If NumComps(Erg)=1 Then Erg:=Ideal(Erg) End;
Return Erg; 
End;

Define FetchQring1(M,I)
  If I=Ideal(0) Then Return M End;
  If Type(M)=IDEAL Then He:=I
  Else
    Mi:=$.Iden($.NCols(Mat(M)));
    N:=$.Outer(Mi,Mat(I.Gens));
    He:=Module($.Transposed(N));
  End;
  L:=$.Lift_Std2(He);
  Erg:=$.Reduce(L,M);
Return Erg[1]
End;

Define Help_FetchQring()
   PrintLn 'FetchQring ( M : Mod/Ide , I : Ideal ) : Mod/Ide';
   PrintLn 'evaluate the canonical epimorphismus P--->P/I.';
End;

------------------------------------------------
--
Define PointsLinear(Id,M)
  If $.NCols(M)<>NumIndets() Then Return
    '(m x NumIndets()) Matrix expected' End;
  LI:=Len(Id);
  For I:=1 To Len(M) Do
    F:=RMap(M[I]);
    H:=Image(Id,F);
    M[I]:=H.Gens;
  End;
  M:=Module(Transposed(M));
  Ker:=Syz(M);
  Erg:=Transposed(Mat(Ker)*Mat(Id));
Return Ideal(Erg[1])
End;

Define Help_PointsLinear()
   PrintLn 'PointsLinear ( I : Ideal , M : Matrix ) : Ideal';
   PrintLn 'Find a linear subsystem of the polynomials in I vanishing at the';
   PrintLn 'points which are the rows of M.';
End;

--------------------------------------------------
--
Define DoubleDual(M)
  If Type(M)=MODULE Then ShiM:=M.Shifts Else ShiM:=Null End;
  M:=Mat(M);
  M:=Transposed(M);
  M2:=Syz(Module(M));
  M3:=Syz(M2);
  If M3=Module([]) Then N:=Module([]) Else
    N:=Module(Transposed(Mat(M3))) End;
  N2:=Syz(N);
  Erg1:=Syz(N2);
  If ShiM<>Null Then Erg1:=Module(Shifts(ShiM),Erg1.Gens) End;
  If M2=Module([]) Then M2:=Module([]) Else
    M2:=Module(Transposed(Mat(M2))) End;
  Lif:=$.Lift_Std2(N2);
  If Lif=[[],[]] Then Erg2:=M2 Else
    Erg2:=$.Lift(Lif,M2) End;
Return [Erg1,Erg2]
End;

Define Help_DoubleDual()
   PrintLn 'DoubleDual ( M : Module ) : List';
   PrintLn 'returns a list of the form [N,f]. N is set equal to the double';
   PrintLn 'dual Hom(M,Hom (M, P)) of M over the polynomial ring. f is set to';
   PrintLn 'the natural map from M to N (that is, from the free module giving';
   PrintLn 'the generators of M to the one giving the generators of N.';
End;

--------------------------------------------------
--
Define DoubleDual1(M,A)
  E1:=$.Hommap(M,A);
  E2:=$.Hommap(E1[1],A);
  A:=Mat(A);
  FA:=$.Iden($.NCols(A));
  If E1[2]=Module([]) Then FMA:=Mat[0] Else
    FMA:=Transposed(Mat(E1[2])) End;
  T:=$.Outer(FMA,FA);
  FM:=$.Iden($.NCols(Mat(M)));
  Taut:=$.Flatten(FA);
  Taut:=Transposed(Taut);
  Taut:=$.Outer(FM,Taut);
  S:=Taut*T;
  FMAA:=$.Lift_Std2(E2[2]);
  If FMAA=[[],[]] Then Erg2:=S Else
    Erg2:=$.Lift(FMAA,S) End;
  Erg2:=Module(Erg2);
  Erg1:=Module(E2[1]);
  Erg:=[Erg1,Erg2];
Return Erg
End;

Define Help_DoubleDual1()
   PrintLn 'DoubleDual1 ( M : Module ,A : Module ) : Module';
   PrintLn 'returns a list of the form [N,f]. N is set equal to the double';
   PrintLn 'dual Hom(M,Hom (M, A)) of M into the module A. f is set to';
   PrintLn 'the natural map from M to N (that is, from the free module giving';
   PrintLn 'the generators of M to the one giving the generators of N.';
End;

--------------------------------------------------
--
Define Pushforward1(...)
  MEMORY.LA:=Len(ARGV);
  If MEMORY.LA<3 Then Return'At least three arguments expected' End;
  If MEMORY.LA>4 Then Return'Only three or four arguments expected' End;
  If MEMORY.LA=4 Then MEMORY.MaxDe:=ARGV[4] End;
  S:=ARGV[1];
  F:=ARGV[2];
  M:=ARGV[3];
  CCR:=Characteristic();
  MEMORY.LF:=Len(F);
  Using Var(S) Do MEMORY.NIS:=NumIndets() End;
  If CCR<>Characteristic(Var(S)) Then Return
     'Rings must have the same characteristic.' End;

  S1R1::=CoeffRing[x[1..MEMORY.NIS],y[1..MEMORY.LF]];

  Using S1R1 Do
    M:=$.Fetch2(S,M);
    M:=$.Transposed(Mat(M));
    Fu:=$.Fetch2(S,Untagged(F));
    Dif:=Fu-Last(Indets(),MEMORY.LF);
    Dif:=Mat(Dif);
    If M<>Mat[0] Then M:=Transposed($.Tensor(M,Dif))
      Else M:=Transposed(Dif) End;
    If MEMORY.LA=4 Then
      M:=Module(M);
      M.DegTrunc:=MEMORY.MaxDe;
      GB.Start_GBasis(M);
      GB.Complete(M);
      M:=M.GBasis; 
    Else
      M:=GBasis(Module(M));
    End;
    If Len(M[1])=1 Then 
      If Ideal(M)=Ideal(1) Then M:=Ideal(M) Else
        M:=Elim(x,Ideal(M)) End;
    Else
      M:=Elim(x,Module(M));
    End;
  End;
  L:=NewList(MEMORY.NIS,0);
  L:=Concat(L,Indets());
  L:=First(L,MEMORY.NIS+MEMORY.LF);
  FBack:=RMap(L);
  Erg:=Image(M,FBack);
Destroy S1R1;
Return Erg
End;

Define Help_Pushforward1()
   PrintLn ' Pushforward1( S1 : Str , F : Map , M : Mod , [I:Int]) : Mod';
   PrintLn 'The first string must indicate a ring R. The second argument must';
   PrintLn 'be a map f from the current ring to R and the third argument must';
   PrintLn 'be a module M in R. Let P be the current ring. The program';
   PrintLn 'computes a presentation for the P-submodule of M generated by the';
   PrintLn 'generators given for M as R-module. If an optional fourth integer';
   PrintLn 'I is given, then the computation is made only up to degree I.';
End;

--------------------------------------------------
--
Define Pushforward(S,F,M)
  CuVa:=Indets();
  Using Var(S) Do
    T:=NumIndets();
    FuLi:=Mat(F);
    MerkM:=M;
    M:=$.Tensor(FuLi,Transposed(Mat(M)));
    M:=Module($.Transposed(M));
    M:=GBasis(M);
    Cod:=$.Codim(Module(M));
    If Cod<>T Then
      PrintLn;
      PrintLn'The module is not finite over the current ring.';
      Return'Try a different map.';
    Else
      M:=$.KBasis(Module(M),Indets());
      M:=$.Modulo(M,MerkM);
    End;
  End;
  Erg:=$.Pushforward1(S,F,M);
Return Erg
End;

Define Help_Pushforward()
   PrintLn ' Pushforward( S1 : String , F : Map , M : Mod ) : Module';
   PrintLn 'The first string must indicate a ring R. The second argument must';
   PrintLn 'be a map f from the current ring to R and the third argument must';
   PrintLn 'be a module in R. The program first checks whether the module';
   PrintLn 'is finitely generated over the current ring via f. If it is, the';
   PrintLn 'program computes the pushforward of the given module.';
End;

---------------------------------------------------
--
Define Subring(...)
  LA:=Len(ARGV);
  If LA<2 Then Return'At least two arguments expected.' End;
  If LA>3 Then Return'Only two or three arguments expected.' End;
  S:=ARGV[1];
  F:=ARGV[2];
  Using Var(S) Do M:=Module(0) End;
  If LA=2 Then Erg:=$.Pushforward1(S,F,M)
    Else Erg:=$.Pushforward1(S,F,M,ARGV[3]) End;
Return Erg
End;

Define Help_Subring()
   PrintLn ' Subring( S1 : Stri , F : Map , [I : Int]) : Ideal';
   PrintLn 'The first argument must be a string, containing the name of a';
   PrintLn 'ring S. The second argument must be a map F from R to S, where';
   PrintLn 'R is the currnet ring. Then the program Subring defines an ideal';
   PrintLn 'K in the current R such that R/K = subring generated by F in the';
   PrintLn 'basering of F. If an optional third parameter I is present, then';
   PrintLn 'the computation is made only up to degree I.';
End;

---------------------------------------------------
--
--F ist in S
--M ist in S
--H ist in S

Define Diagonalsubmodule(S,Fu,M,H)
  Using Var(S) Do HM:=H*M End;
  HM1:=$.Pushforward1(S,Fu,HM);
  Using Var(S) Do
    HM1:=Image(HM1,Fu);
    Hdiagsub:=$.Lift_Std(H);
    Erg:=$.Lift(Hdiagsub,HM1);
    If NumComps(Erg)=1 Then Erg:=Cast(Erg,IDEAL) End;
  End;
Return Erg
End;

Define Help_Diagonalsubmodule()
   PrintLn ' Diagonalsubmodule( S:Str , F:Map , Mo:Mod , H:Mod ) : Module';
   PrintLn 'The first string must name a ring S. The second must be a map';
   PrintLn 'F: R --> S of rings, where R is the current ring. The third';
   PrintLn 'argument must be a submodule Mo in S, which presents any S-module';
   PrintLn 'M presented as G1 -->G --> M -->0. The last argument must be';
   PrintLn 'any inclusion h: G --> H. Then the programm computes the S-sub-';
   PrintLn 'module M1 of M generated by G \intersect H_R, where H_R is the';
   PrintLn 'R-free R-submodule of H  generated by the given S-generators.';
End;

---------------------------------------------------
--
Define FromBiGraded(I,J,S,M)
  Using Var(S) Do
    IndS:=Indets();
    V1:=First(IndS,I+1);
    V2:=NewList(J+1);
  End;
  For K:=1 To J+1 Do
    Using Var(S) Do V2[K]:=IndS[I+1+K] End;
  End;
  Using Var(S) Do
    Segr:=Transposed(Mat(V2))*Mat(V1);
    Segr:=$.Flatten(Segr);
    F:=RMap(Segr[1]);
  End;
  Erg:=$.Pushforward1(S,F,M);
Return Erg
End;

Define Help_FromBiGraded()
   PrintLn ' FromBiGraded( I:Int , J:Int , S:Str , M:Mod) : Module';
   PrintLn 'S1 must name a ring R and M must be a bigraded module over';
   PrintLn 'P^I x P^J. Then the programm computes the singly graded module';
   PrintLn 'over P^{IJ+I+J} which represents the same sheaf as m, via the';
   PrintLn 'segre embedding. It is assumed that the current ring has at least';
   PrintLn 'IJ+I+J+1 variables, and the first IJ+I+J+1 of these are used.';
End;

---------------------------------------------------
--
Define Scroll(...)
  A:=Len(ARGV);
  MerkA:=A;
  For I:=1 To A Do
    If Type(ARGV[I])<>INT Then Return'Scroll: only integer expected' End;
    A:=A+ARGV[I];
  End;
  NI:=NumIndets();
  If NI<A Then Return'Scroll: not enough variables.' End;
  M:=NewMat(2,A-MerkA);
  L1:=First(Indets(),A);
  L2:=L1;
  Streich:=1;
  Remove(L2,Streich);
  For I:=1 To MerkA-1 Do
    Streich:=Streich+ARGV[I];
    Remove(L2,Streich);
  End;
  M[2]:=L2;
  Streich:=ARGV[1]+1;
  Remove(L1,Streich);
  For I:=2 To MerkA Do
    Streich:=Streich+ARGV[I];
    Remove(L1,Streich);
  End;
  M[1]:=L1;
  Erg:=[$.Wedge(M,2),M];
  Erg[1]:=Ideal(Erg[1,1]);
Return Erg
End;

Define Help_Scroll()
   PrintLn ' Scroll( I1 : Int , ... , In : Int ) : [I : Ideal , M : Mat]';
   PrintLn 'Makes I the ideal of the rational normal scroll of type I1 I2 ...';
   PrintLn 'In, a variety of dimension n and degree d = \sum_i Ii in P^r,';
   PrintLn 'where r = d+n-1. The programm uses the first d+n variables from';
   PrintLn 'the current ring, which must have at least as many. The matrix M';
   PrintLn 'is the matrix, whose 2 x 2 minors generate I.';
End;

---------------------------------------------------
--
Define Monomial_Curve(...)
  Vgl:=NumIndets()+1;
  A:=Len(ARGV);
  If Vgl<A Then Return
    'Mon_Cur: ring must have at least 'Vgl' variables.' End;

  If A=1 And Type(ARGV[1])=LIST Then 
   For I:=1 To Len(ARGV[1]) Do
    If Type(ARGV[1,I])<>INT Then Return
      'MonCur: List must only contain integer' End;
   End;
   MEMORY.Liste:=ARGV[1];
   A:=Len(ARGV[1]);
  Else
   For I:=1 To A Do
    If Type(ARGV[I])<>INT Then Return'MonCur: only integer expected' End;
   End;
   MEMORY.Liste:=ARGV;
  End;

  MoCR::=Q[s,t];
  Using MoCR Do
    ML:=Max(MEMORY.Liste);
    L:=[s^ML];
  End;
  For I:=1 To A Do
    Using MoCR Do Append(L,s^(ML-MEMORY.Liste[I])*t^MEMORY.Liste[I]) End;
  End;
  Using MoCR Do F:=RMap(L) End;
  Erg:=$.Subring('MoCR',F,A+1);
  Destroy MoCR;
  Erg:=Minimalized(Erg);
Return Erg
End;

Define Help_Monomial_Curve()
   PrintLn ' Monomial_Curve( I1 : Int , ... , In : Int  ) : Ideal';
   PrintLn 'Sets I = the defining ideal of the projective curve given';
   PrintLn 'parametrically on an affine piece by t ---> ( t^I1, ... ,t^In ).';
   PrintLn 'The ideal is defined in the current ring, which must have at';
   PrintLn 'least n+1 variables of equal degree at the beginning of its list';
   PrintLn 'of variables.';
End;

---------------------------------------------------
--
Define OrbitEquality(...)
  MEMORY.RiEnv:=RingEnv();
  LA:=Len(ARGV);
  If LA>3 Then Return'At most three arguments expected' End;
  S:=ARGV[1];
  MEMORY.P:=ARGV[2];
  Using Var(S) Do MEMORY.NIS:=NumIndets() End;
  HeRi::=Q[a[1..MEMORY.NIS,1..MEMORY.NIS]];
  M:=Ord(HeRi);
  M:=$.DSum(Ord(Var(S)),M);
  XAR::=Q[x[1..MEMORY.NIS],a[1..MEMORY.NIS,1..MEMORY.NIS]],Ord(M);
  Using XAR Do
    Xvar:=First(Indets(),MEMORY.NIS);
    M:=$.Generic_Mat(a[1,1],MEMORY.NIS,MEMORY.NIS);
    CV:=Transposed(M*Mat(Ideal(Xvar)));
    F:=RMap(CV[1]);
    P:=Image(MEMORY.P,F);
    He:=$.Coef(Mat[P],Xvar);
    Merk:=He[2];
  End;
  Using HeRi Do
    F2:=$.Fetch('XAR',Merk);
    F:=RMap(F2[1]);
  End;
  If LA=3 Then Erg:=$.Subring('HeRi',F,ARGV[3])
    Else Erg:=$.Subring('HeRi',F) End;
  Destroy HeRi;
  Destroy XAR;
Return Erg
End;

Define Help_OrbitEquality()
   PrintLn ' OrbitEquality( S : Str , F : Poly , [I:Int] ) : Ideal';
   PrintLn 'Two or three arguments expected. First argument must be a string';
   PrintLn 'containing a ring R. The second argument must be a poly F in the';
   PrintLn 'ring R. If a third optional argument is given, it must be an';
   PrintLn 'integer. The programm computes the ideal J of equations defining';
   PrintLn 'the orbit of the HOMOGENEOUS polynomial G under the general';
   PrintLn 'linear group. If the third argument is present, it specifies the';
   PrintLn 'maximal total degree to which to carry the computation.';
End;

---------------------------------------------------
--
Define Curoncubic(M)
    C:=$.Concat($.Iden(3),Mat[[1],[1],[1]],$.Transposed(M));
    Cu:=$.Wedge(C,3);
    Cu:=$.Compress(Cu);
    NC:=20-$.NCols(Cu);
    If NC<>0 Then PrintLn;Print 'There are ',NC,
     ' linear dependencies among the chosen points.';
    Return;
    End;
    Ma:=Transposed(C);
    Poi:=$.Points(Ma);
    GB.Start_GBasis(Poi);
    GB.Complete(Poi);
    SyPoi:=Syz(Poi.MinGens);
    J:=$.KBasis(SyPoi,Indets(),[2,2]);
    Coni:=Poi*Module(J);
    If $.NRows(Coni)<>0 Then PrintLn;Print 
     'There is a conic',Coni,'containing the chosen points.';
    Return;
    End;
    J:=$.KBasis(SyPoi,Indets(),[3,3]);
    Cub:=Poi*Module(J);
    GB.Start_GBasis(Cub);
    GB.Complete(Cub);
    NC:=Len(Cub.MinGens);
    Erg:=Ideal(Cub.MinGens);
Return Erg
End;

Define Help_Curoncubic()
   PrintLn ' Curoncubic( M : Mat ) : Ideal';
   PrintLn 'Expected a 2x3 matrix M in the ring R, representing 2 points in';
   PrintLn 'points in P2. The programm takes these points together with the';
   PrintLn 'four points (1,0,0), (0,1,0), (0,0,1), (1,1,1) and checks, if';
   PrintLn 'three points lie on a common line in P2. If not it checks, if the';
   PrintLn 'six points lie on a common quartic. If not it computes the';
   PrintLn 'vanishing ideal of the common cubic on which the six points lie.';
End;


Define Curoncubic2(S,M,I)
  Using Var(S) Do
    MaCuCu:=$.Concat($.Iden(3),Mat[[1],[1],[1]],Transposed(M));
    I3CuCu:=$.Wedge(MaCuCu,3);
    I3CuCu:=$.Compress(I3CuCu);
    DepCuCu:=20-$.NCols(I3CuCu);
    If DepCuCu=0 Then Skip Else PrintLn
     'There are ',DepCuCu,' linear dependencies among the chosen points.' End;
    MaCuCu:=Transposed(MaCuCu);
    PoiCuCu:=$.Points(MaCuCu);
    GB.Start_GBasis(PoiCuCu);
    GB.Complete(PoiCuCu);
    SyPoiCuCu:=Syz(PoiCuCu.MinGens);
    JCuCu:=$.KBasis(SyPoiCuCu,Indets(),[2,2]);
    ConiCuCu:=PoiCuCu*Module(JCuCu);
    If $.NRows(ConiCuCu)<>0 Then
      PrintLn'There is a conic',ConiCuCu,'containing the chosen points.' End;
    JCuCu:=$.KBasis(SyPoiCuCu,Indets(),[3,3]);
    CubCuCu:=PoiCuCu*Module(JCuCu);
    GB.Start_GBasis(CubCuCu);
    GB.Complete(CubCuCu);
    NCCuCu:=Len(CubCuCu.MinGens);
    If NCCuCu<>4 Then
      PrintLn'There are ',NCCuCu,' cubics';
      PrintLn CubCuCu;
      PrintLn 'containing the chosen points.';
      PrintLn'So I quit.';
      Return ;
    End;
    LCuCu:=[CubCuCu.MinGens[ZaehlCuCu,1] | ZaehlCuCu In 1..NCCuCu];
    FCuCu:=RMap(LCuCu);
  End;
  Erg:=$.Pushforward1(S,FCuCu,I);
  Erg:=Minimalized(Erg);
Return Erg
End;

Define Help_Curoncubic2()
   PrintLn ' Curoncubic2( S1 : Str , Ma : Matrix , I : Ideal ) : Ideal';
   PrintLn 'First argument must be a string containing a ring R. The second';
   PrintLn 'argument must be a 2x3 matrix M in the ring R, representing 2';
   PrintLn 'points in P2 (other than the coordinate points), and the third';
   PrintLn 'argument must be an ideal in R. This script sets I to the ideal';
   PrintLn 'of the image scheme on the cubic in the current ring obtained by';
   PrintLn 'blowing up the 6 points given by M and the 4 coord points. To get';
   PrintLn 'the ideal of the cubic itself, take I to be the zero ideal.'; 
End;

---------------------------------------------------

Define RatSur1(...)
  I:=ARGV[1];
  M:=ARGV[2];
  If Len(ARGV)=3 Then L:=$.Points(M,ARGV[3]) 
    Else L:=$.Points(M) End;
  If Type(L)=STRING Then Return L End;
  SL:=Syz(L);
  M1:=$.KBasis(SL,Indets(),[I,I]);
  M1:=Module(M1);
  Erg:=Mat(M1)*Mat(L);
  Erg:=Cast(Erg,IDEAL);
Return Erg
End;

Define Help_RatSur1()
   PrintLn ' RatSur1( I : Int , M : Mat , [ Li : List]) : Ideal';
   PrintLn 'Computes a linear series ls of the form |dL - \sum ni pi|, where';
   PrintLn 'L is a line in Pr, pi are points in Pr specified in M, ni are';
   PrintLn 'optional multiplicities specified as the degree of the generators';
   PrintLn 'in the list Li. The output ls is an ideal over the current ring,';
   PrintLn 'which must have at least r+1 variables. It is generated by the';
   PrintLn 'forms of degree d vanishing at point pi from M with multiplicity';
   PrintLn 'ni from Li.';
End;

---------------------------------------------------
--
--wir arbeiten in einen ring mit n+m Variablen, wobei die ersten
--n Variablen eliminiert werden (Ring muss eine Elimordnung haben!
--Wenn man einen anderen Ring hat, so kann man mit Fetch das
--Ergebnis dorthin bringen.

Define ProjProd(Id,N)
  I:=$.Sat6(Id,Ideal(First(Indets(),N)));
  I:=Ideal(GBasis(I));
  Erg:=Elim(First(Indets(),N),I);
--  F:=First(Concat(NewList(N,0),Indets()),NumIndets());
--  Erg:=Image(Erg,F);
Return Erg
End;

Project_From_Product(Id,N):=$.ProjProd(Id,N);

Define Help_ProjProd()
   PrintLn ' ProjProd( Id : Ideal , N : Int ) : Ideal';
   PrintLn 'Finds the defining ideal J of the image of a subscheme of';
   PrintLn 'A^n x A^m, minus any component supported on 0 x A^m, projected';
   PrintLn 'to the second factor. It is assumed that the current ring has at';
   PrintLn 'least m variables, and its first m variables are treated as the';
   PrintLn 'variables of A^m.  Further, it is assumed that the base ring of';
   PrintLn 'Id has an elimination order, so that elim will eliminate the';
   PrintLn 'first N avariables.';
End;

---------------------------------------------------
--
Define RationalNormalCurve(P)
  L:=List(P);
  N:=Len(L);
  M1:=Indet(1)..Indet(N-1);
  M2:=NewList(N-1);
  Pi:=1;
  For I:=1 To N-1 Do Pi:=Pi*(L[N]-L[I]) End;
  For I:=1 To N-1 Do
    M2[I]:=(Pi/(L[N]-L[I]))*(L[N]*Indet(I)-L[I]*Indet(N));
  End;
  Erg2:=Mat[M1,M2];
  Erg:=[Ideal(Minors(2,Erg2)),Erg2];
Return Erg
End;

Define Help_RationalNormalCurve()
   PrintLn ' RationalNormalCurve( V : Vector ) : List';
   PrintLn 'Makes the ideal I of the rational normal curve through the n+1';
   PrintLn 'coordinate points, the point 1,1,...,1, and the point specified';
   PrintLn 'by the vector V.  The entries of V must be nonzero and pairwise';
   PrintLn 'distinct for these to be in linearly general position. The result';
   PrintLn 'is a list, whose first argument is the ideal I. The 2xn matrix';
   PrintLn 'whose 2x2 minors generate I is the second argument of the list.';
   PrintLn 'The programm uses the first n+1 variables of the current ring';
   PrintLn '(which must have at least that many.)';
End;

---------------------------------------------------
--
Define K3Carpet(M,N)
  M:=Mat(M);
  N:=Mat(N);
  NRM:=$.NRows(M);
  NRN:=$.NRows(N);
  If NRM<2 Or NRN<2 Then Return
    'Matrices must have at least two rows.'
  End;
  If $.NCols(M)<>2 Or $.NCols(N)<>2 Then Return
    'm x 2 matrices expected' End;

  I2:=Concat(Minors(2,M),Minors(2,N));

  Tot:=$.Concat(Transposed(M),Transposed(N));
  Tot:=Transposed(Tot);
  X:=1;
  I3:=[];
  Repeat
    Y:=1;
    Repeat
      OM:=Minors(2,$.Submat(Tot,[X,(NRM+Y+1)],[1,2]));
      IM:=Minors(2,$.Submat(Tot,[(X+1),(NRM+Y)],[1,2]));
      Dif:=OM[1]-IM[1];
      Append(I3,Dif);
      Y:=Y+1;
    Until Y=NRN;
    X:=X+1;
  Until X=NRM;
  Erg1:=Concat(I2,I3);
  Erg:=Ideal(Erg1);
Return Erg
End;

Define Help_K3Carpet()
  PrintLn ' K3Carpet( M : Mat , N : Mat ) : Ideal';   
  PrintLn 'M and N must be mx2 and nx2 matrices with m,n >=2. Then the Ideal';
  PrintLn 'of minors of M, minors of N, and differences of 2x2 minors of the';
  PrintLn 'concatenated matrix M|N of the form |i j+1|-|i+1 j| where |m n|';
  PrintLn 'denotes the minor involving the mth col of M and the nth col of N.';
  PrintLn 'In the case where M and N are disjoint catalecticant matrices,';
  PrintLn 'with 2 <= m <= n columns respectively, the ideal I is the ideal';
  PrintLn 'of a k3 carpet of sectional genus g = a+b and clifford index a.';
End;

---------------------------------------------------
--
Define Codim(M)
  If Type(M)=IDEAL Then
    If M<>Homogenized(Indet(1),M) Then
      Return 'Homogeneous ideal expected!' End;
  Return $.Codim1(M)
  End;

  If Type(M)=MODULE Then
    LM:=Gens(LT(M));
    For I:=1 To Len(LM) Do LM[I]:=List(LM[I]) End;
    Erg:=Ideal([LM[I,1] | I In 1..Len(LM)]);
    Erg:=$.Codim1(Erg);
    For J:=2 To Len(LM[1]) Do
      I:=[LM[I,J] | I In 1..Len(LM)];
      I:=Ideal(I);
      Erg:=Min([Erg,$.Codim1(I)]);
    End;
  End;
Return Erg
End;

Define Help_Codim()
   PrintLn 'Codim( M : Module / Ideal ) : Int';
   PrintLn 'returns the codimension of the module (the ideal) M.';
End;

----------------------------------------------------
--
Define Codim1(I)
  If I=Ideal(1) Then Return NumIndets()+1 End;
Return Dim(CurrentRing())-Dim(CurrentRing()/I)
End;

----------------------------------------------------
--
Define Removlid(I)
  I:=Ideal(GBasis(I));
  C:=Dim(CurrentRing())-Dim(CurrentRing()/I);
  E:=$.Ext_R(C,I);
  Erg:=$.Ann(E);
Return Erg
End;

Define Help_Removlid()
  PrintLn 'Removlid( Id : Ideal ) : Ideal';
  PrintLn 'Sets I to the intersection of the highest dimensional primary';
  PrintLn 'components of Id. Uses the formula I = ann ext^c(Id,R), where c';
  PrintLn 'is the codimension of m and R is the current ring.';
End;

----------------------------------------------------
--
Define Removlow(M)
  MEMORY.Ri:=RingEnv();
  F1:=Indets();
  NI:=NumIndets();
  Ordn:=Ord();
  Wei:=WeightsMatrix();
  HeRi::=Q[x[1..NI]],Ord(Ordn),Weights(Wei);
  Using HeRi Do
    M:=$.Fetch2(MEMORY.Ri,M);
    GB.Start_Res(M);
    GB.Complete(M);
    MEMORY.D:=GB.GetResLen(M);
    HeM:=Ideal(M.GBasis);
    Erg1:=HeM;
    MEMORY.Cod:=$.Codim(HeM);
  End;
  If MEMORY.D<=MEMORY.Cod Then Return $.Fetch2('HeRi',HeM) End;

  Repeat
    Using HeRi Do
      Hel1:=GB.GetNthSyz(M,MEMORY.D-1);
      MD:=Module($.Transposed(Mat(Hel1.Gens)));
      MD1:=Module($.Transposed(Mat(GB.GetNthSyz(M,MEMORY.D))));
      If MD1=Module([0]) Then SMD1:=Module($.Iden(NumComps(MD)))
        Else SMD1:=Syz(MD1) End;
      E:=$.Modulo(SMD1,MD);
      If E=Module([0]) Then Skip
      Else
        E:=$.Prune(E);
        TE:=Type(E);
        E:=GBasis(E);
        E:=Cast(E,TE);
      End;
      If (E=Module([0]) Or $.Codim(E)>MEMORY.D) Then
        MEMORY.D:=MEMORY.D-1;
      Else
        A:=$.Ann(E);
        A:=Ideal(Interreduced(A.Gens));
        Erg1:=$.Sat6(Erg1,A);
        M:=Erg1;
        GB.Start_Res(M);
        GB.Complete(M);
        D1:=GB.GetResLen(M);
        If D1>=MEMORY.D Then MEMORY.D:=MEMORY.D-1
          Else MEMORY.D:=D1 End;
      End;
    End;
  Until MEMORY.D<=MEMORY.Cod;

  Erg:=$.Fetch2('HeRi',Erg1);
  Destroy HeRi;
Return Erg
End;

Define Help_Removlow()
  PrintLn 'Removlid( M : Module/Ideal , N : Int ) : Ideal';
  PrintLn 'Sets I to the intersection of the highest dimensional primary';
  PrintLn 'components of M. Computes as many free resolutions to do this as';
  PrintLn 'there are dimensions of embedded primes but no projections.';
End;

----------------------------------------------------
--
Define Removlst(M)
  MEMORY.Endbed:=FALSE;
  MEMORY.Ri:=RingEnv();
  F1:=Indets();
  NI:=NumIndets();
  Ordn:=Ord();
  Wei:=WeightsMatrix();
  HeRi::=Q[x[1..NI]],Ord(Ordn),Weights(Wei);
  Using HeRi Do
    M:=$.Fetch2(MEMORY.Ri,M);
    GB.Start_Res(M);
    GB.Complete(M);
    MEMORY.D:=GB.GetResLen(M);
    Erg1:=Ideal(M.GBasis);
    MEMORY.Cod:=$.Codim(Erg1);
  End;

  Repeat
    If MEMORY.D<=MEMORY.Cod Then Return Ideal(1) End;
    Using HeRi Do
      Hel1:=GB.GetNthSyz(M,MEMORY.D-1);
      MD:=Module($.Transposed(Mat(Hel1.Gens)));
      MD1:=Module($.Transposed(Mat(GB.GetNthSyz(M,MEMORY.D))));
      If MD1=Module([0]) Then SMD1:=Module($.Iden(NumComps(MD)))
        Else SMD1:=Syz(MD1) End;
      E:=$.Modulo(SMD1,MD);
      If E=Module([0]) Then Skip
      Else
        E:=$.Prune(E);
        TE:=Type(E);
        E:=GBasis(E);
        E:=Cast(E,TE);
      End;
      If (E=Module(0) Or $.Codim(E)>MEMORY.D) Then
        MEMORY.D:=MEMORY.D-1
      Else
        Erg1:=$.Ann(E);
        MEMORY.Endbed:=TRUE;
      End;
    End;

    If MEMORY.D<=MEMORY.Cod Then Return Ideal(1) End;
  Until (MEMORY.D=MEMORY.Cod Or MEMORY.Endbed=TRUE);

  Erg:=$.Fetch2('HeRi',Erg1);
  Erg:=$.Sat6(M,Erg);
  Destroy HeRi;
Return Erg
End;

Define Help_Removlst()
  PrintLn 'Removlst( M : Module/Ideal ) : Ideal';
  PrintLn 'Sets I to the intersection of the highest dimensional primary';
  PrintLn 'components of M excepting those of lowest dimension. Computes';
  PrintLn 'one free resolutionto do this, no projections, no determinants.';
End;

----------------------------------------------------
--
Define RatNoros(I,J)
  NI:=NumIndets();
  MEMORY.I:=I;
  MEMORY.J:=J;
  If (NI<J+1 Or I>J-2 Or I<1) Then
    Return'RatNoros: Bad parameters.' End;
  RatNoR::=CoeffRing[z[1..NI],s,t];
  Using RatNoR Do
    ZR:=[[1]];
    Append(ZR,First(Indets(),I));
    ZR:=ConcatLists(ZR);
    TMat:=NewMat(MEMORY.I+1,MEMORY.J+1,0);
  End;
  For K:=0 To J Do
    Using RatNoR Do TMat[1,K+1]:=t^K End;
  End;
  For K:=2 To I+1 Do
    For L:=1 To J+1 Do
      Using RatNoR Do TMat[K,L]:=Der(TMat[K-1,L],t) End;
    End;
  End;
  Using RatNoR Do
    FMat:=Mat(ZR)*TMat;
    MEMORY.LFMat:=$.NCols(FMat);
    MaxDegMat:=Deg(FMat[1,MEMORY.LFMat]);
  End;
  For I:=1 To MEMORY.LFMat Do
    Using RatNoR Do
      FMat[1,I]:=Homogenized(s,FMat[1,I]);
      FMat[1,I]:=FMat[1,I]*s^(MaxDegMat+1-I);
    End;
  End;
  Using RatNoR Do
    F1:=RMap(FMat[1]);
  End;
  Erg:=$.Subring('RatNoR',F1);
  Destroy RatNoR;
Return Erg
End;

Define Help_RatNoros()
  PrintLn 'RatNoros ( I : Int , J : Int ) : Ideal';
  PrintLn 'We require 1 <= I <= J-1. The result Id is set to the ideal of';
  PrintLn 'the union of the osculating I-planes to the  standard rational';
  PrintLn 'normal curve 1 t t^2 ... , over the current ring, which must have';
  PrintLn 'at least j+1 variables.';
End;

----------------------------------------------------
--
--I ein Ideal in Ring Q(x_1,..,x_r)
--currentring ist ring Q(y_1,..,y_s,x_1,..,x_r).
--wobei s>=(Anzahl der Erzeuger von I)=:t
--Es sollte s=t sein!
--Es werden die letzten r und die ersten t Variablen benutzt.

Define Blowup(RI,I)
  Using Var(RI) Do
    MEMORY.LI:=Len(I);
    MEMORY.NI:=NumIndets();
  End;
  If MEMORY.LI > NumIndets()-MEMORY.NI Then Return
    'Blowup: Currentring has not enough variables.' End;
  R3::=Q[x[1..MEMORY.NI]];
  R2::=Q[y[1..MEMORY.LI]];
  R1::=Q[t];
  O:=$.DSum(Ord(R1),Ord(R2),Ord(R3));
  HeRiBlUp::=Q[t,y[1..MEMORY.LI],x[1..MEMORY.NI]],Ord(O);
  Using HeRiBlUp Do
    F:=RMap(Last(Indets(),MEMORY.NI));
    J:=Image(I,F);
    TJ:=t*J;
    Y:=First(Indets(),MEMORY.LI+1);
    Remove(Y,1);
    K:=Y-Gens(TJ);
    K:=Ideal(GBasis(Ideal(K)));
    Elt:=Elim(t,K);
  End;
  L:=[0];
  L:=Concat(L,Last(Indets(),MEMORY.LI));
  For K:=1 To MEMORY.NI Do Append(L,Indet(K)) End;
  F:=RMap(L);
  Erg:=Image(Elt,F);
  Destroy HeRiBlUp;
  Destroy R1;
  Destroy R2;
  Destroy R3;
Return Erg
End;

Define Help_Blowup()
  PrintLn 'Blowup ( S1 : Str , I : Ide ) : Ideal';
  PrintLn 'The first sting must name a ring R=K[X_1,...,X_n]. The second';
  PrintLn 'argument must be an ideal I=(f_1,...,f_r) in R. The program then';
  PrintLn 'computes a presentation for the blowup-ring of I in R. It is';
  PrintLn 'assumed that the current ring has at least n+r variables.';
End;

----------------------------------------------------
--
Define NormalCone(RI,I)
  Using Var(RI) Do
    MEMORY.LI:=Len(I);
    MEMORY.NI:=NumIndets();
  End;
  If MEMORY.LI > NumIndets()-MEMORY.NI Then Return
    'NormalCo: Currentring has not enough variables.' End;
  J1:=$.Blowup(RI,I);
  J2:=$.Fetch(RI,I);
  Erg:=J1+J2;
  Erg:=Minimalized(Erg);
Return Erg
End;

Define Help_NormalCone()
  PrintLn ' Normalcone( S1:Str , I : Ideal ) : Ideal';
  PrintLn 'First argument must be a string containing a graded ring R. The';
  PrintLn 'second argument must be a homogeneous ideal J in the ring R.';
  PrintLn 'Then the graded ring P/Id = R/J + J/J^2 + J^2/J^3 + ..., where P';
  PrintLn '(the current ring) is the a polynomial algebra over R.';
  PrintLn 'P/Id corresponds to the normal cone of the scheme defined by J.';
End;

----------------------------------------------------
--
Define Analytic_Spread(I)
  MEMORY.RI:=RingEnv();
  MEMORY.NI:=NumIndets();
  MEMORY.LI:=Len(I);
  HeRi::=Q[a[1..100],x[1..MEMORY.NI]];
  Using HeRi Do
    J:=$.Blowup(MEMORY.RI,I);
    J1:=Ideal(Last(Indets(),MEMORY.NI));
    Fib:=J1+J;
    Fib:=Ideal(GBasis(Fib));
    S:=$.Codim(Fib); 
    Erg:=MEMORY.NI+MEMORY.LI-S;
  End;
Destroy HeRi;
Return Erg
End;

AnalySpr(I):=$.Analytic_Spread(I);

Define Help_Analytic_Spread()
 PrintLn ' Analytic_Spread( I : Ideal ) : Int';
 PrintLn 'Computes the analytic spread of the ideal I (that is, the (affine)';
 PrintLn 'dimension of the fiber of the irrelevant ideal in the blowup of I.)';
End;

----------------------------------------------------
--
Define DualVariety(I,N)
  If Type(I)=POLY Then I:=Ideal(I) End;
  MEMORY.RiEnv:=RingEnv();
  Jac:=Jacobian(I.Gens);
  Sing:=$.Wedge(Jac,N);
  Sing:=$.Flatten(Sing);
  MEMORY.NI:=NumIndets();
  HeRiDuVa::=Q[a[1..MEMORY.NI],x[1..MEMORY.NI]],Lex;
  Using HeRiDuVa Do
    I:=$.Fetch2(MEMORY.RiEnv,I);
    Jac:=$.Fetch2(MEMORY.RiEnv,Jac);
    Sing:=$.Fetch2(MEMORY.RiEnv,Sing);
    Jac1:=Mat(Concat(Jac,[Last(Indets(),MEMORY.NI)]));
    Grap:=$.Flatten($.Wedge(Jac1,N+1));
    Grap:=Mat(Concat(Grap[1],I.Gens));
    Grap:=$.Sat6(Ideal(Grap[1]),Ideal(Sing[1]));
    Erg:=$.ProjProd(Grap,MEMORY.NI);
  End;
  L:=NewList(MEMORY.NI,0);
  F:=RMap(Concat(L,Indets()));
  Erg:=Image(HeRiDuVa:: Erg,F);
Return Erg
End;

Define Help_DualVariety()
 PrintLn ' DualVariety( I : Ideal , N : Int ) : Ideal';
 PrintLn 'Given the ideal I of a variety X of codimensions c in projective';
 PrintLn 'space, forms the classical dual variety -- that is, the closure of';
 PrintLn 'the set of hyperplanes containing tangent planes at smooth points';
 PrintLn 'of X.';
End;

-----------------------------------------------------
--
--Uebernommen von Antonio Capani und Lorenzo Robbiano
--mit kleinem Zusatz!

Define DegSort(Var L)
  For I := 1 To Len(L)-1 Do
    M := I;
    For J := I+1 To Len(L) DO
      If Deg(LT(L[J])) < Deg(LT(L[M])) Then M := J End;
    End;
    If M <> I Then
      C := L[M];
      L[M] := L[I];
      L[I] := C
    End
  End
End;

Define SortDeg(...)
  If Len(ARGV)=1 And Type(ARGV[1]) IsIn [MODULE,IDEAL] Then
    M:=ARGV[1];
    M:=M.Gens;
    $.DegSort(M);
    Return Cast(M,Type(ARGV[1]));
  Elsif Type(ARGV[1]) = LIST Then M := ARGV[1] Else M := ARGV End;
  $.DegSort(M);
  Return M;
End;

Define Help_SortDeg()
  PrintLn ' SortDeg( M : Mod/Ide ) : Mod/Ide';
  PrintLn 'Sort the generators of m so that the degrees are in increasing';
  PrintLn 'order.';
End;

-----------------------------------------------------
--
Define Adjoint_Fraction(R,F,I)
  SInd:=Indets();
  Using Var(R) Do RI:=Ideal(Indets()) End;
  RInd:=Gens($.Fetch(R,RI));
  YVars:=Diff(SInd,RInd);
  I:=$.Fetch(R,I);
  F:=Ideal($.Fetch(R,F));
  FY:=F*Ideal(YVars);
  Wei:=WeightsList();
  Append(Wei,1);
  MEMORY.RiEnv:=RingEnv();
  Append(SInd,1);
  Homogri::=CoeffRing[a[1..NumIndets()],t],Weights(Wei);
  FBack:=RMap(SInd);
  Using Homogri Do
    I:=$.Fetch2(MEMORY.RiEnv,I);
    FY:=$.Fetch2(MEMORY.RiEnv,FY);
    F:=$.Fetch2(MEMORY.RiEnv,F);
    K0:=Ideal(FY.Gens-I.Gens);
    K0:=Homogenized(t,K0);
    F:=t*F;
    Erg:=$.Sat6(K0,F);
  End;
  Erg:=Image(Erg,FBack);
Return Erg
End;

Define Help_Adjoint_Fraction()
  PrintLn ' Adjoint_Fraction( S1, S2, S3 : Strings ) : Ideal';
  PrintLn 'The first string must name an ring R. The second argument must be';
  PrintLn 'a poly F in R and the third argument must be an ideal I in R.';
  PrintLn 'Compute the ideal J, so that S/J = R[(IF^(-1)], where S is the';
  PrintLn 'current ring, which must be an polynomial algebra over R and F';
  PrintLn 'must be a nonzerodivisor of R.';
End;

----------------------------------------------------
--
Define X_To_Last(...)
  MEMORY.RiEnv:=RingEnv();
  LA:=Len(ARGV);
  If LA>2 Then Return'Only one or two arguments expected' End;
  I:=Indets();
  If LA=1 Then
    If Type(ARGV[1])IsIn [LIST,POLY] Then L:=Ideal(ARGV[1])
      Else L:=ARGV[1] End;
    G1:=$.Contract(L,I);
    G:=$.Complement(Module(G1));
    G:=G+Module(G1);
    G:=$.Transposed(Mat(G));
    Erg2:=Mat(I)*G;
    F:=$.Inverse(G);
    Erg1:=Mat[I]*F;
    Erg:=[Ideal(Erg1[1]),Ideal(Erg2[1])];
  Else
    S:=ARGV[1];
    Using Var(S) Do MEMORY.NIS:=NumIndets() End;
    If NumIndets()<>MEMORY.NIS Then Return
      "The two rings must have the same number of variables." End;
    MEMORY.ARG2:=ARGV[2];
    Using Var(S) Do
      If Type(MEMORY.ARG2) IsIn [LIST,POLY] Then
        L:=Ideal(MEMORY.ARG2) Else L:=MEMORY.ARG2 End;
      G1:=$.Contract(L,Indets());
      G:=$.Complement(Module(G1));
      G:=G+Module(G1);
      G:=$.Transposed(Mat(G));
      Erg2:=Mat[Indets()]*G;
      Erg2:=Ideal(Erg2[1]);
      F:=$.Inverse(G);
    End;
    F:=$.Fetch(ARGV[1],F);
    Erg1:=Mat[Indets()]*F;
    Erg1:=Ideal(Erg1[1]);
    Erg:=[Erg1,Erg2];
  End;
  Return Erg
End;

Xtolast(...):=X_To_Last(...);

Define Help_X_To_Last()
  PrintLn ' X_To_Last( ... ) : Ideal';
  PrintLn 'One or two arguments expected. If one argument is given, it must';
  PrintLn 'be an ideal I. If two arguments are given, then the first must be';
  PrintLn 'a string. It must indicate a ring R. The second argument must be';
  PrintLn 'an ideal I in R. Let S be the current ring (one argument : S=R!).';
  PrintLn 'The ideal must have less generators than there are variables of';
  PrintLn 'R or S. Then the resulting ideals can be view as inverse ring maps';
  PrintLn 'f: R -->S and g: S-->R.  The effect of f is to make the linear';
  PrintLn 'forms in "I" act as the last variables.'; 
End;

----------------------------------------------------
--
Define NZD(P,M)
  MEMORY.RiEnvNZD:=RingEnv();
  NI:=NumIndets();
  W:=WeightsList();
  HeRi::=Q[y[1..NI]],DegRevLex,Weights(W);
  Using HeRi Do
    FNZD:=$.X_To_Last(MEMORY.RiEnvNZD,P);
    FNZD:=FNZD[1];
    FNZD:=RMap(FNZD.Gens);
    M1NZD:=Image(M,FNZD);
    M1NZD:=$.Lift_Std2(M1NZD);
    MNZD:=Module(M1NZD[1]);
    PNZD:=Image(P,FNZD);
    N1NZD:=$.Sat3(MNZD,PNZD);
    Zer:=$.Reduce(M1NZD,N1NZD);
    Zer:=Zer[1];
    If Module(Zer)=Module() Then MEMORY.WaFa:=FALSE
      Else MEMORY.WaFa:=TRUE End;
  End;
  If MEMORY.WaFa Then
    PrintLn P," is a zerodivisor."
  Else
    PrintLn P," is a nonzerodivisor."
  End;
End;

Define Help_NZD()
  PrintLn ' NZD( F : Poly , M : Module/Ideal )';
  PrintLn 'Prints whether F is a nonzerodivisor for M or not.';
End;

----------------------------------------------------
--
Define Symmetric_Algebra(M)
  If Type(M)=MAT Then M:=Module(M) End;
  MEMORY.LM:=NumComps(M);
  MEMORY.NI:=NumIndets();
  HeR1::=Q[a[1..MEMORY.LM]];
  OM:=$.DSum(Ord(HeR1),Ord());
  SymAlgRi::=Q[a[1..MEMORY.LM],b[1..MEMORY.NI]],Ord(OM);
  Using SymAlgRi Do
    F:=RMap(Last(Indets(),MEMORY.NI));
    M:=Image(M,F);
    A:=$.Transposed(Mat(First(Indets(),MEMORY.LM)));
    Erg:=$.Transposed(Mat(M)*A);
    Erg:=[Ideal(Erg[1]),Last(Indets(),MEMORY.NI),First(Indets(),MEMORY.LM)];
  End;
  Destroy HeR1;
Return Erg
End;

SymmAlg(M):=$.Symmetric_Algebra(M);

Define Help_Symmetric_Algebra()
  PrintLn ' Symmetric_Algebra( M : Module ) : List';
  PrintLn 'Compute the symmetric algebra I of the module presented by M.';
  PrintLn 'It returns a list where I ist the first element. The second and';
  PrintLn 'third elements of the list are the variables coming from the ring';
  PrintLn 'and the rows of M, respectively.';
End;

----------------------------------------------------
--
Define NbynCommuting(I)
  MEMORY.I:=I;
  NbynRi::=Q[a[1..I,1..I],b[1..I,1..I]];
  Using NbynRi Do
    A:=$.Generic_Mat(a[1,1],MEMORY.I,MEMORY.I);
    B:=$.Generic_Mat(b[1,1],MEMORY.I,MEMORY.I);
    M:=$.Flatten(A*B-B*A);
    H:=1..(MEMORY.I*MEMORY.I-1);
    M:=$.Submat(M,[1],H);
    L:=List(M);
    Id:=Ideal(L[1]);
    Erg:=[Id,A,B];
  End;
  Erg:=NbynRi:: Erg;
Return Erg
End;

Nbyncomm(I):=$.NbynCommuting(I);

Define Help_NbynCommuting()
   PrintLn "NbynCommuting( I : Int ) : Ring with List ";
   PrintLn "creates a ring with a generic pair of n by n commuting";
   PrintLn "matrices A,B and an ideal I in the new ring containing the";
   PrintLn "entries of the matrix AB-BA. The new ring has variables";
   PrintLn "a[i,j] and b[i,j]. Return: L:=[I,A,B].";
End;

-------------------------------------------------------------------
--
Define Putmat(M,S)
  If Type(M)<>MAT Then Return
    "First argument must be a matrix." End;
  D:=OpenOFile(S);
  OpenLog(D);
  $.NRows(M);
  PrintLn;
  $.NCols(M);
  PrintLn;
  For I:=1 To $.NRows(M) Do
    For J:=1 To $.NCols(M) Do
      M[I,J];
      PrintLn;
    End;
  End;
  CloseLog(D);
End;

Define Help_Putmat()
   PrintLn "Putmat( M : Matrix , S : String )";
   PrintLn "Write the matrix M to the file S in a format suitable to";
   PrintLn "read by mat in macaulay. Hint: You must delete the blancs";
   PrintLn "in each row. E.g: Output: x - t . Change it to: x-t !";
End;

----------------------------------------------
--
--es wird neuer Ring mit Variablen a[1]..a[N] gemacht

Define MinPres(I)
  If Type(I)=POLY Then I:=Ideal(I) End;
  MEMORY.RiEnv:=RingEnv();
  NI:=NumIndets();
  Red:=NewList(NI);
  For J:=1 To NI Do Red[J]:=[Indet(J),0] End;
  Inde:=$.Lift_Std2(Ideal(Indets()));
  Ker:=$.Lift(Inde,I);
  Ker:=Subst(Ker,Red);
  KerStrich:=$.Transposed(Mat(Ker));
  Ma:=Syz(Module(KerStrich));
  Ma:=$.Transposed(Mat(Ma));
  MiPreRi::=Q[a[1..$.NCols(Ma)]];
  Using MiPreRi Do
    Ma:=$.Fetch2(MEMORY.RiEnv,Ma);
    F:=Ma*$.Transposed(Mat(Indets()));
    F:=$.Transposed(F);
    F:=RMap(F[1]);
    J:=Image(I,F);
  End;
  Erg:=[J,F];
Return Erg
End;

Minimal_Presentation(I):=$.MinPres(I);

Define Help_Minimal_Presentation()
  PrintLn ' Minimal_Presentation( I : Ideal ) : List';
  PrintLn 'Find a minimal presentation K[varlist]/J for a given ring P/I,';
  PrintLn 'where P is the current ring. The ring K[varlist] is computed and';
  PrintLn 'named MiPreRi. The result is a list, whose first entry is the';
  PrintLn 'ideal J, and the second is a map f: P --> k[varlist] inducing an';
  PrintLn 'isomorphism P/I ----> k[varlist]/J.';
End;

---------------------------------------------------
---------------------------------------------------
--
--Das folgende wurde uebernommen von Gabriel De Dominicis
--(nur auf Version 3.4 umgeschrieben)!

Define LJDim(I)
 If I=Ideal(1) Then Return -1 End;
 Return Dim(CurrentRing()/I)
End;

----------------------------------------------------

IdealOfMinors(M,N):=Ideal(Minors(N,M));
Jacobian(S):=Mat[[Der(P,X)|X In Indets()]|P In S];
Jacobian2(S,L):=Mat[[Der(P,X)|X In L]|P In S];

----------------------------------------------------

Define LowerJacobian(I,A)
  NI:=NumIndets();
  If NI=A Then Return Ideal(1) End;
  J:=$.Jacobian(I.Gens);
  If (NI-A>Min([$.NRows(J),$.NCols(J)])) Then Return I End;
  He:=$.IdealOfMinors(J,NI-A);
  He2:=Concat(I.Gens,He.Gens);
  Erg:=Ideal(He2);
  Return Erg
End;

----------------------------------------------------

Define RadicalOfUnmixed1(I)
  If I=Ideal(1) Then Return I End;
  D:=Dim(CurrentRing()/I);
  LJ:=$.LowerJacobian(I,D);
  If ($.LJDim(LJ)<D) Then Return I
  Else
    NumInd:=NumIndets();
    A:=D;
    While LJ<>Module() Do
     If ($.LJDim(LJ)=D) Then
      SLJ:=Ideal(LJ.Gens);
      A:=A+1;
      LJ:=$.WedgeCokernel(SLJ,NumInd-A+1);
     End;
    End;
    SLJ:=$.Ann1(LJ);
    NI:=I:SLJ;
    Return $.RadicalOfUnmixed(NI)
  End;
End;

Define Help_RadicalOfUnmixed1()
  PrintLn 'RadicalOfUnMixed1 ( I : Ideal ) : Ideal';
  PrintLn 'returns the radical of the UNMIXED ideal I.';
End;

-------------------------------------------------------
--
Define RadicalOfUnmixed(I)
  If I=Ideal(1) Then Return I End;
  D:=Dim(CurrentRing()/I);
  LJ:=$.LowerJacobian(I,D);
  If ($.LJDim(LJ)<D) Then Return I
  Else
    A:=D;
    While ($.LJDim(LJ)=D) Do
      SLJ:=Ideal(LJ.Gens); -- ideal duplication
      A:=A+1;
      LJ:=$.LowerJacobian(I,A);
    End;
    NI:=I:SLJ;
    Return $.RadicalOfUnmixed(NI);
  End;
End;

Define Help_RadicalOfUnmixed()
  PrintLn 'RadicalOfUnMixed ( I : Ideal ) : Ideal';
  PrintLn 'returns the radical of the UNMIXED ideal I.';
End;

-----------------------------------------------------

JacobianMinors(I,A):=Minors(NumIndets()-A,$.Jacobian(I.Gens));

-----------------------------------------------------
--
Define RadicalOfUnmixed2(I,L)
  If I=Ideal(1) Then Return I End;
  M:=Len(L);
  IZ:=Ideal(L);
  NI:=NumIndets();
  JM:=$.JacobianMinors(IZ,NI-M);
  J0:=Ideal(JM);
  K:=IZ:J0;
  S:=K:I;
  Return K:S;
End;

Define Help_RadicalOfUnmixed2()
  PrintLn 'RadicalOfUnMixed2 ( I : Ideal , L : List ) : Ideal';
  PrintLn 'returns the radical of the UNMIXED ideal I, where';
  PrintLn 'L is a regular sequence in I.'
End;

---------------------------------------------------

Define Radical(I)
  If I=Ideal(1) Then Return I
    Else
    Repeat
      J:=$.Removlst(I);
      J1:=$.Sat6(I,J);
      If J1=Ideal(1) Then I:=J End;
    Until J1<>Ideal(1);
    K:=$.RadicalOfUnmixed(J1);
    K1:=$.Sat6(I,K);
    Return Intersection(K,$.Radical(K1));
  End;
End;

Define Help_Radical()
  PrintLn 'Radical ( I : Ideal ) : Ideal';
  PrintLn 'returns the radical of the ideal I.';
End;

-----------------------------------------------------
-----------------------------------------------------
--
Define WedgeCokernel(M,I)
  M:=Mat(M);
  Wed:=FALSE;
  NRo:=$.NRows(M);
  Repeat
    Row:=Ideal(M[NRo]);
    Kosz:=$.Transposed($.Koszul(Row,I));
    If Wed=FALSE Then Wed:=Kosz Else Wed:=$.Concat(Kosz,Wed) End;
    NRo:=NRo-1;
  Until NRo=0;
  Erg:=$.Transposed(Wed);
  If $.NCols(Erg)=1 Then Return Ideal(Module(Erg)) End;
Return Module(Erg)
End;

Define Help_WedgeCokernel()
  PrintLn 'WedgeCokernel ( I : Mod/Ide , N : Int ) : Mod/Ide';
  PrintLn 'return the module presenting the N-th exterior power of the';
  PrintLn 'cokernel of I.';
End;

-----------------------------------------------------
--
Define Perp(S,M)
  Using Var(S) Do
    MFla:=$.Flatten(M);
    MVa:=GBasis(Ideal(MFla[1]));
    MEMORY.D:=Len(MVa);
    M1:=$.Diff(MFla[1],MVa);
    N1:=Syz(Module(M1));
    MEMORY.NRo:=$.NRows(M);
    MEMORY.NCo:=$.NCols(M);
  End;
  RoRi::=Q[w[1..MEMORY.NRo]];
  CoRi::=Q[v[1..MEMORY.NCo]];
  NI:=NumIndets();
  O1:=$.DSum(Ord(),Ord(RoRi),Ord(CoRi));
  HeRi::=Q[a[1..NI],w[1..MEMORY.NRo],v[1..MEMORY.NCo]],Ord(O1);
  Using HeRi Do
    N1:=$.Fetch2(S,N1);
    Cur:=First(Indets(),Len(N1));
    He:=Last(Indets(),MEMORY.NRo+MEMORY.NCo);
    Ro:=First(He,MEMORY.NRo);
    Co:=Last(He,MEMORY.NCo);
    Prod:=Ideal(Ro)*Ideal(Co);
    Cur:=Transposed(Mat(Cur));
    N:=Transposed(Mat(N1))*Cur;
    N:=Mat(Prod.Gens)*N;
    N:=Transposed($.Diff(Ideal(Co),Ideal(N[1])));
    N:=Transposed($.Diff(Ideal(Ro),Ideal(N[1])));
  End;
  Erg:=$.Fetch2('HeRi',N);
Return Module(Erg)
End;

Define Help_Perp()
  PrintLn 'Perp ( S : Str , Ma : Matrix ) : Mod';
  PrintLn 'The first string must indicate a ring R. The second argument must';
  PrintLn 'be a (v x w) matrix M of linear forms in d variables in R, which';
  PrintLn 'expresses a d-dimensional linear space of linear transformations.';
  PrintLn 'Output is a (vw-d)-dimensional linear space of w x v matrices,';
  PrintLn 'expressed as a w x v matrix of linear forms n over the current';
  PrintLn 'ring, which must have at least vw-d variables (the first vw-d of';
  PrintLn 'which are used.)';
End;

---------------------------------------------------------
--
Define SymCokernel(M,I)
  MEMORY.NI:=NumIndets();
  M:=Mat(M);
  MEMORY.NC:=$.NCols(M);
  T1::=Q[u[1..MEMORY.NC]];
  Ordn:=$.DSum(Ord(T1),Ord());
  DESTROY(T1);
  HeRi::=Q[u[1..MEMORY.NC],v[1..MEMORY.NI]],Ord(Ordn);
  Using HeRi Do
    F:=RMap(Last(Indets(),MEMORY.NI));
    M:=Transposed(Image(M,F));
    Ide:=Mat(First(Indets(),MEMORY.NC))*M;
    TP:=Ideal(First(Indets(),MEMORY.NC))^I;
    TP1:=Ideal(First(Indets(),MEMORY.NC))^(I+1);
    TP1:=Ideal(Concat(TP1.Gens,Ide[1]));
    S:=$.Modulo(TP,TP1);
  End;
  Erg:=$.Pushforward1('HeRi',F,S);
  Destroy HeRi;
Return Erg
End;

Define Help_SymCokernel()
  PrintLn 'SymCokernel ( M : Module , I : Int ) : Module';
  PrintLn 'returns the presentation matrix for the I-th symmetric power of';
  PrintLn 'the cokernel of M.';
End;

----------------------------------------------------
--
Define PBundle(R,M,M0)
  Using Var(R) Do
    Li:=$.SymmAlg(M);
    Using SymAlgRi Do
      PM:=$.Sat6(Li[1],Ideal(Li[2]));
      F:=RMap(Li[2]);
      M0:=Image(M0,F);
      M0:=Mat(Li[3])*Transposed(Mat(M0));
      M0:=Ideal(M0[1]);
      M0:=MC.FetchQring(M0,PM);
      F1:=RMap(M0.Gens);
    End;
  End;
  Erg:=$.Subring('SymAlgRi',F1);
Return Erg
End;

Define Help_PBundle()
  PrintLn 'PBundle ( S : Str , M : Mod , M0 : Mod ) : Ideal';
  PrintLn 'The first string must name a ring S. The second argument must be a';
  PrintLn 'module M in S. The third argument must be a submod. M0 of M in S.';
  PrintLn 'The programm find the ideal J in the current ring R, such that R/J';
  PrintLn 'is isomorphic to the subring of P(M) generated by the elements of';
  PrintLn 'the submodule M0 in the projective bundle of M. The number of';
  PrintLn 'variables in the ring R should be at least as large as the number';
  PrintLn 'of generators of M0, and they should all have the same weight.';
End;

----------------------------------------------------
--
Define LBundleLim(M,Shi)
  MEMORY.RiEnv:=RingEnv();
  GB.Start_GBasis(M);
  GB.Complete(M);
  M0:=$.KBasis(Module(M.GBasis),Indets(),[0+Shi,0+Shi]);
  M0:=Module(M0);
  NR:=Len(M0);
  M:=Module(M);
  PrintLn'Number of sections of the line bundle or sheaf :',NR;
  LBundRi::=Q[x[1..NR]];
  Using LBundRi Do Erg:=$.PBundle(MEMORY.RiEnv,M,M0) End;
Return Erg
End;

Define Help_LBundleLim()
  PrintLn 'LBundleLim ( M : Module , I : Int ) : Module';
  PrintLn 'Find the equations of the image to projective space defined by';
  PrintLn 'the line bundle which is the sheafification of the module M,';
  PrintLn 'on the projective scheme X = Supp(M).  The variables of this';
  PrintLn 'new projective space are named x[0], ..., x[r]. You must tell';
  PrintLn 'the program, if the module M has negativ shifts (e.g. I=2 for';
  PrintLn 'shifts(-2,...,-2). (besser machen)';
End;

----------------------------------------------------
--
Define CotanBihom(X,Y,I)
  Vars:=Transposed($.DSum(Mat(X),Mat(Y)));
  E1:=Mat(Syz(Module(I)));
  J:=$.Concat($.Jacobian2(I.Gens,X),$.Jacobian2(I.Gens,Y));
  M:=$.FetchQring(E1,I);
  J:=$.FetchQring(J,I);
  Vars:=$.FetchQring(Vars,I);
  Vars2:=$.Quotkern(Vars,I);
  Vars3:=$.Quotkern(Vars2,I);
  V2:=$.Lift_Std2(Vars2);
  K:=$.Lift(V2,J);
  Erg:=K+Module(Mat(Vars3));
  Erg:=$.Tensor($.Transposed(Mat(Erg)),Mat(I.Gens));
  Erg:=Module($.Transposed(Erg));
Return Erg
End;

Define Help_CotanBihom()
  PrintLn 'CotanBihom ( L1 : List , L2 : List , I : Ideal) : Module';
  PrintLn 'This script computes the graded module representing the cotangent';
  PrintLn 'sheaf of the variety defined by the given bihomogeneous ideal I';
  PrintLn 'in Pr x Ps. The first list must contain r+1 variables and the';
  PrintLn 'second must contain s+1 variables of the current ring which are';
  PrintLn 'used for Pr resp. Ps.';
End;

-----------------------------------------------------
--
--Hier nur Ausgabe (I/I^2)^* Modul ueber dem aktuellen Polynomring

Define Normal_Sheaf(I)
  I:=Ideal(GBasis(I));
  SI:=Syz(I);
  TI:=Mat(SI);
  Ma:=$.Tensor(Mat(I.Gens),TI);
  Erg:=$.Transposed(Ma);
  Erg:=$.Syz1(Module(Transposed(Ma)),$.NCols(TI));
  Erg:=$.Transposed(Mat(Interreduced(Erg.Gens)));
  Ma:=$.Tensor(Mat(I.Gens),Erg);
  Erg:=$.Syz1(Module(Transposed(Ma)),$.NCols(Erg));
Return Erg
End;

Define Help_Normal_Sheaf()
  PrintLn 'Normal_Sheaf ( Id : Ideal ) : Module';
  PrintLn 'Computes a presentation for N = (Id/Id^2)^*, the normal sheaf,';
  PrintLn 'as a module over the ambient ring.';
End;

-------------------------------------------------

Max(M):=Max([Deg(M.Gens[I]) | I In 1..Len(M)]);
Min(M):=Min([Deg(M.Gens[I]) | I In 1..Len(M)]);

-----------------------------------------------------
--
Define RegularSequence(I)
  I:=Minimalized(I);
  CDim:=$.Codim(I);
  L:=$.SortDeg(I.Gens);
  Erg:=[L[1]];
  N:=1;
  Z:=1;
  J:=Ideal(Erg);
  While N<CDim Do
    N:=N+1;
    Z:=Z+1;
    He:=J.Gens;
    Append(He,L[Z]);
    J:=Ideal(He);
    Vgl:=$.Codim(J);
    While Vgl<>N Do
      Z:=Z+1;
      He:=J.Gens;
      Append(He,L[Z]);
      J:=Ideal(He);
      Vgl:=$.Codim(J);
    End;
    JN:=Ideal(Last(J.Gens,Z-N+1));
    JMax:=MC.Max(JN);
    While $.Codim(Ideal(Erg))<N Do
      FN:=$.RandoMel(JN,JMax);
      Erg:=Concat(Erg,FN.Gens[1]);
    End;
  End;
  E1:=Ideal(Erg);
Return Erg
End;

Define Help_RegularSequence()
  PrintLn 'RegularSequence ( Id : Ideal ) : List';
  PrintLn 'Find a regular sequence in the ideal Id.';
End;

-----------------------------------------------------

Define RegularSequence1(I)
  CDim:=$.Codim(I);
  L:=$.SortDeg(I.Gens);
  Erg:=[L[1]];
  Remove(L,1);
  N:=1;
  While N<CDim Do
    Zer:=Ideal(0);
    I1:=Ideal(L);
    I1:=$.FetchQring(I1,Ideal(Erg));
    N:=N+1;
    Z:=1;
    J:=Ideal(L[Z]);
    He:=$.Colone(Zer,J,Ideal(Erg));
    Bed:=Not(He=Ideal());
    While Bed Do
      Z:=Z+1;
      He:=J.Gens;
      Append(He,L[Z]);
      J:=Ideal(He);
      He:=$.Colone(Zer,J,Ideal(Erg));
      Bed:=Not(He=Ideal());
      If Z=Len(L) Then Bed:=FALSE End;
    End;
    JMin:=MC.Max(J);
    FN:=$.RandoMel(J,JMin);
    Remove(L,1);
    Erg:=Concat(Erg,FN.Gens[1]);
  End;
Return Erg
End;

Define Help_RegularSequence1()
  PrintLn 'RegularSequence1 ( Id : Ideal ) : List';
  PrintLn 'Find a regular sequence in the ideal Id.';
End;

-----------------------------------------------------
--
Define L_Dual0(N)
  I:=Indets();
  Erg1:=NewList(Len(I));
  Erg2:=1;
  For J:=1 To Len(I) Do
    Erg1[J]:=I[J]^N;
    Erg2:=Erg2*I[J]^(N-1);
  End;
Return [Ideal(Erg1),Erg2]
End;

Define Help_L_Dual0()
  PrintLn 'L_Dual0 ( N : Int ) : List';
  PrintLn 'Expected a positive integer N. Returns the list [Indets()^N,Prod]';
  PrintLn 'where Prod is the product of all indeterminantes ^(N-1).';
End;

------------------------------------------------
--
Define L_Min0(M)
  ISyz:=Syz(M);
  NV:=NumIndets();
  F:=NewList(NV,0);
  F[1]:=1;
  For I:=1 To NV Do F[I]:=[Indet(I),F[I]] End;
  Ibar:=Subst(ISyz,F);
  Ker:=$.Complement(Module(Ibar));
  Erg:=Mat(Ker)*Mat(M);
  Erg:=Module(Erg);
  If NumComps(Erg)=1 Then Return Ideal(Erg) End;
Return Erg
End;

Define Help_L_Min0()
  PrintLn 'L_Min0 ( I : Ideal ) : Ideal';
  PrintLn 'Find a minimal geneating set, J1,  for a Ideal I1 over the';
  PrintLn 'localization R of a polynomial ring at the origin. I is a';
  PrintLn 'homogeneous ideal over a ring R[t], and I1 is obtained from I by'; 
  PrintLn 'setting "t" to one. J1 is obtained similarly from J, which is the';
  PrintLn 'computed ideal.';
End;

------------------------------------------------
--fuer Ideale
Define L_Min1(...)
  If Len(ARGV)=2 Then J:=ARGV[2] End;
  M:=ARGV[1];
  NR:=Len(M);
  M:=Mat(M.Gens);
  NI:=NumIndets();
  Va:=Indets();
  Va[1]:=1;
  M1:=$.Outer(Mat(Va),M);
  If Len(ARGV)=1 Then N:=$.Syz1(Ideal(M1[1]),NR) 
    Else N:=$.Syz1(Ideal(M1[1]),NR,J) End;
  Va[1]:=[Indet(1),1];
  For I:=2 To NI Do
    Va[I]:=[Va[I],0];
  End;
  N:=Mat(N);
  N0:=Subst(N,Va);
  N0:=$.Compress($.Transposed(N0));
  N0:=Module(N0);
  If N0=Module() Then NS:=Ideal(1) Else NS:=Syz(N0) End;
  Erg:=Mat(M)*$.Transposed(Mat(NS));
Return Ideal(Erg[1])
End;

Define Help_L_Min1()
  PrintLn 'L_Min1 ( I : Ideal , [K : Ideal] ) : Ideal';
  PrintLn 'Find a minimal geneating set, J1,  for a Ideal I1 over the';
  PrintLn 'localization R of a polynomial ring at the origin. I is a';
  PrintLn 'homogeneous ideal over a ring R[t], and I1 is obtained from I by'; 
  PrintLn 'setting "t" to one. J1 is obtained similarly from J, which is the';
  PrintLn 'computed ideal. If a second ideal is given, it says that we work';
  PrintLn 'in the quotient ring R/K.';
End;

------------------------------------------------
--geht nur fuer Ideale
Define L_Min2(M)
  MEMORY.NI:=NumIndets();
  HomogRi::=CoeffRing[t,x[1..MEMORY.NI]];
  Inde:=Indets();
  Insert(Inde,1,1);
  F1:=RMap(Inde);
  Using HomogRi Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using HomogRi Do L[I]:=x[I] End End;
  Using HomogRi Do
    F:=RMap(L);
    M:=Image(M,F);
    L:=M.Gens;
    For I:=1 To Len(M) Do L[I]:=Homogenized(t,L[I]) End;
    M:=Ideal(L);
    M:=$.L_Min0(M);
  End;
  Erg:=Image(M,F1);
  Destroy HomogRi;
Return Erg
End;

Define Help_L_Min2()
  PrintLn 'L_Min2 ( I : Ideal ) : Ideal';
  PrintLn 'Find a minimal generating set J for the submodule I over';
  PrintLn 'localization P at the homogeneous maximal ideal of the base ring';
  PrintLn 'of I.';
End;

----------------------------------------------------

Define L_Min(M)
  MT:=Type(M);
  M1:=Syz(M);
  L:=NewList(NumIndets(),0);
  L:=RMap(L);
  H:=Image(M1,L);
  H1:=$.Complement(H);
  He:=NewList(Len(H1));
  For J:=1 To Len(H1) Do 
    For K:=1 To Len(H1.Gens[J]) Do
      If He[J]=Null Then He[J]:=H1.Gens[J,K]*M.Gens[K] 
      Else He[J]:=He[J]+H1.Gens[J,K]*M.Gens[K] End;
   End;
  End;
  Erg:=Cast(He,MT);
Return Erg
End;

Define Help_L_Min()
  PrintLn 'L_Min ( M : Module/Ideal ) : Module/Ideal';
  PrintLn 'Find a minimal generating set J for the submodule M over';
  PrintLn 'localization P at the homogeneous maximal ideal of the base ring';
  PrintLn 'of M.';
End;

----------------------------------------------------
--
Define L_TangentCone(M)
  MEMORY.NI:=NumIndets();
  OrdNeu:=$.DSum(Mat[[1]],Ord());
  HomogRi::=CoeffRing[t,x[1..MEMORY.NI]],Ord(OrdNeu);
  Inde:=Indets();
  Insert(Inde,1,1);
  F1:=RMap(Inde);
  Using HomogRi Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using HomogRi Do L[I]:=x[I] End End;
  Using HomogRi Do
    F:=RMap(L);
    M:=Image(M,F);
    I:=Homogenized(t,M);
    J:=GBasis(I);
    J:=Ideal(J);
  End;
  J:=Image(J,F1);
  J:=J.Gens;
  L:=NewList(Len(J));
  For K:=1 To Len(J) Do
    J[K]:=Monomials(J[K]);
    $.DegSort(J[K]);
    Z:=1;
    L[K]:=J[K,Z];
    While Z<Len(J[K]) And (Deg(J[K,Z+1])=Deg(L[K])) Do 
      L[K]:=L[K]+J[K,Z+1];
      Z:=Z+1; 
    End;
  End;  
  J:=Ideal(L);
  Erg:=$.Stdpart(J);
  Destroy HomogRi;
Return Erg
End;

Define Help_L_TangentCone()
  PrintLn 'L_TangentCone ( I : Ideal ) : Ideal';
  PrintLn 'Compute the tangent cone, or the associated graded algebra, of a';
  PrintLn 'ring R/I, where R is the localization of a polynomial ring S at';
  PrintLn 'the origin (ie the localization at the homogeneous max. ideal).';
End;

----------------------------------------------------
--
Define L_FromDual(I)
  If Type(I)=POLY Then I:=Ideal(I) End;
  N:=Max([Deg(I.Gens[K]) | K In 1..Len(I.Gens)])+1;
  E1:=$.L_Dual0(N);
  J:=E1[1];
  Dual:=E1[2];
  II:=$.Contract(I,Ideal(Dual));
  II:=$.FetchQring(II,J);
  MEMORY.NI:=NumIndets();
  HomogRi::=CoeffRing[t,x[1..MEMORY.NI]];
  Inde:=Indets();
  Insert(Inde,1,1);
  F1:=RMap(Inde);
  Using HomogRi Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using HomogRi Do L[I]:=x[I] End End;
  Using HomogRi Do
    F:=RMap(L);
    J1:=Image(J,F);
    II:=Ideal(Module(Image(II,F)));
    L:=II.Gens;
    For I:=1 To Len(II) Do L[I]:=Homogenized(t,L[I]) End;
    II:=Module(L);
    Qu2:=$.Quotkern(II,J1);
    Qu2:=Module(Mat(Qu2));
    Qu2:=Interreduced(Qu2.Gens);
    Qu:=$.Stdpart(Qu2,[t]);
    Qu:=Ideal(Qu);
  End;
  Qu:=Image(Qu,F1);
  L:=Qu.Gens;
  L:=Concat(L,J.Gens);
  Destroy HomogRi;
  Erg:=$.L_Min(Ideal(L));
Return Erg
End;

Define Help_L_FromDual()
  PrintLn 'L_FromDual ( I : Ideal ) : Ideal';
  PrintLn 'Compute the ideal J which is dual to the inverse system I1.';
  PrintLn 'I1 dual polynomials of the 1xn matrix I.';
End;

------------------------------------------------
--
Define L_ToDual(I,N)
  E1:=$.L_Dual0(N);
  J:=E1[1];
  Dual:=E1[2];
  I:=$.FetchQring(I,J);
  MEMORY.NI:=NumIndets();
  HomogRi1::=CoeffRing[t,x[1..MEMORY.NI]];
  Inde:=Indets();
  Insert(Inde,1,1);
  F1:=RMap(Inde);
  Using HomogRi1 Do L:=NewList(MEMORY.NI) End;
  For I:=1 To MEMORY.NI Do Using HomogRi1 Do L[I]:=x[I] End End;
  Using HomogRi1 Do
    F:=RMap(L);
    J:=Image(J,F);
    I:=Image(I,F);
    L:=I.Gens;
    For I:=1 To Len(L) Do L[I]:=Homogenized(t,L[I]) End;
    M:=Module(L);
    Qu2:=$.Quotkern(M,J);
    Qu2:=Minimalized(Qu2);
    Q:=$.Stdpart(Qu2,[t]);
    QMin:=$.L_Min1(Q,J);
  End;
  QMin:=Image(QMin,F1);
  Destroy HomogRi1;
  Erg:=$.Contract(QMin,[Dual]);
  Erg:=Module(Erg);
Return Ideal(Erg)
End;

Define Help_L_ToDual()
  PrintLn 'L_ToDual ( N : Int , I : Ideal ) : Ideal';
  PrintLn 'Compute the dual socle of a zero dimensional ideal I over the';
  PrintLn 'localization of the base ring of I at the homogeneous maximal';
  PrintLn 'ideal. N must be an integer such that xi^N is in I, for each';
  PrintLn 'variable xi of the current ring.';
End;

------------------------------------------------
--
Define Macrep(D,N)
  L:=NewList(0);
  While Not(D<1 Or N<1) Do
    Wahr:=TRUE;
    B1:=0;
    I:=D;
    While Wahr Do
      B:=Bin(I,D);
      If B>N Then
        N:=N-B1;
        Append(L,[I-1,D]);
        D:=D-1;
        Wahr:=FALSE;
      End;
      I:=I+1;
      B1:=B;
    End;
  End;
Return L
End;

Define Help_Macrep()
  PrintLn 'Macrep ( I : Int , J : Int ) : List';
  PrintLn 'returns the Ith Macaulay representation of J; that is, returns,';
  PrintLn 'one by one, the integers kI > k{I-1} >  > k1 >= 1 (as long as'; 
  PrintLn 'ki >= i) such that';
  PrintLn '     J = kI_C_I + k{I-1}_C_{I-1} +...';
  PrintLn "where a_C_b denotes the binomial coeff 'a choose b'.";
  PrintLn 'The list contains all the tuples a_C_b.';
End;

------------------------------------------------

Define Reg(M)
  R:=Res(M);
  LR:=Len(R[2]);
  R:=Untagged(R);
  R:=R[2];
  For I:=1 To LR Do R[I]:=R[I,1] End;
  MaxDeg:=NewList(LR);
  For I:=1 To LR Do 
    M:=R[I];
    MaxDeg[I]:=[Deg(M.Gens[J]) | J In 1..Len(M.Gens)];
    MaxDeg[I]:=Max(MaxDeg[I]);
  End;  
  Regu:=[ 1-I+MaxDeg[I] | I In 1..LR];
Return Max(Regu)
End;

Define Help_Reg()
  PrintLn 'Reg ( M : Module ) : Int';
  PrintLn 'The function computes an free resolution of a homog. module M,';
  PrintLn 'The result is the smallest integer reg such that the kth syzygy';
  PrintLn 'of the image of M is generated in degree lower or equal k+reg.';
End;

------------------------------------------------

End; --Package

Alias   MC      := $cocoa/macaulay;

EOF