module SEGRE;

COMMENT

          Module SEGRE for the REDUCE package CALI
                             by
             R/"udiger Achilles and Davide Aliffi

                   Universit\`a di Bologna
                   Dipartimento di Matematica
                   Piazza di Porta S. Donato 5
                   I-40126 Bologna (Italy)
            achilles@dm.unibo.it, aliffi@dm.unibo.it


Please send all comments, bugs, hints, wishes, criticisms etc. to the
above email addresses.

If you use SEGRE or parts thereof in a project and/or publish results 
that were partly obtained using SEGRE, we ask you to cite SEGRE:

R.~Achilles and D.~Aliffi,
   {\it Segre}: A script for the REDUCE package CALI. Bologna, 1999-2001.
   Available at {\tt http://www.dm.unibo.it/\~{}achilles/segre/}.


Abstract:

This algebraic module extends (and needs) CALI [H.-G. Gr\"abe: 
CALI -- A REDUCE package for commutative algebra, Version 2.2.1 (1995).
Available through the REDUCE library {\tt redlib@rand.org}] and 
provides convenient procedures for calculations in multiplicity theory,
intersection theory, and singularity theory. Based on a procedure for
the computation of the leading coefficients of Hilbert polynomials of
multigraded rings, it contains procedures for the calculation of

1. mixed multiplicities,

2. Tworzewski's extended index of intersection
   [P.~Tworzewski: Intersection theory in complex analytic geometry.
   {\it Ann.\ Polon.\ Math.} {\bf 62} (1995), 177--191],

3. the multiplicity sequence or generalized Samuel multiplicity of
   Achilles-Manaresi
   [R.~Achilles and M.~Manaresi: Multiplicities of a bigraded ring and
   intersection theory. {\it Math.\ Ann.} {\bf 309} (1997), 573--591],

4. the Segre numbers of Gaffney-Gassler
   [T.~Gaffney and R.~Gassler: Segre numbers and hypersurface
   singularities. {\it J.~Algebraic Geom.}\/ {\bf 8} (1999), 695--736],

5. L\^e numbers (and, in particular, Milnor numbers)
   [D.~B.~Massey: {\it L\^e cycles and hypersurface singularities.}
   Lecture Notes Math.\ 1615, Springer-Verlag, Berlin-Heidelberg, 1995].

In fact, 5. is a special case of 4., and 2. and 4. are special cases of
3., see [R. Achilles and S. Rams: Intersection numbers, Segre numbers
and generalized Samuel multiplicities. Arch. Math. (Basel) 77 (2001), 
391-398.].

END COMMENT;

terpri(); write "SEGRE, 16-September-2001"; terpri();

algebraic;

symbolic procedure vars0 u;
% Vars([x,] n) returns {x0, ..., xn}, even if x has a value, 
% x='x by default.
  begin integer n; scalar v;
  if not memq(length u,'(1 2)) then 
  rederr "vars must have 1 or 2 arguments"
  else if length u = 1 then
    <<if not numberp (n:=reval car u) then typerr(n, "number");
       v:= for i:=0:n collect mkid('x,i)>>
  else
     <<if not numberp (n:=reval cadr u) then typerr(n, "number");
       v:= for i:=0:n collect mkid(car u,i)>>;
  return 'list . v;
end;

put('vars,'psopfn,'vars0)$

symbolic procedure mkidn0 u;
% new_mkid(x,n) returns xn, but nil in case of a naming clash.
  if length u neq 2 then rederr "new_mkid must have 2 arguments" 
    else if 
  mkid(reval car u, reval cadr u)=reval mkid(reval car u,reval cadr u)
    then mkid(reval car u, reval cadr u) else nil;

put('new_mkid,'psopfn,'mkidn0)$

procedure subvars(v,nv,ideal);
  sub(for i:=1:(length v) collect part(v,i)=part(nv,i), ideal);

procedure var(v,ideals,i);
% Returns the "variables" of the list v indexed by the digit i. If
% necessary, in order to avoid conflicts with parameters contained in
% the list ideals, other digits are inserted between the old name of
% the variable and i.
begin integer aux, i, j;
  j:=-1;
  repeat
    <<aux:=0; j:=j+1;
    for each item in v do if not new_mkid(item,j*10+i)
    then aux:=aux+1>>
  until
    aux=0 and sub(for each item in v collect new_mkid(item,j*10+i)=0,
    {v,ideals})={v,ideals};
  return for each item in v collect new_mkid(item,j*10+i)
end;

procedure newvars(v,ideals,n,i);
% Returns n new variables (that is, different from the ones in the list
% v and in the list ideals) ending with index i.
begin integer m, n, i; scalar w;
  m:=length v;
  w:=v;
  while length(w)<m+n do <<v:=var(w,ideals,i); w:=append(w,v)>>;
  return for k:=(m+1):(m+n) collect part(w,k);
end;

procedure multi(r,d);
% Returns the exponents (in lexicographical order) of all monomials of
% degree d in r variables.
if (r<1 and d=0) then {{}} else if (r<1 and d neq 0) then {} else
for i:=0:d join (for each item in multi(r-1,d-i) collect i.item);

symbolic procedure revmulti(r,d);
% Returns reverse multi(r,d).
if (r<1 and d=0) then {{}} else if (r<1 and d neq 0) then {} else
for i:=0:d join (for each x in revmulti(r-1,i) collect (d-i) cons x);

procedure hilbcoeff(gb,w,sumt);
% Returns the coefficients of the Hilbert polynomial of a
% multigraded ideal gb. w is a list of weight vectors that define
% the multidegrees of the variables, and sumt is a list of length(w)
% natural numbers specifying the desired sum transform.
begin integer r, d, aux;
  scalar vars, wh, numerator, numdiff, denominator, ideal, grad,
  gradout;
  r:=length(w);
  if r neq length sumt 
  then rederr "2nd and 3rd list not of same length";
  vars:=first getring();
  if length length gb = 1 then gb:=ideal2mat gb;
  setmodule(ideal,gb);
  gb:=gbasis ideal;
  setmodule(ideal,gb);
  setgbasis ideal;
  d:=(dim ideal)-r+(for each item in sumt sum item);
  wh:=weightedhilbertseries(gb,w);
  denominator:=den(wh);
  numerator:=num(wh)*sub(for i:=1:r collect part(vars,i)=0,
  denominator);
  gradout:={};
 for k:=0:d do begin
    grad:={};
    for each item in multi(r,k) do begin
      numdiff:=numerator;
      for i:=1:r do
      if (aux:=deg(denominator,part(vars,i))-1+part(sumt,i)
      -part(item,i)) < 0 then numdiff:=0 else
      numdiff:=(-1)**aux*sub(part(vars,i)=1,
      df(numdiff,part(vars,i),aux)/factorial aux);
      grad:=append(grad,{numdiff});
    end;
  if r>2 then triprint(reverse grad,r,k);
  gradout:=grad . gradout;
 end;
  return gradout;
end;

procedure degrees(gb,w,sumt); 
if length w = 1 then first first hilbcoeff(gb,w,sumt)
else first hilbcoeff(gb,w,sumt);

procedure degs(gb,w); degrees(gb,
blockorder(first getring(),w), for each x in w collect 1);

procedure hilbpoly(gb,w,sumt);
begin integer r, d, aux;
  scalar vars, wh, numerator, numdiff, denominator, ideal, poly;
  r:=length(w);
  vars:=first getring();
  setideal(ideal,gb);
  gb:=gbasis ideal;
  setideal(ideal,gb);
  setgbasis ideal;
  d:=(dim ideal)-r+(for each item in sumt sum item);
  wh:=weightedhilbertseries(gb,w);
  denominator:=den(wh);
  numerator:=num(wh)*sub(for i:=1:r collect part(vars,i)=0,
  denominator);
  poly:=0;
   for k:=0:d do begin
    for each m in multi(r,k) do begin
     numdiff:=numerator;
     for i:=1:r do
     if (aux:=deg(denominator,part(vars,i))-1+part(sumt,i)
     -part(m,i)) < 0 then numdiff:=0 else
     numdiff:=(-1)**aux*bin(part(vars,i)+part(m,i),part(m,i))*
     sub(part(vars,i)=1,df(numdiff,part(vars,i),aux)/factorial aux);
     poly:=numdiff+poly;
    end;
   end;
  return poly
end;

procedure bin(m,n); for i:=1:n product (m-i+1)/i;
% Returns the binomial coefficient m choose n.

symbolic procedure wordlength(word); length(explode word);
symbolic procedure followline(n); <<terpri()$; spaces(n)>>$;
% To go to a new line at the position given by the integer n.
flag ('(wordlength, followline, prin2, spaces),'opfn);

procedure tprint(l,v,d);
% Used in triprint to print the output of degrees in triangular form.                                            
  begin integer c,m,s;
  m:=length l;    
  if m neq 0 then m:=wordlength max l;
%  m:=0;
%  for each x in l do if wordlength x > m then m:=wordlength x;
  s:=2 - remainder(m,2); 
  c:=(m-s)/2;
    for i:=1:(d+1) do begin
       followline((2*d+1-i)*m+c*i);
       for j:= (i-1)*i/2 +1+ v : i*(i+1)/2 + v do
       <<spaces(m-wordlength part(l,j)); prin2 part(l,j);spaces s>>$
    end;
  followline(0);
end;

procedure split(r,d); % Used in triprint.
  if (r=3 or d=0) then {{3,d}} else
  for i:=0:d join (for each x in split(r-1,i) collect x); 

procedure triprint(l,r,d);
% To print the output of degrees in triangular form.
   begin scalar v;
   v:=0;
   for each x in split(r,d) do 
   <<tprint(l,v,second x); v:=v+length multi(first x,second x)>>;
end;

procedure int_ncone(ideals);
% Ideals is a list of not more than 5 ideals of proj. varieties to be
% intersected. Returns the normal cone of the intersection with respect
% to the diagonal embedding.
begin integer r, n;
   scalar diag, va, varsnew, varscone, p, gr, grsub, ring;
   if length ideals > 5 then 
   rederr "int_cone has at most 5 arguments";
   r:=length(ideals);
   ring:=getring();
   va:=first ring;
   n:=length(va);
   varsnew:= append(va, for i:=2:r join var(va,ideals,11-i));
   varscone:= for i:=2:r join var(va,ideals,i);
   diag:= for i:=2:r join
 (for k:=1:n collect part(va,k)-part(varsnew,(i-1)*n+k));
   p:= for i:=2:r join sub(for k:=1:n collect
   part(va,k)=part(varsnew,(i-1)*n+k),part(ideals,i));
   p:=append(first ideals,p);
   setring(varsnew, {}, lex);
   gr:=assgrad(p,diag,varscone);
   grsub:=sub(for i:=2:r join
 (for k:=1:n collect part(varsnew,(i-1)*n+k)=part(va,k)),gr);
   setring(append(va,varscone),{},lex);
   return interreduce(grsub)
end;

procedure is_hom(vars,ideal);
% Returns 1 if the polynomials in the list ideal are homogeneous
% with respect to the variables in the list vars, otherwise 0.
begin integer u, k; scalar vars, a, s;
  a:=first vars;
  k:=1;
  u:=1;
  while (u=1 and k<length(ideal)+1) do begin
    s:=sub(for each item in vars collect item=a,part(ideal,k));
    s:=s/a**deg(s,a);
    if sub(a=1,s) neq s then u:=u-1;
    k:=k+1 end;
  return u;
end;

procedure int_segre(ideals);
% Ideals is a list of no more than 5 ideals of varieties to be
% intersected. Returns the Segre multiplicities (multiplicity sequence,
% extended index of intersection) of the intersection with respect to
% the diagonal embedding, ordered by dimension.
begin integer n, r; scalar ring, s, gr, bigrad, va, nc;
   if length ideals > 5 then 
   rederr "int_segre has at most 5 arguments";
   r:=length(ideals);
   ring:=getring();
   va:=first ring;
   n:=length(va);
   nc:=int_ncone(ideals);
   if is_hom(va,nc) then
 s:= degs(nc,{n,(r-1)*n})
   else
 begin %write "inhomogeneous";
       gr:=assgrad(nc,va,var(va,ideals,1));
       bigrad:=sub((for each item in va collect item=0),gr);
       setring(for i:=1:r join var(va,ideals,i),{},third ring);
       s:=degs(bigrad,{n,(r-1)*n})
    end;
   setring ring;
   return s
end;

procedure segre(p,i);
% Segre numbers of the ideal i in S/p ordered by dimension.
begin integer n, n2; scalar ring, s, vars, v2, v3, ncone, gr, bigrad;
  ring:=getring();
  vars:=first ring;
  n:=length(vars);
  i:=interreduce i;
  n2:=length(i);
  v2:=newvars(vars,{p,i},n2,2);
  v3:=newvars(vars,{p,i},n,3);
  ncone:=assgrad(p,i,v2);
  gr:=assgrad(ncone,vars,v3);
  bigrad:=sub(for each item in vars collect item=0,gr);
  setring(append(v3,v2),{},third ring);
%  s:=hilbcoeff(bigrad,blockorder(first getring(),{n,n2}),{1,1});
  s:=degs(bigrad,{n,n2});
  setring ring;
  return s;
end;

procedure samuelmult(p,i); first segre(p,i);
% Samuel's multiplicity of i in S/p. If i is not m-primary, then
% the j-multiplicity is returned.

procedure segremax(p,i); segre(p,idealprod(i,first getring()));
% Segre numbers of the ideal i in S/p multiplied by the maximal ideal.

procedure le(h);
% (Generic) L\^e numbers of the polynomial function h, ordered by
% dimension.
  begin scalar jacobian;
  jacobian:=for each var in first(getring()) collect df(h,var);
% write mixed({0},first getring(),jacobian);
  return segre({0},jacobian)
end;

procedure jac(m,c);
% Returns the Jacobian ideal of the variety of codimension c 
% defined by the list of polynomials m. Variables are taken from 
% the current ring.
interreduce mat2list minors(matjac(m,first getring()),c);

procedure mixed(p,id,j);
% Mixed multiplicities e_k(id|j) for arbitrary ideals id and j in R=S/p.
begin integer n, n2, n3, d;
  scalar ring, vars, v1, v2, v3, bl, gr, gr2, trigrad, dd, mm,
  pideal, m, pj;
  ring:=getring();
  vars:=first ring;
  setideal(pideal,p);
  d:=dim pideal;
  setideal(m,vars);
  if submodulep(p,m)=no then rederr "ring = 0"; 
  id:=interreduce id;
  j:=interreduce j; 
  n3:=length id;
  n2:=length j;
  n:=length vars;
  v1:=newvars(vars,{p,j,id},n,1);
  v2:=newvars(vars,{p,j,id},n2,2);
  v3:=newvars(vars,{p,j,id},n3,3);
  bl:=blowup(p,j,v2);
  gr:=assgrad(bl,id,v3);
  gr2:=assgrad(gr,vars,v1);
  trigrad:=sub((for each item in vars collect item=0),gr2);
  setring(append(append(v1,v3),v2),{},lex);
  dd:=degs(trigrad,{n,n3,n2});
  mm:=for i:=d+1 step -1 until 1 collect part(dd,i);
  setring ring;
  setideal(pj,append(p,j));
  if dim(pj)=0 then return part(mm,d+1):=samuelmult(p,j) else
  return mm;
end;

procedure segrenew(p,id,j);
% Segre numbers of j in R=S/p with respect to an ideal id such that
% id + j is m-primary.
begin integer n, n2, n3, d;
  scalar ring, vars, v1, v2, v3, bl, gr, gr2, trigrad, dd, mm,
  pideal;
  ring:=getring();
  setideal(pideal,p);
  d:=dim pideal;
  vars:=first ring;
  id:=interreduce id;
  j:=interreduce j;
  n3:=length id;
  n2:=length j;
  n:=length vars;
  v1:=newvars(vars,{p,j,id},n,1);
  v2:=newvars(vars,{p,j,id},n2,2);
  v3:=newvars(vars,{p,j,id},n3,3);
  bl:=assgrad(p,j,v2);
  gr:=assgrad(bl,id,v3);
  gr2:=assgrad(gr,vars,v1);
  trigrad:=sub((for each item in vars collect item=0),gr2);
  setring(append(append(v1,v3),v2),{},lex);
  dd:=degs(trigrad,{n,n3,n2});
  mm:=for i:=1:(d+1) collect part(dd,i);
  setring ring;
  return mm
end;

procedure saveprimes(pd,p);
% Saves the prime ideals of a primary decomposition pd together with
% its base ring on external files p1, p2, ... in the working directory
% for later use as input in further calulations by saying
% "setideal(name_ideal,initmat p1)$".
for i:=1:length(pd) do <<savemat(second part(pd,i),mkid(p,i))>>;

procedure saveprimaries(pd,q);
% Saves the primary ideals of a primary decomposition pd together with
% its base ring on external files q1, q2, ... in the working directory
% for later use as input in further calculations by saying
% "setideal(name_ideal,initmat q1)$".
for i:=1:length(pd) do <<savemat(first part(pd,i),mkid(q,i))>>;

put('veronese,'psopfn,'veronese0)$
% Veronese(r, d [, pr, x]) returns the ideal of the image of the 
% veronese map of degree d from projective r-space to projective
% n-space; x is the name root of the variables which is 'x by default;
% If pr is a list of integers (empty by default) from {0,1,...,n}, then
% the ideal of the projection of the Veronese variety from the subspace
% {x_i=0| i NOT element of pr} to the complementary projective 
% (n-#pr)-space is returned. 
procedure ver(r,d,pr,vx);
  begin integer m;
  scalar ind, mu, s, v, vs, ver;
  mu:=multi(r+1,d);
  m:=length(mu)-1;
  ind:=for i:=0:m collect i;
  for each item in pr do
  ind:=for each x in ind join if x neq item then {x} else {};
  ver:=for each i in ind collect for k:=0:r 
  product mkid(s,k)**part(mu,m+1-i,k+1);
  vs:=vars(s,r);
  setring(append(vs,vx),{},lex);
  v:=eliminate(for i:=1:length(ind) collect part(vx,i)-part(ver,i),vs);
  setring(vx,{},lex);
  return v
end;

symbolic procedure veronese0 u;
  begin integer i, j, r, d, m, n;
  scalar x, pr, ind, mu, vx, ver;
  if not memq(length u,'(2 3 4)) then 
  rederr "veronese must have 2, 3 or 4 arguments"
  else if length u = 2 then 
  <<pr:='list . {}; x:='x>> else if length u = 4
  then <<pr:=caddr u; x:=cadddr u>> else
  if listp caddr u then <<pr:=caddr u; x:='x>> else 
  <<pr:='list . {}; x:=caddr u>>;
  r:=car u;
  d:=cadr u;
  mu:=multi(r+1,d);
  m:=length(mu)-2;
  ind:=for i:=0:m collect i;
  for each item in pr do
  ind:=for each x in ind join if x neq item then {x} else {};
  n:=length(ind)-1;
  while i<n+1 and mkid(x,n-i)=reval mkid(x,n-i) do 
  <<vx:=mkid(x,n-i) cons vx; i:=i+1>>;
  if (j:=length vx)<n+1 then return write 
  "***** variable naming clash: ", mkid(x,n-j), " = ", 
  reval mkid(x,n-j);
  vx:='list . vx;
  return ver(r,d,pr,vx)
end;

put('grassmann,'psopfn,'grass0)$
% Grassmann(k, n [,x]) returns the ideal of the Grassmannian of
% k-planes in projective n-space under the Pluecker embedding,
% where x is the name root of the variables x0, x1, ...
% which is 'x by default.

symbolic procedure grass0 u;
  begin integer i, j, k, l, n; scalar x, vx;
  if not memq(length u,'(2 3)) then 
  rederr "grassmann must have 2 or 3 arguments"
  else if length u = 2 then x:='x else x:=caddr u;
  k:=car u;
  n:=cadr u;
  l:=factorial(n+1)/factorial(k+1)/factorial(n-k);
  while i<l and mkid(x,l-1-i)=reval mkid(x,l-1-i) do 
  <<vx:=mkid(x,l-1-i) cons vx; i:=i+1>>;
  if (j:=length vx)<l then return write 
  "***** variable naming clash: ", mkid(x,l-1-j), " = ", 
  reval mkid(x,l-1-j);
  vx:='list . vx;
  return grass(k,n,vx);
end;

procedure grass(k,n,vx);
  begin integer l; scalar pf, s, vs, gr;
  matrix matrix!=grass(k+1,n+1);
   for i:=1:(k+1) do
     for j:=1:(n+1) do
   matrix!=grass(i,j):=mkid(s,j+(i-1)*(n+1));
  vs:=rest vars(s,(k+1)*(n+1));
  setring(vs,{},lex);
  pf:=ideal_of_minors(matrix!=grass,k+1);
  setring(append(vs,vx),{},lex);
  gr:=eliminate(for i:=1:length(vx) collect part(vx,i)-part(pf,i),vs);
  setring(vx,{},lex);
  return gr;
end;

procedure coef(f,v,ex);
% Returns the coefficient of the monomial v1^e1*v2^e2*...*vn^en
% in f, where f is a polynomial in the variables v = {v1,v2,...,vn}
% and ex = {e1,e2,...,en}. 
  if length v=1 then coeffn(f, first v, first ex) else
  coef(coeffn(f,first v, first ex), rest v,rest ex);

procedure totdeg(f,v);
% Returns the total degree of a polynomial f in the variables v.
  if length v=1 then deg(f,first v) else max(for i:=0:deg(f,first v) 
  collect i+totdeg(coeffn(f,first v,i),rest v));

procedure lcmult(p);
% Returns the least common multiple of the polynomials in the list p.
  if length p=1 then first p else
  lcmult(lcm(first p, second p) cons rest rest p);

procedure bavula(id);
% Returns the correct degree of the ideal id also if the degree of
% the variables (defined by the ecart vector) is not necessarily one.
begin scalar x, hs, ideal;
  x:=first first getring();
  setideal(ideal,id);
  hs:=hilbertseries ideal;
  while sub({x=1},den hs)=0 do hs:=hs*(1-x);
  return lcmult(part(getring(),4))*sub({x=1},hs);
end;

procedure ljoin(a,b);
% Returns the ideal of the limit of join variety (or relative tangent
% cone) at 0 of two varieties defined by the ideals a and b. If a and
% b are homogeneous, this is the ideal of the embedded join the 
% projective varieties defined by them, and if a = b then this is
% the ideal of the secant variety of the projective variety defined
% by a.
  begin integer n;
  scalar r, v;
  r:=getring();
  v:=first r;
  n:=length v;
  a:=int_ncone{a,b};
  b:=for i:=1:n join {part(first getring(),n+i)=part(v,i),part(v,i)=0};
  a:=sub(b,a);
  setring r;
  return interreduce a;
end;

symbolic procedure intf!=resolve m;
% This is a corrected version of the CALI-procedure intf!=resolve.
  begin scalar c,c1,d;
%  intf_test m; 
  if (length m neq 1 and length m neq 2) or (not idp car m) 
  then typerr(m,"identifier");
  if length m=2 then d:=reval cadr m else d:=10;
  m:=car m; c1:=intf_get m;
  if ((c:=get(m,'resolution)) and (car c >= d)) then
        return makelist for each x in cdr c collect dpmat_2a x;
  c:=Resolve!*(c1,d);
  put(m,'resolution,d.c);
  if not get(m,'syzygies) then put(m,'syzygies,cadr c);
  return makelist for each x in c collect dpmat_2a x;
  end;

symbolic operator submat;
symbolic procedure submat(m,x,y);                                        
  'mat . for each a in cdr x collect for each b in cdr y collect 
  nth(nth(cdr m,a),b);
   
procedure modulo(m,n);
begin scalar mn;
  if length length m = 1 then m:=ideal2mat m;
  if length length n = 1 then n:=ideal2mat n;
  setmodule(mn,matappend(m,n));
  n:=syzygies mn;
  return interreduce submat(n,for i:=1:first(length n) collect i,
  for i:=1:first(length m) collect i);
end;

procedure complement a;
begin scalar m, b, tpb, gb, id, nf, lg, g, firstrow;
  a:=sub(for each x in first getring() collect x=0,a);
  setmodule(m,tp a);
  b:=syzygies m;
  setdegrees {};
  setmodule(tpb,tp b);
  id:=idencoldegs tpb;
  lg:=lift_gbasis tpb; g:=first lg; gb:=second lg;
  if rank g = 0 then 
  return submat(gb,for i:=1:first length id collect i,
  for i:=1:second length b collect i) else
  nf:=second normalform(id,g);
  return -nf*gb;
end;

put('lift_gbasis,'psopfn,'int!=lift_gbasis);
symbolic procedure int!=lift_gbasis m;
  begin scalar c, c1;
  intf_test m; m:=car m; c1:=intf_get m;
  c:=groeb_stbasis(c1,t,t,nil);
  return 'list.{dpmat_2a first c,dpmat_2a second c};
end;

symbolic procedure idencoldegs!* m;
  dpmat_unit(dpmat_cols m,dpmat_coldegs m);

put('idencoldegs,'psopfn,'int!=idencoldegs);
symbolic procedure int!=idencoldegs m;
begin scalar c, c1;
  intf_test m; m:=car m; c1:=intf_get m;
  c:=idencoldegs!* c1;
  return dpmat_2a c;
end;

procedure prune m; modulo(complement m,m);

procedure hom(n,res,w,a,e);
% If res is a resolution of the graded R-module M,
% hom(n,res,w,a,e) returns the arithmetic degree arith-deg_{n-1}(M).
% In addition, if a is not 0, then Ann(Ext^n(M,R)) is written and
% if e is not 0, then Ext^n(M,R) is written.  w is a list of integer
% weight vectors assigned to the ring variables.
begin integer d;
  scalar ann, ext, homres, im, ker, sumt;
  if n+1>length res then 
    <<if a then write "Ann(Ext^",n,"(M,R)) = {1}"; 
      if e then write mat((1)); return 0>>;
  d:=length first getring();
  sumt:=for each item in w collect 1;
  setdegrees {};
  if n=0 then 
    <<
    setmodule(ext,first res);
    if dim ext = d then  
          <<if a then write "Ann(Ext^0(M,R)) = {0}";
            if e then write first res;
            return degrees(first res,w,sumt)>> 
    else <<if a then write "Ann(Ext^0(M,R)) = {1}";
           if e then write mat((1));
           return 0>>
    >>;
  if part(res,n+1)={} then setmodule(homres,mat((0))) else
  setmodule(homres,tp part(res,n+1));
  ker:=syzygies homres;
  im:=tp part(res,n);
  if a then <<
     ann:=modulequotient(interreduce im, ker); 
     write "Ann(Ext^",n,"(M,R)) = ", ann>>;
  ann:=prune modulo(ker,im);
  if e then write ann;
  setdegrees{};
  setmodule(ext,ann); 
  if dim ext = d-n then return degrees(ann,w,sumt) else return 0;
end;

put('adeg,'psopfn,'adeg!*);
symbolic procedure adeg!* m;
% Adeg(M [, w, a, e]) returns the list 
% {arith-deg_{-1} M = deg Ext^{n+1}(M,R), ..., 
% arith-deg_n M = deg Ext^0(M,R)} of arithmetic degrees of a graded
% ideal (or module) M in (or over) a polynomial ring R with n + 1 
% variables. In addition, if e and a are not 0, the Ext-modules and 
% their annihilators are written. The list w of weight vectors
% is for calculations in multigraded rings.
% By default w = {{1,1,...,1}}, a = 0, e = 0.
begin scalar w, a, e;
w:='list.{'list.for i:=1:length ring_names cali!=basering collect 1};
if length m = 1 then return a_deg(car m,w,a,e);
if listp cadr m and cadr m neq {} then <<w:=cadr m;
if length m > 2 then a:=caddr m;
if length m > 3 then e:=cadddr m>> else
<<if length m > 1 then a:=cadr m;
if length m > 2 then e:=caddr m>>;
return a_deg(car m,w,a,e)
end;

procedure a_deg(m,w,a,e);
begin scalar res, mo; integer d;
  d:=length first getring();
  if m ={} then m:=mat((0));
  if length length m = 1 then m:=ideal2mat m;
  setmodule(mo,m);
  res:=resolve(mo,d);
  return for i:=d step -1 until 0 collect hom(i,res,w,a,e);
end;

symbolic procedure help!* x;
begin integer i; scalar cali, segre, list;
cali:={

{'affine_monomial_curve, "affine_monomial_curve(l,vars)
$l$ is a list of integers, $vars$ a list of variable names of the
same length as $l$. The procedure sets the current base ring and
returns the defining ideal of the affine monomial curve with generic
point $(t^i\ :\ i\in l)$.
"},

{'affine_points, "affine_points m
$m$ is a matrix of domain elements (in algebraic prefix form)
with as many columns as the current base ring has ring variables. This
procedure returns the defining ideal of the collection of points in
affine space with coordinates given by the rows of $m$. Note that $m$
may contain parameters. In this case $k$ is treated as rational
function field.
"},

{'analytic_spread, "analytic_spread m
Computes the analytic spread of $m$.
"},

{'annihilator, "annihilator m
returns the annihilator of the dpmat $m\subseteq S^c$, i.e.\
$Ann\ S^c/M$.
"},

{'assgrad, "assgrad(M,N,vars)
Computes the associated graded ring $gr_R(N)$ over $R=S/M$, where 
$S$ is the current base ring. 
{\tt vars} is a list of new variable names, one for each generator
of $N$.  They are used to create a second ring $T$ to return an 
ideal $J$ such that $(S\oplus T)/J$ is the desired associated graded
ring over the new current base ring $S\oplus T$.
"},

{'bettiNumbers, "bettiNumbers gbr
extracts the list of Betti numbers from the resolution of $gbr$.
"},

{'blowup, "blowup(M,N,vars)
Computes the blow up ${\cal R}(N)$ of $N$ over the ring $R=S/M$,
where $S$ is the current base ring. {\tt vars} is a list of new
variable names, one for each generator of $N$. They are used to create
a second ring $T$ to return an ideal $J$ such that $(S\oplus T)/J$ is
the desired blowup ring over the new current base ring $S\oplus T$.
"},

{'change_termorder, "change_termorder(m,r)  and  change_termorder1(m,r)
Change the current ring to $r$ and compute the Groebner basis of
$m$ wrt.\ the new ring $r$ by the FGLM approach. The former uses
internally a precomputed border basis.
"},

{'change_termorder1, "change_termorder(m,r)  and  change_termorder1(m,r)
Change the current ring to $r$ and compute the Groebner basis of
$m$ wrt.\ the new ring $r$ by the FGLM approach. The former uses
internally a precomputed border basis.
"},

{'codim, "codim gb
returns the codimension of $S^c/gb$.
"},

{'degree, "degree gb
returns the multiplicity of $gb$ as the sum of the coefficients
of the (classical) Hilbert series numerator.
"},

{'degsfromresolution, "degsfromresolution gbr
returns the list of column degrees from the minimal resolution
of $gbr$.
"},

{'deleteunits, "deleteunits m
factors each basis element of the dpmat ideal $m$ and removes
factors that are polynomial units. Applies only to non Noetherian
term orders.
"},

{'dim, "dim gb
returns the dimension of $S^c/gb$.
"},

{'dimzerop, "dimzerop gb
tests whether $S^c/gb$ is zerodimensional.
"},

{'directsum, "directsum(m1,m2,...)
returns the direct sum of the modules $m1,m2,\ldots$, embedded
into the direct sum of the corresponding free modules.
"},

{'dpgcd, "dpgcd(f,g)
returns the gcd of two polynomials $f$ and $g$, computed by the
syzygy method.
"},

{'easydim, "easydim m   and   easyindepset m
If the given ideal or module is unmixed (e.g.\ prime) then all
maximal strongly independent sets are of equal size and one can look
for a maximal with respect to inclusion rather than size strongly
independent set. These procedures don't test the input for being a
Groebner basis or unmixed, but construct a maximal with respect to
inclusion independent set of the basic leading terms resp.\ detect
from this (an approximation for) the dimension.
"},

{'easyindepset, "easydim m   and   easyindepset m
If the given ideal or module is unmixed (e.g.\ prime) then all
maximal strongly independent sets are of equal size and one can look
for a maximal with respect to inclusion rather than size strongly
independent set. These procedures don't test the input for being a
Groebner basis or unmixed, but construct a maximal with respect to
inclusion independent set of the basic leading terms resp.\ detect
from this (an approximation for) the dimension.
"},

{'easyprimarydecomposition, "easyprimarydecomposition m
a short primary decomposition using ideal separation of isolated
primes of $m$, that yields true results only for modules without
embedded components. Returns a list of $\{component, associated\
prime\}$ pairs.
"},

{'eliminate, "eliminate(m,<variable list>)
computes the elimination ideal/module eliminating the variables
in the given variable list (a subset of the variables of the current
base ring). Changes temporarily the term order to degrevlex.
"},

{'eqhull, "eqhull m
returns the equidimensional hull of the dpmat $m$.
"},

{'extendedgroebfactor, "extendedgroebfactor(m,c) and extendedgroebfactor1(m,c)
return for a polynomial ideal $m$ and a list of (polynomial)
constraints $c$ a list of results $\{b_i,c_i,v_i\}$, where $b_i$ is
a triangular set wrt.\ the variables $v_i$ and $c_i$ is a list of
constraints, such that $Z(m,c) = \bigcup Z(b_i,c_i)$. 
For the first version the output may be not minimal.
The second version decides superfluous components already
during the algorithm.
"},

{'extendedgroebfactor1, "extendedgroebfactor(m,c) and extendedgroebfactor1(m,c)
return for a polynomial ideal $m$ and a list of (polynomial)
constraints $c$ a list of results $\{b_i,c_i,v_i\}$, where $b_i$ is
a triangular set wrt.\ the variables $v_i$ and $c_i$ is a list of
constraints, such that $Z(m,c) = \bigcup Z(b_i,c_i)$. 
For the first version the output may be not minimal.
The second version decides superfluous components already
during the algorithm.
"},

{'gbasis, "gbasis gb
returns the Groebner resp. local standard basis of $gb$.
"},

{'getkbase, "getkbase gb
returns a k-vector space basis of $S^c/gb$, consisting of module
terms, provided $gb$ is zerodimensional.
"},

{'getleadterms, "getleadterms gb
returns the dpmat of leading terms of a Groebner resp. local standard
basis of $gb$.
"},

{'GradedBettinumbers, "GradedBettinumbers gbr
extracts the list of degree lists of the free summands in a
minimal resolution of $gbr$.
"},

{'groebfactor, "groebfactor(m[,c])
returns for the dpmat ideal $m$ and an optional constraint list
$c$ a (reduced) list of dpmats such that the union of their zeroes is
exactly $Z(m,c)$. Factors all polynomials involved in the Groebner
algorithms of the partial results.
"},

{'HilbertSeries, "HilbertSeries gb
returns the Hilbert series of $gb$ with respect to the current
ecart vector.
"},

{'homstbasis, "homstbasis m
computes the standard basis of $m$ by Lazard's homogenization
approach.
"},

{'ideal2mat, "ideal2mat m
converts the ideal (=list of polynomials) $m$ into a column
vector.
"},

{'ideal_of_minors, "ideal_of_minors(mat,k)
computes the generators for the ideal of $k$-minors of the matrix
$mat$.
"},

{'ideal_of_pfaffians, "ideal_of_pfaffians(mat,k)
computes the generators for the ideal of the $2k$-pfaffians of
the skewsymmetric matrix $mat$.
"},

{'idealpower, "idealpower(m,n)
returns the interreduced basis of the ideal power $m^n$ with
respect to the integer $n\geq 0$.
"},

{'idealprod, "idealprod(m1,m2,...)
returns the interreduced basis of the ideal product 
\mbox{$m1\cdot m2\cdot \ldots$} of the ideals $m1,m2,\ldots$.
"},

{'idealquotient, "idealquotient(m1,m2)
returns the ideal quotient $m1:m2$ of the module $m1\subseteq
S^c$ by the ideal $m2$.
"},

{'idealsum, "idealsum(m1,m2,...)
returns the interreduced basis of the ideal sum $m1+m2+\ldots$.
"},

{'indepvarsets, "indepvarsets gb
returns the list of strongly independent sets of $gb$ with respect
to the current term order, see [Kredel-Weispfenning, J. Symb. Comp.
6 (1988), 231--247] for a definition in the case of ideals and 
[Graebe, J. Alg. Comb. 2 (1993), 137--145] for submodules of free
modules.
"},

{'initmat, "initmat(m,<file name>
initializes the dpmat $m$ together with its base ring, term order
and column degrees from a file.
"},

{'interreduce, "interreduce m
returns the interreduced module basis given by the rows of $m$,
i.e.\ a basis with pairwise indivisible leading terms.
"},

{'isolatedprimes, "isolatedprimes m
returns the list of isolated primes of the dpmat $m$, i.e.\ the
isolated primes of $Ann\ S^c/M$.
"},

{'isprime, "isprime gb
tests the ideal $gb$ to be prime.
"},

{'iszeroradical, "iszeroradical gb
tests the zerodimensional ideal $gb$ to be radical.
"},

{'lazystbasis, "lazystbasis m
computes the standard basis of $m$ by the lazy algorithm, see
e.g.\ \cite{MPT}.
"},

{'listgroebfactor, "listgroebfactor in
computes for the list $in$ of ideal bases a list $out$ of \gr
bases by the Groebner factorization method, such that 
$\bigcup_{m\in in}Z(m) = \bigcup_{m\in out}Z(m)$.
"},

{'mat2list, "mat2list m
converts the matrix $m$ into a list of its entries.
"},

{'matappend, "matappend(m1,m2,...)
collects the rows of the dpmats $m1,m2,\ldots $ to a common
matrix. $m1,m2,\ldots$ must be submodules of the same free module,
i.e.\ have equal column degrees (and size).
"},

{'mathomogenize, "mathomogenize(m,var)
returns the result obtained by homogenization of the rows of m
with respect to the variable {\tt var} and the current \ind{ecart
vector}.
\footnote{Dehomogenize with {\tt sub(z=1,m)} if $z$ is the
homogenizing variable.}
"},

{'matintersect, "matintersect(m1,m2,...)
returns the interreduced basis of the intersection $m1\bigcap
m2\bigcap \ldots$.
"},

{'matjac, "matjac(m,<variable list>)
returns the Jacobian matrix of the ideal m with respect to the 
supplied variable list.
"},

{'matqquot, "matqquot(m,f)
returns the stable quotient $m:(f)^\infty$ of the dpmat $m$ by
the polynomial $f\in S$.
"},

{'matquot, "matquot(m,f)
returns the quotient $m:(f)$ of the dpmat $m$ by the polynomial
$f\in S$.
"},

{'matstabquot, "matstabquot(m1,id)
returns the stable quotient $m1:id^\infty$ of the dpmat $m1$ by
the ideal $id$.
"},

{'matsum, "matsum(m1,m2,...)
returns the interreduced basis of the module sum $m1+m2+\ldots$
in a common free module.
"},

{'minimal_generators, "minimal_generators m
returns a set of minimal generators of the dpmat $m$.
"},

{'minors, "minors(m,b)
returns the matrix of minors of size $b\times b$ of the matrix $m$.
"},

{'a_mod_m, "a mod m
computes the (true) normal form(s), i.e.\ a standard quotient
representation, of $a$ modulo the dpmat $m$. $a$ may be either a
polynomial or a polynomial list ($c=0$) or a matrix ($c>0$) of the
correct number of columns.
"},

{'modequalp, "modequalp(gb1,gb2)
tests, whether $gb1$ and $gb2$ are equal (returns YES or NO).
"},

{'modulequotient, "modulequotient(m1,m2)
returns the module quotient $m1:m2$ of two dpmats $m1,m2$ in a
common free module.
"},

{'normalform, "normalform(m1,m2)
returns a list of three dpmats $\{m3,r,z\}$, where $m3$ is the
normalform of $m1$ modulo $m2$, $z$ a scalar matrix of polynomial
units (i.e.\ polynomials of degree 0 in the noetherian case and
polynomials with leading term of degree 0 in the tangent cone case),
and $r$ the relation matrix, such that \[m3=z*m1+r*m2.\]
"},

{'nzdp, "nzdp(f,m)
tests whether the dpoly $f$ is a non zero divisor on $coker\ m$.
"},

{'pfaffian, "pfaffian mat
returns the pfaffian of a skewsymmetric matrix $mat$.
"},

{'preimage, "preimage(m,map)
computes the preimage of the ideal $m$ under the given
polynomial map and sets the current base ring to the preimage ring.
"},

{'primarydecomposition, "primarydecomposition m
returns the primary decomposition of the dpmat $m$ as a list of
$\{component, associated\ prime\}$ pairs.
"},

{'proj_monomial_curve, "proj_monomial_curve(l,vars)
$l$ is a list of integers, $vars$ a list of variable names of the
same length as $l$. The procedure sets the current base ring and
returns the defining ideal of the projective monomial curve with
generic point \mbox{$(s^{d-i}\cdot t^i\ :\ i\in l)$} in $R$ where 
$d=max\{x\, :\, x\in l\}$.
"},

{'proj_points, "proj_points m
$m$ is a matrix of domain elements (in algebraic prefix form)
with as many columns as the current base ring has ring variables. This
procedure returns the defining ideal of the collection of points in
projective space with homogeneous coordinates given by the rows of
$m$. Note that $m$ may as for {\tt affine\_points} contain
parameters.
"},

{'radical, "radical m
returns the radical of the dpmat ideal $m$.
"},

{'random_linear_form, "random_linear_form(vars,bound)
returns a random linear form in the variables {\tt vars} with integer
coefficients less than the supplied {\tt bound}.
"},

{'ratpreimage, "ratpreimage(m,map)
computes the closure of the preimage of the ideal $m$ under the given
rational map and sets the current base ring to the preimage ring.
"},

{'resolve, "resolve(m[,d])
returns the first $d$ members of the minimal resolution of the
bounded identifier $m$ as a list of matrices. If the resolution has
less than $d$ non zero members, only those are collected. (Default:
$d=100$)
"},

{'savemat, "savemat(m,<file name>)
save the dpmat $m$ together with the settings of it base ring,
term order and column degrees to a file.
"},

{'setgbasis, "setgbasis m
declares the rows of the bounded identifier $m$ to be already a
Groebner resp. local standard basis thus avoiding a possibly time
consuming Groebner or standard basis computation.
"},

{'sieve, "sieve(m,<variable list>)
sieves out all base elements with leading terms having a factor
contained in the specified variable list (a subset of the variables
of the current base ring). Useful for elimination problems solved
``by hand''.
"},

{'singular_locus, "singular_locus(M,c)
returns the defining ideal of the singular locus of $Spec\ S/M$
where $M$ is an ideal of codimension $c$, adding to $M$ the generators
of the ideal of the $c$-minors of the Jacobian of $M$
"},

{'submodulep, "submodulep(m,gb)
tests, whether $m$ is a submodule of $gb$ (returns YES or NO).
"},

{'sym, "sym(M,vars)
Computes the symmetric algebra $Sym(M)$ where $M$ is an ideal defined
over the current base ring $S$. {\tt vars} is a list of new variable
names, one for each generator of $M$. They are used to create a second
ring $R$ to return an ideal $J$ such that $(S\oplus R)/J$ is the 
desired symmetric algebra over the new current base ring $S\oplus R$.
"},

{'symbolic_power, "symbolic_power(m,d)
returns the $d$th symbolic power of the prime dpmat ideal $m$.
"},

{'syzygies, "syzygies m
returns the first syzygy module of the bounded identifier $m$.
"},

{'tangentcone, "tangentcone gb
returns the tangent cone part, i.e.\ the homogeneous part of
highest degree with respect to the first degree vector of the term
order from the Groebner basis elements of the dpmat $gb$. The term
order must be a degree order.
"},

{'unmixedradical, "unmixedradical m
returns the unmixed radical of the dpmat ideal $m$.
"},

{'varopt, "varopt m
finds a heuristically optimal variable order, see \cite{BGK}. 
\[\tt vars:=varopt\ m;\ setring(vars,\{\},lex);\ setideal(m,m);\]
changes to the lexicographic term order with heuristically best
performance for a lexicographic \gr basis computation.
"},

{'WeightedHilbertSeries, "WeightedHilbertSeries(m,w)
returns the weighted Hilbert series of the dpmat $m$. Note that
$m$ is not a bounded identifier and hence not checked to be a
Groebner basis. $w$ is a list of integer weight vectors.
"},

{'zeroprimarydecomposition, "zeroprimarydecomposition m
returns the primary decomposition of the zerodimensional dpmat
$m$ as a list of $\{component, associated\ prime\}$ pairs.
"},

{'zeroprimes, "zeroprimes m
returns the list of primes of the zerodimensional dpmat $m$.
"},

{'zeroradical, "zeroradical gb
returns the radical of the zerodimensional ideal $gb$.
"},

{'zerosolve, "zerosolve m,   zerosolve1 m    and   zerosolve2 m
Returns for a zerodimensional ideal a list of triangular systems
that cover $Z(m)$. 
{\tt Zerosolve} needs a pure lex.\ term order for the ``fast'' turn
to lex.\ as described in [Moeller, J. AAECC 4 (1993), 217--230],
{\tt Zerosolve1} is the ``slow'' turn to lex.\ as described in
[H.-G.\ Graebe, Report Nr.~7, Univ. Leipzig, 1995],
and {\tt Zerosolve2} incorporated the FGLM term order change into
{\tt Zerosolve1}.
"},

{'zerosolve1, "zerosolve m,   zerosolve1 m    and   zerosolve2 m
Returns for a zerodimensional ideal a list of triangular systems
that cover $Z(m)$. 
{\tt Zerosolve} needs a pure lex.\ term order for the ``fast'' turn
to lex.\ as described in [Moeller, J. AAECC 4 (1993), 217--230],
{\tt Zerosolve1} is the ``slow'' turn to lex.\ as described in
[H.-G.\ Graebe, Report Nr.~7, Univ. Leipzig, 1995],
and {\tt Zerosolve2} incorporated the FGLM term order change into
{\tt Zerosolve1}.
"},

{'zerosolve2, "zerosolve m,   zerosolve1 m    and   zerosolve2 m
Returns for a zerodimensional ideal a list of triangular systems
that cover $Z(m)$. 
{\tt Zerosolve} needs a pure lex.\ term order for the ``fast'' turn
to lex.\ as described in [Moeller, J. AAECC 4 (1993), 217--230],
{\tt Zerosolve1} is the ``slow'' turn to lex.\ as described in
[H.-G.\ Graebe, Report Nr.~7, Univ. Leipzig, 1995],
and {\tt Zerosolve2} incorporated the FGLM term order change into
{\tt Zerosolve1}.
"}
};

segre:={

{'vars0, "symbolic procedure vars0(list of length < 3); 
needed for the algebraic procedure vars.
Example: symbolic vars0{'a,2} returns (list a0 a1 a2)
"},

{'vars, "Vars([x,] n) returns {x0, ..., xn}, even if x has a value; 
x='x by default.
"},

{'mkidn0, "symbolic procedure mkidn0(list of length 2); 
needed for the algebraic procedure new_mkid.
Example: symbolic mkidn0{'a,2} returns a2
"},

{'new_mkid, "new_mkid(x,n) returns xn, but nil in case of a naming clash.
"},

{'subvars, "subvars(v,nv,ideal) substitutes the 'variables' v by 
the 'new variables' nv in ideal (v,nv and ideal are lists).
"},

{'var, "var(v,ideals,i) returns the 'variables' of the list v indexed 
by the digit i. If necessary, in order to avoid conflicts with 
parameters contained in the list ideals, other digits are inserted 
between the old name of the variable and i.
"},

{'newvars, "newvars(v,ideals,n,i) returns n new variables (that is, different
from the ones in the lists v and ideals) ending with index i.
"},

{'multi, "multi(r,d) return the exponents (in lexicographical order) of all 
monomials of degree d in r variables.
"},

{'revmulti, "symbolic procedure revmulti(r,d) returns reverse multi(r,d).
"},

{'hilbcoeff, "hilbcoeff(gb,w,sumt);
Returns the coefficients of the Hilbert polynomial of a
multigraded ideal gb. w is a list of weight vectors which define
the multidegrees of the variables, and sumt is a list of length(w)
natural numbers specifying the desired sum transform.
"},

{'degrees, "degrees(gb,w,sumt) returns the leading coefficients of the 
Hilbert polynomial of a multigraded ideal gb. 
w is a list of weight vectors which define the multidegrees of 
the variables, and sumt is a list of length(w)
natural numbers specifying the desired sum transform.
"},

{'degs, "degs(gb,{p_1,...,p_m}) returns degrees(gb,w,{1,...,1});
p_1 + ... + p_m = # variables, all variables of degree 1 
and grouped as specified by the partition {p_1,...,p_m}.
"},

{'hilbpoly, "hilbpoly(gb,w,sumt);
returns the Hilbert polynomial of a multigraded ideal gb. 
w is a list of weight vectors which define the multidegrees of 
the variables, and sumt is a list of length(w)
natural numbers specifying the desired sum transform.
"},

{'bin, "bin(m,n) returns the binomial coefficient m choose n.
"},

{'int_ncone, "int_ncone(ideals);
ideals is a list of at most 5 ideals of proj. varieties to be
intersected. Returns the normal cone of the intersection with 
respect to the diagonal embedding.
"},

{'is_hom, "is_hom(vars,ideal) returns 1 if the polynomials in the list ideal
are homogeneous with respect to the variables in the list vars, 
otherwise 0.
"},

{'int_segre, "int_segre(ideals);
ideals is a list of no more than 5 ideals of varieties to be
intersected. Returns the Segre multiplicities (multiplicity 
sequence, extended index of intersection) of the intersection 
with respect to the diagonal embedding, ordered by dimension.
"},

{'segre, "segre(p,i);
Segre numbers of the ideal i in S/p ordered by dimension.
"},

{'samuelmult, "samuelmult(p,i);  Samuel's multiplicity of i in S/p. If i is 
not m-primary, then the j-multiplicity is returned.
"},

{'segremax, "segremax(p,i);  Segre numbers of the ideal i (in S/p)
multiplied by the maximal ideal . 
"},

{'le, "le(h);  (generic) L\^e numbers of the polynomial function h,
ordered by dimension;
"},

{'jac, "jac(m,c) returns the Jacobian ideal of the variety of 
codimension c defined by the list of polynomials m. 
Variables are taken from the current ring.
"},

{'mixed, "mixed(p,id,j);  mixed multiplicities e_k(id|j) for arbitrary 
ideals id and j in R=S/p.
"},

{'segrenew, "segrenew(p,id,j);  Segre numbers of j in R=S/p with respect to 
an ideal id such that (id + j) is m-primary.
"},

{'saveprimes, "saveprimes(pd,p) saves the prime ideals of a primary decomposition
pd together with its base ring on external files p1, p2, ... in the
working directory for later use as input in further calulations by
saying 'setideal(name_ideal,initmat p1)$'.
"},

{'saveprimaries, "saveprimaries(pd,q) saves the primary ideals of a primary 
decomposition pd together with its base ring on external files 
q1, q2, ... in the working directory for later use as input in 
further calculations by saying 'setideal(name_ideal,initmat q1)$'.
"},

{'veronese0, "symbolic procedure needed for the algebraic procedure veronese.
"},

{'ver, "algebraic procedure needed for the symbolic procedure veronese0.
"},

{'veronese, "veronese(r, d [, pr, x]) returns the ideal of the image of the 
veronese map of degree d from proj. r-space to proj. n-space; 
x is the name root of the variables which is 'x by default.
If pr is a list of integers (empty by default) from {0,1,...,n},
then the ideal of the projection of the Veronese variety from the
subspace {x_i=0| i NOT element of pr} to the complementary 
proj. (n-#pr)-space is returned. 
"},

{'grass0, "symbolic procedure needed for the algebraic procedure grassmann.
"},

{'grass, "algebraic procedure needed for the symbolic procedure grass0.
"},

{'grassmann, "grassmann(k, n [,x]) returns the ideal of the Grassmannian of
k-planes in proj. n-space under the Pluecker embedding,
where x is the name root of the variables x0, x1, ...
which is 'x by default.
"},

{'coef, "coef(f,v,ex);
Returns the coefficient of the monomial v1^e1*v2^e2*...*vn^en
in f, where f is a polynomial in the variables v = {v1,v2,...,vn}
and ex = {e1,e2,...,en}.
"},

{'totdeg, "totdeg(f,v);
Returns the total degree of a polynomial f in the variables v.
"},

{'lcmult, "lcmult(p);
Returns the least common multiple of the polynomials in the list p.
"},

{'bavula, "bavula(id);
Returns the correct degree of the ideal id also if the degree of
the variables (defined by the ecart vector) is not necessarily one
see [V.V. Bavula, Izv. Ross. Akad. Nauk. Ser. Mat. 58 (1994), 19-39;
translation in Russian Acad. Sci. Izv. Math. 44 (1995), 225-246].
"},

{'ljoin, "ljoin(a,b);
Returns the ideal of the limit of join variety (or relative tangent
cone) at 0 of two varieties defined by the ideals a and b. If a and
b are homogeneous, this is the ideal of the embedded join the 
projective varieties defined by them, and if a = b then this is
the ideal of the secant variety of the projective variety defined
by a.
"},

{'adeg, "adeg(M [, w, a, e]);
returns the list {arith-deg_{-1} M = deg Ext^{n+1}(M,R), ..., 
arith-deg_n M = deg Ext^0(M,R)} of arithmetic degrees of a graded
ideal (or module) M in (or over) a polynomial ring R with n + 1 
variables. In addition, if e and a are not 0, the Ext-modules and 
their annihilators are written. The list w of weight vectors
is for calculations in multigraded rings.
By default w = {{1,1,...,1}}, a = 0, e = 0.
"},

{'submat, "submat(m,rows,columns);
Returns the submatrix of the matrix m which consists of the rows
and columns of m specified in the lists rows and columns.
"},
   
{'modulo, "modulo(m,n);
Returns the factor module (m + n)/n, where m and n are submodules
of the same free module.
"},

{'complement, "complement a;
Given a submodule a (a = matrix whose image is the submodule) of a 
free module, returns a minimal summand of the free module such that 
with the submodule, the summand generates the free module.
"},

{'lift_gbasis, "liftgbasis(m);
Returns {g:=gbasis m, c:=change of base matrix} such that g = c m.
"},

{'idencoldegs, "idencoldegs(m);
Returns an identity matrix whose size is the number of columns of m
and which has the same column degrees as m.
"},

{'prune, "prune(m);
Returns a minimal matrix representation for coker m.
"},

{'hom, "hom(n,res,w,a,e);
If res is a resolution of the graded R-module M,
hom(n,res,w,a,e) returns the arithmetic degree arith-deg_{n-1}(M).
In addition, if a is not 0, then Ann(Ext^n(M,R)) is written and
if e is not 0, then Ext^n(M,R) is written.  w is a list of integer
weight vectors assigned to the ring variables.
"}
};

list := append(cali,segre);
i:=0;
if length x=1 then 
(for each item in list do if car x = car item then 
  <<write car cdr item; i:=i+1>>);
if length x>0 and i=0 then
for each item in list do
  if car explode(car x) = car(explode(car item))
  then  <<write car item; spaces(2); i:=i+1>>;
if i=0 then
<<write "usage: help(function) with function from"; terpri();
write for each item in list collect car item>>;
return;
end;

put('help,'psopfn,'help!*);

endmodule; % SEGRE
;end;