source: git/Singular/LIB/gaussman.lib @ c71123

///////////////////////////////////////////////////////////////////////////////
version="$Id: gaussman.lib,v 1.48 2001-08-01 13:21:36 mschulze Exp $";
category="Singularities";

info="
LIBRARY:  gaussman.lib  Gauss-Manin Connection of a Singularity

AUTHOR:   Mathias Schulze, email: mschulze@mathematik.uni-kl.de

OVERVIEW: A library to compute invariants related to the Gauss-Manin connection
          of a an isolated hypersurface singularity

PROCEDURES:
 gmsring(f,s);              Brieskorn lattice in the Gauss-Manin system
 gmsnf(p,K[,Kmax]);         Gauss-Manin system normal form
 gmscoeffs(p,K[,Kmax]);     Gauss-Manin system basis representation
 monodromy(f[,opt]);        monodromy matrix or spectrum of monodromy of f
 vfilt(f[,opt]);            V-filtration on H''/H' or spectrum of f
 endfilt(poly f,list V);    endomorphism filtration of filtration V
 spectrum(f);               spectrum of f
 sppairs(f[,opt]);          spectral pairs or spectrum of f
 spgen(a);                  generate spectrum defined by a
 sppgen(a,w);               generate spectral pairs defined by a and w
 spprint(list Sp);          print spectrum or spectral pairs Sp
 spadd(list Sp1,list Sp2);  sum of spectra Sp1 and Sp2
 spsub(list Sp1,list Sp2);  difference of spectra Sp1 and Sp2
 spmul(list Sp,int k);      product of spectrum Sp and integer k
 spmul(list Sp,intvec k);   linear combination of spectra Sp with coeffs k
 spissemicont(list Sp[,opt]);         test spectrum Sp for semicontinuity
 spsemicont(list Sp0,list Sp[,opt]);  semicontinuity of spectra Sp0 and Sp
 spmilnor(list Sp);         milnor number of spectrum Sp
 spgeomgenus(list Sp);      geometrical genus of spectrum Sp
 spgamma(list Sp);          gamma invariant of spectrum Sp

SEE ALSO: mondromy_lib, spectrum_lib

KEYWORDS: singularities; Gauss-Manin connection; Brieskorn lattice;
          monodromy; spectrum; spectral pairs;
          Hodge filtration; V-filtration; weight filtration
";

LIB "linalg.lib";

///////////////////////////////////////////////////////////////////////////////

static proc stdtrans(ideal I)
{
  def R=basering;

  string os=ordstr(R);
  int j=find(os,",C");
  if(j==0)
  {
    j=find(os,"C,");
  }
  if(j==0)
  {
    j=find(os,",c");
  }
  if(j==0)
  {
    j=find(os,"c,");
  }
  if(j>0)
  {
    os[j..j+1]="  ";
  }

  execute("ring S="+charstr(R)+",(gmspoly,"+varstr(R)+"),(c,dp,"+os+");");

  ideal I=homog(imap(R,I),gmspoly);
  module M=transpose(transpose(I)+freemodule(ncols(I)));
  M=std(M);

  setring(R);
  execute("map h=S,1,"+varstr(R)+";");
  module M=h(M);

  for(int i=ncols(M);i>=1;i--)
  {
    for(j=ncols(M);j>=1;j--)
    {
      if(M[i][1]==0)
      {
        M[i]=0;
      }
      if(i!=j&&M[j][1]!=0)
      {
        if(lead(M[i][1])/lead(M[j][1])!=0)
        {
          M[i]=0;
        }
      }
    }
  }

  M=transpose(simplify(M,2));
  I=M[1];
  attrib(I,"isSB",1);
  M=M[2..ncols(M)];
  module U=transpose(M);

  return(list(I,U));
}
///////////////////////////////////////////////////////////////////////////////

proc gmsring(poly t,string s)
"USAGE:    gmsring(f,s); poly f, string s;
ASSUME:   basering with characteristic 0 and local degree ordering,
          f with isolated singularity at 0
RETURN:
@format
ring G:
  G=C{{s}}*basering,
  s is the inverse of the Gauss-Manin connection of f,
  G contains:
    poly gmspoly: image of f
    ideal gmsjacob: image of Jacobian ideal
    ideal gmsstd: image of standard basis of Jacobian ideal
    matrix gmsmatrix: matrix(gmsjacob)*gmsmatrix=matrix(gmsstd)
    ideal gmsbasis: image of monomial vector space basis of Jacobian algebra
    int gmsmaxweight: maximal weight of variables of basering
  G projects to H''=C{{s}}*gmsbasis
@end format
NOTE:     do not modify gms variables if you want to use gms procedures
KEYWORDS: singularities; Gauss-Manin connection; Brieskorn lattice
EXAMPLE:  example gms; shows examples
"
{
  def R=basering;
  if(charstr(R)!="0")
  {
    ERROR("characteristic 0 expected");
  }
  for(int i=nvars(R);i>=1;i--)
  {
    if(var(i)>1)
    {
      ERROR("local ordering expected");
    }
  }

  ideal dt=jacob(t);
  list l=stdtrans(dt);
  ideal g=l[1];
  if(vdim(g)<=0)
  {
    if(vdim(g)==0)
    {
      ERROR("singularity at 0 expected");
    }
    else
    {
      ERROR("isolated singularity at 0 expected");
    }
  }  
  matrix a=l[2];
  ideal m=kbase(g);

  int gmsmaxweight;
  for(i=nvars(R);i>=1;i--)
  {
    if(deg(var(i))>gmsmaxweight)
    {
      gmsmaxweight=deg(var(i));
    }
  }

  string os=ordstr(R);
  int j=find(os,",C");
  if(j==0)
  {
    j=find(os,"C,");
  }
  if(j==0)
  {
    j=find(os,",c");
  }
  if(j==0)
  {
    j=find(os,"c,");
  }
  if(j>0)
  {
    os[j..j+1]="  ";
  }

  execute("ring G="+string(charstr(R))+",("+s+","+varstr(R)+"),(ws("+
    string(deg(highcorner(g))+2*gmsmaxweight)+"),"+os+",c);");

  poly gmspoly=imap(R,t);
  ideal gmsjacob=imap(R,dt);
  ideal gmsstd=imap(R,g);
  matrix gmsmatrix=imap(R,a);
  ideal gmsbasis=imap(R,m);

  attrib(gmsstd,"isSB",1);
  export gmspoly,gmsjacob,gmsstd,gmsmatrix,gmsbasis,gmsmaxweight;

  return(G);
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  poly f=x5+x2y2+y5;
  def G=gmsring(f,"s");
  setring(G);
  gmspoly;
  print(gmsjacob);
  print(gmsstd);
  print(gmsmatrix);
  gmsmaxweight;
}
///////////////////////////////////////////////////////////////////////////////

