source: git/Singular/LIB/gaussman.lib @ 7c7ca9

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