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

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