Changeset 8c4269a in git


Ignore:
Timestamp:
Mar 20, 2001, 3:16:46 PM (22 years ago)
Author:
Mathias Schulze <mschulze@…>
Branches:
(u'spielwiese', '0d6b7fcd9813a1ca1ed4220cfa2b104b97a0a003')
Children:
93085ab6a10664d6aa7d18b816dda107e95acdb8
Parents:
676724024fe6f74b1903efa35331a0271eaaf678
Message:
*mschulze: added procedures for spectra


git-svn-id: file:///usr/local/Singular/svn/trunk@5325 2c84dea3-7e68-4137-9b89-c4e89433aadc
File:
1 edited

Legend:

Unmodified
Added
Removed

  • Singular/LIB/gaussman.lib

    r676724 r8c4269a  
    11///////////////////////////////////////////////////////////////////////////////
    2 version="$Id: gaussman.lib,v 1.34 2001-03-05 18:28:46 mschulze Exp $";
     2version="$Id: gaussman.lib,v 1.35 2001-03-20 14:16:46 mschulze Exp $";
    33category="Singularities";
    44
    … …  
    99
    1010OVERVIEW: A library to compute invariants related to the Gauss-Manin connection
    11           of a an isolated hypersurface singularity.
     11          of a an isolated hypersurface singularity
    1212
    1313PROCEDURES:
    14  monodromy(f[,...]);    monodromy matrix of f, spectrum of monodromy of f
    15  vfiltration(f[,...]);  V-filtration of f on H''/H', singularity spectrum of f
    16  vfiltjacalg(...);      V-filtration on Jacobian algebra
    17  gamma(...);            C. Hertling's gamma invariant
     14 monodromy(f[,opt]);        monodromy matrix, spectrum of monodromy of f
     15 vfiltration(f[,opt]);      V-filtration on H''/H', singularity spectrum of f
     16 spectrum(f);               singularity spectrum of f
     17 endfilt(poly f,list V);    endomorphism filtration of filtration V
     18 gamma(list S);             gamma invariant of spectrum S
     19 spprint(list S);           print spectrum S
     20 spadd(list S1,list S2);    sum of spectra S1 and S2
     21 spsub(list S1,list S2);    difference of spectra S1 and S2
     22 spmul(list S,int k);       product of spectrum S and integer k
     23 spmul(list S,intvec k);    linear combination of spectra S with coefficients k
     24 spissemicont(list S[,opt]);        test spectrum S for semicontinuity
     25 spsemicont(list S0,list S[,opt]);  relative semicontinuity of spectra S0 and S
     26 spgeomgenus(list S);       geometric genus of spectrum S
    1827
    1928SEE ALSO: mondromy_lib, spectrum_lib
    … …  
    7988
    8089proc monodromy(poly f,list #)
    81 "USAGE:    monodromy(f[,mode]); poly f, int mode
     90"USAGE:    monodromy(f[,opt]); poly f, int opt
    8291ASSUME:   basering has local ordering, f has isolated singularity at 0
    8392RETURN:
    8493@format
    85 if mode=0:
     94if opt==0:
    8695  matrix M: exp(-2*pi*i*M) is a monodromy matrix of f
    87 if mode=1:
    88   ideal e: exp(-2*pi*i*e) is the spectrum of the monodromy of f
    89 default: mode=1
     96if opt==1:
     97  ideal e: exp(-2*pi*i*e) are the eigenvalues of the monodromy of f
     98default: opt=1
    9099@end format
    91100SEE ALSO: mondromy_lib
    92 KEYWORDS: singularities; Gauss-Manin connection; monodromy;
    93           Brieskorn lattice
     101KEYWORDS: singularities; Gauss-Manin connection; monodromy
    94102EXAMPLE:  example monodromy; shows an example
    95103"
    96104{
    97   int mode=1;
     105  int opt=1;
    98106  if(size(#)>0)
    99107  {
    100108    if(typeof(#[1])=="int")
    101109    {
    102       mode=#[1];
     110      opt=#[1];
    103111    }
    104112  }
    … …  
    188196        dbprint(printlevel-voice+2,"//gaussman::monodromy: e="+string(e));
    189197        dbprint(printlevel-voice+2,"//gaussman::monodromy: b="+string(b));
    190         if(mode==1)
     198        if(opt==1)
    191199        {
    192200          mide=maxintdif(e);
    … …  
    300308  }
    301309
    302   if(mode==1)
     310  if(opt==1)
    303311  {
    304312    return(jet(A,0));
    … …  
    313321  ring R=0,(x,y),ds;
    314322  poly f=x5+x2y2+y5;
    315   matrix M=monodromy(f);
    316   print(M);
     323  print(monodromy(f));
    317324}
    318325///////////////////////////////////////////////////////////////////////////////
    319326
    320327proc vfiltration(poly f,list #)
    321 "USAGE:    vfiltration(f[,mode]); poly f, int mode
     328"USAGE:    vfiltration(f[,opt]); poly f, int opt
    322329ASSUME:   basering has local ordering, f has isolated singularity at 0
    323330RETURN:
    324331@format
    325 list l:
    326 if mode=0 or mode=1:
    327   ideal l[1]: spectral numbers in increasing order
    328   intvec l[2]:
    329     int l[2][i]: multiplicity of spectral number l[1][i]
    330 if mode=1:
    331   list l[3]:
    332   module l[3][i]: vector space basis of l[1][i]-th graded part
    333                   of the V-filtration on H''/H' in terms of l[4]
    334   ideal l[4]: monomial vector space basis of H''/H'
    335   ideal l[5]: standard basis of the Jacobian ideal
    336 default: mode=1
     332list V: V-filtration of f on H''/H'
     333if opt==0 or opt==1:
     334  ideal V[1]: spectral numbers in increasing order
     335  intvec V[2]:
     336    int V[2][i]: multiplicity of spectral number V[1][i]
     337if opt==1:
     338  list V[3]:
     339    module V[3][i]: vector space basis of V[1][i]-th graded part
     340                    in terms of V[4]
     341  ideal V[4]: monomial vector space basis
     342default: opt=1
    337343@end format
    338344NOTE:     H' and H'' denote the Brieskorn lattices
    339345SEE ALSO: spectrum_lib
    340 KEYWORDS: singularities; Gauss-Manin connection; spectrum;
    341           Brieskorn lattice; Hodge filtration; V-filtration
     346KEYWORDS: singularities; Gauss-Manin connection;
     347          Brieskorn lattice; Hodge filtration; V-filtration; spectrum
    342348EXAMPLE:  example vfiltration; shows an example
    343349"
    344350{
    345   int mode=1;
     351  int opt=1;
    346352  if(size(#)>0)
    347353  {
    348354    if(typeof(#[1])=="int")
    349355    {
    350       mode=#[1];
     356      opt=#[1];
    351357    }
    352358  }
    … …  
    550556  dbprint(printlevel-voice+2,
    551557    "//gaussman::vfiltration: compute V-filtration on H0/H1");
    552   ideal s;
     558  ideal a;
    553559  k=0;
    554560  list V;
    … …  
    556562  V[ncols(eM)+1]=std(V1);
    557563  intvec d;
    558   if(mode==0)
     564  if(opt==0)
    559565  {
    560566    for(i=ncols(eM);number(eM[i])-1>number(n-1)/2;i--)
    … …  
    574580      {
    575581        k++;
    576         s[k]=eM[i]-1;
     582        a[k]=eM[i]-1;
    577583        d[k]=size(V[i])-size(V[i+1]);
    578584      }
    … …  
    599605      {
    600606        k++;
    601         s[k]=eM[i]-1;
     607        a[k]=eM[i]-1;
    602608        d[k]=size(V[i])-size(V[i+1]);
    603609      }
    … …  
    608614    {
    609615      k++;
    610       s[k]=s[j];
    611       s[j]=n-1-s[k];
     616      a[k]=a[j];
     617      a[j]=n-1-a[k];
    612618      d[k]=d[j];
    613619      j--;
    614620    }
    615621
    616     return(list(s,d));
     622    return(list(a,d));
    617623  }
    618624  else
    … …  
    638644        {
    639645          k++;
    640           s[k]=eM[i]-1;
     646          a[k]=eM[i]-1;
    641647          dbprint(printlevel-voice+2,
    642648            "//gaussman::vfiltration: transform to V0");
    … …  
    647653          if(j<0)
    648654          {
    649             if(s[k]==number(n-1)/2)
     655            if(a[k]==number(n-1)/2)
    650656            {
    651657              j=k-1;
    … …  
    657663          }
    658664          k++;
    659           s[k]=s[j];
    660           s[j]=eM[i]-1;
     665          a[k]=a[j];
     666          a[j]=eM[i]-1;
    661667          v[k]=v[j];
    662668          dbprint(printlevel-voice+2,
    … …  
    679685    d[k]=size(v[k]);
    680686
    681     return(list(s,d,v,m,sJ));
     687    return(list(a,d,v,m));
    682688  }
    683689}
    … …  
    686692  ring R=0,(x,y),ds;
    687693  poly f=x5+x2y2+y5;
    688   list l=vfiltration(f);
    689   print(l);
    690 }
    691 ///////////////////////////////////////////////////////////////////////////////
    692 
    693 proc vfiltjacalg(list l)
    694 "USAGE:   vfiltjacalg(vfiltration(f)); poly f
    695 ASSUME:  basering has local ordering, f has isolated singularity at 0
     694  vfiltration(f);
     695}
     696///////////////////////////////////////////////////////////////////////////////
     697
     698proc spectrum(poly f)
     699"USAGE:    spectrum(f); poly f
     700ASSUME:   basering has local ordering, f has isolated singularity at 0
    696701RETURN:
    697702@format
    698 list l:
    699   ideal l[1]: spectral numbers of the V-filtration
    700               on the Jacobian algebra in increasing order
    701   intvec l[2]:
    702     int l[2][i]: multiplicity of spectral number l[1][i]
    703   list l[3]:
    704   module l[3][i]: vector space basis of the l[1][i]-th graded part
    705                   of the V-filtration on the Jacobian algebra
    706                   in terms of l[4]
    707   ideal l[4]: monomial vector space basis of the Jacobian algebra
    708   ideal l[5]: standard basis of the Jacobian ideal
     703list S: singularity spectrum of f
     704  ideal S[1]: spectral numbers in increasing order
     705  intvec S[2]:
     706    int S[2][i]: multiplicity of spectral number S[1][i]
    709707@end format
    710 EXAMPLE: example vfiltjacalg; shows an example
     708SEE ALSO: spectrum_lib
     709KEYWORDS: singularities; Gauss-Manin connection; spectrum
     710EXAMPLE:  example spectrum; shows an example
    711711"
    712712{
    713   def s,d,v,m,sJ=l[1..5];
    714   int mu=ncols(m);
    715 
    716   int i,j,k;
    717   module V=v[1];
    718   for(i=2;i<=size(v);i++)
    719   {
    720     V=V,v[i];
    721   }
    722 
    723   dbprint(printlevel-voice+2,
    724     "//gaussman::vfiltjacalg: compute multiplication in Jacobian algebra");
    725   list M;
    726   matrix U=freemodule(ncols(m));
    727   for(i=ncols(m);i>=1;i--)
    728   {
    729     M[i]=lift(V,coeffs(reduce(m[i]*m,U,sJ),m)*V);
    730   }
    731 
    732   int i0,j0,i1,j1;
    733   number r0=number(s[1]-s[ncols(s)]);
    734   number r1,r2;
    735   matrix M0;
    736   module L;
    737   list v0=freemodule(ncols(m));
    738   ideal s0=r0;
    739 
    740   while(r0<number(s[ncols(s)]-s[1]))
    741   {
    742     dbprint(printlevel-voice+2,
    743       "//gaussman::vfiltjacalg: find next possible index");
    744     r1=number(s[ncols(s)]-s[1]);
    745     for(j=ncols(s);j>=1;j--)
    746     {
    747       for(i=ncols(s);i>=1;i--)
    748       {
    749         r2=number(s[i]-s[j]);
    750         if(r2>r0&&r2<r1)
    751         {
    752           r1=r2;
    753         }
    754         else
    755         {
    756           if(r2<=r0)
    757           {
    758             i=0;
    759           }
    760         }
    761       }
    762     }
    763     r0=r1;
    764 
    765     l=ideal();
    766     for(k=ncols(m);k>=2;k--)
    767     {
    768       l=l+list(ideal());
    769     }
    770 
    771     dbprint(printlevel-voice+2,
    772       "//gaussman::vfiltjacalg: collect conditions for V["+string(r0)+"]");
    773     j=ncols(s);
    774     j0=mu;
    775     while(j>=1)
    776     {
    777       i0=1;
    778       i=1;
    779       while(i<ncols(s)&&s[i]<s[j]+r0)
    780       {
    781         i0=i0+d[i];
    782         i++;
    783       }
    784       if(s[i]<s[j]+r0)
    785       {
    786         i0=i0+d[i];
    787         i++;
    788       }
    789       for(k=1;k<=ncols(m);k++)
    790       {
    791         M0=M[k];
    792         if(i0>1)
    793         {
    794           l[k]=l[k],M0[1..i0-1,j0-d[j]+1..j0];
    795         }
    796       }
    797       j0=j0-d[j];
    798       j--;
    799     }
    800 
    801     dbprint(printlevel-voice+2,
    802       "//gaussman::vfiltjacalg: compose condition matrix");
    803     L=transpose(module(l[1]));
    804     for(k=2;k<=ncols(m);k++)
    805     {
    806       L=L,transpose(module(l[k]));
    807     }
    808 
    809     dbprint(printlevel-voice+2,
    810       "//gaussman::vfiltjacalg: compute kernel of condition matrix");
    811     v0=v0+list(syz(L));
    812     s0=s0,r0;
    813   }
    814 
    815   dbprint(printlevel-voice+2,"//gaussman::vfiltjacalg: compute graded parts");
    816   option(redSB);
    817   for(i=1;i<size(v0);i++)
    818   {
    819     v0[i+1]=std(v0[i+1]);
    820     v0[i]=std(reduce(v0[i],v0[i+1]));
    821   }
    822 
    823   dbprint(printlevel-voice+2,
    824     "//gaussman::vfiltjacalg: remove trivial graded parts");
    825   i=1;
    826   while(size(v0[i])==0)
    827   {
    828     i++;
    829   }
    830   list v1=v0[i];
    831   intvec d1=size(v0[i]);
    832   ideal s1=s0[i];
    833   i++;
    834   while(i<=size(v0))
    835   {
    836     if(size(v0[i])>0)
    837     {
    838       v1=v1+list(v0[i]);
    839       d1=d1,size(v0[i]);
    840       s1=s1,s0[i];
    841     }
    842     i++;
    843   }
    844   return(list(s1,d1,v1,m));
     713  return(vfiltration(f,0));
    845714}
    846715example
    … …  
    848717  ring R=0,(x,y),ds;
    849718  poly f=x5+x2y2+y5;
    850   vfiltjacalg(vfiltration(f));
    851 }
    852 ///////////////////////////////////////////////////////////////////////////////
    853 
    854 proc gamma(list l)
    855 "USAGE:   gamma(vfiltration(f,0)); poly f
     719  spprint(spectrum(f));
     720}
     721///////////////////////////////////////////////////////////////////////////////
     722
     723proc endfilt(poly f,list V)
     724"USAGE:   endfilt(f,V); poly f, list V
    856725ASSUME:  basering has local ordering, f has isolated singularity at 0
    857 RETURN:  number g: C. Hertling's gamma invariant
    858 EXAMPLE: example gamma; shows an example
     726RETURN:
     727@format
     728list V1: endomorphim filtration of V on the Jacobian algebra of f
     729  ideal V1[1]: spectral numbers in increasing order
     730  intvec V1[2]:
     731    int V1[2][i]: multiplicity of spectral number V1[1][i]
     732  list V1[3]:
     733    module V1[3][i]: vector space basis of the V1[1][i]-th graded part
     734                     in terms of V1[4]
     735  ideal V1[4]: monomial vector space basis
     736@end format
     737SEE ALSO: spectrum_lib
     738KEYWORDS: singularities; Gauss-Manin connection; spectrum;
     739          Brieskorn lattice; Hodge filtration; V-filtration
     740EXAMPLE: example endfilt; shows an example
    859741"
    860742{
    861   ideal s=l[1];
    862   intvec d=l[2];
    863   int n=nvars(basering)-1;
    864   number g=0;
    865   int i,j;
    866   for(i=1;i<=ncols(s);i++)
    867   {
    868     for(j=1;j<=d[i];j++)
    869     {
    870       g=g+(number(s[i])-number(n-1)/2)^2;
    871     }
    872   }
    873   g=-g/4+sum(d)*number(s[ncols(s)]-s[1])/48;
    874   return(g);
     743  def a,d,v,m=V[1..4];
     744  int mu=ncols(m);
     745  ideal sJ=std(jacob(f));
     746
     747  int i,j,k;
     748  module V0=v[1];
     749  for(i=2;i<=size(v);i++)
     750  {
     751    V0=V0,v[i];
     752  }
     753
     754  dbprint(printlevel-voice+2,
     755    "//gaussman::endfilt: compute multiplication in Jacobian algebra");
     756  list M;
     757  matrix U=freemodule(ncols(m));
     758  for(i=ncols(m);i>=1;i--)
     759  {
     760    M[i]=lift(V0,coeffs(reduce(m[i]*m,U,sJ),m)*V0);
     761  }
     762
     763  int i0,j0,i1,j1;
     764  number b0=number(a[1]-a[ncols(a)]);
     765  number b1,b2;
     766  matrix M0;
     767  module L;
     768  list v0=freemodule(ncols(m));
     769  ideal a0=b0;
     770
     771  while(b0<number(a[ncols(a)]-a[1]))
     772  {
     773    dbprint(printlevel-voice+2,
     774      "//gaussman::endfilt: find next possible index");
     775    b1=number(a[ncols(a)]-a[1]);
     776    for(j=ncols(a);j>=1;j--)
     777    {
     778      for(i=ncols(a);i>=1;i--)
     779      {
     780        b2=number(a[i]-a[j]);
     781        if(b2>b0&&b2<b1)
     782        {
     783          b1=b2;
     784        }
     785        else
     786        {
     787          if(b2<=b0)
     788          {
     789            i=0;
     790          }
     791        }
     792      }
     793    }
     794    b0=b1;
     795
     796    list l=ideal();
     797    for(k=ncols(m);k>=2;k--)
     798    {
     799      l=l+list(ideal());
     800    }
     801
     802    dbprint(printlevel-voice+2,
     803      "//gaussman::endfilt: collect conditions for V1["+string(b0)+"]");
     804    j=ncols(a);
     805    j0=mu;
     806    while(j>=1)
     807    {
     808      i0=1;
     809      i=1;
     810      while(i<ncols(a)&&a[i]<a[j]+b0)
     811      {
     812        i0=i0+d[i];
     813        i++;
     814      }
     815      if(a[i]<a[j]+b0)
     816      {
     817        i0=i0+d[i];
     818        i++;
     819      }
     820      for(k=1;k<=ncols(m);k++)
     821      {
     822        M0=M[k];
     823        if(i0>1)
     824        {
     825          l[k]=l[k],M0[1..i0-1,j0-d[j]+1..j0];
     826        }
     827      }
     828      j0=j0-d[j];
     829      j--;
     830    }
     831
     832    dbprint(printlevel-voice+2,
     833      "//gaussman::endfilt: compose condition matrix");
     834    L=transpose(module(l[1]));
     835    for(k=2;k<=ncols(m);k++)
     836    {
     837      L=L,transpose(module(l[k]));
     838    }
     839
     840    dbprint(printlevel-voice+2,
     841      "//gaussman::endfilt: compute kernel of condition matrix");
     842    v0=v0+list(syz(L));
     843    a0=a0,b0;
     844  }
     845
     846  dbprint(printlevel-voice+2,"//gaussman::endfilt: compute graded parts");
     847  option(redSB);
     848  for(i=1;i<size(v0);i++)
     849  {
     850    v0[i+1]=std(v0[i+1]);
     851    v0[i]=std(reduce(v0[i],v0[i+1]));
     852  }
     853
     854  dbprint(printlevel-voice+2,
     855    "//gaussman::endfilt: remove trivial graded parts");
     856  i=1;
     857  while(size(v0[i])==0)
     858  {
     859    i++;
     860  }
     861  list v1=v0[i];
     862  intvec d1=size(v0[i]);
     863  ideal a1=a0[i];
     864  i++;
     865  while(i<=size(v0))
     866  {
     867    if(size(v0[i])>0)
     868    {
     869      v1=v1+list(v0[i]);
     870      d1=d1,size(v0[i]);
     871      a1=a1,a0[i];
     872    }
     873    i++;
     874  }
     875  return(list(a1,d1,v1,m));
    875876}
    876877example
    … …  
    878879  ring R=0,(x,y),ds;
    879880  poly f=x5+x2y2+y5;
    880   gamma(vfiltration(f,0));
    881 }
    882 ///////////////////////////////////////////////////////////////////////////////
     881  endfilt(f,vfiltration(f));
     882}
     883///////////////////////////////////////////////////////////////////////////////
     884
     885proc gamma(list S)
     886"USAGE:   gamma(S); list S
     887RETURN:  number: gamma invariant of spectrum S
     888EXAMPLE: example gamma; shows an example
     889"
     890{
     891  ideal a=S[1];
     892  intvec d=S[2];
     893  int n=nvars(basering)-1;
     894  number g=0;
     895  int i,j;
     896  for(i=1;i<=ncols(a);i++)
     897  {
     898    for(j=1;j<=d[i];j++)
     899    {
     900      g=g+(number(a[i])-number(n-1)/2)^2;
     901    }
     902  }
     903  g=-g/4+sum(d)*number(a[ncols(a)]-a[1])/48;
     904  return(g);
     905}
     906example
     907{ "EXAMPLE:"; echo=2;
     908  ring R=0,(x,y),ds;
     909  poly f=x5+x2y2+y5;
     910  gamma(spectrum(f));
     911}
     912///////////////////////////////////////////////////////////////////////////////
     913
     914proc spprint(list S)
     915"USAGE:   spprint(S); list S
     916RETURN:  string: spectrum S
     917EXAMPLE: example spprint; shows an example
     918"
     919{
     920  string s;
     921  for(int i=1;i<size(S[2]);i++)
     922  {
     923    s=s+"("+string(S[1][i])+","+string(S[2][i])+"),";
     924  }
     925  s=s+"("+string(S[1][i])+","+string(S[2][i])+")";
     926  return(s);
     927}
     928example
     929{ "EXAMPLE:"; echo=2;
     930  ring R=0,(x,y),ds;
     931  list S=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
     932  spprint(S);
     933}
     934///////////////////////////////////////////////////////////////////////////////
     935
     936proc spadd(list S1,list S2)
     937"USAGE:   spadd(S1,S2); list S1,S2
     938RETURN:  list: sum of spectra S1 and S2
     939EXAMPLE: example spadd; shows an example
     940"
     941{
     942  ideal s;
     943  intvec m;
     944  int i,i1,i2=1,1,1;
     945  while(i1<=size(S1[2])||i2<=size(S2[2]))
     946  {
     947    if(i1<=size(S1[2]))
     948    {
     949      if(i2<=size(S2[2]))
     950      {
     951        if(number(S1[1][i1])<number(S2[1][i2]))
     952        {
     953          s[i]=S1[1][i1];
     954          m[i]=S1[2][i1];
     955          i++;
     956          i1++;
     957        }
     958        else
     959        {
     960          if(number(S1[1][i1])>number(S2[1][i2]))
     961          {
     962            s[i]=S2[1][i2];
     963            m[i]=S2[2][i2];
     964            i++;
     965            i2++;
     966          }
     967          else
     968          {
     969            if(S1[2][i1]+S2[2][i2]!=0)
     970            {
     971              s[i]=S1[1][i1];
     972              m[i]=S1[2][i1]+S2[2][i2];
     973              i++;
     974            }
     975            i1++;
     976            i2++;
     977          }
     978        }
     979      }
     980      else
     981      {
     982        s[i]=S1[1][i1];
     983        m[i]=S1[2][i1];
     984        i++;
     985        i1++;
     986      }
     987    }
     988    else
     989    {
     990      s[i]=S2[1][i2];
     991      m[i]=S2[2][i2];
     992      i++;
     993      i2++;
     994    }
     995  }
     996  return(list(s,m));
     997}
     998example
     999{ "EXAMPLE:"; echo=2;
     1000  ring R=0,(x,y),ds;
     1001  list S1=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
     1002  spprint(S1);
     1003  list S2=list(ideal(-1/6,1/6),intvec(1,1));
     1004  spprint(S2);
     1005  spprint(spadd(S1,S2));
     1006}
     1007///////////////////////////////////////////////////////////////////////////////
     1008
     1009proc spsub(list S1,list S2)
     1010"USAGE:   spsub(S1,S2); list S1,S2
     1011RETURN:  list: difference of spectra S1 and S2
     1012EXAMPLE: example spsub; shows an example
     1013"
     1014{
     1015  return(spadd(S1,spmul(S2,-1)));
     1016}
     1017example
     1018{ "EXAMPLE:"; echo=2;
     1019  ring R=0,(x,y),ds;
     1020  list S1=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
     1021  spprint(S1);
     1022  list S2=list(ideal(-1/6,1/6),intvec(1,1));
     1023  spprint(S2);
     1024  spprint(spsub(S1,S2));
     1025}
     1026///////////////////////////////////////////////////////////////////////////////
     1027
     1028proc spmul(list #)
     1029"USAGE:
     1030@format
     10311) spmul(S,k); list S, int k
     10322) spmul(S,k); list S, intvec k
     1033@end format
     1034RETURN:
     1035@format
     10361) list: product of spectrum S and integer k
     10372) list: linear combination of spectra S with coefficients k
     1038@end format
     1039EXAMPLE: example spmul; shows an example
     1040"
     1041{
     1042  if(size(#)==2)
     1043  {
     1044    if(typeof(#[1])=="list")
     1045    {
     1046      if(typeof(#[2])=="int")
     1047      {
     1048        return(list(#[1][1],#[1][2]*#[2]));
     1049      }
     1050      if(typeof(#[2])=="intvec")
     1051      {
     1052        list S0=list(ideal(),intvec(0));
     1053        for(int i=size(#[2]);i>=1;i--)
     1054        {
     1055          S0=spadd(S0,spmul(#[1][i],#[2][i]));
     1056        }
     1057        return(S0);
     1058      }
     1059    }
     1060  }
     1061  return(list(ideal(),intvec(0)));
     1062}
     1063example
     1064{ "EXAMPLE:"; echo=2;
     1065  ring R=0,(x,y),ds;
     1066  list S=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
     1067  spprint(S);
     1068  spprint(spmul(S,2));
     1069  list S1=list(ideal(-1/6,1/6),intvec(1,1));
     1070  spprint(S1);
     1071  list S2=list(ideal(-1/3,0,1/3),intvec(1,2,1));
     1072  spprint(S2);
     1073  spprint(spmul(list(S1,S2),intvec(1,2)));
     1074}
     1075///////////////////////////////////////////////////////////////////////////////
     1076
     1077proc spissemicont(list S,list #)
     1078"USAGE:   spissemicont(S[,opt]); list S, int opt
     1079RETURN:
     1080@format
     1081int k=
     1082if opt==0:
     1083  1, if sum of spectrum S over all intervals [a,a+1) is positive
     1084  0, if sum of spectrum S over some interval [a,a+1) is negative
     1085if opt==1:
     1086  1, if sum of spectrum S over all intervals [a,a+1) and (a,a+1) is positive
     1087  0, if sum of spectrum S over some interval [a,a+1) or (a,a+1) is negative
     1088default: opt=0
     1089@end format
     1090EXAMPLE: example spissemicont; shows an example
     1091"
     1092{
     1093  int opt=0;
     1094  if(size(#)>0)
     1095  {
     1096    if(typeof(#[1])=="int")
     1097    {
     1098      opt=1;
     1099    }
     1100  }
     1101  int i,j,k=1,1,0;
     1102  while(j<=size(S[2]))
     1103  {
     1104    while(j+1<=size(S[2])&&S[1][j]<S[1][i]+1)
     1105    {
     1106      k=k+S[2][j];
     1107      j++;
     1108    }
     1109    if(j==size(S[2])&&S[1][j]<S[1][i]+1)
     1110    {
     1111      k=k+S[2][j];
     1112      j++;
     1113    }
     1114    if(k<0)
     1115    {
     1116      return(0);
     1117    }
     1118    k=k-S[2][i];
     1119    if(k<0&&opt==1)
     1120    {
     1121      return(0);
     1122    }
     1123    i++;
     1124  }
     1125  return(1);
     1126}
     1127example
     1128{ "EXAMPLE:"; echo=2;
     1129  ring R=0,(x,y),ds;
     1130  list S1=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
     1131  spprint(S1);
     1132  list S2=list(ideal(-1/6,1/6),intvec(1,1));
     1133  spprint(S2);
     1134  spissemicont(spsub(S1,spmul(S2,5)));
     1135  spissemicont(spsub(S1,spmul(S2,5)),1);
     1136  spissemicont(spsub(S1,spmul(S2,6)));
     1137}
     1138///////////////////////////////////////////////////////////////////////////////
     1139
     1140proc spsemicont(list S0,list S,list #)
     1141"USAGE:   spsemicont(S,k[,opt]); list S0, list S, int opt
     1142RETURN:  list of intvecs l:
     1143         spissemicont(sub(S0,spmul(S,k)),opt)==1 iff k<=l[i] for some i
     1144NOTE:    if the spectra S occur with multiplicities k in a deformation
     1145         of the [quasihomogeneous] spectrum S0 then
     1146         spissemicont(sub(S0,spmul(S,k))[,1])==1
     1147EXAMPLE: example spsemicont; shows an example
     1148"
     1149{
     1150  list l,l0;
     1151  int i,k;
     1152  while(spissemicont(S0,#))
     1153  {
     1154    if(size(S)>1)
     1155    {
     1156      l0=spsemicont(S0,list(S[1..size(S)-1]));
     1157      for(i=size(l0);i>=1;i--)
     1158      {
     1159        l0[i][size(S)]=k;
     1160      }
     1161      l=l+l0;
     1162    }
     1163    S0=spsub(S0,S[size(S)]);
     1164    k++;
     1165  }
     1166  if(size(S)>1)
     1167  {
     1168    return(l);
     1169  }
     1170  else
     1171  {
     1172    return(list(intvec(k-1)));
     1173  }
     1174}
     1175example
     1176{ "EXAMPLE:"; echo=2;
     1177  ring R=0,(x,y),ds;
     1178  list S0=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
     1179  spprint(S0);
     1180  list S1=list(ideal(-1/6,1/6),intvec(1,1));
     1181  spprint(S1);
     1182  list S2=list(ideal(-1/3,0,1/3),intvec(1,2,1));
     1183  spprint(S2);
     1184  list S=S1,S2;
     1185  list l=spsemicont(S0,S);
     1186  l;
     1187  spissemicont(spsub(S0,spmul(S,l[1])));
     1188  spissemicont(spsub(S0,spmul(S,l[1]-1)));
     1189  spissemicont(spsub(S0,spmul(S,l[1]+1)));
     1190}
     1191///////////////////////////////////////////////////////////////////////////////
     1192
     1193proc spgeomgenus(list S)
     1194"USAGE:   spgeomgenus(S); list S
     1195RETURN:  int g: geometric genus of spectrum S
     1196EXAMPLE: example spgeomgenus; shows an example
     1197"
     1198{
     1199  int g=0;
     1200  int i=1;
     1201  while(i+1<=size(S[2])&&number(S[1][i])<=number(0))
     1202  {
     1203    g=g+S[2][i];
     1204    i++;
     1205  }
     1206  if(i==size(S[2])&&number(S[1][i])<=number(0))
     1207  {
     1208    g=g+S[2][i];
     1209  }
     1210  return(g);
     1211}
     1212example
     1213{ "EXAMPLE:"; echo=2;
     1214  ring R=0,(x,y),ds;
     1215  list S=list(ideal(-1/2,-3/10,-1/10,0,1/10,3/10,1/2),intvec(1,2,2,1,2,2,1));
     1216  spprint(S);
     1217  spgeomgenus(S);
     1218}
     1219///////////////////////////////////////////////////////////////////////////////
Note: See TracChangeset for help on using the changeset viewer.