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