source: git/Singular/LIB/sing.lib @ 0f5091

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