proc gmsnf(ideal p,int K,list #)
"USAGE:    gmsnf(p,K[,Kmax]); poly p, int K[, int Kmax];
ASSUME:   basering was constructed by gms, K<=Kmax
RETURN:
@format
list l:
  ideal l[1]: projection of p to H''=C{{s}}*gmsbasis mod s^{K+1}
  ideal l[2]: p=l[1]+l[2] mod s^(Kmax+1)
@end format
NOTE:     by setting p=l[2] the computation can be continued up to order
          at most Kmax, by default Kmax=infinity
KEYWORDS: singularities; Gauss-Manin connection; Brieskorn lattice
EXAMPLE:  example gmsnf; shows examples
"
{
  int Kmax=-1;
  if(size(#)>0)
  {
    if(typeof(#[1])=="int")
    {
      Kmax=#[1];
      if(K>Kmax)
      {
        Kmax=K;
      }
    }
  }

  intvec v=1;
  v[nvars(basering)]=0;

  int k;
  if(Kmax>=0)
  {
    p=jet(jet(p,K,v),(Kmax+1)*deg(var(1))-2*gmsmaxweight);
  }

  ideal r,q;
  r[ncols(p)]=0;
  q[ncols(p)]=0;

  poly s;
  int i,j;
  for(k=ncols(p);k>=1;k--)
  {
    while(p[k]!=0&&deg(lead(p[k]),v)<=K)
    {
      i=1;
      s=lead(p[k])/lead(gmsstd[i]);
      while(i<ncols(gmsstd)&&s==0)
      {
        i++;
        s=lead(p[k])/lead(gmsstd[i]);
      }
      if(s!=0)
      {
        p[k]=p[k]-s*gmsstd[i];
        for(j=1;j<=nrows(gmsmatrix);j++)
        {
          if(Kmax>=0)
          {
            p[k]=p[k]+
              jet(jet(diff(s*gmsmatrix[j,i],var(j+1))*var(1),Kmax,v),
                (Kmax+1)*deg(var(1))-2*gmsmaxweight);
          }
          else
          {
            p[k]=p[k]+diff(s*gmsmatrix[j,i],var(j+1))*var(1);
          }
        }
      }
      else
      {
        r[k]=r[k]+lead(p[k]);
        p[k]=p[k]-lead(p[k]);
      }
      while(deg(lead(p[k]))>(K+1)*deg(var(1))-2*gmsmaxweight&&
        deg(lead(p[k]),v)<=K)
      {
        q[k]=q[k]+lead(p[k]);
        p[k]=p[k]-lead(p[k]);
      }
    }
    q[k]=q[k]+p[k];
  }

  return(list(r,q));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  poly f=x5+x2y2+y5;
  def G=gmsring(f,"s");
  setring(G);
  list l0=gmsnf(gmspoly,0);
  print(l0[1]);
  list l1=gmsnf(gmspoly,1);
  print(l1[1]);
  list l=gmsnf(l0[2],1);
  print(l[1]);
}
///////////////////////////////////////////////////////////////////////////////

proc gmscoeffs(ideal p,int K,list #)
"USAGE:    gmscoeffs(p,K[,Kmax]); poly p, int K[, int Kmax];
ASSUME:   basering was constructed by gms, K<=Kmax
RETURN:
@format
list l:
  matrix l[1]: projection of p to H''=C{{s}}*gmsbasis=C{{s}}^mu mod s^(K+1)
  ideal l[2]: p=matrix(gmsbasis)*l[1]+l[2] mod s^(Kmax+1)
@end format
NOTE:     by setting p=l[2] the computation can be continued up to order 
          at most Kmax, by default Kmax=infinity
KEYWORDS: singularities; Gauss-Manin connection; Brieskorn lattice
EXAMPLE:  example gmscoeffs; shows examples
"
{
  list l=gmsnf(p,K,#);
  ideal r,q=l[1..2];
  poly v=1;
  for(int i=2;i<=nvars(basering);i++)
  {
    v=v*var(i);
  }
  matrix C=coeffs(r,gmsbasis,v);
  return(C,q);
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  poly f=x5+x2y2+y5;
  def G=gmsring(f,"s");
  setring(G);
  list l0=gmscoeffs(gmspoly,0);
  print(l0[1]);
  list l1=gmscoeffs(gmspoly,1);
  print(l1[1]);
  list l=gmscoeffs(l0[2],1);
  print(l[1]);
}
///////////////////////////////////////////////////////////////////////////////

static proc maxintdif(ideal e)
{
  int i,j,id;
  int mid=0;
  for(i=ncols(e);i>=1;i--)
  {
    for(j=i-1;j>=1;j--)
    {
      id=int(e[i]-e[j]);
      if(id<0)
      {
        id=-id;
      }
      if(id>mid)
      {
        mid=id;
      }
    }
  }
  return(mid);
}
///////////////////////////////////////////////////////////////////////////////

static proc maxorddif(matrix H)
{
  int i,j,d;
  int d0,d1=-1,-1;
  for(i=nrows(H);i>=1;i--)
  {
    for(j=ncols(H);j>=1;j--)
    {
      d=ord(H[i,j]);
      if(d>=0)
      {
        if(d0<0||d<d0)
        {
          d0=d;
        }
        if(d1<0||d>d1)
        {
          d1=d;
        }
      }
    }
  }
  return(d1-d0);
}
///////////////////////////////////////////////////////////////////////////////

proc monodromy(poly f,list #)
"USAGE:    monodromy(f[,opt]); poly f, int opt
ASSUME:   basering with characteristic 0 and local degree ordering,
          f with isolated singularity at 0
RETURN:
@format
if opt=0:
list l:
  ideal l[1]: exp(-2*pi*i*l[1]) are the eigenvalues of the monodromy
if opt=1:
list l: Jordan data jordan(M) of a monodromy matrix exp(-2*pi*i*M)
default: opt=1
@end format
SEE ALSO: mondromy_lib
KEYWORDS: singularities; Gauss-Manin connection; Brieskorn lattice; monodromy
EXAMPLE:  example monodromy; shows examples
"
{
  int opt=1;
  if(size(#)>0)
  {
    if(typeof(#[1])=="int")
    {
      opt=#[1];
    }
  }

  def R=basering;
  int n=nvars(R)-1;
  def G=gmsring(f,"s");
  setring G;

  int mu,modm=ncols(gmsbasis),maxorddif(gmsbasis);
  ideal r=gmspoly*gmsbasis;
  list l;
  matrix U=freemodule(mu);
  matrix A0[mu][mu],C;
  module H,dH=freemodule(mu),freemodule(mu);
  module H0;
  int k=-1;
  while(size(reduce(H,std(H0*s)))>0)
  {
    k++;
    dbprint(printlevel-voice+2,"// k="+string(k));
    dbprint(printlevel-voice+2,"// compute matrix A of t");
    if(opt==0)
    {
      l=gmscoeffs(r,k,mu);
    }
    else
    {
      l=gmscoeffs(r,k,mu+n);
    }
    C,r=l[1..2];
    A0=A0+C;

    dbprint(printlevel-voice+2,"// compute saturation of H''");
    H0=H;
    dH=jet(module(A0*dH+s^2*diff(matrix(dH),s)),k);
    H=H*s+dH;
  }
  A0=A0-k*s;

  dbprint(printlevel-voice+2,"// compute basis of saturation of H''");
  H=std(H0);
  int modH=maxorddif(H)/deg(s);
  dbprint(printlevel-voice+2,"// k="+string(modH+1));
  dbprint(printlevel-voice+2,"// compute matrix A of t");
  if(opt==0)
  {
    l=gmscoeffs(r,modH+1,modH+1);
  }
  else
  {
    l=gmscoeffs(r,modH+1,modH+1+n);
  }
  C,r=l[1..2];
  A0=A0+C;
  dbprint(printlevel-voice+2,"// transform A to saturation of H''");
  l=division(H*s,A0*H+s^2*diff(matrix(H),s));
  matrix A=jet(l[1],l[2],0);

  dbprint(printlevel-voice+2,
    "// compute eigenvalues e with multiplicities m of A");
  l=eigenval(jet(A,0));
  def e,m=l[1..2];
  dbprint(printlevel-voice+2,"// e="+string(e));
  dbprint(printlevel-voice+2,"// m="+string(m));

  if(opt==0)
  {
    setring(R);
    ideal e=imap(G,e);
    return(list(e));
  }

  dbprint(printlevel-voice+2,"// compute maximal integer difference of e");
  int mide=maxintdif(e);
  dbprint(printlevel-voice+2,"// mide="+string(mide));

  if(mide>0)
  {
    dbprint(printlevel-voice+2,"// k="+string(modH+1+mide));
    dbprint(printlevel-voice+2,"// compute matrix A of t");
    l=gmscoeffs(r,modH+1+mide,modH+1+mide);
    C,r=l[1..2];
    A0=A0+C;
    dbprint(printlevel-voice+2,"// transform A to saturation of H''");
    l=division(H*s,A0*H+s^2*diff(matrix(H),s));
    A=jet(l[1],l[2],mide);

    intvec ide;
    ide[mu]=0;
    int i,j;
    for(i=ncols(e);i>=1;i--)
    {
      for(j=i-1;j>=1;j--)
      {
        k=int(e[j]-e[i]);
        if(k>ide[j])
        {
          ide[j]=k;
        }
        if(-k>ide[i])
        {
          ide[i]=-k;
        }
      }
    }
    for(j,k=ncols(e),mu;j>=1;j--)
    {
      for(i=m[j];i>=1;i--)
      {
        ide[k]=ide[j];
        k--;
      }
    }

    while(mide>0)
    {
      dbprint(printlevel-voice+2,"// transform basis to reduce mide by 1");

      A0=jet(A,0);
      U=0;
      for(i=ncols(e);i>=1;i--)
      {
        U=syz(power(A0-e[i],n+1))+U;
      }
      A=lift(U,A*U);

      for(i=mu;i>=1;i--)
      {
        for(j=mu;j>=1;j--)
        {
          if(ide[i]==0&&ide[j]>0)
          {
            A[i,j]=A[i,j]/s;
          }
          else
          {
            if(ide[i]>0&&ide[j]==0)
            {
              A[i,j]=A[i,j]*s;
            }
          }
        }
      }
      for(i=mu;i>=1;i--)
      {
        if(ide[i]>0)
        {
          A[i,i]=A[i,i]-1;
          ide[i]=ide[i]-1;
        }
      }

      mide--;
      dbprint(printlevel-voice+2,"// mide="+string(mide));
    }

    A=jet(A,0);
  }

  setring(R);
  matrix A=imap(G,A);
  return(jordan(A));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  poly f=x5+x2y2+y5;
  print(monodromy(f));
}
///////////////////////////////////////////////////////////////////////////////

proc vfilt(poly f,list #)
"USAGE:    vfilt(f[,opt]); poly f, int opt
ASSUME:   basering with characteristic 0 and local degree ordering,
          f with isolated singularity at 0
RETURN:
@format
list V: V-filtration of f on H''/H'
if opt=0 or opt=1:
  intvec V[1]: numerators of spectral numbers
  intvec V[2]: denominators of spectral numbers
  intvec V[3]:
    int V[3][i]: multiplicity of spectral number V[1][i]/V[2][i]
if opt=1:
  list V[4]:
    module V[4][i]: vector space basis of V[1][i]/V[2][i]-th graded part
                    in terms of V[5]
  ideal V[5]: monomial vector space basis
default: opt=1
@end format
NOTE:     H' and H'' denote the Brieskorn lattices
SEE ALSO: spectrum_lib
KEYWORDS: singularities; Gauss-Manin connection; Brieskorn lattice;
          Hodge filtration; V-filtration; spectrum
EXAMPLE:  example vfilt; shows examples
"
{
  int opt=1;
  if(size(#)>0)
  {
    if(typeof(#[1])=="int")
    {
      opt=#[1];
    }
  }

  def R=basering;
  int n=nvars(R)-1;
  def G=gmsring(f,"s");
  setring G;

  int mu,modm=ncols(gmsbasis),maxorddif(gmsbasis);
  ideal r=gmspoly*gmsbasis;
  list l;
  matrix U=freemodule(mu);
  matrix A[mu][mu],C;
  module H,dH=freemodule(mu),freemodule(mu);
  module H0;
  int k=-1;
  int N=n+1;

  while(size(reduce(H,std(H0*s)))>0)
  {
    k++;
    dbprint(printlevel-voice+2,"// k="+string(k));
    dbprint(printlevel-voice+2,"// compute matrix A of t");
    l=gmscoeffs(r,k);
    C,r=l[1..2];
    A=A+C;

    dbprint(printlevel-voice+2,"// compute saturation of H''");
    H0=H;
    dH=jet(module(A*dH+s^2*diff(matrix(dH),s)),k);
    H=H*s+dH;
  }
  A=A-k*s;

  dbprint(printlevel-voice+2,"// compute basis of saturation of H''");
  H=std(H0);
  int modH=maxorddif(H)/deg(s);
  dbprint(printlevel-voice+2,"// k="+string(N+modH));
  dbprint(printlevel-voice+2,"// compute matrix A of t");
  l=gmscoeffs(r,N+modH,N+modH);
  C,r=l[1..2];
  A=A+C;

  dbprint(printlevel-voice+2,"// transform H'' to saturation of H''");
  l=division(H,freemodule(mu)*s^k);
  H0=jet(l[1],l[2],N-1);

  dbprint(printlevel-voice+2,"// compute vector spaces");
  poly p;
  int i0,j0,i1,j1;
  matrix V0[mu*N][mu*N];
  matrix V1[mu*N][mu*(N-1)];
  for(i0=mu;i0>=1;i0--)
  {
    for(i1=mu;i1>=1;i1--)
    {
      p=H0[i1,i0];
      while(p!=0)
      {
        j1=leadexp(p)[1];
        for(j0=N-j1-1;j0>=0;j0--)
        {
          V0[i1+(j1+j0)*mu,i0+j0*mu]=V0[i1+(j1+j0)*mu,i0+j0*mu]+leadcoef(p);
          if(j1+j0+1<N)
          {
            V1[i1+(j1+j0+1)*mu,i0+j0*mu]=
            V1[i1+(j1+j0+1)*mu,i0+j0*mu]+leadcoef(p);
          }
        }
        p=p-lead(p);
      }
    }
  }

  dbprint(printlevel-voice+2,"// transform A to saturation of H''");
  l=division(H*s,A*H+s^2*diff(matrix(H),s));
  A=jet(l[1],l[2],N-1);

  dbprint(printlevel-voice+2,"// compute matrix M of A");
  matrix M[mu*N][mu*N];
  for(i0=mu;i0>=1;i0--)
  {
    for(i1=mu;i1>=1;i1--)
    {
      p=A[i1,i0];
      while(p!=0)
      {
        j1=leadexp(p)[1];
        for(j0=N-j1-1;j0>=0;j0--)
        {
          M[i1+(j0+j1)*mu,i0+j0*mu]=leadcoef(p);
        }
        p=p-lead(p);
      }
    }
  }
  for(i0=mu;i0>=1;i0--)
  {
    for(j0=N-1;j0>=0;j0--)
    {
      M[i0+j0*mu,i0+j0*mu]=M[i0+j0*mu,i0+j0*mu]+j0;
    }
  }

  dbprint(printlevel-voice+2,"// compute eigenvalues eA of A");
  ideal eA=eigenval(jet(A,0))[1];
  dbprint(printlevel-voice+2,"// eA="+string(eA));

  dbprint(printlevel-voice+2,"// compute eigenvalues eM of M");
  ideal eM;
  k=0;
  intvec u;
  for(int i=N;i>=1;i--)
  {
    u[i]=1;
  }
  i0=1;
  while(u[N]<=ncols(eA))
  {
    for(i,i1=i0+1,i0;i<=N;i++)
    {
      if(eA[u[i]]+i<eA[u[i1]]+i1)
      {
        i1=i;
      }
    }
    k++;
    eM[k]=eA[u[i1]]+i1-1;
    u[i1]=u[i1]+1;
    if(u[i1]>ncols(eA))
    {
      i0=i1+1;
    }
  }
  dbprint(printlevel-voice+2,"// eM="+string(eM));

  dbprint(printlevel-voice+2,"// compute V-filtration on H''/sH''");
  ideal a;
  k=0;
  list V;
  V[ncols(eM)+1]=interred(V1);
  intvec d;
  if(opt==0)
  {
    for(i=ncols(eM);number(eM[i])-1>number(n-1)/2;i--)
    {
      dbprint(printlevel-voice+2,"// compute V["+string(i)+"]");
      V1=module(V1)+syz(power(M-eM[i],n+1));
      V[i]=interred(intersect(V1,V0));

      if(size(V[i])>size(V[i+1]))
      {
        k++;
        a[k]=eM[i]-1;
        d[k]=size(V[i])-size(V[i+1]);
      }
    }

    dbprint(printlevel-voice+2,"// symmetry index found");
    int j=k;

    if(number(eM[i])-1==number(n-1)/2)
    {
      dbprint(printlevel-voice+2,"// compute V["+string(i)+"]");
      V1=module(V1)+syz(power(M-eM[i],n+1));
      V[i]=interred(intersect(V1,V0));

      if(size(V[i])>size(V[i+1]))
      {
        k++;
        a[k]=eM[i]-1;
        d[k]=size(V[i])-size(V[i+1]);
      }
    }

    dbprint(printlevel-voice+2,"// apply symmetry");
    while(j>=1)
    {
      k++;
      a[k]=a[j];
      a[j]=n-1-a[k];
      d[k]=d[j];
      j--;
    }

    setring(R);
    ideal a=imap(G,a);
    return(list(a,d));
  }
  else
  {
    list v;
    int j=-1;
    for(i=ncols(eM);i>=1;i--)
    {
      dbprint(printlevel-voice+2,"// compute V["+string(i)+"]");
      V1=module(V1)+syz(power(M-eM[i],n+1));
      V[i]=interred(intersect(V1,V0));

      if(size(V[i])>size(V[i+1]))
      {
        if(number(eM[i]-1)>=number(n-1)/2)
        {
          k++;
          a[k]=eM[i]-1;
          v[k]=matrix(freemodule(ncols(V[i])),mu,mu*N)*division(V0,V[i])[1];
        }
        else
        {
          if(j<0)
          {
            if(a[k]==number(n-1)/2)
            {
              j=k-1;
            }
            else
            {
              j=k;
            }
          }
          k++;
          a[k]=a[j];
          a[j]=eM[i]-1;
          v[k]=v[j];
          v[j]=matrix(freemodule(ncols(V[i])),mu,mu*N)*division(V0,V[i])[1];
          j--;
        }
      }
    }

    dbprint(printlevel-voice+2,"// compute graded parts");
    for(k=1;k<size(v);k++)
    {
      v[k]=interred(reduce(v[k],std(v[k+1])));
      d[k]=size(v[k]);
    }
    v[k]=interred(v[k]);
    d[k]=size(v[k]);

    setring(R);
    ideal a=imap(G,a);
    list v=imap(G,v);
    ideal m=imap(G,gmsbasis);
    return(list(a,d,v,m));
  }
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  poly f=x5+x2y2+y5;
  vfilt(f);
}
///////////////////////////////////////////////////////////////////////////////

proc endfilt(poly f,list V)
"USAGE:   endfilt(f,V); poly f, list V
ASSUME:  basering with characteristic 0 and local degree ordering,
         f with isolated singularity at 0
RETURN:
@format
list V1: endomorphim filtration of V on the Jacobian algebra of f
  ideal V1[1]: spectral numbers in increasing order
  intvec V1[2]:
    int V1[2][i]: multiplicity of spectral number V1[1][i]
  list V1[3]:
    module V1[3][i]: vector space basis of the V1[1][i]-th graded part
                     in terms of V1[4]
  ideal V1[4]: monomial vector space basis
@end format
SEE ALSO: spectrum_lib
KEYWORDS: singularities; Gauss-Manin connection; Brieskorn lattice; spectrum;
          Hodge filtration; V-filtration
EXAMPLE: example endfilt; shows examples
"
{
  if(charstr(basering)!="0")
  {
    ERROR("characteristic 0 expected");
  }
  int n=nvars(basering)-1;
  for(int i=n+1;i>=1;i--)
  {
    if(var(i)>1)
    {
      ERROR("local ordering expected");
    }
  }
  ideal sJ=std(jacob(f));
  if(vdim(sJ)<=0)
  {
    if(vdim(sJ)==0)
    {
      ERROR("singularity at 0 expected");
    }
    else
    {
      ERROR("isolated singularity at 0 expected");
    }
  }

  def a,d,v,m=V[1..4];
  int mu=ncols(m);

  module V0=v[1];
  for(i=2;i<=size(v);i++)
  {
    V0=V0,v[i];
  }

  dbprint(printlevel-voice+2,"// compute multiplication in Jacobian algebra");
  list M;
  matrix U=freemodule(ncols(m));
  for(i=ncols(m);i>=1;i--)
  {
    M[i]=lift(V0,coeffs(reduce(m[i]*m,U,sJ),m)*V0);
  }

  int j,k,i0,j0,i1,j1;
  number b0=number(a[1]-a[ncols(a)]);
  number b1,b2;
  matrix M0;
  module L;
  list v0=freemodule(ncols(m));
  ideal a0=b0;

  while(b0<number(a[ncols(a)]-a[1]))
  {
    dbprint(printlevel-voice+2,"// find next possible index");
    b1=number(a[ncols(a)]-a[1]);
    for(j=ncols(a);j>=1;j--)
    {
      for(i=ncols(a);i>=1;i--)
      {
        b2=number(a[i]-a[j]);
        if(b2>b0&&b2<b1)
        {
          b1=b2;
        }
        else
        {
          if(b2<=b0)
          {
            i=0;
          }
        }
      }
    }
    b0=b1;

    list l=ideal();
    for(k=ncols(m);k>=2;k--)
    {
      l=l+list(ideal());
    }

    dbprint(printlevel-voice+2,"// collect conditions for V1["+string(b0)+"]");
    j=ncols(a);
    j0=mu;
    while(j>=1)
    {
      i0=1;
      i=1;
      while(i<ncols(a)&&a[i]<a[j]+b0)
      {
        i0=i0+d[i];
        i++;
      }
      if(a[i]<a[j]+b0)
      {
        i0=i0+d[i];
        i++;
      }
      for(k=1;k<=ncols(m);k++)
      {
        M0=M[k];
        if(i0>1)
        {
          l[k]=l[k],M0[1..i0-1,j0-d[j]+1..j0];
        }
      }
      j0=j0-d[j];
      j--;
    }

    dbprint(printlevel-voice+2,"// compose condition matrix");
    L=transpose(module(l[1]));
    for(k=2;k<=ncols(m);k++)
    {
      L=L,transpose(module(l[k]));
    }

    dbprint(printlevel-voice+2,"// compute kernel of condition matrix");
    v0=v0+list(syz(L));
    a0=a0,b0;
  }

  dbprint(printlevel-voice+2,"// compute graded parts");
  option(redSB);
  for(i=1;i<size(v0);i++)
  {
    v0[i+1]=std(v0[i+1]);
    v0[i]=std(reduce(v0[i],v0[i+1]));
  }

  dbprint(printlevel-voice+2,"// remove trivial graded parts");
  i=1;
  while(size(v0[i])==0)
  {
    i++;
  }
  list v1=v0[i];
  intvec d1=size(v0[i]);
  ideal a1=a0[i];
  i++;
  while(i<=size(v0))
  {
    if(size(v0[i])>0)
    {
      v1=v1+list(v0[i]);
      d1=d1,size(v0[i]);
      a1=a1,a0[i];
    }
    i++;
  }
  return(list(a1,d1,v1,m));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  poly f=x5+x2y2+y5;
  endfilt(f,vfilt(f));
}
///////////////////////////////////////////////////////////////////////////////

proc spectrum(poly f)
"USAGE:    spectrum(f); poly f
ASSUME:   basering with characteristic 0 and local degree ordering,
          f with isolated singularity at 0
RETURN:
@format
list Sp: spectrum of f
  ideal Sp[1]: spectral numbers in increasing order
  intvec Sp[2]:
    int Sp[2][i]: multiplicity of spectral number Sp[1][i]
@end format
SEE ALSO: spectrum_lib
KEYWORDS: singularities; Gauss-Manin connection; Brieskorn lattice; spectrum
EXAMPLE:  example spnumbers; shows examples
"
{
  return(sppairs(f,0));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  poly f=x5+x2y2+y5;
  spprint(spectrum(f));
}
///////////////////////////////////////////////////////////////////////////////

proc sppairs(poly f,list #)
"USAGE:    sppairs(f[,opt]); poly f, int opt
ASSUME:   basering with characteristic 0 and local degree ordering,
          f with isolated singularity at 0
RETURN:
@format
if opt=0
list Sp: spectrum of f
  ideal Sp[1]: spectral numbers in increasing order
  intvec Sp[2]: corresponding multiplicities of spectral numbers
if opt=1:
list Spp: spectral pairs of f
  ideal Spp[1]: spectral numbers in increasing order
  intvec Spp[2]: corresponding weight filtration indices in increasing order
  intvec Spp[3]: corresponding multiplicities of spectral pairs
default: opt=1
@end format
SEE ALSO: spectrum_lib
KEYWORDS: singularities; Gauss-Manin connection; Brieskorn lattice;
          spectrum; spectral pairs
EXAMPLE:  example sppairs; shows examples
"
{
  int opt=1;
  if(size(#)>0)
  {
    if(typeof(#[1])=="int")
    {
      opt=#[1];
    }
  }

  def R=basering;
  int n=nvars(R)-1;
  def G=gmsring(f,"s");
  setring(G);

  int mu,modm=ncols(gmsbasis),maxorddif(gmsbasis);
  ideal r=gmspoly*gmsbasis;
  list l;
  matrix U=freemodule(mu);
  matrix A0[mu][mu],C;
  module H0;
  module H,dH=freemodule(mu),freemodule(mu);
  int k=-1;
  while(size(reduce(H,std(H0*s)))>0)
  {
    k++;
    dbprint(printlevel-voice+2,"// k="+string(k));
    dbprint(printlevel-voice+2,"// compute matrix A of t");
    l=gmscoeffs(r,k,mu+n);
    C,r=l[1..2];
    A0=A0+C;

    dbprint(printlevel-voice+2,"// compute saturation of H''");
    H0=H;
    dH=jet(module(A0*dH+s^2*diff(matrix(dH),s)),k);
    H=H*s+dH;
  }
  A0=A0-k*s;

  dbprint(printlevel-voice+2,"// compute basis of saturation of H''");
  H=std(H0);
  int modH=maxorddif(H)/deg(s);
  dbprint(printlevel-voice+2,"// transform H'' to saturation of H''");
  l=division(H,freemodule(mu)*s^k);
  H0=l[1];

  dbprint(printlevel-voice+2,"// k="+string(modH+1));
  dbprint(printlevel-voice+2,"// compute matrix A of t");
  l=gmscoeffs(r,modH+1,modH+1+n);
  C,r=l[1..2];
  A0=A0+C;
  dbprint(printlevel-voice+2,"// transform A to saturation of H''");
  l=division(H*s,A0*H+s^2*diff(matrix(H),s));
  matrix A=jet(l[1],l[2],0);

  int i,j;
  matrix V;
  if(!opt)
  {
    dbprint(printlevel-voice+2,"// transform to Jordan basis");
    U=jordanbasis(A)[1];
    V=lift(U,freemodule(mu));
    A=V*A*U;
    dbprint(printlevel-voice+2,"// compute normal form of H''");
    H0=std(V*H0);

    dbprint(printlevel-voice+2,"// compute spectral numbers");
    ideal a;
    for(i=1;i<=mu;i++)
    {
      j=leadexp(H0[i])[nvars(basering)+1];
      a[i]=A[j,j]+deg(lead(H0[i]))/deg(s)-1;
    }

    setring(R);
    return(spgen(imap(G,a)));
  }

  dbprint(printlevel-voice+2,
    "// compute eigenvalues e with multiplicities m of A");
  l=eigenval(A);
  def e,m=l[1..2];
  dbprint(printlevel-voice+2,"// e="+string(e));
  dbprint(printlevel-voice+2,"// m="+string(m));
  dbprint(printlevel-voice+2,"// compute maximal integer difference of e");
  int mide=maxintdif(e);
  dbprint(printlevel-voice+2,"// mide="+string(mide));

  if(mide>0)
  {
    dbprint(printlevel-voice+2,"// k="+string(modH+1+mide));
    dbprint(printlevel-voice+2,"// compute matrix A of t");
    l=gmscoeffs(r,modH+1+mide,modH+1+mide);
    C,r=l[1..2];
    A0=A0+C;
    dbprint(printlevel-voice+2,"// transform A to saturation of H''");
    l=division(H*s,A0*H+s^2*diff(matrix(H),s));
    A=jet(l[1],l[2],mide);

    intvec ide;
    ide[mu]=0;
    for(i=ncols(e);i>=1;i--)
    {
      for(j=i-1;j>=1;j--)
      {
        k=int(e[j]-e[i]);
        if(k>ide[j])
        {
          ide[j]=k;
        }
        if(-k>ide[i])
        {
          ide[i]=-k;
        }
      }
    }
    for(j,k=ncols(e),mu;j>=1;j--)
    {
      for(i=m[j];i>=1;i--)
      {
        ide[k]=ide[j];
        k--;
      }
    }

    while(mide>0)
    {
      dbprint(printlevel-voice+2,"// transform to separate eigenvalues");
      A0=jet(A,0);
      U=0;
      for(i=ncols(e);i>=1;i--)
      {
        U=syz(power(A0-e[i],n+1))+U;
      }
      V=lift(U,freemodule(mu));
      A=V*A*U;
      H0=V*H0;

      dbprint(printlevel-voice+2,"// transform to reduce mide by 1");
      for(i=mu;i>=1;i--)
      {
        for(j=mu;j>=1;j--)
        {
          if(ide[i]==0&&ide[j]>0)
          {
            A[i,j]=A[i,j]/s;
          }
          else
          {
            if(ide[i]>0&&ide[j]==0)
            {
              A[i,j]=A[i,j]*s;
            }
          }
        }
      }
      H0=transpose(H0);
      for(i=mu;i>=1;i--)
      {
        if(ide[i]>0)
        {
          A[i,i]=A[i,i]-1;
          ide[i]=ide[i]-1;
          H0[i]=H0[i]*s;
        }
      }
      H0=transpose(H0);

      mide--;
      dbprint(printlevel-voice+2,"// mide="+string(mide));
    }

    A=jet(A,0);
  }

  dbprint(printlevel-voice+2,"// transform to Jordan basis");
  intvec w0;
  l=jordanbasis(A);
  U,w0=l[1..2];
  V=lift(U,freemodule(mu));
  A0=V*A*U;

  dbprint(printlevel-voice+2,"// compute weight filtration basis");
  vector u;
  i=1;
  while(i<ncols(A))
  {
    j=i+1;
    while(j<ncols(A)&&A[i,i]==A[j,j])
    {
      if(w0[i]<w0[j])
      {
        k=w0[i];
        w0[i]=w0[j];
        w0[i]=k;
        u=U[i];
        U[i]=U[j];
        U[j]=u;
      }
      j++;
    }
    if(j==ncols(A)&&A[i,i]==A[j,j]&&w0[i]<w0[j])
    {
      k=w0[i];
      w0[i]=w0[j];
      w0[i]=k;
      u=U[i];
      U[i]=U[j];
      U[j]=u;
    }
    i=j;
  }

  dbprint(printlevel-voice+2,"// transform to weight filtration basis");
  V=lift(U,freemodule(mu));
  A=V*A*U;
  dbprint(printlevel-voice+2,"// compute normal form of H''");
  H0=std(V*H0);

  dbprint(printlevel-voice+2,"// compute spectral pairs");
  ideal a;
  intvec w;
  for(i=1;i<=mu;i++)
  {
    j=leadexp(H0[i])[nvars(basering)+1];
    a[i]=A[j,j]+deg(lead(H0[i]))/deg(s)-1;
    w[i]=w0[j]+n;
  }
  setring(R);
  return(sppgen(imap(G,a),w));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  poly f=x5+x2y2+y5;
  spprint(sppairs(f));
}
///////////////////////////////////////////////////////////////////////////////

proc spgen(ideal a)
"USAGE:   spgen(a); ideal a
RETURN:
@format
list Sp: numbers in a with multiplicities
  ideal Sp[1]: numbers in a in increasing order
  intvec Sp[2]: corresponding multiplicities
@end format
EXAMPLE: example spgen; shows examples
"
{
  ideal a0=jet(a,0);
  int i,j;
  poly p;
  for(i=1;i<=ncols(a0);i++)
  {
    for(j=i+1;j<=ncols(a0);j++)
    {
      if(number(a0[i])>number(a0[j]))
      {
        p=a0[i];
        a0[i]=a0[j];
        a0[j]=p;
      }
    }
  }
  j=1;
  a=a0[1];
  intvec m=1;
  for(i=2;i<=ncols(a0);i++)
  {
    if(a0[i]==a[j])
    {
      m[j]=m[j]+1;
    }
    else
    {
      j++;
      a[j]=a0[i];
      m[j]=1;
    }
  }
  return(list(a,m));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  ideal a=-1/2,-3/10,-3/10,-1/10,-1/10,0,1/10,1/10,3/10,3/10,1/2;
  spprint(spgen(a));
}
///////////////////////////////////////////////////////////////////////////////

proc sppgen(ideal a,intvec w)
"USAGE:   sppgen(a); ideal a
RETURN:
@format
list Spp: pairs in a and w with multiplicities
  ideal Spp[1]: numbers in a
  intvec Spp[2]: corresponding integers in w
  intvec Spp[3]: corresponding multiplicities
@end format
EXAMPLE: example sppgen; shows examples
"
{
  ideal a0=jet(a,0);
  intvec w0=w;
  int i,j,k;
  poly p;
  for(i=1;i<=ncols(a0);i++)
  {
    for(j=i+1;j<=ncols(a0);j++)
    {
      if(number(a0[i])>number(a0[j])||a0[i]==a0[j]&&w0[i]>w0[j])
      {
        p=a0[i];
        a0[i]=a0[j];
        a0[j]=p;
        k=w0[i];
        w0[i]=w0[j];
        w0[j]=k;
      }
    }
  }
  j=1;
  a=a0[1];
  w=w0[1];
  intvec m=1;
  for(i=2;i<=ncols(a0);i++)
  {
    if(a0[i]==a[j]&&w0[i]==w[j])
    {
      m[j]=m[j]+1;
    }
    else
    {
      j++;
      a[j]=a0[i];
      w[j]=w0[i];
      m[j]=1;
    }
  }
  return(list(a,w,m));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  ideal a=-1/2,-3/10,-3/10,-1/10,-1/10,0,1/10,1/10,3/10,3/10,1/2;
  intvec w=2,1,1,1,1,1,1,1,1,1,0;
  spprint(sppgen(a,w));
}
///////////////////////////////////////////////////////////////////////////////

proc spprint(list Sp)
"USAGE:   spprint(Sp); list Sp
RETURN:  string: spectrum or spectral pairs Sp
EXAMPLE: example spprint; shows examples
"
{
  string s;
  if(size(Sp)==2)
  {
    for(int i=1;i<size(Sp[2]);i++)
    {
      s=s+"("+string(Sp[1][i])+","+string(Sp[2][i])+"),";
    }
    s=s+"("+string(Sp[1][i])+","+string(Sp[2][i])+")";
  }
  else
  {
    for(int i=1;i<size(Sp[3]);i++)
    {
      s=s+"(("+string(Sp[1][i])+","+string(Sp[2][i])+"),"+string(Sp[3][i])+"),";
    }
    s=s+"(("+string(Sp[1][i])+","+string(Sp[2][i])+"),"+string(Sp[3][i])+")";
  }
  return(s);
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  list Sp=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
  spprint(Sp);
}
///////////////////////////////////////////////////////////////////////////////

proc spadd(list Sp1,list Sp2)
"USAGE:   spadd(Sp1,Sp2); list Sp1,Sp2
RETURN:  list: sum of spectra Sp1 and Sp2
EXAMPLE: example spadd; shows examples
"
{
  ideal s;
  intvec m;
  int i,i1,i2=1,1,1;
  while(i1<=size(Sp1[2])||i2<=size(Sp2[2]))
  {
    if(i1<=size(Sp1[2]))
    {
      if(i2<=size(Sp2[2]))
      {
        if(number(Sp1[1][i1])<number(Sp2[1][i2]))
        {
          s[i]=Sp1[1][i1];
          m[i]=Sp1[2][i1];
          i++;
          i1++;
        }
        else
        {
          if(number(Sp1[1][i1])>number(Sp2[1][i2]))
          {
            s[i]=Sp2[1][i2];
            m[i]=Sp2[2][i2];
            i++;
            i2++;
          }
          else
          {
            if(Sp1[2][i1]+Sp2[2][i2]!=0)
            {
              s[i]=Sp1[1][i1];
              m[i]=Sp1[2][i1]+Sp2[2][i2];
              i++;
            }
            i1++;
            i2++;
          }
        }
      }
      else
      {
        s[i]=Sp1[1][i1];
        m[i]=Sp1[2][i1];
        i++;
        i1++;
      }
    }
    else
    {
      s[i]=Sp2[1][i2];
      m[i]=Sp2[2][i2];
      i++;
      i2++;
    }
  }
  return(list(s,m));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  list Sp1=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
  spprint(Sp1);
  list Sp2=list(ideal(-1/6,1/6),intvec(1,1));
  spprint(Sp2);
  spprint(spadd(Sp1,Sp2));
}
///////////////////////////////////////////////////////////////////////////////

proc spsub(list Sp1,list Sp2)
"USAGE:   spsub(Sp1,Sp2); list Sp1,Sp2
RETURN:  list: difference of spectra Sp1 and Sp2
EXAMPLE: example spsub; shows examples
"
{
  return(spadd(Sp1,spmul(Sp2,-1)));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  list Sp1=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
  spprint(Sp1);
  list Sp2=list(ideal(-1/6,1/6),intvec(1,1));
  spprint(Sp2);
  spprint(spsub(Sp1,Sp2));
}
///////////////////////////////////////////////////////////////////////////////

proc spmul(list #)
"USAGE:
@format
1) spmul(Sp,k); list Sp, int k
2) spmul(Sp,k); list Sp, intvec k
@end format
RETURN:
@format
1) list: product of spectrum Sp and integer k
2) list: linear combination of spectra Sp with coefficients k
@end format
EXAMPLE: example spmul; shows examples
"
{
  if(size(#)==2)
  {
    if(typeof(#[1])=="list")
    {
      if(typeof(#[2])=="int")
      {
        return(list(#[1][1],#[1][2]*#[2]));
      }
      if(typeof(#[2])=="intvec")
      {
        list Sp0=list(ideal(),intvec(0));
        for(int i=size(#[2]);i>=1;i--)
        {
          Sp0=spadd(Sp0,spmul(#[1][i],#[2][i]));
        }
        return(Sp0);
      }
    }
  }
  return(list(ideal(),intvec(0)));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  list Sp=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
  spprint(Sp);
  spprint(spmul(Sp,2));
  list Sp1=list(ideal(-1/6,1/6),intvec(1,1));
  spprint(Sp1);
  list Sp2=list(ideal(-1/3,0,1/3),intvec(1,2,1));
  spprint(Sp2);
  spprint(spmul(list(Sp1,Sp2),intvec(1,2)));
}
///////////////////////////////////////////////////////////////////////////////

proc spissemicont(list Sp,list #)
"USAGE:   spissemicont(Sp[,opt]); list Sp, int opt
RETURN:
@format
int k=
if opt=0:
  1, if sum of spectrum Sp over all intervals [a,a+1) is positive
  0, if sum of spectrum Sp over some interval [a,a+1) is negative
if opt=1:
  1, if sum of spectrum Sp over all intervals [a,a+1) and (a,a+1) is positive
  0, if sum of spectrum Sp over some interval [a,a+1) or (a,a+1) is negative
default: opt=0
@end format
EXAMPLE: example spissemicont; shows examples
"
{
  int opt=0;
  if(size(#)>0)
  {
    if(typeof(#[1])=="int")
    {
      opt=1;
    }
  }
  int i,j,k=1,1,0;
  while(j<=size(Sp[2]))
  {
    while(j+1<=size(Sp[2])&&Sp[1][j]<Sp[1][i]+1)
    {
      k=k+Sp[2][j];
      j++;
    }
    if(j==size(Sp[2])&&Sp[1][j]<Sp[1][i]+1)
    {
      k=k+Sp[2][j];
      j++;
    }
    if(k<0)
    {
      return(0);
    }
    k=k-Sp[2][i];
    if(k<0&&opt==1)
    {
      return(0);
    }
    i++;
  }
  return(1);
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  list Sp1=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
  spprint(Sp1);
  list Sp2=list(ideal(-1/6,1/6),intvec(1,1));
  spprint(Sp2);
  spissemicont(spsub(Sp1,spmul(Sp2,5)));
  spissemicont(spsub(Sp1,spmul(Sp2,5)),1);
  spissemicont(spsub(Sp1,spmul(Sp2,6)));
}
///////////////////////////////////////////////////////////////////////////////

proc spsemicont(list Sp0,list Sp,list #)
"USAGE:   spsemicont(Sp,k[,opt]); list Sp0, list Sp, int opt
RETURN:  list of intvecs l:
         spissemicont(sub(Sp0,spmul(Sp,k)),opt)==1 iff k<=l[i] for some i
NOTE:    if the spectra Sp occur with multiplicities k in a deformation
         of the [quasihomogeneous] spectrum Sp0 then 
         spissemicont(sub(Sp0,spmul(Sp,k))[,1])==1
EXAMPLE: example spsemicont; shows examples
"
{
  list l,l0;
  int i,j,k;
  while(spissemicont(Sp0,#))
  {
    if(size(Sp)>1)
    {
      l0=spsemicont(Sp0,list(Sp[1..size(Sp)-1]));
      for(i=1;i<=size(l0);i++)
      {
        if(size(l)>0)
        {
          j=1;
          while(j<size(l)&&l[j]!=l0[i])
          {
            j++;
          }
          if(l[j]==l0[i])
          {
            l[j][size(Sp)]=k;
          }
          else
          {
            l0[i][size(Sp)]=k;
            l=l+list(l0[i]);
          }
        }
        else
        {
          l=l0;
        }
      }
    }
    Sp0=spsub(Sp0,Sp[size(Sp)]);
    k++;
  }
  if(size(Sp)>1)
  {
    return(l);
  }
  else
  {
    return(list(intvec(k-1)));
  }
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  list Sp0=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
  spprint(Sp0);
  list Sp1=list(ideal(-1/6,1/6),intvec(1,1));
  spprint(Sp1);
  list Sp2=list(ideal(-1/3,0,1/3),intvec(1,2,1));
  spprint(Sp2);
  list Sp=Sp1,Sp2;
  list l=spsemicont(Sp0,Sp);
  l;
  spissemicont(spsub(Sp0,spmul(Sp,l[1])));
  spissemicont(spsub(Sp0,spmul(Sp,l[1]-1)));
  spissemicont(spsub(Sp0,spmul(Sp,l[1]+1)));
}
///////////////////////////////////////////////////////////////////////////////

proc spmilnor(list Sp)
"USAGE:   spmilnor(Sp); list Sp
RETURN:  int: Milnor number of spectrum Sp
EXAMPLE: example spmilnor; shows examples
"
{
  return(sum(Sp[2]));
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  list Sp=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
  spprint(Sp);
  spmilnor(Sp);
}
///////////////////////////////////////////////////////////////////////////////

proc spgeomgenus(list Sp)
"USAGE:   spgeomgenus(Sp); list Sp
RETURN:  int: geometrical genus of spectrum Sp
EXAMPLE: example spgeomgenus; shows examples
"
{
  int g=0;
  int i=1;
  while(i+1<=size(Sp[2])&&number(Sp[1][i])<=number(0))
  {
    g=g+Sp[2][i];
    i++;
  }
  if(i==size(Sp[2])&&number(Sp[1][i])<=number(0))
  {
    g=g+Sp[2][i];
  }
  return(g);
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  list Sp=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
  spprint(Sp);
  spgeomgenus(Sp);
}
///////////////////////////////////////////////////////////////////////////////

proc spgamma(list Sp)
"USAGE:   spgamma(Sp); list Sp
RETURN:  number: gamma invariant of spectrum Sp
EXAMPLE: example spgamma; shows examples
"
{
  int i,j;
  number g=0;
  for(i=1;i<=ncols(Sp[1]);i++)
  {
    for(j=1;j<=Sp[2][i];j++)
    {
      g=g+(number(Sp[1][i])-number(nvars(basering)-2)/2)^2;
    }
  }
  g=-g/4+sum(Sp[2])*number(Sp[1][ncols(Sp[1])]-Sp[1][1])/48;
  return(g);
}
example
{ "EXAMPLE:"; echo=2;
  ring R=0,(x,y),ds;
  list Sp=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
  spprint(Sp);
  spgamma(Sp);
}
///////////////////////////////////////////////////////////////////////////////