source: git/Singular/LIB/gaussman.lib @ 12c3e5

spielwiese
Last change on this file since 12c3e5 was 12c3e5, checked in by Mathias Schulze <mschulze@…>, 23 years ago
Singular/Singular/LIB/gaussman.lib git-svn-id: file:///usr/local/Singular/svn/trunk@4720 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 19.8 KB
Line 
1///////////////////////////////////////////////////////////////////////////////
2
3version="$Id: gaussman.lib,v 1.8 2000-11-10 10:29:47 mschulze Exp $";
4info="
5LIBRARY:  gaussman.lib  GAUSS-MANIN CONNECTION OF A SINGULARITY
6
7AUTHOR:   Mathias Schulze (mschulze@mathematik.uni-kl.de)
8
9OVERVIEW:
10 A library to compute invariants related to the Gauss-Manin connection
11 of an isolated hypersurface singularity
12
13PROCEDURES:
14 monomat  : monodromy matrix
15 monospec : spectrum of monodromy
16 vfilt    : V-filtration on H''/H'
17 singspec : singularity spectrum
18 vjacob   : V-filtration on Jacobian algebra
19";
20
21LIB "jordan.lib";
22
23///////////////////////////////////////////////////////////////////////////////
24
25static proc maxintdif(ideal e)
26{
27  dbprint(printlevel-voice+2,"//gaussman::maxintdif");
28  int i,j,id;
29  int mid=0;
30  for(i=ncols(e);i>=1;i--)
31  {
32    for(j=i-1;j>=1;j--)
33    {
34      id=int(e[i]-e[j]);
35      if(id<0)
36      {
37        id=-id;
38      }
39      if(id>mid)
40      {
41        mid=id;
42      }
43    }
44  }
45  return(mid);
46}
47///////////////////////////////////////////////////////////////////////////////
48
49static proc maxorddif(matrix H)
50{
51  dbprint(printlevel-voice+2,"//gaussman::maxorddif");
52  int i,j,d;
53  int d0,d1=-1,-1;
54  for(i=nrows(H);i>=1;i--)
55  {
56    for(j=ncols(H);j>=1;j--)
57    {
58      d=ord(H[i,j]);
59      if(d>=0)
60      {
61        if(d0<0||d<d0)
62        {
63          d0=d;
64        }
65        if(d1<0||d>d1)
66        {
67          d1=d;
68        }
69      }
70    }
71  }
72  return(d1-d0);
73}
74///////////////////////////////////////////////////////////////////////////////
75
76static proc invunit(poly u,int n)
77{
78  dbprint(printlevel-voice+2,"//gaussman::invunit");
79  if(ord(u)>0)
80  {
81    ERROR("no unit");
82  }
83  poly u0=jet(u,0);
84  u=jet(1-u/u0,n);
85  poly w=u;
86  poly v=1+u;
87  for(int i=n div ord(u);i>1;i--)
88  {
89    w=jet(w*u,n);
90    v=v+w;
91  }
92  v=jet(v,n)/u0;
93  return(v);
94}
95///////////////////////////////////////////////////////////////////////////////
96
97static proc expand(matrix M,matrix U,int n)
98{
99  dbprint(printlevel-voice+2,"//gaussman::expand");
100  for(int i=ncols(U);i>=1;i--)
101  {
102    U[i,i]=invunit(U[i,i],n-ord(M[i]));
103  }
104  return(jet(M*U,n));
105}
106///////////////////////////////////////////////////////////////////////////////
107
108static proc redNF(module M,module N,list #)
109{
110  matrix U=freemodule(ncols(M));
111  if(size(#)>0)
112  {
113    if(typeof(#[1])=="matrix")
114    {
115      U=#[1];
116    }
117  }
118
119  for(int i=ncols(M);i>=1;i--)
120  {
121    M[i]=M[i]/lead(U[i,i]);
122    U[i,i]=U[i,i]/lead(U[i,i]);
123  }
124  N=std(N);
125  module redNFM=matrix(0,nrows(M),ncols(M));
126  dbprint(printlevel-voice+2,"//gaussman::redNF: reduce");
127  module weakNFM=reduce(M,N);
128  while(size(weakNFM)>0)
129  {
130    redNFM=matrix(redNFM)+matrix(lead(weakNFM));
131    M=matrix(M)-matrix(lead(weakNFM))*U;
132    dbprint(printlevel-voice+2,"//gaussman::redNF: reduce");
133    weakNFM=reduce(M,N);
134  }
135  return(redNFM);
136}
137///////////////////////////////////////////////////////////////////////////////
138
139proc monomat(poly f,list #)
140"USAGE:   <matrix> M=monomat(<poly> f);
141ASSUME:  f defines an isolated hypersurface singularity
142RETURN:  exp(-2*pi*i*M) is a monodromy matrix
143EXAMPLE: example monomat; shows an example
144"
145{
146  int mide=-1;
147  if(size(#)>0)
148  {
149    mide=0;
150  }
151
152  int i,j;
153  int n=nvars(basering)-1;
154  for(i=n+1;i>=1;i--)
155  {
156    if(var(i)>1)
157    {
158      ERROR("basering not local");
159    }
160  }
161  ideal J=jacob(f);
162  ideal sJ=std(J);
163  if(vdim(sJ)<=0)
164  {
165    if(vdim(sJ)==0)
166    {
167      ERROR("singularity not singular");
168    }
169    else
170    {
171      ERROR("singularity not isolated");
172    }
173  }
174  ideal m=kbase(sJ);
175  int mu,modm=ncols(m),maxorddif(m);
176
177  ideal w=f*m;
178  matrix U=freemodule(mu);
179  matrix A0[mu][mu],A,C,D;
180  list l;
181  module H,dH=freemodule(mu),freemodule(mu);
182  module H0;
183  int sdH=1;
184  int k=-1;
185  int K,N;
186
187  while(k<K||sdH>0)
188  {
189    k++;
190    dbprint(printlevel-voice+2,"//gaussman::monomat: k="+string(k));
191
192    dbprint(printlevel-voice+2,"//gaussman::monomat: compute C");
193    C=coeffs(redNF(w,sJ,U),m);
194    A0=A0+C*var(1)^k;
195
196    if(sdH>0)
197    {
198      H0=H;
199      dbprint(printlevel-voice+2,"//gaussman::monomat: compute dH");
200      dH=jet(module(A0*dH+var(1)^2*diff(matrix(dH),var(1))),k);
201      H=H*var(1)+dH;
202
203      dbprint(printlevel-voice+2,"//gaussman::monomat: test dH==0");
204      sdH=size(reduce(H,std(H0*var(1))));
205      if(sdH>0)
206      {
207        A0=A0-var(1);
208      }
209      else
210      {
211        dbprint(printlevel-voice+2,"//gaussman::monomat: basis of saturation");
212        H=minbase(H0);
213        int modH=maxorddif(H);
214        K=modH+1;
215      }
216    }
217
218    if(k==K&&sdH==0)
219    {
220      N=k-modH;
221      dbprint(printlevel-voice+2,"//gaussman::monomat: A on saturation");
222      l=division(H*var(1),A0*H+var(1)^2*diff(matrix(H),var(1)));
223      A=expand(l[1],l[2],N-1);
224      if(mide<0)
225      {
226        dbprint(printlevel-voice+2,"//gaussman::monomat: eigenvalues e of A");
227        ideal e=jordan(A,-1)[1];
228        dbprint(printlevel-voice+2,"//gaussman::monomat: e="+string(e));
229        mide=maxintdif(e);
230        K=K+mide;
231      }
232    }
233
234    if(k<K||sdH>0)
235    {
236      dbprint(printlevel-voice+2,"//gaussman::monomat: division by J");
237      l=division(J,ideal(matrix(w)-matrix(m)*C*U));
238      D=l[1];
239
240      dbprint(printlevel-voice+2,"//gaussman::monomat: compute w/U");
241      for(j=mu;j>=1;j--)
242      {
243        if(l[2][j,j]!=0)
244        {
245          dbprint(printlevel-voice+2,
246            "//gaussman::monomat: compute U["+string(j)+"]");
247          U[j,j]=U[j,j]*l[2][j,j];
248        }
249        dbprint(printlevel-voice+2,
250          "//gaussman::monomat: compute w["+string(j)+"]");
251        w[j]=0;
252        for(i=n+1;i>=1;i--)
253        {
254          w[j]=w[j]+U[j,j]*diff(D[i,j],var(i))-diff(U[j,j],var(i))*D[i,j];
255        }
256      }
257      U=U*U;
258    }
259  }
260
261  while(mide>0)
262  {
263    dbprint(printlevel-voice+2,"//gaussman::monomat: mide="+string(mide));
264
265    intvec b;
266    b[mu]=0;
267    U=0;
268    module dU;
269    A0=jet(A,0);
270    matrix A0e;
271    for(i=ncols(e);i>=1;i--)
272    {
273      A0e=freemodule(mu);
274      for(j=n;j>=0;j--) // Potenzen von Matrizen?
275      {
276        A0e=A0e*(A0-e[i]);
277      }
278      dU=syz(A0e);
279      U=dU+U;
280      b[i]=size(dU);
281    }
282    A=division(U,A*U)[1];
283
284    intvec ide;
285    ide[mu]=0;
286    for(i=ncols(e);i>=1;i--)
287    {
288      for(j=i-1;j>=1;j--)
289      {
290        k=int(e[j]-e[i]);
291        if(k>ide[i])
292        {
293          ide[i]=k;
294        }
295        if(-k>ide[j])
296        {
297          ide[j]=-k;
298        }
299      }
300    }
301    for(j,k=ncols(b),mu;j>=1;j--)
302    {
303      for(i=b[j];i>=1;i--)
304      {
305        ide[k]=ide[j];
306        k--;
307      }
308    }
309
310    for(i=mu;i>=1;i--)
311    {
312      if(ide[i]>0)
313      {
314        A[i,i]=A[i,i]+1;
315        e[i]=e[i]+1;
316      }
317      for(j=mu;j>=1;j--)
318      {
319        if(ide[i]==0&&ide[j]>0)
320        {
321          A[i,j]=A[i,j]*var(1);
322        }
323        else
324        {
325          if(ide[i]>0&&ide[j]==0)
326          {
327            A[i,j]=A[i,j]/var(1);
328          }
329        }
330      }
331    }
332    mide--;
333  }
334
335  return(jet(A,0));
336}
337example
338{ "EXAMPLE:"; echo=2;
339  ring R=0,(x,y),ds;
340  poly f=x5+x2y2+y5;
341  matrix M=monomat(f);
342  print(M);
343}
344///////////////////////////////////////////////////////////////////////////////
345
346proc monospec(poly f)
347"USAGE:   <matrix> M=monospec(<poly> f);
348ASSUME:  f defines an isolated hypersurface singularity
349RETURN:  the spectrum of exp(-2*pi*i*M) is the spectrum of monodromy
350EXAMPLE: example monospec; shows an example
351"
352{
353  return(monomat(f,0));
354}
355example
356{ "EXAMPLE:"; echo=2;
357  ring R=0,(x,y),ds;
358  poly f=x5+x2y2+y5;
359  matrix M=monospec(f);
360  print(M);
361}
362///////////////////////////////////////////////////////////////////////////////
363
364proc vfilt(poly f,list #)
365"USAGE:   <list> l=vfilt(<poly> f);
366ASSUME:  f defines an isolated hypersurface singularity
367RETURN:  <ideal> l[1] : spectral numbers in increasing order
368         <intvec> l[2] :
369           <int> l[2][i] : multiplicity of spectral number l[1][i]
370         <list> l[3] :
371           <module> l[3][i] : vector space basis of l[1][i]-th graded part
372                              of the V-filtration on H''/H' in terms of l[4]
373         <ideal> l[4] : monomial vector space basis of H''/H'
374         <ideal> l[5] : standard basis of Jacobian ideal
375EXAMPLE: example vfilt; shows an example
376"
377{
378  int i,j;
379  int n=nvars(basering)-1;
380  for(i=n+1;i>=1;i--)
381  {
382    if(var(i)>1)
383    {
384      ERROR("basering not local");
385    }
386  }
387  ideal J=jacob(f);
388  ideal sJ=std(J);
389  if(vdim(sJ)<=0)
390  {
391    if(vdim(sJ)==0)
392    {
393      ERROR("singularity not singular");
394    }
395    else
396    {
397      ERROR("singularity not isolated");
398    }
399  }
400  ideal m=kbase(sJ);
401  int mu,modm=ncols(m),maxorddif(m);
402
403  ideal w=f*m;
404  matrix U=freemodule(mu);
405  matrix A[mu][mu],C,D;
406  list l;
407  module H,dH=freemodule(mu),freemodule(mu);
408  module H0;
409  int sdH=1;
410  int k=-1;
411  int K;
412
413  while(k<K||sdH>0)
414  {
415    k++;
416    dbprint(printlevel-voice+2,"//gaussman::vfilt: k="+string(k));
417
418    dbprint(printlevel-voice+2,"//gaussman::vfilt: compute C");
419    C=coeffs(redNF(w,sJ,U),m);
420    A=A+C*var(1)^k;
421
422    if(sdH>0)
423    {
424      H0=H;
425      dbprint(printlevel-voice+2,"//gaussman::vfilt: compute dH");
426      dH=jet(module(A*dH+var(1)^2*diff(matrix(dH),var(1))),k);
427      H=H*var(1)+dH;
428
429      dbprint(printlevel-voice+2,"//gaussman::vfilt: test dH==0");
430      sdH=size(reduce(H,std(H0*var(1))));
431      if(sdH>0)
432      {
433        A=A-var(1);
434      }
435      else
436      {
437        dbprint(printlevel-voice+2,"//gaussman::vfilt: basis of saturation");
438        H=minbase(H0);
439        int modH=maxorddif(H);
440        if(k<n)
441        {
442          K=modH+n+1;
443        }
444        else
445        {
446          K=modH+k+1;
447        }
448        H0=freemodule(mu)*var(1)^k;
449      }
450    }
451
452    if(k<K||sdH>0)
453    {
454      dbprint(printlevel-voice+2,"//gaussman::vfilt: division by J");
455      l=division(J,ideal(matrix(w)-matrix(m)*C*U));
456      D=l[1];
457
458      dbprint(printlevel-voice+2,"//gaussman::monomat: compute w/U");
459      for(j=mu;j>=1;j--)
460      {
461        if(l[2][j,j]!=0)
462        {
463          dbprint(printlevel-voice+2,
464            "//gaussman::monomat: compute U["+string(j)+"]");
465          U[j,j]=U[j,j]*l[2][j,j];
466        }
467        dbprint(printlevel-voice+2,
468          "//gaussman::monomat: compute w["+string(j)+"]");
469        w[j]=0;
470        for(i=n+1;i>=1;i--)
471        {
472          w[j]=w[j]+U[j,j]*diff(D[i,j],var(i))-diff(U[j,j],var(i))*D[i,j];
473        }
474      }
475      U=U*U;
476    }
477  }
478  int N=k-modH;
479
480  dbprint(printlevel-voice+2,"//gaussman::vfilt: transform H0 to saturation");
481  l=division(H,H0);
482  H0=expand(l[1],l[2],N-1);
483
484  dbprint(printlevel-voice+2,"//gaussman::vfilt: H0 as vector space V0");
485  dbprint(printlevel-voice+2,"//gaussman::vfilt: H1 as vector space V1");
486  poly p;
487  int i0,j0,i1,j1;
488  matrix V0[mu*N][mu*N];
489  matrix V1[mu*N][mu*(N-1)];
490  for(i0=mu;i0>=1;i0--)
491  {
492    for(i1=mu;i1>=1;i1--)
493    {
494      p=H0[i1,i0];
495      while(p!=0)
496      {
497        j1=leadexp(p)[1];
498        for(j0=N-j1-1;j0>=0;j0--)
499        {
500          V0[i1+(j1+j0)*mu,i0+j0*mu]=V0[i1+(j1+j0)*mu,i0+j0*mu]+leadcoef(p);
501          if(j1+j0+1<N)
502          {
503            V1[i1+(j1+j0+1)*mu,i0+j0*mu]=
504            V1[i1+(j1+j0+1)*mu,i0+j0*mu]+leadcoef(p);
505          }
506        }
507        p=p-lead(p);
508      }
509    }
510  }
511
512  dbprint(printlevel-voice+2,"//gaussman::vfilt: A on saturation");
513  l=division(H*var(1),A*H+var(1)^2*diff(matrix(H),var(1)));
514  A=expand(l[1],l[2],N-1);
515
516  dbprint(printlevel-voice+2,"//gaussman::vfilt: matrix M of A");
517  matrix M[mu*N][mu*N];
518  for(i0=mu;i0>=1;i0--)
519  {
520    for(i1=mu;i1>=1;i1--)
521    {
522      p=A[i1,i0];
523      while(p!=0)
524      {
525        j1=leadexp(p)[1];
526        for(j0=N-j1-1;j0>=0;j0--)
527        {
528          M[i1+(j0+j1)*mu,i0+j0*mu]=leadcoef(p);
529        }
530        p=p-lead(p);
531      }
532    }
533  }
534  for(i0=mu;i0>=1;i0--)
535  {
536    for(j0=N-1;j0>=0;j0--)
537    {
538      M[i0+j0*mu,i0+j0*mu]=M[i0+j0*mu,i0+j0*mu]+j0;
539    }
540  }
541
542  dbprint(printlevel-voice+2,"//gaussman::vfilt: eigenvalues eA of A");
543  ideal eA=jordan(A,-1)[1];
544  dbprint(printlevel-voice+2,"//gaussman::vfilt: eA="+string(eA));
545
546  dbprint(printlevel-voice+2,"//gaussman::vfilt: eigenvalues eM of M");
547  ideal eM;
548  k=0;
549  intvec u;
550  for(i=N;i>=1;i--)
551  {
552    u[i]=1;
553  }
554  i0=1;
555  while(u[N]<=ncols(eA))
556  {
557    for(i,i1=i0+1,i0;i<=N;i++)
558    {
559      if(eA[u[i]]+i<eA[u[i1]]+i1)
560      {
561        i1=i;
562      }
563    }
564    k++;
565    eM[k]=eA[u[i1]]+i1-1;
566    u[i1]=u[i1]+1;
567    if(u[i1]>ncols(eA))
568    {
569      i0=i1+1;
570    }
571  }
572  dbprint(printlevel-voice+2,"//gaussman::vfilt: eM="+string(eM));
573
574  dbprint(printlevel-voice+2,"//gaussman::vfilt: V-filtration on H0/H1");
575  ideal s;
576  k=0;
577  list V;
578  matrix Me;
579  V[ncols(eM)+1]=std(V1);
580  intvec d;
581  if(size(#)>0)
582  {
583    for(i=ncols(eM);number(eM[i])-1>number(n-1)/2;i--)
584    {
585      Me=freemodule(mu*N);
586      for(i0=n;i0>=0;i0--) // Potenzen von Matrizen?
587      {
588        Me=Me*(M-eM[i]);
589      }
590
591      dbprint(printlevel-voice+2,
592        "//gaussman::vfilt: compute V["+string(i)+"]");
593      V1=module(V1)+syz(Me);
594      V[i]=std(intersect(V1,V0));
595
596      if(size(V[i])>size(V[i+1]))
597      {
598        k++;
599        s[k]=eM[i]-1;
600        d[k]=size(V[i])-size(V[i+1]);
601      }
602    }
603
604    dbprint(printlevel-voice+2,"//gaussman::vfilt: symmetry index reached");
605    j=k;
606    if(number(eM[i])-1==number(n-1)/2)
607    {
608      Me=freemodule(mu*N);
609      for(i0=n;i0>=0;i0--) // Potenzen von Matrizen?
610      {
611        Me=Me*(M-eM[i]);
612      }
613
614      dbprint(printlevel-voice+2,
615        "//gaussman::vfilt: compute V["+string(i)+"]");
616      V1=module(V1)+syz(Me);
617      V[i]=std(intersect(V1,V0));
618
619      if(size(V[i])>size(V[i+1]))
620      {
621        k++;
622        s[k]=eM[i]-1;
623        d[k]=size(V[i])-size(V[i+1]);
624      }
625    }
626
627    dbprint(printlevel-voice+2,"//gaussman::vfilt: apply symmetry");
628    while(j>=1)
629    {
630      k++;
631      s[k]=s[j];
632      s[j]=n-1-s[k];
633      d[k]=d[j];
634      j--;
635    }
636
637    return(list(s,d));
638  }
639  else
640  {
641    list v;
642    j=-1;
643    for(i=ncols(eM);i>=1;i--)
644    {
645      Me=freemodule(mu*N);
646      for(i0=n;i0>=0;i0--) // Potenzen von Matrizen?
647      {
648        Me=Me*(M-eM[i]);
649      }
650
651      dbprint(printlevel-voice+2,
652        "//gaussman::vfilt: compute V["+string(i)+"]");
653      V1=module(V1)+syz(Me);
654      V[i]=std(intersect(V1,V0));
655
656      if(size(V[i])>size(V[i+1]))
657      {
658        if(number(eM[i]-1)>=number(n-1)/2)
659        {
660          k++;
661          s[k]=eM[i]-1;
662          dbprint(printlevel-voice+2,"//gaussman::vfilt: transform to V0");
663          v[k]=matrix(freemodule(ncols(V[i])),mu,mu*N)*division(V0,V[i])[1];
664        }
665        else
666        {
667          if(j<0)
668          {
669            if(s[k]==number(n-1)/2)
670            {
671              j=k-1;
672            }
673            else
674            {
675              j=k;
676            }
677          }
678          k++;
679          s[k]=s[j];
680          s[j]=eM[i]-1;
681          v[k]=v[j];
682          dbprint(printlevel-voice+2,"//gaussman::vfilt: transform to V0");
683          v[j]=matrix(freemodule(ncols(V[i])),mu,mu*N)*division(V0,V[i])[1];
684          j--;
685        }
686      }
687    }
688
689    dbprint(printlevel-voice+2,"//gaussman::vfilt: graded parts");
690    option(redSB);
691    for(k=1;k<size(v);k++)
692    {
693      v[k]=std(reduce(v[k],std(v[k+1])));
694      d[k]=size(v[k]);
695    }
696    v[k]=std(v[k]);
697    d[k]=size(v[k]);
698
699    return(list(s,d,v,m,sJ));
700  }
701}
702example
703{ "EXAMPLE:"; echo=2;
704  ring R=0,(x,y),ds;
705  poly f=x5+x2y2+y5;
706  list l=vfilt(f);
707  print(l);
708}
709///////////////////////////////////////////////////////////////////////////////
710
711proc singspec(poly f)
712"USAGE:   <list> l=singspec(<poly> f);
713ASSUME:  f defines an isolated hypersurface singularity
714RETURN:  <ideal> l[1] : spectral numbers in increasing order
715         <intvec> l[2] :
716           <int> l[2][i] : multiplicity of spectral number l[1][i]
717EXAMPLE: example singspec; shows an example
718"
719{
720  return(vfilt(f,0));
721}
722example
723{ "EXAMPLE:"; echo=2;
724  ring R=0,(x,y),ds;
725  poly f=x5+x2y2+y5;
726  list l=singspec(f);
727  print(l);
728}
729///////////////////////////////////////////////////////////////////////////////
730
731proc gamma(list l)
732"USAGE:   <number> g=gamma(singspec(<poly> f));
733ASSUME:  f defines an isolated hypersurface singularity
734RETURN:  Hertling's gamma invariant
735EXAMPLE: example gamma; shows an example
736"
737{
738  ideal s=l[1];
739  intvec d=l[2];
740  int n=nvars(basering)-1;
741  number g=0;
742  int i,j;
743  for(i=1;i<=ncols(s);i++)
744  {
745    for(j=1;j<=d[i];j++)
746    {
747      g=g+(number(s[i])-number(n-1)/2)^2;
748    }
749  }
750  g=-g/4+sum(d)*number(s[ncols(s)]-s[1])/48;
751  return(g);
752}
753example
754{ "EXAMPLE:"; echo=2;
755  ring R=0,(x,y),ds;
756  poly f=x5+x2y2+y5;
757  gamma(singspec(f));
758}
759///////////////////////////////////////////////////////////////////////////////
760
761proc gamma4(list l)
762"USAGE:   <number> g4=gamma4(singspec(<poly> f));
763ASSUME:  f defines an isolated hypersurface singularity
764RETURN:  Hertling's gamma(4) invariant
765EXAMPLE: example gamma4; shows an example
766"
767{
768  ideal s=l[1];
769  intvec d=l[2];
770  int n=nvars(basering)-1;
771  number g4=0;
772  int i,j;
773  for(i=1;i<=ncols(s);i++)
774  {
775    for(j=1;j<=d[i];j++)
776    {
777      g4=g4+(number(s[i])-number(n-1)/2)^4;
778    }
779  }
780  g4=g4-(number(s[ncols(s)]-s[1])/12-1/30)*
781    (sum(d)*number(s[ncols(s)]-s[1])/4-24*gamma(l));
782 return(g4);
783}
784example
785{ "EXAMPLE:"; echo=2;
786  ring R=0,(x,y),ds;
787  poly f=x5+x2y2+y5;
788  gamma4(singspec(f));
789}
790///////////////////////////////////////////////////////////////////////////////
791
792proc vjacob(list l)
793"USAGE:   <list> l=vjacob(vfilt(<poly> f));
794ASSUME:  f defines an isolated hypersurface singularity
795RETURN:  <ideal> l[1] : spectral numbers of the V-filtration on the
796                        Jacobian algebra in increasing order
797         <intvec> l[2] :
798           <int> l[2][i] : multiplicity of spectral number l[1][i]
799         <list> l[3] :
800           <module> l[3][i] : vector space basis of l[1][i]-th graded part
801                              of the V-filtration on the Jaconian algebra
802                              in terms of l[4]
803         <ideal> l[4] : monomial vector space basis of the Jacobian algebra
804         <ideal> l[5] : standard basis of Jacobian ideal
805EXAMPLE: example vjacob; shows an example
806"
807{
808  def s,d,v,m,sJ=l[1..5];
809  int mu=ncols(m);
810
811  int i,j,k;
812  module V=v[1];
813  for(i=2;i<=size(v);i++)
814  {
815    V=V,v[i];
816  }
817
818  list M;
819  for(i=ncols(m);i>=1;i--)
820  {
821    M[i]=lift(V,coeffs(redNF(m[i]*m,sJ),m)*V);
822  }
823
824  int i0,j0,i1,j1;
825  number r0=number(s[1]-s[ncols(s)]);
826  number r1,r2;
827  matrix M0;
828  module L;
829  list v0=freemodule(ncols(m));
830  ideal s0=r0;
831
832  while(r0<number(s[ncols(s)]-s[1]))
833  {
834    r1=number(s[ncols(s)]-s[1]);
835    for(j=ncols(s);j>=1;j--)
836    {
837      for(i=ncols(s);i>=1;i--)
838      {
839        r2=number(s[i]-s[j]);
840        if(r2>r0&&r2<r1)
841        {
842          r1=r2;
843        }
844        else
845        {
846          if(r2<=r0)
847          {
848            i=0;
849          }
850        }
851      }
852    }
853    r0=r1;
854
855    l=ideal();
856    for(k=ncols(m);k>=2;k--)
857    {
858      l=l+list(ideal());
859    }
860
861    j0=mu-d[ncols(s)]+1;
862    for(j=ncols(s);j>=1;j--)
863    {
864      i0=1;
865      i=1;
866      while(i<ncols(s)&&s[i]<s[j]+r0)
867      {
868        i0=i0+d[i];
869        i++;
870      }
871      if(s[i]<s[j]+r0)
872      {
873        i0=i0+d[i];
874        i++;
875      }
876      for(k=1;k<=ncols(m);k++)
877      {
878        M0=M[k];
879        if(i0>1)
880        {
881          l[k]=l[k],M0[1..i0-1,j0..j0+d[j]-1];
882        }
883      }
884      j0=j0-d[j];
885    }
886
887    L=transpose(module(l[1]));
888    for(k=2;k<=ncols(m);k++)
889    {
890      L=L,transpose(module(l[k]));
891    }
892
893    v0=v0+list(syz(L));
894    s0=s0,r0;
895  }
896
897  option(redSB);
898  for(i=1;i<size(v0);i++)
899  {
900    v0[i+1]=std(v0[i+1]);
901    v0[i]=std(reduce(v0[i],v0[i+1]));
902  }
903
904  i=1;
905  while(size(v0[i])==0)
906  {
907    i++;
908  }
909  list v1=v0[i];
910  intvec d1=size(v0[i]);
911  ideal s1=s0[i];
912  i++;
913  while(i<=size(v0))
914  {
915    if(size(v0[i])>0)
916    {
917      v1=v1+list(v0[i]);
918      d1=d1,size(v0[i]);
919      s1=s1,s0[i];
920    }
921    i++;
922  }
923  return(list(s1,d1,v1,m));
924}
925example
926{ "EXAMPLE:"; echo=2;
927  ring R=0,(x,y),ds;
928  poly f=x5+x2y2+y5;
929  vjacob(vfilt(f));
930}
931///////////////////////////////////////////////////////////////////////////////
932
933proc tst_gaussm(poly f)
934{
935  echo=2;
936  basering;
937  f;
938  print(monomat(f));
939  print(monospec(f));
940  list l=vfilt(f);
941  l;
942  vjacob(l);
943  l=singspec(f);
944  l;
945  gamma(l);
946  gamma4(l);
947}
948///////////////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.