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

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