source: git/Singular/LIB/surfacesignature.lib @ ea87a9

fieker-DuValspielwiese
Last change on this file since ea87a9 was ea87a9, checked in by Hans Schoenemann <hannes@…>, 14 years ago
tabs and spaces git-svn-id: file:///usr/local/Singular/svn/trunk@13403 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 11.8 KB
Line 
1///////////////////////////////////////////////////////////////////////////////
2version="$Id$";
3category="Singularities";
4info="
5LIBRARY:  surfacesignature.lib        signature of surface singularity
6
7AUTHORS:  Gerhard Pfister             pfister@mathematik.uni-kl.de
8@*        Muhammad Ahsan Banyamin     ahsanbanyamin@gmail.com
9@*        Stefan Steidel              steidel@mathematik.uni-kl.de
10
11OVERVIEW:
12
13  A library for computing the signature of irreducible surface singularity.
14  The signature of a surface singularity is defined in [Durfee, A.: The
15  Signature of Smoothings of Complex Surface Singularities, Math. Ann., 232,
16  85-98 (1978)]. The algorithm we use has been proposed in [Nemethi, A.: The
17  signature of f(x,y)+z^N, Proceedings of Singularity Conference (C.T.C. Wall's
18  60th birthday meeting), Liverpool 1996, London Math.Soc. LN 263(1999),
19  131-149].
20
21PROCEDURES:
22 brieskornSign(a1,a2,a3);  signature of Brieskorn singularity x^a1+y^a2+z^a3
23 signature(N,f);           signature of singularity z^N+f(x,y)=0, f irreducible
24";
25
26LIB "hnoether.lib";
27LIB "alexpoly.lib";
28LIB "gmssing.lib";
29
30///////////////////////////////////////////////////////////////////////////////
31//------- sigma(z^N + f) in terms of Puiseux pairs of f for f irreducible -----
32
33static proc exponentSequence(poly f)
34//=== computes the sequence a_1,...,a_s of exponents as described in [Nemethi]
35//=== using the Puiseux pairs (m_1, n_1),...,(m_s, n_s) of f:
36//===  - a_1 = m_1,
37//===  - a_i = m_i - n_i * (m_[i-1] - n_[i-1] * a_[i-1]).
38//===
39//=== Return: list of two intvecs:
40//===         1st entry: A = (a_1,...,a_s)
41//===         2nd entry: N = (n_1,...,n_s)
42{
43   def R = basering;
44   ring S = 0,(x,y),dp;
45   poly f = fetch(R,f);
46   list puiseuxPairs = invariants(f);
47   setring R;
48
49   intvec M = puiseuxPairs[1][3];
50   intvec N = puiseuxPairs[1][4];
51
52   int i;
53   int a = M[1];
54   intvec A = a;
55   for(i = 2; i <= size(M); i++)
56   {
57      a = M[i] - N[i] * (M[i-1] - N[i-1] * a);
58      A[size(A)+1] = a;
59   }
60
61   return(list(A,N));
62}
63example
64{ "EXAMPLE:"; echo = 2;
65   ring r = 0,(x,y),dp;
66   exponentSequence(y4+2x3y2+x6+x5y);
67}
68
69///////////////////////////////////////////////////////////////////////////////
70
71proc brieskornSign(a1,a2,a3)
72"USAGE:  brieskornSign(a1,a2,a3); a1,a2,a3 = integers
73RETURN:  signature of Brieskorn singularity x^a1+y^a2+z^a3
74EXAMPLE: example brieskornSign; shows an example
75"
76{
77   int a_temp, t, k1, k2, k3, s_t, sigma;
78   number s;
79
80   if(a1 > a2) { a_temp = a1; a1 = a2; a2 = a_temp; }
81   if(a2 > a3) { a_temp = a2; a2 = a3; a3 = a_temp; }
82   if(a1 > a2) { a_temp = a1; a1 = a2; a2 = a_temp; }
83
84   for(t = 0; t <= 2; t++)
85   {
86      s_t = 0;
87      for(k1 = 1; k1 <= a1-1; k1++)
88      {
89         for(k2 = 1; k2 <= a2-1; k2++)
90         {
91            for(k3 = 1; k3 <= a3-1; k3++)
92            {
93               s = number(k1)/a1 + number(k2)/a2 + number(k3)/a3;
94               if(t < s)
95               {
96                  if(s < t+1)
97                  {
98                     s_t = s_t + 1;
99                  }
100                  else
101                  {
102                     break;
103                  }
104               }
105            }
106            if(k3 == 1) { break; }
107         }
108         if(k2 == 1) { break; }
109      }
110      sigma = sigma + (-1)^t * s_t;
111   }
112   return(sigma);
113}
114example
115{ "EXAMPLE:"; echo = 2;
116   ring R = 0,x,dp;
117   brieskornSign(11,3,5);
118}
119
120///////////////////////////////////////////////////////////////////////////////
121
122static proc signatureP(int N,poly f)
123"USAGE:  signatureP(N,f); N = integer, f = irreducible poly in 2 variables
124RETURN:  signature of surface singularity defined by z^N + f(x,y) = 0
125EXAMPLE: example signatureP; shows an example
126"
127{
128   int i, d, prod, sigma;
129   list L = exponentSequence(f);
130   int s = size(L[2]);
131
132   if(s == 1)
133   {
134      return(brieskornSign(L[1][1], L[2][1], N));
135   }
136
137   prod = 1;
138   sigma = brieskornSign(L[1][s], L[2][s], N);
139   for(i = s - 1; i >= 1; i--)
140   {
141      prod = prod * L[2][i+1];
142      d = gcd(N, prod);
143      sigma = sigma + d * brieskornSign(L[1][i], L[2][i], N/d);
144   }
145
146   return(sigma);
147}
148example
149{ "EXAMPLE:"; echo = 2;
150   ring r = 0,(x,y),dp;
151   int N  = 3;
152   poly f = x15-21x14+8x13y-6x13-16x12y+20x11y2-x12+8x11y-36x10y2
153            +24x9y3+4x9y2-16x8y3+26x7y4-6x6y4+8x5y5+4x3y6-y8;
154   signatureP(N,f);
155}
156
157///////////////////////////////////////////////////////////////////////////////
158//------- sigma(z^N + f) in terms of the imbedded resolution graph of f -------
159
160static proc dedekindSum(number b, number c, int a)
161{
162   number s,d,e;
163   int k;
164   for(k=1;k<=a-1;k++)
165   {
166      d=k*b mod a;
167      e=k*c mod a;
168      if(d*e!=0)
169      {
170         s=s+(d/a-1/2)*(e/a-1/2);
171      }
172   }
173   return(s);
174}
175
176///////////////////////////////////////////////////////////////////////////////
177
178static proc isRupture(intvec v)
179//=== decides whether the exceptional divisor given by the row v in the
180//=== incidence matrix of the resolution graph intersects at least 3 other
181//=== divisors
182{
183   int i,j;
184   for(i=1;i<=size(v);i++)
185   {
186       if(v[i]<0){return(0);}
187       if(v[i]!=0){j++;}
188   }
189   return(j>=4);
190}
191
192///////////////////////////////////////////////////////////////////////////////
193
194static proc sumExcepDiv(intmat N, list M, int K, int n)
195//=== computes part of the formulae for eta(g,K), g defining an
196//=== isolated curve singularity
197//=== N the incidence matrix of the resolution graph of g
198//=== M list of total multiplicities
199//=== n = nrows(N)
200{
201   int i,j,m,d;
202   for(i=1;i<=n;i++)
203   {
204      if(N[i,i]>0)
205      {
206         m=gcd(K,M[i]);
207         for(j=1;j<=n;j++)
208         {
209            if((i!=j)&&(N[i,j]!=0))
210            {
211               if(m==1){break;}
212               m=gcd(m,M[j]);
213            }
214         }
215         d=d+m-1;
216      }
217   }
218   return(d);
219}
220
221///////////////////////////////////////////////////////////////////////////////
222
223static proc sumEdges(intmat N, list M, int K, int n)
224//=== computes part of the formulae for eta(g,K), g defining an
225//=== isolated curve singularity
226//=== N the incidence matrix of the resolution graph of g
227//=== M list of total multiplicities
228//=== n = nrows(N)
229{
230   int i,j,d;
231   for(i=1;i<=n-1;i++)
232   {
233      for(j=i+1;j<=n;j++)
234      {
235         if(N[i,j]==1)
236         {
237            d=d+gcd(K,gcd(M[i],M[j]))-1;
238         }
239      }
240   }
241   return(d);
242}
243
244///////////////////////////////////////////////////////////////////////////////
245
246static proc etaRes(list L, int K)
247//=== L total multiplicities
248//=== eta-invariant in terms of the imbedded resolution graph of f
249{
250   int i,j,d;
251   intvec v;
252   number e;
253   intmat N = L[1];         // incidence matrix of the resolution graph
254   int n = ncols(L[1]);     // number of vertices in the resolution graph
255   int a = ncols(L[2]);     // number of branches
256   list M;                  // total multiplicities
257   for(i=1;i<=n;i++)
258   {
259      d=L[2][i,1];
260      for(j=2;j<=a;j++)
261      {
262         d=d+L[2][i,j];
263      }
264      if(d==0){d=1;}
265      M[i]=d;
266   }
267   for(i=1;i<=n;i++)
268   {
269      v=N[i,1..n];
270      if(isRupture(v))    // the divisor intersects more then two others
271      {
272         for(j=1;j<=n;j++)
273         {
274            if((i!=j)&&(v[j]!=0))
275            {
276               e=e+dedekindSum(M[j],K,M[i]);
277            }
278         }
279      }
280   }
281   if(a==1)
282   {
283      //the irreducible case
284      return(4*e);
285   }
286   return(a-1+4*e+sumEdges(N,M,K,n)-sumExcepDiv(N,M,K,n));
287}
288
289///////////////////////////////////////////////////////////////////////////////
290//------------ sigma(z^N + f) in terms of the spectral pairs of f -------------
291
292static proc fracPart(number n)
293//=== computes the fractional part n2 of n
294//=== i.e. n2 is not in Z but n-n2 is in Z
295{
296   number a,b;
297   int r;
298   a = numerator(n);
299   b = denominator(n);
300   int z = int(number(a));
301   int y = int(number(b));
302   r = z mod y;
303   int q = (z-r) div y;
304   number n1 = q;
305   number n2 = n-n1;
306   return(n2);
307}
308
309///////////////////////////////////////////////////////////////////////////////
310
311static proc etaSpec(list L, int N)
312//=== L spectral numbers
313//=== eta-invariant in terms of the spectral pairs of f
314{
315   int i;
316   number e, h;
317
318   int n = ncols(L[1]);
319
320   if((n mod 2) == 0)
321   // 0 is not a spectral number, thus f is irreducible
322   {
323      for(i = n/2+1; i <= n; i++)
324      {
325         e = e + (1 - 2 * fracPart(N * number(L[1][i]))) * L[3][i];
326      }
327      return(2*e);
328   }
329   else
330   // 0 is a spectral number, thus f is reducible
331   {
332      // sum of Hodge numbers in eta function
333      for(i = 1; i <= n; i++)
334      {
335         if((L[2][i] == 2) && ((denominator(leadcoef(N*L[1][i]))==1)
336                              ||(denominator(leadcoef(N*L[1][i]))==-1)))
337         {
338            h = h + L[3][i];
339         }
340      }
341
342      // summand coming from spectral number 0 in eta function
343      h = h + L[3][(n+1)/2];
344
345      // sum coming from non-zero spectral numbers in eta function
346      for(i = (n+3)/2; i <= n; i++)
347      {
348         if(!((denominator(leadcoef(N*L[1][i]))==1)
349             ||(denominator(leadcoef(N*L[1][i]))==-1)))
350         {
351            e = e + (1 - 2 * fracPart(N * number(L[1][i]))) * L[3][i];
352         }
353      }
354      return(h + 2*e);
355   }
356}
357
358///////////////////////////////////////////////////////////////////////////////
359//---------------- Consolidation of the three former variants -----------------
360
361proc signature(int N, poly f, list #)
362"USAGE:  signature(N,f); N = integer, f = reduced poly in 2 variables,
363                         # empty or 1,2,3
364@*       - if # is empty or #[1] = 2 then resolution of singularities is used
365@*       - if #[1] = 1 then f has to be analytically irreducible and Puiseux
366                       expansions are used
367@*       - if #[1] = 3 then spectral pairs are used
368RETURN:  signature of surface singularity defined by z^N + f(x,y) = 0
369EXAMPLE: example signature; shows an example
370"
371{
372   if(size(#) == 0)
373   {
374      list L = totalmultiplicities(f);
375      return(etaRes(L,N) - N*etaRes(L,1));
376   }
377
378   if(#[1] == 1)
379   {
380      return(signatureP(N,f));
381   }
382
383   if(#[1] == 2)
384   {
385      list L = totalmultiplicities(f);
386      return(etaRes(L,N) - N*etaRes(L,1));
387   }
388
389   if(#[1] == 3)
390   {
391      def R = basering;
392      def Rds = changeord("ds");
393      setring Rds;
394      poly f = imap(R,f);
395      list L = sppairs(f);
396      setring R;
397      list L = imap(Rds,L);
398      return(etaSpec(L,N) - N*etaSpec(L,1));
399   }
400}
401example
402{ "EXAMPLE:"; echo = 2;
403   ring r = 0,(x,y),dp;
404   int N  = 3;
405   poly f = x15-21x14+8x13y-6x13-16x12y+20x11y2-x12+8x11y-36x10y2
406            +24x9y3+4x9y2-16x8y3+26x7y4-6x6y4+8x5y5+4x3y6-y8;
407   signature(N,f,1);
408   signature(N,f,2);
409}
410
411///////////////////////////////////////////////////////////////////////////////
412
413/*
414Further examples
415
416ring r = 0,(x,y),dp;
417int N;
418poly f,g,g1,g2,g3;
419
420
421// irreducible polynomials
422
423N = 5;
424f = x15-21x14+8x13y-6x13-16x12y+20x11y2-x12+8x11y-36x10y2
425    +24x9y3+4x9y2-16x8y3+26x7y4-6x6y4+8x5y5+4x3y6-y8;
426g = f^3 + x17y17;
427
428N = 6;
429f = y4+2x3y2+x6+x5y;
430g1 = f^2 + x5y5;
431g2 = f^3 + x11y11;
432g3 = f^3 + x17y17;
433
434N = 7;
435f = x5+y11;
436g1 = f^3 + x11y11;
437g2 = f^3 + x17y17;
438
439N = 6;
440// k0 = 30, k1 = 35, k2 = 71
441f = x71+6x65+15x59-630x52y6+20x53+6230x46y6+910x39y12+15x47
442    -7530x40y6+14955x33y12-285x26y18+6x41+1230x34y6+4680x27y12
443    +1830x20y18+30x13y24+x35-5x28y6+10x21y12-10x14y18+5x7y24-y30;
444
445// k0 = 16, k1 = 24, k2 = 28, k3 = 30, k4 = 31
446f = x31-781x30+16x29y-3010x29-2464x28y+104x27y2-2805x28-7024x27y
447    -5352x26y2+368x25y3+366x27-7136x26y-984x25y2-8000x24y3
448    +836x23y4+34x26-320x25y-6464x24y2+6560x23y3-8812x22y4+1392x21y5
449    -12x25+256x24y-1296x23y2-1536x22y3+4416x21y4-8864x20y5+1752x19y6
450    -x24+16x23y-88x22y2-16x21y3-404x20y4+3056x19y5-6872x18y6+1648x17y7
451    +8x21y2-96x20y3+524x19y4-1472x18y5+3464x17y6-3808x16y7+1290x15y8
452    -28x18y4+240x17y5-976x16y6+2208x15y7-2494x14y8+816x13y9+56x15y6
453    -320x14y7+844x13y8-1216x12y9+440x11y10-70x12y8+240x11y9-344x10y10
454    +240x9y11+56x9y10-96x8y11+52x7y12-28x6y12+16x5y13+8x3y14-y16;
455
456
457// reducible polynomials
458
459N = 12;
460f = ((y2-x3)^2 - 4x5y - x7)*(x2-y3);
461
462f = 2x3y3-2y5+x4-xy2;
463
464f = -x3y3+x6y+xy6-x4y4;
465*/
Note: See TracBrowser for help on using the repository browser.