source: git/Singular/LIB/sing.lib @ e710e2

spielwiese
Last change on this file since e710e2 was 53f676, checked in by Hans Schönemann <hannes@…>, 19 years ago
*hannes: help of codim fixed git-svn-id: file:///usr/local/Singular/svn/trunk@7958 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 32.2 KB
Line 
1// $Id: sing.lib,v 1.28 2005-04-29 16:48:31 Singular Exp $
2//(GMG/BM, last modified 26.06.96)
3///////////////////////////////////////////////////////////////////////////////
4version="$Id: sing.lib,v 1.28 2005-04-29 16:48:31 Singular Exp $";
5category="Singularities";
6info="
7LIBRARY:  sing.lib      Invariants of Singularities
8AUTHORS:  Gert-Martin Greuel, email: greuel@mathematik.uni-kl.de @*
9          Bernd Martin, email: martin@math.tu-cottbus.de
10
11PROCEDURES:
12 codim(id1, id2);       vector space dimension of of id2/id1 if finite
13 deform(i);             infinitesimal deformations of ideal i
14 dim_slocus(i);         dimension of singular locus of ideal i
15 is_active(f,id);       is poly f an active element mod id? (id ideal/module)
16 is_ci(i);              is ideal i a complete intersection?
17 is_is(i);              is ideal i an isolated singularity?
18 is_reg(f,id);          is poly f a regular element mod id? (id ideal/module)
19 is_regs(i[,id]);       are gen's of ideal i regular sequence modulo id?
20 locstd(i);             SB for local degree ordering without cancelling units
21 milnor(i);             milnor number of ideal i; (assume i is ICIS in nf)
22 nf_icis(i);            generic combinations of generators; get ICIS in nf
23 slocus(i);             ideal of singular locus of ideal i
24 qhspectrum(f,w);       spectrum numbers of w-homogeneous polynomial f
25 Tjurina(i);            SB of Tjurina module of ideal i (assume i is ICIS)
26 tjurina(i);            Tjurina number of ideal i (assume i is ICIS)
27 T_1(i);                T^1-module of ideal i
28 T_2((i);               T^2-module of ideal i
29 T_12(i);               T^1- and T^2-module of ideal i
30 tangentcone(id);       compute tangent cone of id
31
32";
33
34LIB "inout.lib";
35LIB "random.lib";
36LIB "primdec.lib";
37///////////////////////////////////////////////////////////////////////////////
38
39proc deform (ideal id)
40"USAGE:   deform(id); id=ideal or poly
41RETURN:  matrix, columns are kbase of infinitesimal deformations
42EXAMPLE: example deform; shows an example
43"
44{
45   list L=T_1(id,"");
46   def K=L[1]; attrib(K,"isSB",1);
47   return(L[2]*kbase(K));
48}
49example
50{ "EXAMPLE:"; echo = 2;
51   ring r   = 32003,(x,y,z),ds;
52   ideal i  = xy,xz,yz;
53   matrix T = deform(i);
54   print(T);
55   print(deform(x3+y5+z2));
56}
57///////////////////////////////////////////////////////////////////////////////
58
59proc dim_slocus (ideal i)
60"USAGE:   dim_slocus(i);  i ideal or poly
61RETURN:  dimension of singular locus of i
62EXAMPLE: example dim_slocus; shows an example
63"
64{
65   return(dim(std(slocus(i))));
66}
67example
68{ "EXAMPLE:"; echo = 2;
69   ring r  = 32003,(x,y,z),ds;
70   ideal i = x5+y6+z6,x2+2y2+3z2;
71   dim_slocus(i);
72}
73///////////////////////////////////////////////////////////////////////////////
74
75proc is_active (poly f, id)
76"USAGE:   is_active(f,id); f poly, id ideal or module
77RETURN:  1 if f is an active element modulo id (i.e. dim(id)=dim(id+f*R^n)+1,
78         if id is a submodule of R^n) resp. 0 if f is not active.
79         The basering may be a quotient ring
80NOTE:    regular parameters are active but not vice versa (id may have embedded
81         components). proc is_reg tests whether f is a regular parameter
82EXAMPLE: example is_active; shows an example
83"
84{
85   if( size(id)==0 ) { return(1); }
86   if( typeof(id)=="ideal" ) { ideal m=f; }
87   if( typeof(id)=="module" ) { module m=f*freemodule(nrows(id)); }
88   return(dim(std(id))-dim(std(id+m)));
89}
90example
91{ "EXAMPLE:"; echo = 2;
92   ring r   =32003,(x,y,z),ds;
93   ideal i  = yx3+y,yz3+y3z;
94   poly f   = x;
95   is_active(f,i);
96   qring q  = std(x4y5);
97   poly f   = x;
98   module m = [yx3+x,yx3+y3x];
99   is_active(f,m);
100}
101///////////////////////////////////////////////////////////////////////////////
102
103proc is_ci (ideal i)
104"USAGE:   is_ci(i); i ideal
105RETURN:  intvec = sequence of dimensions of ideals (j[1],...,j[k]), for
106         k=1,...,size(j), where j is minimal base of i. i is a complete
107         intersection if last number equals nvars-size(i)
108NOTE:    dim(0-ideal) = -1. You may first apply simplify(i,10); in order to
109         delete zeroes and multiples from set of generators
110         printlevel >=0: display comments (default)
111EXAMPLE: example is_ci; shows an example
112"
113{
114   int n; intvec dimvec; ideal id;
115   i=minbase(i);
116   int s = ncols(i);
117   int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
118//--------------------------- compute dimensions ------------------------------
119   for( n=1; n<=s; n=n+1 )
120   {
121      id = i[1..n];
122      dimvec[n] = dim(std(id));
123   }
124   n = dimvec[s];
125//--------------------------- output ------------------------------------------
126   if( n+s != nvars(basering) )
127   { dbprint(p,"// no complete intersection"); }
128   if( n+s == nvars(basering) )
129   { dbprint(p,"// complete intersection of dim "+string(n)); }
130   dbprint(p,"// dim-sequence:");
131   return(dimvec);
132}
133example
134{ "EXAMPLE:"; echo = 2;
135   int p      = printlevel;
136   printlevel = 1;                // display comments
137   ring r     = 32003,(x,y,z),ds;
138   ideal i    = x4+y5+z6,xyz,yx2+xz2+zy7;
139   is_ci(i);
140   i          = xy,yz;
141   is_ci(i);
142   printlevel = p;
143}
144///////////////////////////////////////////////////////////////////////////////
145
146proc is_is (ideal i)
147"USAGE:   is_is(id);  id ideal or poly
148RETURN:  intvec = sequence of dimensions of singular loci of ideals
149         generated by id[1]..id[i], k = 1..size(id); @*
150         dim(0-ideal) = -1;
151         id defines an isolated singularity if last number is 0
152NOTE:    printlevel >=0: display comments (default)
153EXAMPLE: example is_is; shows an example
154"
155{
156  int l; intvec dims; ideal j;
157  int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
158//--------------------------- compute dimensions ------------------------------
159   for( l=1; l<=ncols(i); l=l+1 )
160   {
161     j = i[1..l];
162     dims[l] = dim(std(slocus(j)));
163   }
164   dbprint(p,"// dim of singular locus = "+string(dims[size(dims)]),
165             "// isolated singularity if last number is 0 in dim-sequence:");
166   return(dims);
167}
168example
169{ "EXAMPLE:"; echo = 2;
170   int p      = printlevel;
171   printlevel = 1;
172   ring r     = 32003,(x,y,z),ds;
173   ideal i    = x2y,x4+y5+z6,yx2+xz2+zy7;
174   is_is(i);
175   poly f     = xy+yz;
176   is_is(f);
177   printlevel = p;
178}
179///////////////////////////////////////////////////////////////////////////////
180
181proc is_reg (poly f, id)
182"USAGE:   is_reg(f,id); f poly, id ideal or module
183RETURN:  1 if multiplication with f is injective modulo id, 0 otherwise
184NOTE:    let R be the basering and id a submodule of R^n. The procedure checks
185         injectivity of multiplication with f on R^n/id. The basering may be a
186         quotient ring
187EXAMPLE: example is_reg; shows an example
188"
189{
190   if( f==0 ) { return(0); }
191   int d,ii;
192   def q = quotient(id,ideal(f));
193   id=std(id);
194   d=size(q);
195   for( ii=1; ii<=d; ii=ii+1 )
196   {
197      if( reduce(q[ii],id)!=0 )
198      { return(0); }
199   }
200   return(1);
201}
202example
203{ "EXAMPLE:"; echo = 2;
204   ring r  = 32003,(x,y),ds;
205   ideal i = x8,y8;
206   ideal j = (x+y)^4;
207   i       = intersect(i,j);
208   poly f  = xy;
209   is_reg(f,i);
210}
211///////////////////////////////////////////////////////////////////////////////
212
213proc is_regs (ideal i, list #)
214"USAGE:   is_regs(i[,id]); i poly, id ideal or module (default: id=0)
215RETURN:  1 if generators of i are a regular sequence modulo id, 0 otherwise
216NOTE:    let R be the basering and id a submodule of R^n. The procedure checks
217         injectivity of multiplication with i[k] on R^n/id+i[1..k-1].
218         The basering may be a quotient ring
219         printlevel >=0: display comments (default)
220         printlevel >=1: display comments during computation
221EXAMPLE: example is_regs; shows an example
222"
223{
224   int d,ii,r;
225   int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
226   if( size(#)==0 ) { ideal id; }
227   else { def id=#[1]; }
228   if( size(i)==0 ) { return(0); }
229   d=size(i);
230   if( typeof(id)=="ideal" ) { ideal m=1; }
231   if( typeof(id)=="module" ) { module m=freemodule(nrows(id)); }
232   for( ii=1; ii<=d; ii=ii+1 )
233   {
234      if( p>=2 )
235      { "// checking whether element",ii,"is regular mod 1 ..",ii-1; }
236      if( is_reg(i[ii],id)==0 )
237      {
238        dbprint(p,"// elements 1.."+string(ii-1)+" are regular, " +
239                string(ii)+" is not regular mod 1.."+string(ii-1));
240         return(0);
241      }
242      id=id+i[ii]*m;
243   }
244   if( p>=1 ) { "// elements are a regular sequence of length",d; }
245   return(1);
246}
247example
248{ "EXAMPLE:"; echo = 2;
249   int p      = printlevel;
250   printlevel = 1;
251   ring r1    = 32003,(x,y,z),ds;
252   ideal i    = x8,y8,(x+y)^4;
253   is_regs(i);
254   module m   = [x,0,y];
255   i          = x8,(x+z)^4;;
256   is_regs(i,m);
257   printlevel = p;
258}
259///////////////////////////////////////////////////////////////////////////////
260
261proc milnor (ideal i)
262"USAGE:   milnor(i); i ideal or poly
263RETURN:  Milnor number of i, if i is ICIS (isolated complete intersection
264         singularity) in generic form, resp. -1 if not
265NOTE:    use proc nf_icis to put generators in generic form
266         printlevel >=0: display comments (default)
267EXAMPLE: example milnor; shows an example
268"
269{
270  i = simplify(i,10);     //delete zeroes and multiples from set of generators
271  int n = size(i);
272  int l,q,m_nr;  ideal t;  intvec disc;
273  int p = printlevel-voice+3;  // p=printlevel+1 (default: p=1)
274//---------------------------- hypersurface case ------------------------------
275  if( n==1 or i==0 )
276  {
277     i = std(jacob(i[1]));
278     m_nr = vdim(i);
279     if( m_nr<0 and p>=1 ) { "// no isolated singularity"; }
280     return(m_nr);
281  }
282//------------ isolated complete intersection singularity (ICIS) --------------
283  for( l=n; l>0; l=l-1)
284  {   t      = minor(jacob(i),l);
285      i[l]   = 0;
286      q      = vdim(std(i+t));
287      disc[l]= q;
288      if( q ==-1 )
289      {  if( p>=1 )
290            {  "// not in generic form or no ICIS; use proc nf_icis to put";
291            "// generators in generic form and then try milnor again!";  }
292         return(q);
293      }
294      m_nr = q-m_nr;
295  }
296//---------------------------- change sign ------------------------------------
297  if (m_nr < 0) { m_nr=-m_nr; }
298  if( p>=1 ) { "//sequence of discriminant numbers:",disc; }
299  return(m_nr);
300}
301example
302{ "EXAMPLE:"; echo = 2;
303   int p      = printlevel;
304   printlevel = 1;
305   ring r     = 32003,(x,y,z),ds;
306   ideal j    = x5+y6+z6,x2+2y2+3z2,xyz+yx;
307   milnor(j);
308   poly f     = x7+y7+(x-y)^2*x2y2+z2;
309   milnor(f);
310   printlevel = p;
311}
312///////////////////////////////////////////////////////////////////////////////
313
314proc nf_icis (ideal i)
315"USAGE:   nf_icis(i); i ideal
316RETURN:  ideal = generic linear combination of generators of i if i is an ICIS
317         (isolated complete intersection singularity), return i if not
318NOTE:    this proc is useful in connection with proc milnor
319         printlevel >=0: display comments (default)
320EXAMPLE: example nf_icis; shows an example
321"
322{
323   i = simplify(i,10);  //delete zeroes and multiples from set of generators
324   int p,b = 100,0;
325   int n = size(i);
326   matrix mat=freemodule(n);
327   int P = printlevel-voice+3;  // P=printlevel+1 (default: P=1)
328//---------------------------- test: complete intersection? -------------------
329   intvec sl = is_ci(i);
330   if( n+sl[n] != nvars(basering) )
331   {
332      dbprint(P,"// no complete intersection");
333      return(i);
334   }
335//--------------- test: isolated singularity in generic form? -----------------
336   sl = is_is(i);
337   if ( sl[n] != 0 )
338   {
339      dbprint(P,"// no isolated singularity");
340      return(i);
341   }
342//------------ produce generic linear combinations of generators --------------
343   int prob;
344   while ( sum(sl) != 0 )
345   {  prob=prob+1;
346      p=p-25; b=b+10;
347      i = genericid(i,p,b);          // proc genericid from random.lib
348      sl = is_is(i);
349   }
350   dbprint(P,"// ICIS in generic form after "+string(prob)+" genericity loop(s)");
351   return(i);
352}
353example
354{ "EXAMPLE:"; echo = 2;
355   int p      = printlevel;
356   printlevel = 1;
357   ring r     = 32003,(x,y,z),ds;
358   ideal i    = x3+y4,z4+yx;
359   nf_icis(i);
360   ideal j    = x3+y4,xy,yz;
361   nf_icis(j);
362   printlevel = p;
363}
364///////////////////////////////////////////////////////////////////////////////
365
366proc slocus (ideal i)
367"USAGE:   slocus(i);  i ideal
368RETURN:  ideal of singular locus of i
369EXAMPLE: example slocus; shows an example
370"
371{
372  def R=basering;
373  int j,k;
374  ideal res;
375
376  if(ord_test(basering)!=1)
377  {
378     string va=varstr(basering);
379     if( size( parstr(basering))>0){va=va+","+parstr(basering);}
380     execute ("ring S = ("+charstr(basering)+"),("+va+"),dp;");
381     ideal i=imap(R,i);
382     list l=equidim(i);
383     setring R;
384     list l=imap(S,l);
385  }
386  else
387  {
388     list l=equidim(i);
389  }
390  int n=size(l);
391  if (n==1){return(slocusEqi(i));}
392  res=slocusEqi(l[1]);
393  for(j=2;j<=n;j++){res=intersect(res,slocusEqi(l[j]));}
394  for(j=1;j<n;j++)
395  {
396     for(k=j+1;k<=n;k++){res=intersect(res,l[j]+l[k]);}
397  }
398  return(res);
399}
400example
401{ "EXAMPLE:"; echo = 2;
402   ring r  = 0,(u,v,w,x,y,z),dp;
403   ideal i = wx,wy,wz,vx,vy,vz,ux,uy,uz,y3-x2;;
404   slocus(i);
405}
406///////////////////////////////////////////////////////////////////////////////
407
408static proc slocusEqi (ideal i)
409"USAGE:   slocus(i);  i ideal
410RETURN:  ideal of singular locus of i if i is pure dimensional
411NOTE:    this proc returns i and c-minors of jacobian ideal of i where c is the
412         codimension of i. Hence, if i is not pure dimensional, slocus may
413         return an ideal such that its 0-locus is strictly contained in the
414         singular locus of i
415EXAMPLE: example slocus; shows an example
416"
417{
418  ideal ist=std(i);
419  if(deg(ist[1])==0){return(ist);}
420  int cod  = nvars(basering)-dim(ist);
421  i        = i+minor(jacob(i),cod);
422  return(i);
423}
424example
425{ "EXAMPLE:"; echo = 2;
426   ring r  = 0,(x,y,z),ds;
427   ideal i = x5+y6+z6,x2+2y2+3z2;
428   slocus(i);
429}
430///////////////////////////////////////////////////////////////////////////////
431
432proc qhspectrum (poly f, intvec w)
433"USAGE:   qhspectrum(f,w);  f=poly, w=intvec;
434ASSUME:  f is a weighted homogeneous isolated singularity w.r.t. the weights
435         given by w; w must consist of as many positive integers as there
436         are variables of the basering
437COMPUTE: the spectral numbers of the w-homogeneous polynomial f, computed in a
438         ring of characteristic 0
439RETURN:  intvec  d,s1,...,su  where:
440         d = w-degree(f)  and  si/d = i-th spectral-number(f)
441         No return value if basering has parameters or if f is no isolated
442         singularity, displays a warning in this case
443EXAMPLE: example qhspectrum; shows an example
444"
445{
446   int i,d,W;
447   intvec sp;
448   def r   = basering;
449   if( find(charstr(r),",")!=0 )
450   {
451       "// coefficient field must not have parameters!";
452       return();
453    }
454   ring s  = 0,x(1..nvars(r)),ws(w);
455   map phi = r,maxideal(1);
456   poly f  = phi(f);
457   d       = ord(f);
458   W       = sum(w)-d;
459   ideal k = std(jacob(f));
460   if( vdim(k) == -1 )
461   {
462       "// f is no isolated singuarity!";
463       return();
464    }
465   k = kbase(k);
466   for (i=1; i<=size(k); i++)
467   {
468      sp[i]=W+ord(k[i]);
469   }
470   list L  = sort(sp);
471   sp      = d,L[1];
472   return(sp);
473}
474example
475{ "EXAMPLE:"; echo = 2;
476   ring r;
477   poly f=x3+y5+z2;
478   intvec w=10,6,15;
479   qhspectrum(f,w);
480   // the spectrum numbers are:
481   // 1/30,7/30,11/30,13/30,17/30,19/30,23/30,29/30
482}
483///////////////////////////////////////////////////////////////////////////////
484
485proc Tjurina (id, list #)
486"USAGE:   Tjurina(id[,<any>]);  id=ideal or poly
487ASSUME:  id=ICIS (isolated complete intersection singularity)
488RETURN:  standard basis of Tjurina-module of id,
489         of type module if id=ideal, resp. of type ideal if id=poly.
490         If a second argument is present (of any type) return a list: @*
491           [1] = Tjurina number,
492           [2] = k-basis of miniversal deformation,
493           [3] = SB of Tjurina module,
494           [4] = Tjurina module
495DISPLAY: Tjurina number if printlevel >= 0 (default)
496NOTE:    Tjurina number = -1 implies that id is not an ICIS
497EXAMPLE: example Tjurina; shows examples
498"
499{
500//---------------------------- initialisation ---------------------------------
501  def i = simplify(id,10);
502  int tau,n = 0,size(i);
503  if( size(ideal(i))==1 ) { def m=i; }  // hypersurface case
504  else { def m=i*freemodule(n); }       // complete intersection case
505//--------------- compute Tjurina module, Tjurina number etc ------------------
506  def t1 = jacob(i)+m;                  // Tjurina module/ideal
507  def st1 = std(t1);                    // SB of Tjurina module/ideal
508  tau = vdim(st1);                      // Tjurina number
509  dbprint(printlevel-voice+3,"// Tjurina number = "+string(tau));
510  if( size(#)>0 )
511  {
512     def kB = kbase(st1);               // basis of miniversal deformation
513     return(tau,kB,st1,t1);
514  }
515  return(st1);
516}
517example
518{ "EXAMPLE:"; echo = 2;
519   int p      = printlevel;
520   printlevel = 1;
521   ring r     = 0,(x,y,z),ds;
522   poly f     = x5+y6+z7+xyz;        // singularity T[5,6,7]
523   list T     = Tjurina(f,"");
524   show(T[1]);                       // Tjurina number, should be 16
525   show(T[2]);                       // basis of miniversal deformation
526   show(T[3]);                       // SB of Tjurina ideal
527   show(T[4]); "";                   // Tjurina ideal
528   ideal j    = x2+y2+z2,x2+2y2+3z2;
529   show(kbase(Tjurina(j)));          // basis of miniversal deformation
530   hilb(Tjurina(j));                 // Hilbert series of Tjurina module
531   printlevel = p;
532}
533///////////////////////////////////////////////////////////////////////////////
534
535proc tjurina (ideal i)
536"USAGE:   tjurina(id);  id=ideal or poly
537ASSUME:  id=ICIS (isolated complete intersection singularity)
538RETURN:  int = Tjurina number of id
539NOTE:    Tjurina number = -1 implies that id is not an ICIS
540EXAMPLE: example tjurina; shows an example
541"
542{
543   return(vdim(Tjurina(i)));
544}
545example
546{ "EXAMPLE:"; echo = 2;
547   ring r=32003,(x,y,z),(c,ds);
548   ideal j=x2+y2+z2,x2+2y2+3z2;
549   tjurina(j);
550}
551///////////////////////////////////////////////////////////////////////////////
552
553proc T_1 (ideal id, list #)
554"USAGE:   T_1(id[,<any>]);  id = ideal or poly
555RETURN:  T_1(id): of type module/ideal if id is of type ideal/poly.
556         We call T_1(id) the T_1-module of id. It is a std basis of the
557         presentation of 1st order deformations of P/id, if P is the basering.
558         If a second argument is present (of any type) return a list of
559         3 modules:
560            [1]= T_1(id)
561            [2]= generators of normal bundle of id, lifted to P
562            [3]= module of relations of [2], lifted to P
563                 (note: transpose[3]*[2]=0 mod id)
564         The list contains all non-easy objects which must be computed
565         to get T_1(id).
566DISPLAY: k-dimension of T_1(id) if printlevel >= 0 (default)
567NOTE:    T_1(id) itself is usually of minor importance. Nevertheless, from it
568         all relevant information can be obtained. The most important are
569         probably vdim(T_1(id)); (which computes the Tjurina number),
570         hilb(T_1(id)); and kbase(T_1(id));
571         If T_1 is called with two argument, then matrix([2])*(kbase([1]))
572         represents a basis of 1st order semiuniversal deformation of id
573         (use proc 'deform', to get this in a direct way).
574         For a complete intersection the proc Tjurina is faster
575EXAMPLE: example T_1; shows an example
576"
577{
578   ideal J=simplify(id,10);
579//--------------------------- hypersurface case -------------------------------
580  if( size(J)<2 )
581  {
582     ideal t1  = std(J+jacob(J[1]));
583     module nb = [1]; module pnb;
584     dbprint(printlevel-voice+3,"// dim T_1 = "+string(vdim(t1)));
585     if( size(#)>0 )
586     {
587        module st1 = t1*gen(1);
588        attrib(st1,"isSB",1);
589        return(st1,nb,pnb);
590     }
591     return(t1);
592  }
593//--------------------------- presentation of J -------------------------------
594   int rk;
595   def P = basering;
596   module jac, t1;
597   jac  = jacob(J);                 // jacobian matrix of J converted to module
598   list A=nres(J,2);                // compute presentation of J
599   def A(1..2)=A[1..2]; kill A;     // A(2) = 1st syzygy module of J
600//---------- go to quotient ring mod J and compute normal bundle --------------
601   qring  R    = std(J);
602   module jac = fetch(P,jac);
603   module t1  = transpose(fetch(P,A(2)));
604   list B=nres(t1,2);               // resolve t1, B(2)=(J/J^2)*=normal_bdl
605   def B(1..2)=B[1..2]; kill B;
606   t1         = modulo(B(2),jac);   // pres. of normal_bdl/trivial_deformations
607   rk=nrows(t1);
608//-------------------------- pull back to basering ----------------------------
609   setring P;
610   t1 = fetch(R,t1)+J*freemodule(rk);  // T_1-module, presentation of T_1
611   t1 = std(t1);
612   dbprint(printlevel-voice+3,"// dim T_1 = "+string(vdim(t1)));
613   if( size(#)>0 )
614   {
615      module B2 = fetch(R,B(2));        // presentation of normal bundle
616      list L = t1,B2,A(2);
617      attrib(L[1],"isSB",1);
618      return(L);
619   }
620   return(t1);
621}
622example
623{ "EXAMPLE:"; echo = 2;
624   int p      = printlevel;
625   printlevel = 1;
626   ring r     = 32003,(x,y,z),(c,ds);
627   ideal i    = xy,xz,yz;
628   module T   = T_1(i);
629   vdim(T);                      // Tjurina number = dim_K(T_1), should be 3
630   list L=T_1(i,"");
631   module kB  = kbase(L[1]);
632   print(L[2]*kB);               // basis of 1st order miniversal deformation
633   show(L[2]);                   // presentation of normal bundle
634   print(L[3]);                  // relations of i
635   print(transpose(L[3])*L[2]);  // should be 0 (mod i)
636   printlevel = p;
637}
638///////////////////////////////////////////////////////////////////////////////
639
640proc T_2 (ideal id, list #)
641"USAGE:   T_2(id[,<any>]);  id = ideal
642RETURN:  T_2(id): T_2-module of id . This is a std basis of a presentation of
643         the module of obstructions of R=P/id, if P is the basering.
644         If a second argument is present (of any type) return a list of
645         4 modules and 1 ideal:
646            [1]= T_2(id)
647            [2]= standard basis of id (ideal)
648            [3]= module of relations of id (=1st syzygy module of id) @*
649            [4]= presentation of syz/kos
650            [5]= relations of Hom_P([3]/kos,R), lifted to P
651         The list contains all non-easy objects which must be computed
652         to get T_2(id).
653DISPLAY: k-dimension of T_2(id) if printlevel >= 0 (default)
654NOTE:    The most important information is probably vdim(T_2(id)).
655         Use proc miniversal to get equations of miniversal deformation.
656EXAMPLE: example T_2; shows an example
657"
658{
659//--------------------------- initialisation ----------------------------------
660  def P = basering;
661   ideal J = id;
662   module kos,SK,B2,t2;
663   list L;
664   int n,rk;
665//------------------- presentation of non-trivial syzygies --------------------
666   list A=nres(J,2);                      // resolve J, A(2)=syz
667   def A(1..2)=A[1..2]; kill A;
668   kos  = koszul(2,J);                    // module of Koszul relations
669   SK   = modulo(A(2),kos);               // presentation of syz/kos
670   ideal J0 = std(J);                     // standard basis of J
671//?*** sollte bei der Berechnung von res mit anfallen, zu aendern!!
672//---------------------- fetch to quotient ring mod J -------------------------
673   qring R = J0;                          // make P/J the basering
674   module A2' = transpose(fetch(P,A(2))); // dual of syz
675   module t2  = transpose(fetch(P,SK));   // dual of syz/kos
676   list B=nres(t2,2);                     // resolve (syz/kos)*
677   def B(1..2)=B[1..2]; kill B;
678   t2 = modulo(B(2),A2');                 // presentation of T_2
679   rk = nrows(t2);
680//---------------------  fetch back to basering -------------------------------
681   setring P;
682   t2 = fetch(R,t2)+J*freemodule(rk);
683   t2 = std(t2);
684   dbprint(printlevel-voice+3,"// dim T_2 = "+string(vdim(t2)));
685   if( size(#)>0 )
686   {
687      B2 = fetch(R,B(2));        // generators of Hom_P(syz/kos,R)
688      L  = t2,J0,A(2),SK,B2;
689      return(L);
690   }
691   return(t2);
692}
693example
694{ "EXAMPLE:"; echo = 2;
695   int p      = printlevel;
696   printlevel = 1;
697   ring  r    = 32003,(x,y),(c,dp);
698   ideal j    = x6-y4,x6y6,x2y4-x5y2;
699   module T   = T_2(j);
700   vdim(T);
701   hilb(T);"";
702   ring r1    = 0,(x,y,z),dp;
703   ideal id   = xy,xz,yz;
704   list L     = T_2(id,"");
705   vdim(L[1]);                           // vdim of T_2
706   print(L[3]);                          // syzygy module of id
707   printlevel = p;
708}
709///////////////////////////////////////////////////////////////////////////////
710
711proc T_12 (ideal i, list #)
712"USAGE:   T_12(i[,any]);  i = ideal
713RETURN:  T_12(i): list of 2 modules: @*
714           *  standard basis of T_1-module =T_1(i), 1st order deformations @*
715           *  standard basis of T_2-module =T_2(i), obstructions of R=P/i @*
716         If a second argument is present (of any type) return a list of
717         9 modules, matrices, integers: @*
718             [1]= standard basis of T_1-module
719             [2]= standard basis of T_2-module
720             [3]= vdim of T_1
721             [4]= vdim of T_2
722             [5]= matrix, whose cols present infinitesimal deformations @*
723             [6]= matrix, whose cols are generators of relations of i(=syz(i)) @*
724             [7]= matrix, presenting Hom_P(syz/kos,R), lifted to P @*
725             [8]= presentation of T_1-module, no std basis
726             [9]= presentation of T_2-module, no std basis
727DISPLAY: k-dimension of T_1 and T_2 if printlevel >= 0 (default)
728NOTE:    Use proc miniversal from deform.lib to get miniversal deformation of i,
729         the list contains all objects used by proc miniversal
730EXAMPLE: example T_12; shows an example
731"
732{
733//--------------------------- initialisation ----------------------------------
734   int  n,r1,r2,d1,d2;
735   def P = basering;
736   i = simplify(i,10);
737   module jac,t1,t2,sbt1,sbt2;
738   matrix Kos,Syz,SK,kbT_1,Sx;
739   list L;
740   ideal  i0 = std(i);
741//-------------------- presentation of non-trivial syzygies -------------------
742   list I= nres(i,2);                           // resolve i
743   Syz  = matrix(I[2]);                         // syz(i)
744   jac = jacob(i);                              // jacobi ideal
745   Kos = koszul(2,i);                           // koszul-relations
746   SK  = modulo(Syz,Kos);                       // presentation of syz/kos
747//--------------------- fetch to quotient ring  mod i -------------------------
748   qring   Ox  = i0;                             // make P/i the basering
749   module Jac = fetch(P,jac);
750   matrix No  = transpose(fetch(P,Syz));        // ker(No) = Hom(syz,Ox)
751   module So  = transpose(fetch(P,SK));         // Hom(syz/kos,R)
752   list resS  = nres(So,2);
753   matrix Sx  = resS[2];
754   list resN  = nres(No,2);
755   matrix Nx  = resN[2];
756   module T_2  = modulo(Sx,No);                  // presentation of T_2
757   r2         = nrows(T_2);
758   module T_1  = modulo(Nx,Jac);                 // presentation of T_1
759   r1         = nrows(T_1);
760//------------------------ pull back to basering ------------------------------
761   setring P;
762   t1   = fetch(Ox,T_1)+i*freemodule(r1);
763   t2   = fetch(Ox,T_2)+i*freemodule(r2);
764   sbt1 = std(t1);
765   d1   = vdim(sbt1);
766   sbt2 = std(t2);
767   d2   = vdim(sbt2);
768   dbprint(printlevel-voice+3,"// dim T_1 = "+string(d1),"// dim T_2 = "+string(d2));
769   if  ( size(#)>0)
770   {
771     if (d1>0)
772     {
773       kbT_1 = fetch(Ox,Nx)*kbase(sbt1);
774     }
775     else
776     {
777       kbT_1 = 0;
778     }
779     Sx   = fetch(Ox,Sx);
780     L = sbt1,sbt2,d1,d2,kbT_1,Syz,Sx,t1,t2;
781     return(L);
782   }
783   L = sbt1,sbt2;
784   return(L);
785}
786example
787{ "EXAMPLE:"; echo = 2;
788   int p      = printlevel;
789   printlevel = 1;
790   ring r     = 199,(x,y,z,u,v),(c,ws(4,3,2,3,4));
791   ideal i    = xz-y2,yz2-xu,xv-yzu,yu-z3,z2u-yv,zv-u2;
792                            //a cyclic quotient singularity
793   list L     = T_12(i,1);
794   print(L[5]);             //matrix of infin. deformations
795   printlevel = p;
796}
797///////////////////////////////////////////////////////////////////////////////
798proc codim (id1, id2)
799"USAGE:   codim(id1,id2); id1,id2 ideal or module, both must be standard bases
800RETURN:  int, which is:
801         1. the codimension of id2 in id1, i.e. the vectorspace dimension of
802            id1/id2 if id2 is contained in id1 and if this number is finite
803         2. -1 if the dimension of id1/id2 is infinite
804         3. -2 if id2 is not contained in id1,
805COMPUTE: consider the two hilberseries iv1(t) and iv2(t), then, in case 1.,
806         q(t)=(iv2(t)-iv1(t))/(1-t)^n must be rational, and the result is the
807         sum of the coefficients of q(t) (n dimension of basering)
808EXAMPLE: example codim; shows an example
809"
810{
811   intvec iv1, iv2, iv;
812   int i, d1, d2, dd, i1, i2, ia, ie;
813  //--------------------------- check id2 < id1 -------------------------------
814   ideal led = lead(id1);
815   attrib(led, "isSB",1);
816   i = size(NF(lead(id2),led));
817   if ( i > 0 )
818   {
819     return(-2);
820   }
821  //--------------------------- 1. check finiteness ---------------------------
822   i1 = dim(id1);
823   i2 = dim(id2);
824   if (i1 < 0)
825   {
826     if (i2 == 0)
827     {
828       return vdim(id2);
829     }
830     else
831     {
832       return(-1);
833     }
834   }
835   if (i2 != i1)
836   {
837     return(-1);
838   }
839   if (i2 <= 0)
840   {
841     return(vdim(id2)-vdim(id1));
842   }
843 // if (mult(id2) != mult(id1))
844 //{
845 //  return(-1);
846 // }
847  //--------------------------- module ---------------------------------------
848   d1 = nrows(id1);
849   d2 = nrows(id2);
850   dd = 0;
851   if (d1 > d2)
852   {
853     id2=id2,maxideal(1)*gen(d1);
854     dd = -1;
855   }
856   if (d2 > d1)
857   {
858     id1=id1,maxideal(1)*gen(d2);
859     dd = 1;
860   }
861  //--------------------------- compute first hilbertseries ------------------
862   iv1 = hilb(id1,1);
863   i1 = size(iv1);
864   iv2 = hilb(id2,1);
865   i2 = size(iv2);
866  //--------------------------- difference of hilbertseries ------------------
867   if (i2 > i1)
868   {
869     for ( i=1; i<=i1; i=i+1)
870     {
871       iv2[i] = iv2[i]-iv1[i];
872     }
873     ie = i2;
874     iv = iv2;
875   }
876   else
877   {
878     for ( i=1; i<=i2; i=i+1)
879     {
880       iv1[i] = iv2[i]-iv1[i];
881     }
882     iv = iv1;
883     for (ie=i1;ie>=0;ie=ie-1)
884     {
885       if (ie == 0)
886       {
887         return(0);
888       }
889       if (iv[ie] != 0)
890       {
891         break;
892       }
893     }
894   }
895   ia = 1;
896   while (iv[ia] == 0) { ia=ia+1; }
897  //--------------------------- ia <= nonzeros <= ie -------------------------
898   iv1 = iv[ia];
899   for(i=ia+1;i<=ie;i=i+1)
900   {
901     iv1=iv1,iv[i];
902   }
903  //--------------------------- compute second hilbertseries -----------------
904   iv2 = hilb(iv1);
905  //--------------------------- check finitenes ------------------------------
906   i2 = size(iv2);
907   i1 = ie - ia + 1 - i2;
908   if (i1 != nvars(basering))
909   {
910     return(-1);
911   }
912  //--------------------------- compute result -------------------------------
913   i1 = 0;
914   for ( i=1; i<=i2; i=i+1)
915   {
916     i1 = i1 + iv2[i];
917   }
918   return(i1+dd);
919}
920example
921{ "EXAMPLE:"; echo = 2;
922   ring r  = 0,(x,y,z),dp;
923   ideal j = y6,x4;
924   ideal m = x,y;
925   attrib(m,"isSB",1);  //let Singular know that ideals are a standard basis
926   attrib(j,"isSB",1);
927   codim(m,j);          // should be 23 (Milnor number -1 of y7-x5)
928}
929
930///////////////////////////////////////////////////////////////////////////////
931
932proc tangentcone (id,list #)
933"USAGE:   tangentcone(id [,n]); id = ideal, n = int
934RETURN:  the tangent cone of id
935NOTE:    the procedure works for any monomial ordering.
936         If n=0 use std w.r.t. local ordering ds, if n=1 use locstd
937EXAMPLE: example tangentcone; shows an example
938"
939{
940  int ii,n;
941  def bas = basering;
942  ideal tang;
943  if (size(#) !=0) { n= #[1]; }
944  if( n==0 )
945  {
946     def @newr@=changeord("ds"); setring @newr@;
947     ideal @id = imap(bas,id);
948     @id = std(@id);
949     setring bas;
950     id = imap(@newr@,@id);
951     kill @newr@;
952  }
953  else
954  {
955    id = locstd(id);
956  }
957 
958  for(ii=1; ii<=size(id); ii++)
959  {
960    tang[ii]=jet(id[ii],mindeg(id[ii]));     
961  }
962  return(tang); 
963}
964example
965{ "EXAMPLE:"; echo = 2;
966   ring R = 0,(x,y,z),ds;
967   ideal i  = 7xyz+z5,x2+y3+z7,5z5+y5;
968   tangentcone(i);
969}   
970///////////////////////////////////////////////////////////////////////////////
971
972proc locstd (id)
973"USAGE:   locstd (id); id = ideal
974RETURN:  a standard basis for a local degree ordering
975NOTE:    the procedure homogenizes id w.r.t. a new 1st variable @t@, computes
976         a SB wrt (dp(1),dp) and substitutes @t@ by 1.
977         Hence the result is a SB with respect to an ordering which sorts
978         first w.r.t. the order and then refines it with dp. This is a
979         local degree ordering.
980         This is done in order to avoid cancellation of units and thus
981         be able to use option(contentSB);
982EXAMPLE: example locstd; shows an example
983"
984{
985  int ii;
986  def bas = basering;
987  execute("ring  @r_locstd
988     =("+charstr(bas)+"),(@t@,"+varstr(bas)+"),(dp(1),dp);");
989  ideal @id = imap(bas,id);
990  ideal @hid = homog(@id,@t@);
991  @hid = std(@hid);
992  @hid = subst(@hid,@t@,1);
993  setring bas;
994  def @hid = imap(@r_locstd,@hid);
995  attrib(@hid,"isSB",1);
996  kill @r_locstd;
997  return(@hid); 
998}
999example
1000{ "EXAMPLE:"; echo = 2;
1001   ring R = 0,(x,y,z),ds;
1002   ideal i  = xyz+z5,2x2+y3+z7,3z5+y5;
1003   locstd(i);
1004}   
Note: See TracBrowser for help on using the repository browser.