passagemath-singular 10.6.31rc3__cp314-cp314-musllinux_1_2_x86_64.whl

sage_wheels/share/singular/LIB/deform.lib

@@ -0,0 +1,925 @@
+//////////////////////////////////////////////////////////////////////////////
+version="version deform.lib 4.3.1.3 Jan_2023 "; // $Id: 2c496e9bb836e18fda75ad35289a7a0421c5aad4 $
+category="Singularities";
+info="
+LIBRARY:  deform.lib    Miniversal Deformation of Singularities and Modules
+AUTHOR:   Bernd Martin, email: martin@math.tu-cottbus.de
+
+PROCEDURES:
+ versal(Fo[,d,any])        miniversal deformation of isolated singularity Fo
+ mod_versal(Mo,I,[,d,any]) miniversal deformation of module Mo modulo ideal I
+ lift_kbase(N,M);          lifting N into standard kbase of M
+ lift_rel_kb(N,M[,kbM,p])  relative lifting N into a kbase of M
+";
+
+LIB "inout.lib";
+LIB "general.lib";
+LIB "matrix.lib";
+LIB "homolog.lib";
+LIB "sing.lib";
+///////////////////////////////////////////////////////////////////////////////
+
+proc versal (ideal Fo,list #)
+"USAGE:   versal(Fo[,d,any]); Fo=ideal, d=int, any=list
+COMPUTE: miniversal deformation of Fo up to degree d (default d=100),
+RETURN: list L of 4 rings:
+         L[1] extending the basering Po by new variables given by
+          \"A,B,..\" (deformation parameters); the new variables precede
+         the old ones, the ordering is the product of \"ls\" and \"ord(Po)\" @*
+         L[2] = L[1]/Fo extending Qo=Po/Fo, @*
+         L[3] = the embedding ring of the versal base space, @*
+         L[4] = L[1]/Js extending L[3]/Js. @*
+      In the ring L[1] the following matrices are stored:
+         @*Js  = giving the versal base space (obstructions),
+         @*Fs  = giving the versal family of Fo,
+         @*Rs  = giving the lifting of Ro=syz(Fo).
+
+      If d is defined (!=0), it computes up to degree d.
+      @*If 'any' is defined and any[1] is no string, interactive version.
+      @*Otherwise 'any' is interpreted as a list of predefined strings:
+      \"my\",\"param\",\"order\",\"out\": @*
+      (\"my\" internal prefix, \"param\" is a letter (e.g. \"A\") for the
+      name of the first parameter or (e.g. \"A(\") for index parameter
+      variables, \"order\" ordering string for ring extension), \"out\" name
+      of output file).
+NOTE:   printlevel < 0        no additional output,
+        printlevel >=0,1,2,.. informs you, what is going on;
+        this proc uses 'execute'.
+EXAMPLE:example versal; shows an example
+"
+{
+//------- prepare -------------------------------------------------------------
+  string str,@param,@order,@my,@out,@degrees;
+  int @d,d_max,@t1,t1',@t2,@colR,ok_ann,@smooth,@noObstr,@size,@j;
+  int p    = printlevel-voice+3;
+  int time = timer;
+  intvec @iv,@jv,@is_qh,@degr;
+  d_max    = 100;
+  @my = ""; @param="A"; @order="ds"; @out="no";
+  @size    = size(#);
+  if( @size>0 ) { if (#[1]>0) { d_max = #[1];} }
+  if( @size>1 )
+  { if(typeof(#[2])!="string")
+    { string @active;
+      @my,@param,@order,@out = interact1();
+    }
+    else
+    { @my = #[2];
+      if (@size>2) {@param = #[3];}
+      if (@size>3) {@order = #[4];}
+      if (@size>4) {@out   = #[5];}
+    }
+  }
+  if (ord_test(basering)==-1) {  Fo   = minbase(Fo);}
+  else                        {  Fo   =interred(Fo);}
+  @is_qh      = qhweight(Fo);
+  int    @rowR= size(Fo);
+  def    Po   = basering;
+setring  Po;
+  poly   X_s  = product(maxideal(1));
+//-------  reproduce T_12 -----------------------------------------------------
+  list   Ls   = T_12(Fo,1);
+  matrix Ro   = Ls[6];                         // syz(i)
+  matrix InfD = Ls[5];                         // matrix of inf. deformations
+  matrix PreO = Ls[7];                         // representation of (Syz/Kos)*
+  module PreO'= std(PreO);
+  module PreT = Ls[2];                         // representation of modT_2 (sb)
+  if(dim(PreT)==0)
+  {
+    matrix kbT_2 = kbase(PreT);                 // kbase of T_2
+  }
+  else
+  {
+    matrix kbT_2 ;                              // kbase of T_2 : empty
+  }
+  @t1 = Ls[3];                                 // vdim of T_1
+  @t2 = Ls[4];                                 // vdim of T_2
+  kill Ls;
+  t1' = @t1;
+  if( @t1==0) { dbprint(p,"// rigid!"); return(list());}
+  if( @t2==0) { @smooth=1; dbprint(p,"// smooth base space");}
+  dbprint(p,"// ready: T_1 and T_2");
+  @colR = ncols(Ro);
+//-----  test: quasi-homogeneous, choice of inf. def.--------------------------
+  @degrees = homog_test(@is_qh,matrix(Fo),InfD);
+  @jv = 1..@t1;
+  if (@degrees!="")
+  { dbprint(p-1,"// T_1 is quasi-homogeneous represented with weight-vector",
+    @degrees);
+  }
+  if (defined(@active))
+  { "// matrix of infinitesimal deformations:";print(InfD);
+    "// weights of infinitesimal deformations (  empty ='not qhomog'):";
+     @degrees;
+     matrix dummy;
+     InfD,dummy,t1' = interact2(InfD,@jv);kill dummy;
+  }
+ //---- create new rings and objects ------------------------------------------
+  list list_of_rings=get_rings(Fo,t1',1,@order,@param);
+  def myPx= list_of_rings[1];
+  def myQx= list_of_rings[2];
+  def myOx= list_of_rings[3];
+  def mySo= list_of_rings[4];
+  kill list_of_rings;
+  setring myPx;
+  @jv=0; @jv[t1']=0; @jv=@jv+1; @jv[nvars(basering)]=0;
+                                               //weight-vector for calculating
+                                               //rel-jet with resp to def-para
+  ideal  Io   = imap(Po,Fo);
+  ideal  J,m_J,tid;     attrib(J,"isSB",1);
+  matrix Fo   = matrix(Io);                   //initial equations
+  matrix homF = kohom(Fo,@colR);
+  matrix Ro   = imap(Po,Ro);
+  matrix homR = transpose(Ro);
+  matrix homFR= concat(homR,homF);
+  module hom' = std(homFR);
+  matrix Js[1][@t2];
+  matrix F_R,Fs,Rs,Fn,Rn;
+  export Js,Fs,Rs;
+  matrix Mon[t1'][1]=maxideal(1);
+  Fn  = transpose(imap(Po,InfD)*Mon);         //infinitesimal deformations
+  Fs  = Fo + Fn;
+  dbprint(p-1,"// infinitesimal deformation: Fs: ",Fs);
+  Rn  = (-1)*lift(Fo,Fs*Ro);                  //infinit. relations
+  Rs  = Ro + Rn;
+  F_R = Fs*Rs;
+  tid = 0 + ideal(F_R);
+  if (tid[1]==0) {d_max=1;}                   //finished ?
+ setring myOx;
+  matrix Fs,Rs,Cup,Cup',F_R,homFR,New,Rn,Fn;
+  module hom';
+  ideal  null,tid;  attrib(null,"isSB",1);
+ setring myQx;
+  poly X_s = imap(Po,X_s);
+  matrix Cup,Cup',MASS;
+  ideal  tid,null;               attrib(null,"isSB",1);
+  ideal  J,m_J;                  attrib(J,"isSB",1);
+                                 attrib(m_J,"isSB",1);
+  matrix PreO = imap(Po,PreO);
+  module PreO'= imap(Po,PreO');  attrib(PreO',"isSB",1);
+  module PreT = imap(Po,PreT);   attrib(PreT,"isSB",1);
+  matrix kbT_2 = imap(Po,kbT_2);
+  matrix Mon  = fetch(myPx,Mon);
+  matrix F_R  = fetch(myPx,F_R);
+  matrix Js[1][@t2];
+//------- start the loop ------------------------------------------------------
+   for (@d=2;@d<=d_max;@d=@d+1)
+   {
+     if( @t1==0) {break};
+     dbprint(p,"// start computation in degree "+string(@d)+".");
+     dbprint(p-3,">>> TIME = "+string(timer-time));
+     dbprint(p-3,"==> memory = "+string(kmemory())+"k");
+//------- compute obstruction-vector  -----------------------------------------
+     if (@smooth) { @noObstr=1;}
+     else
+     { Cup = jet(F_R,@d,@jv);
+       Cup = matrix(reduce(ideal(Cup),m_J),@colR,1);
+       Cup = jet(Cup,@d,@jv);
+     }
+//------- express obstructions in kbase of T_2  -------------------------------
+     if ( @noObstr==0 )
+     {  Cup' = reduce(Cup,PreO');
+        tid  = simplify(ideal(Cup'),10);
+        if(tid[1]!=0)
+        {  dbprint(p-4,"// *");
+           Cup=Cup-Cup';
+        }
+        Cup   = lift(PreO,Cup);
+        MASS  = lift_rel_kb(Cup,PreT,kbT_2,X_s);
+        dbprint(p-3,"// next MASSEY-products:",MASS-jet(MASS,@d-1,@jv));
+        if    (MASS==transpose(Js))
+              { @noObstr=1;dbprint(p-1,"// no obstruction"); }
+         else { @noObstr=0; }
+      }
+//------- obtain equations of base space --------------------------------------
+      if ( @noObstr==0 )
+      { Js = transpose(MASS);
+        dbprint(p-2,"// next equation of base space:",
+        simplify(ideal(Js),10));
+        setring myPx;
+        Js   = imap(myQx,Js);
+        degBound = @d+1;
+        J    = std(ideal(Js));
+        m_J  = std(J*ideal(Mon));
+        degBound = 0;
+//--------------- obtain new base-ring ----------------------------------------
+        if(defined(myOx)) {kill myOx;}
+        attrib(J,"isSB",1); // J is a degBound-SB (deg @d)
+        qring myOx = J;
+        matrix Fs,Rs,F_R,Cup,Cup',homFR,New,Rn,Fn;
+        module hom';
+        ideal  null,tid;  attrib(null,"isSB",1);
+      }
+//---------------- lift equations F and relations R ---------------------------
+      setring myOx;
+      Fs    = fetch(myPx,Fs);
+      Rs    = fetch(myPx,Rs);
+      F_R   = Fs*Rs;
+      F_R   = matrix(reduce(ideal(F_R),null));
+      tid   = 0 + ideal(F_R);
+      if (tid[1]==0) { dbprint(p-1,"// finished"); break;}
+      Cup   = (-1)*transpose(jet(F_R,@d,@jv));
+      homFR = fetch(myPx,homFR);
+      hom'  = fetch(myPx,hom');  attrib(hom',"isSB",1);
+      Cup'  = simplify(reduce(Cup,hom'),10);
+      tid   = simplify(ideal(Cup'),10);
+      if (tid[1]!=0)
+      {  dbprint(p-4,"// #");
+         Cup=Cup-Cup';
+      }
+      New   = lift(homFR,Cup);
+      Rn    = matrix(ideal(New[1+@rowR..nrows(New),1]),@rowR,@colR);
+      Fn    = matrix(ideal(New[1..@rowR,1]),1,@rowR);
+      Fs    = Fs+Fn;
+      Rs    = Rs+Rn;
+      F_R   = Fs*Rs;
+      tid   = 0+reduce(ideal(F_R),null);
+//---------------- fetch results into other rings -----------------------------
+      setring myPx;
+      Fs    = fetch(myOx,Fs);
+      Rs    = fetch(myOx,Rs);
+      F_R   = Fs*Rs;
+      setring myQx;
+      F_R = fetch(myPx,F_R);
+      m_J = fetch(myPx,m_J);  attrib(m_J,"isSB",1);
+      J   = fetch(myPx,J);    attrib(J,"isSB",1);
+      Js  = fetch(myPx,Js);
+      tid = fetch(myOx,tid);
+      if (tid[1]==0) { dbprint(p-1,"// finished");break;}
+   }
+//---------  end loop and final output ----------------------------------------
+   setring myPx;
+   if (@out!="no")
+   {  string out = @out+"_"+string(@d);
+      "// writing file "+out+" with matrix Js, matrix Fs, matrix Rs ready
+      for reading in rings "+myPx+" or "+myQx;
+      write(out,"matrix Js[1][",@t2,"]=",Js,";matrix Fs[1][",@rowR,"]=",Fs,
+      ";matrix Rs[",@rowR,"][",@colR,"]=",Rs,";");
+   }
+   dbprint(p-3,">>> TIME = "+string(timer-time));
+   if (@is_qh != 0)
+   { @degr = qhweight(ideal(Js));
+     @degr = @degr[1..t1'];
+     dbprint(p-1,"// quasi-homogeneous weights of miniversal base",@degr);
+   }
+   dbprint(p-1,
+   "// ___ Equations of miniversal base space ___",Js,
+   "// ___ Equations of miniversal total space ___",Fs);
+   dbprint(p,"","
+// 'versal' returned a list, say L, of four rings. In L[1] are stored:
+//   as matrix Fs: Equations of total space of the miniversal deformation,
+//   as matrix Js: Equations of miniversal base space,
+//   as matrix Rs: syzygies of Fs mod Js.
+// To access these data, type
+     def Px=L[1]; setring Px; print(Fs); print(Js); print(Rs);
+
+// L[2] = L[1]/Fo extending Qo=Po/Fo,
+// L[3] = the embedding ring of the versal base space,
+// L[4] = L[1]/Js extending L[3]/Js.
+");
+   return(list(myPx,myQx,mySo,myOx));
+}
+example
+{ "EXAMPLE:"; echo = 2;
+   int p          = printlevel;
+   printlevel     = 0;
+   ring r1        = 0,(x,y,z,u,v),ds;
+   matrix m[2][4] = x,y,z,u,y,z,u,v;
+   ideal Fo       = minor(m,2);
+                    // cone over rational normal curve of degree 4
+   list L=versal(Fo);
+   L;
+   def Px=L[1];
+   setring Px;
+   // ___ Equations of miniversal base space ___:
+   Js;"";
+   // ___ Equations of miniversal total space ___:
+   Fs;"";
+}
+///////////////////////////////////////////////////////////////////////////////
+
+proc mod_versal(matrix Mo, ideal I, list #)
+"USAGE:   mod_versal(Mo,Io[,d,any]); Io=ideal, Mo=module, d=int, any =list
+COMPUTE: miniversal deformation of coker(Mo) over Qo=Po/Io, Po=basering;
+RETURN:  list L of 4 rings:
+         L[1] extending the basering Po by new variables given by
+          \"A,B,..\" (deformation parameters); the new variables precede
+         the old ones, the ordering is the product of \"ls\" and \"ord(Po)\" @*
+         L[2] = L[1]/Io extending Qo, @*
+         L[3] = the embedding ring of the versal base space, @*
+         L[4] = L[1]/(Io+Js) ring of the versal deformation of coker(Ms). @*
+      In the ring L[1] the following matrices are stored:
+         @*Js  = giving the versal base space (obstructions),
+         @*Fs  = giving the versal family of Mo,
+         @*Rs  = giving the lifting of syzygies Lo=syz(Mo).
+      If d is defined (!=0), it computes up to degree d.
+      @*If 'any' is defined and any[1] is no string, interactive version.
+      @*Otherwise 'any' is interpreted as a list of predefined strings:
+      \"my\",\"param\",\"order\",\"out\": @*
+      (\"my\" internal prefix, \"param\" is a letter (e.g. \"A\") for the
+      name of the first parameter or (e.g. \"A(\") for index parameter
+      variables, \"order\" ordering string for ring extension), \"out\" name
+      of output file).
+NOTE:   printlevel < 0        no additional output,
+        printlevel >=0,1,2,.. informs you, what is going on,
+        this proc uses 'execute'.
+EXAMPLE:example mod_versal; shows an example
+"
+{
+//------- prepare -------------------------------------------------------------
+  intvec save_opt=option(get);
+  option(cancelunit);
+  string str,@param,@order,@my,@out,@degrees;
+  int @d,d_max,f0,f1,f2,e1,e1',e2,ok_ann,@smooth,@noObstr,@size,@j;
+  int p    = printlevel-voice+3;
+  int time = timer;
+  intvec @iv,@jv,@is_qh,@degr;
+  d_max    = 100;
+  @my = ""; @param="A"; @order="ds"; @out="no";
+  @size = size(#);
+  if( @size>0 ) { d_max = #[1]; }
+  if( @size>1 )
+  { if(typeof(#[2])!="string")
+    { string @active;
+      @my,@param,@order,@out = interact1();
+    }
+    else
+    { @my = #[2];
+      if (@size>2) {@param = #[3];}
+      if (@size>3) {@order = #[4];}
+      if (@size>4) {@out   = #[5];}
+    }
+  }
+  @is_qh      = qhweight(I);
+  def    Po   = basering;
+ setring Po;
+  poly   X_s = product(maxideal(1));
+//-------- compute Ext's ------------------------------------------------------
+         I   = std(I);
+ qring   Qo  = I;
+  matrix Mo  = fetch(Po,Mo);
+  list   Lo  = compute_ext(Mo,p);
+         f0,f1,f2,e1,e2,ok_ann=Lo[1];
+  matrix Ls,kb1,lift1 = Lo[2],Lo[3],Lo[4];
+  matrix kb2,C',D' = Lo[5][2],Lo[5][3],Lo[5][5];
+  module ex2,Co,Do = Lo[5][1],Lo[5][4],Lo[5][6];
+  kill Lo;
+  dbprint(p,"// ready: Ext1 and Ext2");
+//-----  test: quasi-homogeneous, choice of inf. def.--------------------------
+  @degrees = homog_test(@is_qh,Mo,kb1);
+  e1' = e1;  @jv = 1..e1;
+  if (@degrees != "")
+  { dbprint(p-1,"// Ext1 is quasi-homogeneous represented: "+@degrees);
+  }
+  if (defined(@active))
+  { "// kbase of Ext1:";
+    print(kb1);
+    "// weights of kbase of Ext1 ( empty = 'not qhomog')";@degrees;
+    kb1,lift1,e1' = interact2(kb1,@jv,lift1);
+  }
+//-------- get new rings and objects ------------------------------------------
+  setring Po;
+  list list_of_rings=get_rings(I,e1',0,@order,@param);
+  def ooPx= list_of_rings[1];
+  def ooQx= list_of_rings[2];
+  def ooOx= list_of_rings[3];
+  def ooSo= list_of_rings[4];
+  kill list_of_rings;
+  setring ooPx;
+  ideal  J,m_J;
+  ideal  I_J  = imap(Po,I);
+  ideal  Io   = I_J;
+  matrix Mon[e1'][1] = maxideal(1);
+  matrix Ms   = imap(Qo,Mo);
+  matrix Ls   = imap(Qo,Ls);
+  matrix Js[1][e2];
+  setring ooQx;
+  ideal  J,I_J,tet,null;              attrib(null,"isSB",1);
+  ideal  m_J  = fetch(ooPx,m_J);   attrib(m_J,"isSB",1);
+  @jv=0;  @jv[e1] = 0; @jv = @jv+1;   @jv[nvars(ooPx)] = 0;
+  matrix Ms   = imap(Qo,Mo);          export(Ms);
+  matrix Ls   = imap(Qo,Ls);          export(Ls);
+  matrix Js[e2][1];                   export(Js);
+  matrix MASS;
+  matrix Mon  = fetch(ooPx,Mon);
+  matrix Mn,Ln,ML,Cup,Cup',Lift;
+  matrix C'   = imap(Qo,C');
+  module Co   = imap(Qo,Co);          attrib(Co,"isSB",1);
+  module ex2  = imap(Qo,ex2);         attrib(ex2,"isSB",1);
+  matrix D'   = imap(Qo,D');
+  module Do   = imap(Qo,Do);          attrib(Do,"isSB",1);
+  matrix kb2  = imap(Qo,kb2);
+  matrix kb1  = imap(Qo,kb1);
+  matrix lift1= imap(Qo,lift1);
+  poly   X_s  = imap(Po,X_s);
+  intvec intv = e1',e1,f0,f1,f2;
+         Ms,Ls= get_inf_def(Ms,Ls,kb1,lift1,X_s);
+  kill   kb1,lift1;
+  dbprint(p-1,"// infinitesimal extension",Ms);
+//----------- start the loop --------------------------------------------------
+  for (@d=2;@d<=d_max;@d=@d+1)
+  {
+    dbprint(p-3,">>> time = "+string(timer-time));
+    dbprint(p-3,"==> memory = "+string(memory(0)/1000)+
+                ",  allocated = "+string(memory(1)/1000));
+    dbprint(p,"// start deg = "+string(@d));
+//-------- get obstruction ----------------------------------------------------
+    Cup  = matrix(ideal(Ms*Ls),f0*f2,1);
+    Cup  = jet(Cup,@d,@jv);
+    Cup  = reduce(ideal(Cup),m_J);
+    Cup  = jet(Cup,@d,@jv);
+//-------- express obstruction in kbase ---------------------------------------
+    Cup' = reduce(Cup,Do);
+    tet  = simplify(ideal(Cup'),10);
+    if (tet[1]!=0)
+    { dbprint(p-4,"// *");
+      Cup = Cup-Cup';
+    }
+    Cup  = lift(D',Cup);
+    if (ok_ann)
+    { MASS = lift_rel_kb(Cup,ex2,kb2,X_s);}
+    else
+    { MASS = reduce(Cup,ex2);}
+    dbprint(p-3,"// next MATRIC-MASSEY-products",
+    MASS-jet(MASS,@d-1,@jv));
+    if   ( MASS==transpose(Js))
+         { @noObstr = 1;dbprint(p-1,"//no obstruction"); }
+    else { @noObstr = 0; }
+//-------- obtain equations of base space -------------------------------------
+    if (@noObstr == 0)
+    { Js = MASS;
+      dbprint(p-2,"// next equation of base space:",simplify(ideal(Js),10));
+      setring ooPx;
+      Js = imap(ooQx,Js);
+      degBound=@d+1;
+      J   = std(ideal(Js));
+      m_J = std(ideal(Mon)*J);
+      degBound=0;
+      I_J = Io,J;                attrib(I_J,"isSB",1);
+//-------- obtain new base ring -----------------------------------------------
+      if (defined(ooOx)) {kill ooOx;}
+      qring ooOx = I_J;
+      ideal null,tet;            attrib(null,"isSB",1);
+      matrix Ms  = imap(ooQx,Ms);
+      matrix Ls  = imap(ooQx,Ls);
+      matrix Mn,Ln,ML,Cup,Cup',Lift;
+      matrix C'  = imap(Qo,C');
+      module Co  = imap(Qo,Co);   attrib(Co,"isSB",1);
+      module ex2 = imap(Qo,ex2);  attrib(ex2,"isSB",1);
+      matrix kb2 = imap(Qo,kb2);
+      poly   X_s = imap(Po,X_s);
+    }
+//-------- get lifts ----------------------------------------------------------
+    setring ooOx;
+    ML  = matrix(reduce(ideal(Ms*Ls),null),f0,f2);
+    Cup = matrix(ideal(ML),f0*f2,1);
+    Cup = jet(Cup,@d,@jv);
+    Cup'= reduce(Cup,Co);
+    tet = simplify(ideal(Cup'),10);
+    if (tet[1]!=0)
+    { dbprint(p-4,"// #");
+     Cup = Cup-Cup';
+    }
+    Lift = lift(C',Cup);
+    Mn   = matrix(ideal(Lift),f0,f1);
+    Ln   = matrix(ideal(Lift[f0*f1+1..nrows(Lift),1]),f1,f2);
+    Ms   = Ms-Mn;
+    Ls   = Ls-Ln;
+    dbprint(p-3,"// next extension of Mo",Mn);
+    dbprint(p-3,"// next extension of syz(Mo)",Ln);
+    ML   = reduce(ideal(Ms*Ls),null);
+//--------- test: finished ----------------------------------------------------
+    tet  = simplify(ideal(ML),10);
+    if (tet[1]==0) { dbprint(p-1,"// finished in degree ",@d);}
+//---------fetch results into Qx and Px ---------------------------------------
+    setring ooPx;
+    Ms   = fetch(ooOx,Ms);
+    Ls   = fetch(ooOx,Ls);
+   setring ooQx;
+    Ms   = fetch(ooOx,Ms);
+    Ls   = fetch(ooOx,Ls);
+    ML   = Ms*Ls;
+    ML   = matrix(reduce(ideal(ML),null),f0,f2);
+    tet  = imap(ooOx,tet);
+    if (tet[1]==0) { break;}
+  }
+//------- end of loop, final output -------------------------------------------
+  if (@out != "no")
+  { string out = @out+"_"+string(@d);
+    "// writing file '"+out+"' with matrix Js, matrix Ms, matrix Ls
+    ready for reading in rings qqPx or qqQx";
+    write(out,"matrix Js[1][",e2,"]=",Js,";matrix Ms[",f0,"][",f1,"]=",Ms,
+    ";matrix Ls[",f1,"][",f2,"]=",Ls,";");
+  }
+  dbprint(p-3,">>> TIME = "+string(timer-time));
+  if (@is_qh != 0)
+  { @degr = qhweight(ideal(Js));
+    @degr = @degr[1..e1'];
+    dbprint(p-1,"// quasi-homogeneous weights of miniversal base",@degr);
+  }
+  dbprint(p,"
+// 'mod_versal' returned a list, say L, of four rings. In L[2] are stored:
+//   as matrix Ms: presentation matrix of the deformed module,
+//   as matrix Ls: lifted syzygies,
+//   as matrix Js:  Equations of total space of miniversal deformation
+// To access these data, type
+     def Qx=L[2]; setring Qx; print(Ms); print(Ls); print(Js);
+");
+  option(set,save_opt);
+  return(list(ooPx,ooQx,ooSo,ooOx));
+}
+example
+{ "EXAMPLE:"; echo = 2;
+  int p = printlevel;
+  printlevel = 1;
+  ring  Ro = 0,(x,y),wp(3,4);
+  ideal Io = x4+y3;
+  matrix Mo[2][2] = x2,y,-y2,x2;
+  list L = mod_versal(Mo,Io);
+  def Qx=L[2]; setring Qx;
+  print(Ms);
+  print(Ls);
+  print(Js);
+  printlevel = p;
+  if (defined(Px)) {kill Px,Qx,So;}
+}
+///////////////////////////////////////////////////////////////////////////////
+proc compute_ext(matrix Mo,int p)
+"
+Sub-procedure: obtain Ext1 and Ext2 and other objects used by mod_versal
+"
+{
+   int    l,f0,f1,f2,f3,e1,e2,ok_ann;
+   module Co,Do,ima,ex1,ex2;
+   matrix M0,M1,M2,ker,kb1,lift1,kb2,A,B,C,D;
+//------- resM ---------------------------------------------------------------
+   list resM = nres(Mo,3);
+   M0 = resM[1];
+   M1 = resM[2];
+   M2 = resM[3];   kill resM;
+   f0 = nrows(M0);
+   f1 = ncols(M0);
+   f2 = ncols(M1);
+   f3 = ncols(M2);
+//------ compute Ext^2  ------------------------------------------------------
+   B    = kohom(M0,f3);
+   A    = kontrahom(M2,f0);
+   D    = modulo(A,B);
+   Do   = std(D);
+   ima  = kohom(M0,f2),kontrahom(M1,f0);
+   ex2  = modulo(D,ima);
+   ex2  = std(ex2);
+   e2   = vdim(ex2);
+   kb2  = kbase(ex2);
+      dbprint(p,"// vdim (Ext^2) = "+string(e2));
+//------ test: max = Ann(Ext2) -----------------------------------------------
+   for (l=1;l<=e2;l=l+1)
+   { ok_ann = ok_ann+ord(kb2[l]);
+   }
+   if (ok_ann==0)
+   {  e2 =nrows(ex2);
+      dbprint(p,"// Ann(Ext2) is maximal");
+   }
+//------ compute Ext^1 -------------------------------------------------------
+   B     = kohom(M0,f2);
+   A     = kontrahom(M1,f0);
+   ker   = modulo(A,B);
+   ima   = kohom(M0,f1),kontrahom(M0,f0);
+   ex1   = modulo(ker,ima);
+   ex1   = std(ex1);
+   e1    = vdim(ex1);
+      dbprint(p,"// vdim (Ext^1) = "+string(e1));
+   kb1   = kbase(ex1);
+   kb1   = ker*kb1;
+   C     = concat(A,B);
+   Co    = std(C);
+//------ compute the liftings of Ext^1 ---------------------------------------
+   lift1 = A*kb1;
+   lift1 = lift(B,lift1);
+   intvec iv = f0,f1,f2,e1,e2,ok_ann;
+   list   L' = ex2,kb2,C,Co,D,Do;
+   return(iv,M1,kb1,lift1,L');
+}
+///////////////////////////////////////////////////////////////////////////////
+static proc get_rings(ideal Io,int e1,int switch, list #)
+"
+Sub-procedure: creating ring-extensions, returned as a list of 4 rings
+"
+{
+   def Po = basering;
+   string my;
+   string my_ord = "ds";
+   string my_var = "A";
+   if (size(#)>1)
+   {
+     my_ord = #[1];
+     my_var = #[2];
+   }
+   def my_Px=extendring(e1,my_var,my_ord);
+   setring my_Px;
+   ideal Io  = imap(Po,Io);
+   attrib(Io,"isSB",1);
+   qring my_Qx = Io;
+   if (switch)
+   {
+     setring my_Px;
+     qring my_Ox = std(ideal(0));
+   }
+   else
+   {
+     def my_Ox = my_Qx;
+   }
+   def my_So=defring(charstr(Po),e1,my_var,my_ord);
+   setring my_So;
+   list erg=list(my_Px,my_Qx,my_Ox,my_So);
+   return(erg);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc get_inf_def(list #)
+"
+Sub-procedure: compute infinitesimal family of a module and its syzygies
+               from a kbase of Ext1 and its lifts
+"
+{
+  matrix Ms  = #[1];
+  matrix Ls  = #[2];
+  matrix kb1 = #[3];
+  matrix li1 = #[4];
+  int   e1,f0,f1,f2;
+  poly X_s     = #[5];
+  e1 = ncols(kb1);
+  f0 = nrows(Ms);
+  f1 = nrows(Ls);
+  f2 = ncols(Ls);
+  int  l;
+  for (l=1;l<=e1;l=l+1)
+  {
+     Ms = Ms + var(l)*matrix(ideal(kb1[l]),f0,f1);
+     Ls = Ls - var(l)*matrix(ideal(li1[l]),f1,f2);
+  }
+  return(Ms,Ls);
+}
+//////////////////////////////////////////////////////////////////////////////
+proc lift_rel_kb (module N, module M, list #)
+"USAGE:   lift_rel_kb(N,M[,kbaseM,p]);
+ASSUME:  [p a monomial ] or the product of all variables
+         N, M modules of same rank, M depending only on variables not in p
+         and vdim(M) is finite in this ring,
+         [ kbaseM the kbase of M in the subring given by variables not in p ] @*
+         warning: these assumptions are not checked by the procedure
+RETURN:  matrix A, whose j-th columns present the coeff's of N[j] in kbaseM,
+         i.e. kbaseM*A = reduce(N,std(M))
+EXAMPLE: example lift_rel_kb;  shows examples
+"
+{
+  poly p = product(maxideal(1));
+  if (!attrib(M,"isSB")) { M = std(M);}
+  if (size(#)>0) { p=#[2]; module kbaseM=#[1];}
+  else
+  { if (vdim(M)<=0) { "// vdim(M) not finite";return(A);}
+    module kbaseM = kbase(M);
+  }
+  N = reduce(N,M);
+  matrix A;
+  if (simplify(N,10)[1]==[0]) {return(A);}
+  A = coeffs(N,kbaseM,p);
+  return(A);
+}
+example
+{
+  "EXAMPLE:"; echo=2;
+  ring r=0,(A,B,x,y),dp;
+  module M      = [x2,xy],[xy,y3],[y2],[0,x];
+  module kbaseM = [1],[x],[xy],[y],[0,1],[0,y],[0,y2];
+  poly f=xy;
+  module N = [AB,BBy],[A3xy+x4,AB*(1+y2)];
+  matrix A = lift_rel_kb(N,M,kbaseM,f);
+  print(A);
+  "TEST:";
+  print(matrix(kbaseM)*A-matrix(reduce(N,std(M))));
+}
+///////////////////////////////////////////////////////////////////////////////
+proc lift_kbase (def N,def M)
+"USAGE:   lift_kbase(N,M); N,M=poly/ideal/vector/module
+RETURN:  matrix A, coefficient matrix expressing N as linear combination of
+         k-basis of M. Let the k-basis have k elements and size(N)=c columns.
+         Then A satisfies:
+             matrix(reduce(N,std(M)),k,c) = matrix(kbase(std(M)))*A
+ASSUME:  dim(M)=0 and the monomial ordering is a well ordering or the last
+         block of the ordering is c or C
+EXAMPLE: example lift_kbase; shows an example
+"
+{
+  return(lift_rel_kb(N,M));
+}
+example
+{"EXAMPLE:";     echo=2;
+  ring R=0,(x,y),ds;
+  module M=[x2,xy],[y2,xy],[0,xx],[0,yy];
+  module N=[x3+xy,x],[x,x+y2];
+  print(M);
+  module kb=kbase(std(M));
+  print(kb);
+  print(N);
+  matrix A=lift_kbase(N,M);
+  print(A);
+  matrix(reduce(N,std(M)),nrows(kb),ncols(A)) - matrix(kbase(std(M)))*A;
+}
+
+
+///////////////////////////////////////////////////////////////////////////////
+proc interact1 ()
+"
+Sub_procedure: asking for and reading your input-strings
+"
+{
+ string my = "@";
+ string str,out,my_ord,my_var;
+ my_ord = "ds";
+ my_var = "A";
+ "INPUT: name of output-file (ENTER = no output, do not use \"my\"!)";
+   str = read("");
+   if (size(str)>1)
+   { out = str[1..size(str)-1];}
+   else
+   { out = "no";}
+ "INPUT: prefix-string of ring-extension (ENTER = '@')";
+   str = read("");
+   if ( size(str) > 1 )
+   { my = str[1..size(str)-1]; }
+ "INPUT:parameter-string
+   (give a letter corresponding to first new variable followed by the next letters,
+   or 'T('       - a letter + '('  - getting a string of indexed variables)
+   (ENTER = A) :";
+   str = read("");
+   if (size(str)>1) { my_var=str[1..size(str)-1]; }
+ "INPUT:order-string (local or weighted!) (ENTER = ds) :";
+   str = read("");
+   if (size(str)>1) { my_ord=str[1..size(str)-1]; }
+   if( find(my_ord,"s")+find(my_ord,"w") == 0 )
+   { "// ordering must be an local! changed into 'ds'";
+     my_ord = "ds";
+   }
+   return(my,my_var,my_ord,out);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc interact2 (matrix A, intvec col_vec, list #)
+"
+Sub-procedure: asking for and reading your input
+"
+{
+  module B,C;
+  matrix D;
+  int flag;
+  if (size(#)>0) { D=#[1];flag=1;}
+  int t1 = ncols(A);
+  ">>Do you want all deformations? (ENTER=yes)";
+  string str = read("");
+  if ((size(str)>1) and (str<>"yes"))
+  { ">> Choose columns of the matrix";
+    ">> (Enter = all columns)";
+    "INPUT (number of columns to use as integer-list 'i_1,i_2,.. ,i_t' ):";
+    string columnes = read("");
+
+// improved: CL
+// ==========================================================
+// old:   if (size(columnes)<2) {columnes=string(col_vec);}
+//        t1 = size(columnes)/2;
+// new:
+    if (columnes=="")
+    {
+      intvec vvvv=1..ncols(A);
+    }
+    else
+    {
+      execute("intvec vvvv="+columnes);
+    }
+    t1=size(vvvv);
+// ==========================================================
+
+    int l,l1;
+    for (l=1;l<=t1;l=l+1)
+    {
+      l1=vvvv[l];
+      B[l] = A[l1];
+      if(flag) { C[l]=D[l1];}
+    }
+    A = matrix(B,nrows(A),ncols(B));
+    D = matrix(C,nrows(D),ncols(C));
+  }
+  return(A,D,t1);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc negative_part(intvec iv)
+"
+RETURNS intvec of indices of jv having negative entries (or iv, if non)
+"
+{
+   intvec jv;
+   int    l,k;
+   for (l=1;l<=size(iv);l=l+1)
+   { if (iv[l]<0)
+     {  k = k+1;
+        jv[k]=l;
+     }
+   }
+   if (jv==0) {jv=1; dbprint(printlevel-1,"// empty negative part, return all ");}
+   return(jv);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc find_ord(matrix A, intvec w_vec)
+"
+Sub-proc: return martix ord(a_ij) with respect to weight_vec, or
+          0 if A non-qh
+"
+{
+  int @r = nrows(A);
+  int @c = ncols(A);
+  int i,j;
+  def br = basering;
+  def nr=changeord(list(list("wp",w_vec)));
+  setring nr;
+  matrix A    = imap(br,A);
+  intmat degA[@r][@c];
+  if (homog(ideal(A)))
+  { for (i=1;i<=@r;i=i+1)
+    { for(j=1;j<=@c;j=j+1)
+      {  degA[i,j]=ord(A[i,j]); }
+    }
+  }
+  setring br;
+  if (defined(nr)) { kill nr; }
+  return(degA);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc homog_test(intvec w_vec, matrix Mo, matrix A)
+"
+Sub proc: return relative weight string of columns of A with respect
+          to the given w_vec and to Mo, or \"\" if not qh
+    NOTE: * means weight is not determined
+"
+{
+  int k,l;
+  intvec tv;
+  string @nv;
+  int @r = nrows(A);
+  int @c = ncols(A);
+  A = concat(matrix(ideal(Mo),@r,1),A);
+  intmat a = find_ord(A,w_vec);
+  intmat b[@r][@c];
+  for (l=1;l<=@c;l=l+1)
+  {
+    for (k=1;k<=@r;k=k+1)
+    {  if (A[k,l+1]!=0)
+       { b[k,l] = a[k,l+1]-a[k,1];}
+    }
+    tv = 0;
+    for (k=1;k<=@r;k=k+1)
+    {  if (A[k,l+1]*A[k,1]!=0)
+       {tv = tv,b[k,l];}
+    }
+    if (size(tv)>1)
+    { k = tv[2];
+      tv = tv[2..size(tv)];
+      tv = tv -k;
+      if (tv==0) { @nv = @nv+string(-k)+",";}
+      else {return("");}
+    }
+    else { @nv = @nv+"*,";}
+  }
+  @nv = @nv[1..size(@nv)-1];
+  return(@nv);
+}
+///////////////////////////////////////////////////////////////////////////////
+proc homog_t(intvec d_vec, matrix Fo, matrix A)
+"
+Sub-procedure: Computing relative (with respect to flatten(Fo)) weight_vec
+               of columns of A (return zero if Fo or A not qh)
+"
+{
+   Fo = matrix(Fo,nrows(A),1);
+   A  = concat(Fo,A);
+   A  = transpose(A);
+   def br = basering;
+   def nr=changeord(list(list("wp",d_vec)));
+   setring nr;
+   module A = fetch(br,A);
+   intvec dv;
+   int l = homog(A) ;
+   if (l==0)
+   {
+     setring br;
+     kill Top::nr;
+     if (defined(nr)) { kill nr; }
+     return(l);
+   }
+   dv = attrib(A,"isHomog");
+   l  = dv[1];
+   dv = dv[2..size(dv)];
+   dv = dv-l;
+ setring br;
+   kill Top::nr;
+   if (defined(nr)) { kill nr; }
+   return(dv);
+}
+///////////////////////////////////////////////////////////////////////////////