source: git/Singular/LIB/deform.lib @ d6cc54

fieker-DuValspielwiese
Last change on this file since d6cc54 was c67136, checked in by Kai Krüger <krueger@…>, 26 years ago
classify.lib deform.lib finvar.lib hnoether.lib latex.lib primitiv.lib ring.lib Changes needed for Namespaces-Support (mainly kill of globals) git-svn-id: file:///usr/local/Singular/svn/trunk@2583 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 31.9 KB
Line 
1// $Id: deform.lib,v 1.14 1998-10-21 10:28:19 krueger Exp $
2// author: Bernd Martin email: martin@math.tu-cottbus.de
3//(bm, last modified 4/98)
4///////////////////////////////////////////////////////////////////////////////
5version="$Id: deform.lib,v 1.14 1998-10-21 10:28:19 krueger Exp $";
6info="
7LIBRARY:  deform.lib       PROCEDURES FOR COMPUTING MINIVERSAL DEFORMATION
8                           by Bernd Martin (martin@math.tu-cottbus.de)
9
10 versal(Fo[,d,any])        miniversal deformation of isolated singularity Fo
11 mod_versal(Mo,I,[,d,any]) miniversal deformation of module Mo modulo ideal I
12 lift_kbase(N,M);          lifting N into standard kbase of M
13 lift_rel_kb(N,M[,kbM,p])  relative lifting N into a kbase of M
14 kill_rings([\"prefix\"])    kills the exported rings from above
15
16  SUB-PROCEDURES            used by main procedure:
17                  get_rings,compute_ext,get_inf_def,interact1,
18                  interact2,negative_part,homog_test
19";
20///////////////////////////////////////////////////////////////////////////////
21LIB "inout.lib";
22LIB "general.lib";
23LIB "matrix.lib";
24LIB "homolog.lib";
25LIB "sing.lib";
26///////////////////////////////////////////////////////////////////////////////
27proc versal (ideal Fo,list #)
28"USAGE:   versal(Fo[,d,any]); Fo=ideal, d=int, any=list
29COMUPTE: miniversal deformation of Fo up to degree d (default d=100),
30CREATE:  Rings (exported):
31         'my'Px = extending the basering Po by new variables given by \"A,B,..\"
32                  (deformation parameters), returns as basering,
33                  the new variables come before the old ones,
34                  the ordering is the product between \"ls\" and \"ord(Po)\",
35         'my'Qx = Px/Fo extending Qo=Po/Fo,
36         'my'So = being the embedding-ring of the versal base space,
37         'my'Ox = Px/Js extending So/Js.   (default my=\"\")
38      Matrices (in Px, exported):
39         Js  = giving the versal base space (obstructions),
40         Fs  = giving the versal family of Fo,
41         Rs  = giving the lifting of Ro=syz(Fo).
42      If d is defined (!=0), it computes up to degree d.
43      If 'any' is defined and any[1] is no string, interactive version.
44      Otherwise 'any' gives predefined strings: \"my\",\"param\",\"order\",\"out\"
45      (\"my\" prefix-string, \"param\" is a letter (e.g. \"A\")  for the name of
46      first parameter or (e.g. \"A(\") for index parameter variables, \"order\"
47      ordering string for ring extension), \"out\" name of output-file).
48NOTE:   printlevel < 0        no output at all,
49        printlevel >=0,1,2,.. informs you, what is going on;
50        this proc uses 'execute'.
51EXAMPLE:example versal; shows an example
52"
53{
54//------- prepare -------------------------------------------------------------
55  string str,@param,@order,@my,@out,@degrees;
56  int @d,d_max,@t1,t1',@t2,@colR,ok_ann,@smooth,@noObstr,@size,@j;
57  int p    = printlevel-voice+3;
58  int time = timer;
59  intvec @iv,@jv,@is_qh,@degr;
60  d_max    = 100;
61  @my = ""; @param="A"; @order="ds"; @out="no";
62  @size    = size(#);
63  if( @size>0 ) { d_max = #[1]; }
64  if( @size>1 )
65  { if(typeof(#[2])!="string")
66    { string @active;
67      @my,@param,@order,@out = interact1();
68    }
69    else
70    { @my = #[2];
71      if (@size>2) {@param = #[3];}
72      if (@size>3) {@order = #[4];}
73      if (@size>4) {@out   = #[5];}
74    }
75  }
76  string myPx = @my+"Px";
77  string myQx = @my+"Qx";
78  string myOx = @my+"Ox";
79  string mySo = @my+"So";
80         Fo   = simplify(Fo,10);
81  @is_qh      = qhweight(Fo);
82  int    @rowR= size(Fo);
83  def    Po   = basering;
84setring  Po;
85  poly   X_s  = product(maxideal(1));
86//-------  reproduce T12 ------------------------------------------------------
87  list   Ls   = T12(Fo,1);
88  matrix Ro   = Ls[6];                         // syz(i)
89  matrix InfD = Ls[5];                         // matrix of inf. deformations
90  matrix PreO = Ls[7];                         // representation of (Syz/Kos)*
91  module PreO'= std(PreO);
92  module PreT = Ls[2];                         // representation of modT2 (sb)
93  if(dim(PreT)==0)
94  {
95    matrix kbT2 = kbase(PreT);                 // kbase of T2
96  }
97  else
98  {
99    matrix kbT2 ;                              // kbase of T2 : empty
100  }
101  @t1 = Ls[3];                                 // vdim of T1
102  @t2 = Ls[4];                                 // vdim of T2
103  kill Ls;
104  t1' = @t1;
105  if( @t1==0) { dbprint(p,"// rigit!"); return();}
106  if( @t2==0) { @smooth=1; dbprint(p,"// smooth base space");}
107  dbprint(p,"// ready: T1 and T2");
108  @colR = ncols(Ro);
109//-----  test: quasi-homogeneous, choice of inf. def.--------------------------
110  @degrees = homog_test(@is_qh,matrix(Fo),InfD);
111  @jv = 1..@t1;
112  if (@degrees!="")
113  { dbprint(p-1,"// T1 is quasi-homogeneous represented with weight-vector",
114    @degrees);
115  }
116  if (defined(@active))
117  { "// matrix of infinitesimal deformations:";print(InfD);
118    "// weights of infinitesimal deformations (  emty ='not qhomog'):";
119     @degrees;
120     matrix dummy;
121     InfD,dummy,t1' = interact2(InfD,@jv);kill dummy;
122  }
123 //---- create new rings and objects ------------------------------------------
124  get_rings(Fo,t1',1,@my,@order,@param);
125 setring `myPx`;
126  @jv=0; @jv[t1']=0; @jv=@jv+1; @jv[nvars(basering)]=0;
127                                               //weight-vector for calculating
128                                               //rel-jet with resp to def-para
129  ideal  Io   = imap(Po,Fo);
130  ideal  J,m_J,tid;     attrib(J,"isSB",1);
131  matrix Fo   = matrix(Io);                   //initial equations
132  matrix homF = kohom(Fo,@colR);
133  matrix Ro   = imap(Po,Ro);
134  matrix homR = transpose(Ro);
135  matrix homFR= concat(homR,homF);
136  module hom' = std(homFR);
137  matrix Js[1][@t2];
138  matrix F_R,Fs,Rs,Fn,Rn;
139  export Js,Fs,Rs;
140  matrix Mon[t1'][1]=maxideal(1);
141  Fn  = transpose(imap(Po,InfD)*Mon);         //infinitesimal deformations
142  Fs  = Fo + Fn;
143  dbprint(p-1,"// infinitesimal deformation: Fs: ",Fs);
144  Rn  = (-1)*lift(Fo,Fs*Ro);                  //infinit. relations
145  Rs  = Ro + Rn;
146  F_R = Fs*Rs;
147  tid = 0 + ideal(F_R);
148  if (tid[1]==0) {d_max=1;}                   //finished ?
149 setring `myOx`;
150  matrix Fs,Rs,Cup,Cup',F_R,homFR,New,Rn,Fn;
151  module hom';
152  ideal  null,tid;  attrib(null,"isSB",1);
153 setring `myQx`;
154  poly X_s = imap(Po,X_s);
155  matrix Cup,Cup',MASS;
156  ideal  tid,null;               attrib(null,"isSB",1);
157  ideal  J,m_J;                  attrib(J,"isSB",1);
158                                 attrib(m_J,"isSB",1);
159  matrix PreO = imap(Po,PreO);
160  module PreO'= imap(Po,PreO');  attrib(PreO',"isSB",1);
161  module PreT = imap(Po,PreT);   attrib(PreT,"isSB",1);
162  matrix kbT2 = imap(Po,kbT2);
163  matrix Mon  = fetch(`myPx`,Mon);
164  matrix F_R  = fetch(`myPx`,F_R);
165  matrix Js[1][@t2];
166//------- start the loop ------------------------------------------------------
167   for (@d=2;@d<=d_max;@d=@d+1)
168   {
169     if( @t1==0) {break};
170     dbprint(p,"// start computation in degree "+string(@d)+".");
171     dbprint(p-3,">>> TIME = "+string(timer-time));
172     dbprint(p-3,"==> memory = "+string(kmemory())+"k");
173//------- compute obstruction-vector  -----------------------------------------
174     if (@smooth) { @noObstr=1;}
175     else
176     { Cup = jet(F_R,@d,@jv);
177       Cup = matrix(reduce(ideal(Cup),m_J),@colR,1);
178       Cup = jet(Cup,@d,@jv);
179     }
180//------- express obstructions in kbase of T2  --------------------------------
181     if ( @noObstr==0 )
182     {  Cup' = reduce(Cup,PreO');
183        tid  = simplify(ideal(Cup'),10);
184        if(tid[1]!=0)
185        {  dbprint(p-4,"// *");
186           Cup=Cup-Cup';
187        }
188        Cup   = lift(PreO,Cup);
189        MASS  = lift_rel_kb(Cup,PreT,kbT2,X_s);
190        dbprint(p-3,"// next MASSEY-products:",MASS-jet(MASS,@d-1,@jv));
191        if    (MASS==transpose(Js))
192              { @noObstr=1;dbprint(p-1,"// no obstruction"); }
193         else { @noObstr=0; }
194      }
195//------- obtain equations of base space --------------------------------------
196      if ( @noObstr==0 )
197      { Js = transpose(MASS);
198        dbprint(p-2,"// next equation of base space:",
199        simplify(ideal(Js),10));
200 setring `myPx`;
201        Js   = imap(`myQx`,Js);
202      degBound = @d+1;
203        J    = std(ideal(Js));
204        m_J  = std(J*ideal(Mon));
205      degBound = 0;
206//--------------- obtain new base-ring ----------------------------------------
207        kill `myOx`;
208        if(system("with","Namespaces")==1) { kill Top::`myOx`; }
209  qring `myOx` = J;
210        matrix Fs,Rs,F_R,Cup,Cup',homFR,New,Rn,Fn;
211        module hom';
212        ideal  null,tid;  attrib(null,"isSB",1);
213      }
214//---------------- lift equations F and relations R ---------------------------
215 setring `myOx`;
216      Fs    = fetch(`myPx`,Fs);
217      Rs    = fetch(`myPx`,Rs);
218      F_R   = Fs*Rs;
219      F_R   = matrix(reduce(ideal(F_R),null));
220      tid   = 0 + ideal(F_R);
221      if (tid[1]==0) { dbprint(p-1,"// finished"); break;}
222      Cup   = (-1)*transpose(jet(F_R,@d,@jv));
223      homFR = fetch(`myPx`,homFR);
224      hom'  = fetch(`myPx`,hom');  attrib(hom',"isSB",1);
225      Cup'  = simplify(reduce(Cup,hom'),10);
226      tid   = simplify(ideal(Cup'),10);
227      if (tid[1]!=0)
228      {  dbprint(p-4,"// #");
229         Cup=Cup-Cup';
230      }
231      New   = lift(homFR,Cup);
232      Rn    = matrix(ideal(New[1+@rowR..nrows(New),1]),@rowR,@colR);
233      Fn    = matrix(ideal(New[1..@rowR,1]),1,@rowR);
234      Fs    = Fs+Fn;
235      Rs    = Rs+Rn;
236      F_R   = Fs*Rs;
237      tid   = 0+reduce(ideal(F_R),null);
238//---------------- fetch results into other rings -----------------------------
239  setring `myPx`;
240      Fs    = fetch(`myOx`,Fs);
241      Rs    = fetch(`myOx`,Rs);
242      F_R   = Fs*Rs;
243  setring `myQx`;
244      F_R = fetch(`myPx`,F_R);
245      m_J = fetch(`myPx`,m_J);  attrib(m_J,"isSB",1);
246      J   = fetch(`myPx`,J);    attrib(J,"isSB",1);
247      Js  = fetch(`myPx`,Js);
248      tid = fetch(`myOx`,tid);
249      if (tid[1]==0) { dbprint(p-1,"// finished");break;}
250   }
251//---------  end loop and final output ----------------------------------------
252  setring `myPx`;
253   if (@out!="no")
254   {  string out = @out+"_"+string(@d);
255      "// writing file "+out+" with matrix Js, matrix Fs, matrix Rs ready
256      for reading in rings "+myPx+" or "+myQx;
257      write(out,"matrix Js[1][",@t2,"]=",Js,";matrix Fs[1][",@rowR,"]=",Fs,
258      ";matrix Rs[",@rowR,"][",@colR,"]=",Rs,";");
259   }
260   dbprint(p-3,">>> TIME = "+string(timer-time));
261   if (@is_qh != 0)
262   { @degr = qhweight(ideal(Js));
263     @degr = @degr[1..t1'];
264     dbprint(p-1,"// quasi-homogeneous weights of miniversal base",@degr);
265   }
266   dbprint(p-1,
267   "// ___ Equations of miniversal base space ___",Js,
268   "// ___ Equations of miniversal total space ___",Fs);
269   dbprint(p,"","// Result belongs to ring "+myPx+".",
270   "// Equations of total space of miniversal deformation are ",
271   "// given by Fs, equations of miniversal base space by Js.",
272   "// Make "+myPx+" the basering and list objects defined in "
273   +myPx+" by typing:",
274   "   setring "+myPx+"; show("+myPx+");","   listvar(matrix);",
275   "// NOTE: rings "+myQx+", "+myPx+", "+mySo+" are alive!",
276   "// (use 'kill_rings(\""+@my+"\");' to remove)");
277   return();
278}
279example
280{ "EXAMPLE:"; echo = 2;
281   int p          = printlevel;
282   printlevel     = 0;
283   ring r1        = 0,(x,y,z,u,v),ds;
284   matrix m[2][4] = x,y,z,u,y,z,u,v;
285   ideal Fo       = minor(m,2);
286                    // cone over rational normal curve of degree 4
287   versal(Fo);
288   setring Px;
289   // ___ Equations of miniversal base space ___:
290   Js;"";
291   // ___ Equations of miniversal total space ___:
292   Fs;"";
293   if(system("with","Namespaces")) { kill Ring::Px,Top::Qx,Ring::So; }
294   kill Px,Qx,So;
295   ring  r2       = 0,(x,y,z),ds;
296   ideal Fo       = x2,xy,yz,zx;
297   printlevel     = 3;
298   versal(Fo);
299   printlevel     = p;
300   if(system("with","Namespaces")) { kill Ring::Px,Top::Qx,Ring::So; }
301   kill Px,Qx,So;
302}
303///////////////////////////////////////////////////////////////////////////////
304proc mod_versal(matrix Mo, ideal I, list #)
305"
306USAGE:   mod_versal(Mo,I[,d,any]); I=ideal, M=module, d=int, any =list
307COMUPTE: miniversal deformation of coker(Mo) over Qo=Po/Io, Po=basering;
308CREATE:  Ringsr (exported):
309         'my'Px  = extending the basering by new variables
310                   (deformation parameters),
311                   the new variables come before the old ones,
312                   the ordering is the product between \"my_ord\" and \"ord(Po)\",
313         'my'Qx  = Px/Io extending Qo (returns as basering),
314         'my'Ox  = Px/(Io+Js) ring of the versal deformation of coker(Ms),
315         'my'So  = embedding-ring of the versal base space.  (default 'my'=\"\")
316      Matrices (in Qx, exported):
317         Js  = giving the versal base space (obstructions),
318         Ms  = giving the versal family of Mo,
319         Ls  = giving the lifting of syzygies Lo=syz(Mo),
320      If d is defined (!=0), it computes up to degree d.
321      If 'any' is defined and any[1] is no string, interactive version.
322      Otherwise 'any' gives predefined strings:\"my\",\"param\",\"order\",\"out\"
323      (\"my\" prefix-string, \"param\" is a letter (e.g. \"A\")  for the name of
324      first parameter or (e.g. \"A(\") for index parameter variables, \"ord\"
325      ordering string for ringextension), \"out\" name of output-file).
326NOTE:   printlevel < 0        no output at all,
327        printlevel >=0,1,2,.. informs you, what is going on,
328        this proc uses 'execute'.
329EXAMPLE:example mod_versal; shows an example
330"
331{
332//------- prepare -------------------------------------------------------------
333  string str,@param,@order,@my,@out,@degrees;
334  int @d,d_max,f0,f1,f2,e1,e1',e2,ok_ann,@smooth,@noObstr,@size,@j;
335  int p    = printlevel-voice+3;
336  int time = timer;
337  intvec @iv,@jv,@is_qh,@degr;
338  d_max    = 100;
339  @my = ""; @param="A"; @order="ds"; @out="no";
340  @size = size(#);
341  if( @size>0 ) { d_max = #[1]; }
342  if( @size>1 )
343  { if(typeof(#[2])!="string")
344    { string @active;
345      @my,@param,@order,@out = interact1();
346    }
347    else
348    { @my = #[2];
349      if (@size>2) {@param = #[3];}
350      if (@size>3) {@order = #[4];}
351      if (@size>4) {@out   = #[5];}
352    }
353  }
354  string myPx = @my+"Px";
355  string myQx = @my+"Qx";
356  string myOx = @my+"Ox";
357  string mySo = @my+"So";
358  @is_qh      = qhweight(I);
359  def    Po   = basering;
360 setring Po;
361  poly   X_s = product(maxideal(1));
362//-------- compute Ext's ------------------------------------------------------
363         I   = std(I);
364 qring   Qo  = I;
365  matrix Mo  = fetch(Po,Mo);
366  list   Lo  = compute_ext(Mo,p);
367         f0,f1,f2,e1,e2,ok_ann=Lo[1];
368  matrix Ls,kb1,lift1 = Lo[2],Lo[3],Lo[4];
369  matrix kb2,C',D' = Lo[5][2],Lo[5][3],Lo[5][5];
370  module ex2,Co,Do = Lo[5][1],Lo[5][4],Lo[5][6];
371  kill Lo;
372  dbprint(p,"// ready: Ext1 and Ext2");
373//-----  test: quasi-homogeneous, choice of inf. def.--------------------------
374  @degrees = homog_test(@is_qh,Mo,kb1);
375  e1' = e1;  @jv = 1..e1;
376  if (@degrees != "")
377  { dbprint(p-1,"// Ext1 is quasi-homogeneous represented: "+@degrees);
378  }
379  if (defined(@active))
380  { "// kbase of Ext1:";
381    print(kb1);
382    "// weights of kbase of Ext1 ( empty = 'not qhomog')";@degrees;
383    kb1,lift1,e1' = interact2(kb1,@jv,lift1);
384  }
385//-------- get new rings and objects ------------------------------------------
386 setring Po;
387  get_rings(I,e1',0,@my,@order,@param);
388 setring `myPx`;
389  ideal  J,m_J;
390  ideal  I_J  = imap(Po,I);
391  ideal  Io   = I_J;
392  matrix Mon[e1'][1] = maxideal(1);
393  matrix Ms   = imap(Qo,Mo);
394  matrix Ls   = imap(Qo,Ls);
395  matrix Js[1][e2];
396 setring `myQx`;
397  ideal  J,I_J,tet,null;              attrib(null,"isSB",1);
398  ideal  m_J  = fetch(`myPx`,m_J);   attrib(m_J,"isSB",1);
399  @jv=0;  @jv[e1] = 0; @jv = @jv+1;   @jv[nvars(`myPx`)] = 0;
400  matrix Ms   = imap(Qo,Mo);          export(Ms);
401  matrix Ls   = imap(Qo,Ls);          export(Ls);
402  matrix Js[e2][1];                   export(Js);
403  matrix MASS;
404  matrix Mon  = fetch(`myPx`,Mon);
405  matrix Mn,Ln,ML,Cup,Cup',Lift;
406  matrix C'   = imap(Qo,C');
407  module Co   = imap(Qo,Co);          attrib(Co,"isSB",1);
408  module ex2  = imap(Qo,ex2);         attrib(ex2,"isSB",1);
409  matrix D'   = imap(Qo,D');
410  module Do   = imap(Qo,Do);          attrib(Do,"isSB",1);
411  matrix kb2  = imap(Qo,kb2);
412  matrix kb1  = imap(Qo,kb1);
413  matrix lift1= imap(Qo,lift1);
414  poly   X_s  = imap(Po,X_s);
415  intvec intv = e1',e1,f0,f1,f2;
416         Ms,Ls= get_inf_def(Ms,Ls,kb1,lift1,X_s);
417  kill   kb1,lift1;
418  dbprint(p-1,"// infinitesimal extension",Ms);
419//----------- start the loop --------------------------------------------------
420  for (@d=2;@d<=d_max;@d=@d+1)
421  {
422    dbprint(p-3,">>> time = "+string(timer-time));
423    dbprint(p-3,"==> memory = "+string(memory(0)/1000)+
424                ",  allocated = "+string(memory(1)/1000));
425    dbprint(p,"// start deg = "+string(@d));
426//-------- get obstruction ----------------------------------------------------
427    Cup  = matrix(ideal(Ms*Ls),f0*f2,1);
428    Cup  = jet(Cup,@d,@jv);
429    Cup  = reduce(ideal(Cup),m_J);
430    Cup  = jet(Cup,@d,@jv);
431//-------- express obstruction in kbase ---------------------------------------
432    Cup' = reduce(Cup,Do);
433    tet  = simplify(ideal(Cup'),10);
434    if (tet[1]!=0)
435    { dbprint(p-4,"// *");
436      Cup = Cup-Cup';
437    }
438    Cup  = lift(D',Cup);
439    if (ok_ann)
440    { MASS = lift_rel_kb(Cup,ex2,kb2,X_s);}
441    else
442    { MASS = reduce(Cup,ex2);}
443    dbprint(p-3,"// next MATRIC-MASSEY-products",
444    MASS-jet(MASS,@d-1,@jv));
445    if   ( MASS==transpose(Js))
446         { @noObstr = 1;dbprint(p-1,"//no obstruction"); }
447    else { @noObstr = 0; }
448//-------- obtain equations of base space -------------------------------------
449    if (@noObstr == 0)
450    { Js = MASS;
451      dbprint(p-2,"// next equation of base space:",simplify(ideal(Js),10));
452 setring `myPx`;
453      Js = imap(`myQx`,Js);
454     degBound=@d+1;
455      J   = std(ideal(Js));
456      m_J = std(ideal(Mon)*J);
457     degBound=0;
458      I_J = Io,J;                attrib(I_J,"isSB",1);
459//-------- obtain new base ring -----------------------------------------------
460      kill `myOx`;
461      if(system("with","Namespaces")==1) {
462         if(defined(Top::`myOx`)) { kill Top::`myOx`; }
463      }
464 qring `myOx` = I_J;
465      ideal null,tet;            attrib(null,"isSB",1);
466      matrix Ms  = imap(`myQx`,Ms);
467      matrix Ls  = imap(`myQx`,Ls);
468      matrix Mn,Ln,ML,Cup,Cup',Lift;
469      matrix C'  = imap(Qo,C');
470      module Co  = imap(Qo,Co);   attrib(Co,"isSB",1);
471      module ex2 = imap(Qo,ex2);  attrib(ex2,"isSB",1);
472      matrix kb2 = imap(Qo,kb2);
473      poly   X_s = imap(Po,X_s);
474    }
475//-------- get lifts ----------------------------------------------------------
476   setring `myOx`;
477    ML  = matrix(reduce(ideal(Ms*Ls),null),f0,f2);
478    Cup = matrix(ideal(ML),f0*f2,1);
479    Cup = jet(Cup,@d,@jv);
480    Cup'= reduce(Cup,Co);
481    tet = simplify(ideal(Cup'),10);
482    if (tet[1]!=0)
483    { dbprint(p-4,"// #");
484     Cup = Cup-Cup';
485    }
486    Lift = lift(C',Cup);
487    Mn   = matrix(ideal(Lift),f0,f1);
488    Ln   = matrix(ideal(Lift[f0*f1+1..nrows(Lift),1]),f1,f2);
489    Ms   = Ms-Mn;
490    Ls   = Ls-Ln;
491    dbprint(p-3,"// next extension of Mo",Mn);
492    dbprint(p-3,"// next extension of syz(Mo)",Ln);
493    ML   = reduce(ideal(Ms*Ls),null);
494//--------- test: finished ----------------------------------------------------
495    tet  = simplify(ideal(ML),10);
496    if (tet[1]==0) { dbprint(p-1,"// finished in degree ",@d);}
497//---------fetch results into Qx and Px ---------------------------------------
498   setring `myPx`;
499    Ms   = fetch(`myOx`,Ms);
500    Ls   = fetch(`myOx`,Ls);
501   setring `myQx`;
502    Ms   = fetch(`myOx`,Ms);
503    Ls   = fetch(`myOx`,Ls);
504    ML   = Ms*Ls;
505    ML   = matrix(reduce(ideal(ML),null),f0,f2);
506    tet  = imap(`myOx`,tet);
507    if (tet[1]==0) { break;}
508  }
509//------- end of loop, final output -------------------------------------------
510  if (@out != "no")
511  { string out = @out+"_"+string(@d);
512    "// writing file '"+out+"' with matrix Js, matrix Ms, matrix Ls
513    ready for reading in rings "+myPx+" or "+myQx;
514    write(out,"matrix Js[1][",e2,"]=",Js,";matrix Ms[",f0,"][",f1,"]=",Ms,
515    ";matrix Ls[",f1,"][",f2,"]=",Ls,";");
516  }
517  dbprint(p-3,">>> TIME = "+string(timer-time));
518  if (@is_qh != 0)
519  { @degr = qhweight(ideal(Js));
520    @degr = @degr[1..e1'];
521    dbprint(p-1,"// quasi-homogeneous weights of miniversal base",@degr);
522  }
523  dbprint(p-1,"// Result belongs to qring "+myQx,
524  "// Equations of total space of miniversal deformation are in Js",
525  simplify(ideal(Js),10),
526  "// Matrix of the deformed module is Ms and lifted syzygies are Ls.",
527  "// Make "+myQx+" the basering and list objects defined in "+myQx+
528  " by typing:",
529  "   listvar(ring);setring "+myQx+"; show("+myQx+");listvar(ideal);"+
530  "listvar(matrix);",
531  "// NOTE: rings "+myQx+", "+myOx+", "+mySo+" are still alive!",
532  "// (use: 'kill_rings("+@my+");' to remove them)");
533  return();
534}
535example
536{ "EXAMPLE:"; echo = 2;
537  int p = printlevel;
538  printlevel = 1;
539  ring  Ro = 0,(x,y),wp(3,4);
540  ideal Io = x4+y3;
541  matrix Mo[2][2] = x2,y,-y2,x2;
542  mod_versal(Mo,Io);
543  printlevel = p;
544  if(system("with","Namespaces")) { kill Ring::Px,Top::Qx,Ring::So; }
545  kill Px,Qx,So;
546}
547//=============================================================================
548///////////////////////////////////////////////////////////////////////////////
549proc kill_rings(list #)
550"USAGE: kill_rings([string]);
551Sub-procedure: kills exported rings of 'versal' and
552               'mod_versal' with prefix 'string'
553"
554{
555  string my,br;
556  if (size(#)>0)     { my = #[1];}
557  string na=nameof(basering);
558  br = my+"Qx";
559  if (defined(`br`)) { kill `br`;}
560  br = my+"Px";
561  if (defined(`br`)) { kill `br`;}
562  br = my+"So";
563  if (defined(`br`)) { kill `br`;}
564  br = my+"Ox";
565  if (defined(`br`)) { kill `br`;}
566  br = my+"Sx";
567  if (defined(`br`)) { kill `br`}
568  if(system("with","Namespaces")) {
569    br = my+"Qx";
570    if (defined(Top::`br`)) { kill Top::`br`;}
571    br = my+"Ox";
572    if (defined(Top::`br`)) { kill Top::`br`;}
573    br = my+"Px";
574    if (defined(Ring::`br`)) { kill Ring::`br`;}
575    br = my+"So";
576    if (defined(Ring::`br`)) { kill Ring::`br`;}
577  }
578  if (defined(basering)==0)
579  { "// choose new basering?";
580    if(system("with","Namespaces")) { listvar(Top,ring); }
581    else { listvar(ring); }
582  }
583  return();
584}
585///////////////////////////////////////////////////////////////////////////////
586proc compute_ext(matrix Mo,int p)
587"
588Sub-procedure: obtain Ext1 and Ext2 and other objects used by mod_versal
589"
590{
591   int    l,f0,f1,f2,f3,e1,e2,ok_ann;
592   module Co,Do,ima,ex1,ex2;
593   matrix M0,M1,M2,ker,kb1,lift1,kb2,A,B,C,D;
594//------- resM ---------------------------------------------------------------
595   list resM = nres(Mo,3);
596   M0 = resM[1];
597   M1 = resM[2];
598   M2 = resM[3];   kill resM;
599   f0 = nrows(M0);
600   f1 = ncols(M0);
601   f2 = ncols(M1);
602   f3 = ncols(M2);
603//------ compute Ext^2  ------------------------------------------------------
604   B    = kohom(M0,f3);
605   A    = kontrahom(M2,f0);
606   D    = modulo(A,B);
607   Do   = std(D);
608   ima  = kohom(M0,f2),kontrahom(M1,f0);
609   ex2  = modulo(D,ima);
610   ex2  = std(ex2);
611   e2   = vdim(ex2);
612   kb2  = kbase(ex2);
613      dbprint(p,"// vdim (Ext^2) = "+string(e2));
614//------ test: max = Ann(Ext2) -----------------------------------------------
615   for (l=1;l<=e2;l=l+1)
616   { ok_ann = ok_ann+ord(kb2[l]);
617   }
618   if (ok_ann==0)
619   {  e2 =nrows(ex2);
620      dbprint(p,"// Ann(Ext2) is maximal");
621   }
622//------ compute Ext^1 -------------------------------------------------------
623   B     = kohom(M0,f2);
624   A     = kontrahom(M1,f0);
625   ker   = modulo(A,B);
626   ima   = kohom(M0,f1),kontrahom(M0,f0);
627   ex1   = modulo(ker,ima);
628   ex1   = std(ex1);
629   e1    = vdim(ex1);
630      dbprint(p,"// vdim (Ext^1) = "+string(e1));
631   kb1   = kbase(ex1);
632   kb1   = ker*kb1;
633   C     = concat(A,B);
634   Co    = std(C);
635//------ compute the liftings of Ext^1 ---------------------------------------
636   lift1 = A*kb1;
637   lift1 = lift(B,lift1);
638   intvec iv = f0,f1,f2,e1,e2,ok_ann;
639   list   L' = ex2,kb2,C,Co,D,Do;
640   return(iv,M1,kb1,lift1,L');
641}
642//////////////////////////////////////////////////////////////////////////////
643proc get_rings(ideal Io,int e1,int switch, list #)
644"
645Sub-procedure: creating ring-extensions
646"
647{
648   def Po = basering;
649   string my;
650   string my_ord = "ds";
651   string my_var = "A";
652   if (size(#)>2)
653   {
654     my     = #[1];
655     my_ord = #[2];
656     my_var = #[3];
657   }
658   string my_Px = my+"Px";
659   string my_Qx = my+"Qx";
660   string my_Ox = my+"Ox";
661   string my_So = my+"So";
662  extendring(my_Px,e1,my_var,my_ord);
663   ideal Io  = imap(Po,Io);         attrib(Io,"isSB",1);
664   my ="qring "+my_Qx+" = Io;       export("+my_Qx+");";
665  execute(my);
666   if (switch)
667   {
668     setring `my_Px`;
669     my = "qring "+my_Ox+" = std(ideal(0));export("+my_Ox+");";
670   }
671   else
672   {
673     my = "def "+my_Ox+" = "+my_Qx+";export("+my_Ox+");";
674   }
675  execute(my);
676  defring(my_So,charstr(Po),e1,my_var,my_ord);
677  return();
678}
679//////////////////////////////////////////////////////////////////////////////
680proc get_inf_def(list #)
681"
682Sub-procedure: compute infinitesimal family of a module and its syzygies
683               from a kbase of Ext1 and its lifts
684"
685{
686  matrix Ms  = #[1];
687  matrix Ls  = #[2];
688  matrix kb1 = #[3];
689  matrix li1 = #[4];
690  int   e1,f0,f1,f2;
691  poly X_s     = #[5];
692  e1 = ncols(kb1);
693  f0 = nrows(Ms);
694  f1 = nrows(Ls);
695  f2 = ncols(Ls);
696  int  l;
697  for (l=1;l<=e1;l=l+1)
698  {
699     Ms = Ms + var(l)*matrix(ideal(kb1[l]),f0,f1);
700     Ls = Ls - var(l)*matrix(ideal(li1[l]),f1,f2);
701  }
702  return(Ms,Ls);
703}
704//////////////////////////////////////////////////////////////////////////////
705proc lift_rel_kb (module N, module M, list #)
706"
707USAGE   lift_rel_kb(N,M[,kbaseM,p]);
708ASSUME  [p a monomial ] or the product of all variables
709        N, M modules of same rank,
710        M depending only on variables not in p and vdim(M) finite in this ring,
711        [ kbaseM the kbase of M in the subring given by variables not in p ]
712        warning: check that these assumtions are fulfilled!
713RETURN  matrix A, whose j-th columnes present the coeff's of N[j] in kbaseM,
714        i.e. kbaseM*A = reduce(N,std(M))
715EXAMPLE example lift_rel_kb;  shows examples
716"
717{
718  poly p = product(maxideal(1));
719       M = std(M);
720  matrix A;
721  if (size(#)>0) { p=#[2]; module kbaseM=#[1];}
722  else
723  { if (vdim(M)<=0) { "// vdim(M) not finite";return(A);}
724    module kbaseM = kbase(M);
725  }
726  N = reduce(N,M);
727  if (simplify(N,10)[1]==[0]) {return(A);}
728  A = coeffs(N,kbaseM,p);
729  return(A);
730}
731example
732{
733  "EXAMPLE"; echo=2;
734  ring r=0,(A,B,x,y),dp;
735  module M      = [x2,xy],[xy,y3],[y2],[0,x];
736  module kbaseM = [1],[x],[xy],[y],[0,1],[0,y],[0,y2];
737  poly f=xy;
738  module N = [AB,BBy],[A3xy+x4,AB*(1+y2)];
739  matrix A = lift_rel_kb(N,M,kbaseM,f);
740  print(A);
741  "TEST:";
742  print(matrix(kbaseM)*A-matrix(reduce(N,std(M))));
743  "2nd EXAMPLE";
744  ring   r = 100,(x,y),dp;
745  ideal  I = x2+y2,x2y;
746  module M = jacob(I)+I*freemodule(2);
747  module N = [x+y,1+x2+xy];
748  matrix A = lift_rel_kb(N,M);
749  print(A);
750  print(kbase(std(M))*A);
751  print(reduce(N,std(M)));
752}
753///////////////////////////////////////////////////////////////////////////////
754proc lift_kbase (N, M)
755"USAGE:   lift_kbase(N,M); N,M=poly/ideal/vector/module
756RETURN:  matrix A, coefficient matrix expressing N as linear combination of
757         k-basis of M. Let the k-basis have k elements and size(N)=c columns.
758         Then A satisfies:
759             matrix(reduce(N,std(M)),k,c) = matrix(kbase(std(M)))*A
760ASSUME:  dim(M)=0 and the monomial ordering is a well ordering or the last
761         block of the ordering is c or C
762EXAMPLE: example lift_kbase; shows an example
763"
764{
765  return(lift_rel_kb(N,M));
766}
767example
768{"EXAMPLE:";     echo=2;
769  ring R=0,(x,y),ds;
770  module M=[x2,xy],[y2,xy],[0,xx],[0,yy];
771  module N=[x3+xy,x],[x,x+y2];
772  print(M);
773  module kb=kbase(std(M));
774  print(kb);
775  print(N);
776  matrix A=lift_kbase(N,M);
777  print(A);
778  matrix(reduce(N,std(M)),nrows(kb),ncols(A)) - matrix(kbase(std(M)))*A;
779}
780
781
782///////////////////////////////////////////////////////////////////////////////
783proc interact1 ()
784"
785Sub_procedure: asking for and reading your input-strings
786"
787{
788 string my = "@";
789 string str,out,my_ord,my_var;
790 my_ord = "ds";
791 my_var = "A";
792 "INPUT: name of output-file (ENTER = no output, do not use \"my\"!)";
793   str = read("");
794   if (size(str)>1)
795   { out = str[1..size(str)-1];}
796   else
797   { out = "no";}
798 "INPUT: prefix-string of ring-extension (ENTER = '@')";
799   str = read("");
800   if ( size(str) > 1 )
801   { my = str[1..size(str)-1]; }
802 "INPUT:parameter-string
803   (give a letter corresponding to first new variable followed by the next letters,
804   or 'T('       - a letter + '('  - getting a string of indexed variables)
805   (ENTER = A) :";
806   str = read("");
807   if (size(str)>1) { my_var=str[1..size(str)-1]; }
808 "INPUT:order-string (local or weighted!) (ENTER = ds) :";
809   str = read("");
810   if (size(str)>1) { my_ord=str[1..size(str)-1]; }
811   if( find(my_ord,"s")+find(my_ord,"w") == 0 )
812   { "// ordering must be an local! changed into 'ds'";
813     my_ord = "ds";
814   }
815   return(my,my_var,my_ord,out);
816}
817///////////////////////////////////////////////////////////////////////////////
818proc interact2 (matrix A, intvec col_vec, list #)
819"
820Sub-procedure: asking for and reading your input
821"
822{
823  module B,C;
824  matrix D;
825  int flag;
826  if (size(#)>0) { D=#[1];flag=1;}
827  int t1 = ncols(A);
828  ">>Do you want all deformations? (ENTER=yes)";
829  string str = read("");
830  if (size(str)>1)
831  { ">> Choose columnes of the matrix";
832    ">> (Enter = all columnes)";
833    "INPUT (number of columnes to use as integer-list 'i_1,i_2,.. ,i_t' ):";
834    string columnes = read("");
835    if (size(columnes)<2) {columnes=string(col_vec);}
836    t1 = size(columnes)/2;
837    int l,l1;
838    for (l=1;l<=t1;l=l+1)
839    {
840      execute("l1= "+columnes[2*l-1]+";");
841      B[l] = A[l1];
842      if(flag) { C[l]=D[l1];}
843    }
844    A = matrix(B,nrows(A),size(B));
845    D = matrix(C,nrows(D),size(C));
846  }
847  return(A,D,t1);
848}
849///////////////////////////////////////////////////////////////////////////////
850proc negative_part(intvec iv)
851"
852RETURNS intvec of indices of jv having negative entries (or iv, if non)
853"
854{
855   intvec jv;
856   int    l,k;
857   for (l=1;l<=size(iv);l=l+1)
858   { if (iv[l]<0)
859     {  k = k+1;
860        jv[k]=l;
861     }
862   }
863   if (jv==0) {jv=1; dbprint(printlevel-1,"// empty negative part, return all ");}
864   return(jv);
865}
866///////////////////////////////////////////////////////////////////////////////
867proc find_ord(matrix A, intvec w_vec)
868"
869Sub-proc: return martix ord(a_ij) with respect to weight_vec, or
870          0 if A non-qh
871"
872{
873  int @r = nrows(A);
874  int @c = ncols(A);
875  int i,j;
876  string ord_str = "wp("+string(w_vec)+")";
877  def br = basering;
878 changeord("nr",ord_str);
879  matrix A    = imap(br,A);
880  intmat degA[@r][@c];
881  if (homog(ideal(A)))
882  { for (i=1;i<=@r;i=i+1)
883    { for(j=1;j<=@c;j=j+1)
884      {  degA[i,j]=ord(A[i,j]); }
885    }
886  }
887 setring br;
888  if(system("with","Namespaces")) { kill Ring::nr; }
889  kill nr;
890  return(degA);
891}
892//////////////////////////////////////////////////////////////////////////////////
893proc homog_test(intvec w_vec, matrix Mo, matrix A)
894"
895Sub proc: return relative weight string of columnes of A with respect
896          to the given w_vec and to Mo, or \"\" if not qh
897    NOTE: * means weight is not determined
898"
899{
900  int k,l;
901  intvec tv;
902  string @nv;
903  int @r = nrows(A);
904  int @c = ncols(A);
905  A = concat(matrix(ideal(Mo),@r,1),A);
906  intmat a = find_ord(A,w_vec);
907  intmat b[@r][@c];
908  for (l=1;l<=@c;l=l+1)
909  {
910    for (k=1;k<=@r;k=k+1)
911    {  if (A[k,l+1]!=0)
912       { b[k,l] = a[k,l+1]-a[k,1];}
913    }
914    tv = 0;
915    for (k=1;k<=@r;k=k+1)
916    {  if (A[k,l+1]*A[k,1]!=0)
917       {tv = tv,b[k,l];}
918    }
919    if (size(tv)>1)
920    { k = tv[2];
921      tv = tv[2..size(tv)]; tv = tv -k;
922      if (tv==0) { @nv = @nv+string(-k)+",";}
923      else {return("");}
924    }
925    else { @nv = @nv+"*,";}
926  }
927  @nv = @nv[1..size(@nv)-1];
928  return(@nv);
929}
930//////////////////////////////////////////////////////////////////////////////////
931proc homog_t(intvec d_vec, matrix Fo, matrix A)
932"
933Sub-procedure: Computing relative (with respect to flatten(Fo)) weight_vec
934               of columnes of A (return zero if Fo or A not qh)
935"
936{
937   Fo = matrix(Fo,nrows(A),1);
938   A  = concat(Fo,A);
939   A  = transpose(A);
940   def br = basering;
941   string o_str = "wp("+string(d_vec)+")";
942 changeord("nr",o_str);
943   module A = fetch(br,A);
944   intvec dv;
945   int l = homog(A) ;
946   if (l==0) {
947     setring br;
948     if(system("with","Namespaces")) { kill Ring::nr; }
949     kill nr;
950     return(l);
951   }
952   dv = attrib(A,"isHomog");
953   l  = dv[1];
954   dv = dv[2..size(dv)];
955   dv = dv-l;
956 setring br;
957   if(system("with","Namespaces")) { kill Ring::nr; }
958   kill nr;
959   return(dv);
960}
961
Note: See TracBrowser for help on using the repository browser.