source: git/Singular/LIB/kskernel.lib @ 1288ef

spielwiese
Last change on this file since 1288ef was d31cedc, checked in by Hans Schönemann <hannes@…>, 17 years ago
*hannes: fixed export for v3 git-svn-id: file:///usr/local/Singular/svn/trunk@10132 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 11.5 KB
Line 
1////////////////////////////////////////////////////////////////
2version="$Id: kskernel.lib,v 1.3 2007-06-20 15:30:11 Singular Exp $";
3category="General purpose";
4info="
5LIBRARY:  kskernel.lib   PROCEDURES FOR COMPUTING THE KERNEL
6                         OF THE KODAIRA-SPENCER MAP
7
8AUTHOR:   Tetyana Povalyaeva, povalyae@mathematik.uni-kl.de
9
10PROCEDURES:
11 KSker(p,q);          kernel of the Kodaira-Spencer map of
12                      a versal deformation of an irreducible
13                      plane curve singularity
14 KSconvert(M);        kernel of the Kodaira-Spencer map in
15                      quasihomogeneous variables T with
16                      corresponding negative degrees
17 KSlinear(M);         matrix of linear terms of the kernel of
18                      the Kodaira-Spencer map
19 KScoef(i,j,P,Q,qq);  coefficient of the given term in the matrix
20                      of kernel of the Kodaira-Spencer map
21 StringF(i,j,p,q);    expression in variables T(i) with non-resolved
22                      brackets for the further computation of
23                      coefficient in the matrix of kernel of the
24                      Kodaira-Spencer map
25";
26LIB "general.lib";
27////////////////////////////////////////////////////////////////
28
29//-------------------------- ALGORITHM II ---------------------
30
31//---------------------------- sub procedure ------------------
32// used in sorter
33proc minim(intmat M, int t)
34{
35  int m=v[t];
36  int i,k,done;
37  k=0;done=0;
38  for (i=t+1;i<nrows(M);i++)
39  {
40    if (m>v[i])  { m=v[i];k=i;done=1; }
41  }
42  if (done==1)
43  {
44    for (i=1;i<=3;i++)
45    {
46      done=M[k,i];M[k,i]=M[t,i];M[t,i]=done;
47    }
48    i=v[k];v[k]=v[t];v[t]=i;
49  }
50  return(M);
51}
52
53//---------------------------- sub procedure --------------------
54// sorts M by the third row, ascending
55proc sorter(intmat M)
56{
57  intvec v;
58  int i;
59  for (i=1;i<=nrows(M);i++)
60  { v[i]=M[i,3]; }
61  export (v);
62  int n=1;
63  while (n<=nrows(M))
64  {
65    M=minim(M,n);
66    n++;
67  }
68  kill v;
69  return(M);
70}
71
72//---------------------------- sub procedure --------------------
73// M is a sorted matrix of triples {i,j,k(i,j)}
74// returns a list of coefficients of p
75// wrt. the base {x^i y^j,(i,j) in (M[i,j,k])}=B_u
76proc MonoDec(poly p, matrix M)
77{
78  poly q=p;
79  intvec V;
80  list C;
81  int nM=nrows(M); //cardinality of B_u
82  vector VC=gen(nM+1);
83  int k=1; int i=1; int j=1;
84  while (q!=0)
85  {
86    V=leadexp(q);
87    while ( !((V[1]==M[k,1]) && (V[2]==M[k,2])) )
88    {
89      if (k>=nM)
90      {
91        ERROR("error in monomial base");
92        return(0);
93      }
94      k++;
95    }
96    VC=VC+leadcoef(q)*gen(k);
97    q=q-lead(q);
98    k=1;
99  }
100  VC=VC-gen(nM+1);
101  return(VC);
102}
103
104//----------------------------- main program --------------------
105proc KSker (int p,q)
106"USAGE:  KSker(int p,q); p,q relatively prime integers
107RETURN:  nothing; exports ring KSring, matrix KSkernel and list 'weights';
108         KSkernel is a matrix of coefficients of the
109         generators of the kernel of Kodaira-Spencer map,
110         'weights' is a list of degrees for variables T
111EXAMPLE: example KSker; shows an example
112"
113{
114  option(redSB);
115  option(redTail);
116  int c;
117  int i,j;
118  int k=0;
119  list LM;
120  list tmp;
121  for (i=0;i<=p-2;i++)
122  {
123    for (j=0;j<=q-2;j++)
124    {
125      c=(i*q)+(j*p)-(p*q);
126      if (c>0)
127      {
128        k++;
129        tmp[1]=i;
130        tmp[2]=j;
131        tmp[3]=c; // index of T
132        LM[k]=tmp;
133        tmp=0;
134      }
135    }
136  }
137  if (k==0)
138  {
139    "The kernel of the Kodaira-Spencer map equals zero";
140    return();
141  }
142  if (k==1)
143  {
144    ring KSring=0,(T(1)),ws(c);
145    matrix KSkernel[1][1]=c*T(1);
146    export(KSring);exportto(Top,KSring);
147    export(KSkernel);
148    return();
149  }
150  int cnt=k; // the total number of T's, now k>1
151  intmat M[k][3]; // matrix with triples (i,j,k)
152  for (i=1; i<=k; i++)
153  {
154    M[i,1] = LM[i][1];
155    M[i,2] = LM[i][2];
156    M[i,3] = LM[i][3];
157  }
158  kill LM;
159  M = sorter(M); // now the third column of M contains ordered ascending values
160  list weights;
161  for (i=1; i<=k; i++)
162  {
163    weights[i] = M[i,3]; // positive weights for Ws ordering
164    M[i,3]   = i;
165  }
166  export(weights);
167  ring RT=0,(x,y,T(1..k)),(Ws(q,p),dp);
168  poly F=x^p+y^q;
169  i=0;j=0;
170  for (k=1;k<=cnt;k++)
171  {
172    i = M[k,1];
173    j = M[k,2];
174    F = F + T(k)*x^i*y^j;
175  }
176  ideal I = diff(F,x),diff(F,y);
177  I = std(I);
178  k=0;
179  list normal;
180  poly mul;
181  for (i=0;i<=p-2;i++)
182  {
183    for (j=0;j<=q-2;j++)
184    {
185      c = p*q - ((i+2)*q+(j+2)*p);
186      if ( c > 0 )
187      {
188        mul = x^i*y^j*p*q*F;
189        k++;
190        normal[k] = NF(mul,I);
191      }
192    }
193  }
194  // now we separate T's from (x,y) by treating T's as parameters
195  ring ST=(0,T(1..k)),(x,y),Ws(q,p);
196  setring ST;
197  list Snormal = imap(RT,normal);
198  ideal SI = imap(RT,I);
199  kill RT;
200  SI = std(SI);
201  module L;
202  for (i=1; i<=size(Snormal); i++)
203  {
204    Snormal[i] = NF(Snormal[i],SI);
205    L[i] = MonoDec(Snormal[i],M);
206    if (L[i]==0) // MonoDec has detected non-basis element
207    {
208      "Try reducing the input";
209      return(0);
210    }
211  }
212  // now L is a module in T's
213  ring KSring=0,(T(1..k)),(C,ws(-weights[1..k]));
214  module TL=imap(ST,L);
215  kill ST;
216  // sort it descendently
217  TL = sort(TL)[1];
218  // make the coefficients positive
219  if ((leadcoef(TL[1,1])<0) || (leadcoef(TL[k,k])<0)) { TL = -TL;}
220  matrix KSkernel=matrix(TL);
221  export(KSring);exportto(Top,KSring);
222  export(KSkernel);
223  kill M;
224  return();
225}
226example
227{ "EXAMPLE:"; echo=2;
228   int p=6;
229   int q=7;
230   KSker(p,q);
231   setring KSring;
232   print(KSkernel);
233}
234
235//---------------------------- sub procedure ------------------
236// converts T(1..k) to T(w(1),..w(k)),
237// need global variable "weights"
238proc KSconvert(matrix M)
239"USAGE:  KSconvert(matrix M);
240         M is a matrix of coefficients of the generators of
241         the kernel of Kodaira-Spencer map in variables T(i)
242         from the basering. To be called after the procedure
243         KSker(p,q)
244RETURN:  nothing; exports ring KSring2 and matrix KSkernel2 within it,
245         such that KSring2 resp. KSkernel2 are in variables
246         T(w) with weights -w. These weights are computed
247         in the procedure KSker(p,q)
248EXAMPLE: example KSconvert; shows an example
249"
250{
251  int s=ncols(M); // the total numbers of T's
252  ring T1=0,(T(1..weights[s])),dp;
253  matrix TM=imap(KSring,M);
254  int i;
255  for (i=s;i>=1;i--)
256  {
257    TM=subst(TM,T(i),T(weights[i]));
258  }
259  string Tw="0,(";
260  string Ww="Ws(";
261  string tempo="";
262  for (i=1; i<=s; i++)
263  {
264    tempo=string(weights[i]);
265    Tw = Tw+"T("+tempo+"),";
266    Ww = Ww+"-"+tempo+",";
267  }
268  Tw[size(Tw)] = ")";
269  Ww[size(Ww)] = ")";
270  Tw=Tw+","+Ww+";";
271  execute("ring KSring2="+Tw);
272  matrix KSkernel2=imap(T1,TM);
273  kill T1;
274  export KSring2;
275  export(KSring2);exportto(Top,KSring2);
276  export KSkernel2;
277  return();
278}
279example
280{ "EXAMPLE:"; echo=2;
281   int p=6;
282   int q=7;
283   KSker(p,q);
284   setring KSring;
285   KSconvert(KSkernel);
286   setring KSring2;
287   print(KSkernel2);
288}
289
290proc KSlinear(matrix M)
291"USAGE:  KSlinear(matrix M);
292         computes matrix of linear terms of the kernel of the
293         Kodaira-Spencer map. To be called after the procedure
294         KSker(p,q)
295RETURN:  nothing; but replaces elements of the matrix KSkernel
296         in the ring Ksring with their leading monomials
297         wrt. the local ordering (ls)
298EXAMPLE: example KSlinear; shows an example
299"
300{
301  int s=ncols(M); // the total numbers of T's
302  ring T1=0,(T(1..weights[s])),ls;
303  matrix TM=imap(KSring,M);
304  int i; int j;
305  for (i=1; i<=s;i++)
306  {
307    for (j=1; j<=s;j++)
308    {
309      if (TM[i,j]!=0) { TM[i,j]=lead(TM[i,j]); }
310    }
311  }
312  setring KSring;
313  KSkernel=imap(T1,TM);
314  kill T1;
315}
316example
317{ "EXAMPLE:"; echo=2;
318   int p=6;
319   int q=7;
320   KSker(p,q);
321   setring KSring;
322   KSlinear(KSkernel);
323   print(KSkernel);
324}
325
326//-------------------------- ALGORITHM I ----------------------
327
328//---------------------------- sub procedure ------------------
329proc seq(int p,q)
330// computes u,v such that 1<=u<=p-1, qu=1(mod p)
331//                        1<=v<=q-1, pv=1(mod q)
332{
333  int u=1;  int v=1;
334  for(u=1; u<=p-1; u++)
335  {
336    if (((q*u)%p)==1) {break;}
337   }
338  for(v=1; v<=q-1; v++)
339  {
340    if (((p*v)%q)==1) {break;}
341  }
342  return(u,v);
343}
344
345//---------------------------- sub procedure ------------------
346// returns maximal number i such that u(i)<=b
347proc mix(int b, list u)
348{
349  int result=0;
350  int s=size(u);
351  int w=s;
352  if (s==0) { "size of list is 0"; return(result); }
353  if (b<0 ) { "negative b in MIX"; return(result); }
354  while ((w>1) && (u[w]>b)) { w--;} // min w=1
355  if (w>1)
356  {
357    return(w);
358  }
359  else // w<=1
360  {
361    if ( (w==1) && (u[w]> b) )
362    {
363      w=0;
364      return(w);
365    }
366  }
367  return(w);
368}
369
370//---------------------------- sub procedure ------------------
371proc bracket_k(int r, int s)
372{
373  int b=s-r;
374  int q;
375  int k=1;
376  int SF;
377  F=F+"*(";
378  while (b>0) // simulate repeat ... until b==0
379  {
380    q=mix(b,u);
381    while (q>0)
382    {
383      b=u[q]-1;
384      if (u[q]==(s-r))   // adding T's of max degree
385      {
386        F=F+"T("+ string(q) +")"+ "+";
387      }
388      else
389      {
390        if (S[(1+r+u[q])]!="u")
391        {
392          F=F+"T("+ string(q) +")";
393          bracket_k(r+u[q],s);
394         }
395      }
396      q=mix(b,u);
397      if (q==0) {b=0;}
398    } // end  while q>0
399    SF=size(F);
400    if (F[SF]!="+")
401    {
402      if (SF<=2) { F="";}
403      else { F=F[1..SF-2];}
404    }
405    if (b==0) { break; }   // ... until b==0
406  }
407  F[size(F)]=")";
408  F=F+"+";
409}
410
411//---------------------------- sub procedure ------------------
412// exports S, l, u
413proc StringS(int p, int q)
414{
415  int i=1; int j=0;
416  int e,e1=0,0;
417  string S="";
418  list l,u=0,0;
419  S="l";
420  l[1]=0;
421  int a,b=seq(p,q);
422  int k=1;
423  for (k=1;k<=(p*q-2*p-2*q);k++)
424  {
425    e=(e+a)%p; e1=(e1+b)%q;
426    if ( (e==(p-1)) || (e1==(q-1)) ) { S=S+" "; }
427    else
428    {
429      if ((e*q+e1*p) <= (p*q))
430      {
431        i++; l[i]=k; S=S+"l";
432      }
433      else
434      {
435        j++; u[j]=k; S=S+"u";
436      }
437    }
438  }
439  export S;
440  export u;
441  export l;
442}
443
444//---------------------------- main procedures ----------------
445proc StringF(int i, int j,int p, int q)
446"USAGE:  StringF(int i,j,p,q);
447RETURN:  nothing; exports string F which contains an expression
448         in variables T(i) with non-resolved brackets
449EXAMPLE: example StringF; shows an example
450"
451{
452  string F;
453  export F;exportto(Top,F);
454  StringS(p,q);
455  bracket_k(l[i],u[j]);
456  F=F[3..(size(F)-2)];
457}
458example
459{ "EXAMPLE:"; echo=2;
460 int p=5; int q=14;
461 int i=2; int j=9;
462 StringF(i,j,p,q);
463 F;
464}
465
466proc KScoef(int i,j,P,Q, list qq);
467"USAGE:  KScoef(int i,j,P,Q, list qq);
468RETURN:  exports ring RC and number C within it. C is
469         the coefficient of the word defined in the list qq,
470         being a part of C[i,j] for x^p+y^q
471EXAMPLE: example KScoef; shows an example
472"
473// qq is a list of integers, representing
474// monomial T_q[1] * ...* T_q[s]
475// returns a ring RC in char 0 and number C in it
476{
477  int s=size(qq);
478  int U,V=seq(P,Q);
479  StringS(P,Q);
480  int n=l[i];
481  int d=P*Q;
482  int k=1; int m=1;
483  ring RC=0,x,dp;
484  number C=0;
485  number aux=0;
486  int t=0;
487  int e=0;
488  int e1=0;
489  aux = u[(qq[1])];
490  C = ((-1)^s)*(aux/d);
491  for (k=2; k<=s; k++)
492  {
493    t  = u[(qq[k-1])];
494    e  = (U*n)%P;
495    e  = e+ ((U*t)%P);
496    e1 = (V*n)%Q;
497    e1 = e1 + ((V*t)%Q);
498    n  = n + qq[k-1];
499    t  = u[(qq[k])];
500    if (e>=(P-1))
501    {
502      aux = (U*t)%P;
503      aux = aux/P;
504      C = C*aux;
505    }
506    else
507    {
508      if (e1>=(Q-1))
509      {
510        aux = (V*t)%Q;
511        aux = aux/Q;
512        C = C*aux;
513      }
514    }
515  }
516  export RC;exportto(Top,RC);
517  export C;
518}
519example
520{ "EXAMPLE:"; echo=2;
521 int p=5; int q=14;
522 int i=2; int j=9;
523 list L;
524 ring r=0,x,dp;
525 number c;
526 L[1]=3; L[2]=1; L[3]=3; L[4]=2;
527 KScoef(i,j,p,q,L);
528 c=imap(RC,C);
529 c;
530 L[1]=3; L[2]=1; L[3]=2; L[4]=3;
531 KScoef(i,j,p,q,L);
532 c=c+imap(RC,C);
533 c; // it is a coefficient of T1*T2*T3^2 in C[2,9] for x^5+y^14
534}
Note: See TracBrowser for help on using the repository browser.