Changeset 82716e in git for Singular/LIB/deform.lib
- Timestamp:
- May 14, 1998, 8:45:19 PM (26 years ago)
- Branches:
- (u'spielwiese', 'fe61d9c35bf7c61f2b6cbf1b56e25e2f08d536cc')
- Children:
- 68e324ca946be87c2ab75edd4cc0fd161e1f6ead
- Parents:
- 30c91fe3835d6ff4504cc9ddeeb5866465754c2a
- File:
-
- 1 edited
-
Singular/LIB/deform.lib (modified) (63 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Singular/LIB/deform.lib
r30c91f r82716e 1 // $Id: deform.lib,v 1.1 0 1998-05-05 11:55:22 krueger Exp $1 // $Id: deform.lib,v 1.11 1998-05-14 18:44:57 Singular Exp $ 2 2 // author: Bernd Martin email: martin@math.tu-cottbus.de 3 //(bm, last modified 4/98) 4 /////////////////////////////////////////////////////////////////////////////// 5 version="$Id: deform.lib,v 1.1 0 1998-05-05 11:55:22 krueger Exp $";3 //(bm, last modified 4/98) 4 /////////////////////////////////////////////////////////////////////////////// 5 version="$Id: deform.lib,v 1.11 1998-05-14 18:44:57 Singular Exp $"; 6 6 info=" 7 7 LIBRARY: deform.lib PROCEDURES FOR COMPUTING MINIVERSAL DEFORMATION … … 10 10 versal(Fo[,d,any]) miniversal deformation of isolated singularity Fo 11 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 12 lift_kbase(N,M); lifting N into standard kbase of M 13 13 lift_rel_kb(N,M[,kbM,p]) relative lifting N into a kbase of M 14 14 kill_rings([\"prefix\"]) kills the exported rings from above 15 15 16 16 SUB-PROCEDURES used by main procedure: 17 17 get_rings,compute_ext,get_inf_def,interact1, … … 33 33 COMUPTE: miniversal deformation of Fo up to degree d (default d=100), 34 34 CREATE: Rings (exported): 35 'my'Px = extending the basering Po by new variables given by \"A,B,..\" 35 'my'Px = extending the basering Po by new variables given by \"A,B,..\" 36 36 (deformation parameters), returns as basering, 37 37 the new variables come before the old ones, … … 40 40 'my'So = being the embedding-ring of the versal base space, 41 41 'my'Ox = Px/Js extending So/Js. (default my=\"\") 42 Matrices (in Px, exported): 42 Matrices (in Px, exported): 43 43 Js = giving the versal base space (obstructions), 44 44 Fs = giving the versal family of Fo, … … 48 48 Otherwise 'any' gives predefined strings: \"my\",\"param\",\"order\",\"out\" 49 49 (\"my\" prefix-string, \"param\" is a letter (e.g. \"A\") for the name of 50 first parameter or (e.g. \"A(\") for index parameter variables, \"order\" 50 first parameter or (e.g. \"A(\") for index parameter variables, \"order\" 51 51 ordering string for ring extension), \"out\" name of output-file). 52 52 NOTE: printlevel < 0 no output at all, 53 printlevel >=0,1,2,.. informs you, what is going on; 53 printlevel >=0,1,2,.. informs you, what is going on; 54 54 this proc uses 'execute'. 55 55 EXAMPLE:example versal; shows an example … … 62 62 int time = timer; 63 63 intvec @iv,@jv,@is_qh,@degr; 64 d_max = 100; 64 d_max = 100; 65 65 @my = ""; @param="A"; @order="ds"; @out="no"; 66 66 @size = size(#); 67 67 if( @size>0 ) { d_max = #[1]; } 68 if( @size>1 ) 69 { if(typeof(#[2])!="string") 68 if( @size>1 ) 69 { if(typeof(#[2])!="string") 70 70 { string @active; 71 71 @my,@param,@order,@out = interact1(); … … 86 86 int @rowR= size(Fo); 87 87 def Po = basering; 88 setring Po; 88 setring Po; 89 89 poly X_s = product(maxideal(1)); 90 90 //------- reproduce T12 ------------------------------------------------------ … … 106 106 @t2 = Ls[4]; // vdim of T2 107 107 kill Ls; 108 t1' = @t1; 109 if( @t1==0) { dbprint(p,"// rigit!"); return();} 110 if( @t2==0) { @smooth=1; dbprint(p,"// smooth base space");} 108 t1' = @t1; 109 if( @t1==0) { dbprint(p,"// rigit!"); return();} 110 if( @t2==0) { @smooth=1; dbprint(p,"// smooth base space");} 111 111 dbprint(p,"// ready: T1 and T2"); 112 112 @colR = ncols(Ro); … … 114 114 @degrees = homog_test(@is_qh,matrix(Fo),InfD); 115 115 @jv = 1..@t1; 116 if (@degrees!="") 116 if (@degrees!="") 117 117 { dbprint(p-1,"// T1 is quasi-homogeneous represented with weight-vector", 118 118 @degrees); 119 119 } 120 120 if (defined(@active)) 121 { "// matrix of infinitesimal deformations:";print(InfD); 121 { "// matrix of infinitesimal deformations:";print(InfD); 122 122 "// weights of infinitesimal deformations ( emty ='not qhomog'):"; 123 123 @degrees; 124 124 matrix dummy; 125 125 InfD,dummy,t1' = interact2(InfD,@jv);kill dummy; 126 } 126 } 127 127 //---- create new rings and objects ------------------------------------------ 128 128 get_rings(Fo,t1',1,@my,@order,@param); 129 129 setring `myPx`; 130 @jv=0; @jv[t1']=0; @jv=@jv+1; @jv[nvars(basering)]=0; 130 @jv=0; @jv[t1']=0; @jv=@jv+1; @jv[nvars(basering)]=0; 131 131 //weight-vector for calculating 132 132 //rel-jet with resp to def-para 133 ideal Io = imap(Po,Fo); 133 ideal Io = imap(Po,Fo); 134 134 ideal J,m_J,tid; attrib(J,"isSB",1); 135 135 matrix Fo = matrix(Io); //initial equations … … 139 139 matrix homFR= concat(homR,homF); 140 140 module hom' = std(homFR); 141 matrix Js[1][@t2]; 142 matrix F_R,Fs,Rs,Fn,Rn; 143 export Js,Fs,Rs; 144 matrix Mon[t1'][1]=maxideal(1); 141 matrix Js[1][@t2]; 142 matrix F_R,Fs,Rs,Fn,Rn; 143 export Js,Fs,Rs; 144 matrix Mon[t1'][1]=maxideal(1); 145 145 Fn = transpose(imap(Po,InfD)*Mon); //infinitesimal deformations 146 Fs = Fo + Fn; 146 Fs = Fo + Fn; 147 147 dbprint(p-1,"// infinitesimal deformation: Fs: ",Fs); 148 148 Rn = (-1)*lift(Fo,Fs*Ro); //infinit. relations … … 151 151 tid = 0 + ideal(F_R); 152 152 if (tid[1]==0) {d_max=1;} //finished ? 153 setring `myOx`; 153 setring `myOx`; 154 154 matrix Fs,Rs,Cup,Cup',F_R,homFR,New,Rn,Fn; 155 155 module hom'; 156 ideal null,tid; attrib(null,"isSB",1); 157 setring `myQx`; 158 poly X_s = imap(Po,X_s); 159 matrix Cup,Cup',MASS; 156 ideal null,tid; attrib(null,"isSB",1); 157 setring `myQx`; 158 poly X_s = imap(Po,X_s); 159 matrix Cup,Cup',MASS; 160 160 ideal tid,null; attrib(null,"isSB",1); 161 ideal J,m_J; attrib(J,"isSB",1); 161 ideal J,m_J; attrib(J,"isSB",1); 162 162 attrib(m_J,"isSB",1); 163 matrix PreO = imap(Po,PreO); 163 matrix PreO = imap(Po,PreO); 164 164 module PreO'= imap(Po,PreO'); attrib(PreO',"isSB",1); 165 165 module PreT = imap(Po,PreT); attrib(PreT,"isSB",1); … … 172 172 { 173 173 if( @t1==0) {break}; 174 dbprint(p,"// start computation in degree "+string(@d)+"."); 174 dbprint(p,"// start computation in degree "+string(@d)+"."); 175 175 dbprint(p-3,">>> TIME = "+string(timer-time)); 176 176 dbprint(p-3,"==> memory = "+string(kmemory())+"k"); … … 178 178 if (@smooth) { @noObstr=1;} 179 179 else 180 { Cup = jet(F_R,@d,@jv); 181 Cup = matrix(reduce(ideal(Cup),m_J),@colR,1); 182 Cup = jet(Cup,@d,@jv); 183 } 180 { Cup = jet(F_R,@d,@jv); 181 Cup = matrix(reduce(ideal(Cup),m_J),@colR,1); 182 Cup = jet(Cup,@d,@jv); 183 } 184 184 //------- express obstructions in kbase of T2 -------------------------------- 185 185 if ( @noObstr==0 ) … … 191 191 } 192 192 Cup = lift(PreO,Cup); 193 MASS = lift_rel_kb(Cup,PreT,kbT2,X_s); 194 dbprint(p-3,"// next MASSEY-products:",MASS-jet(MASS,@d-1,@jv)); 193 MASS = lift_rel_kb(Cup,PreT,kbT2,X_s); 194 dbprint(p-3,"// next MASSEY-products:",MASS-jet(MASS,@d-1,@jv)); 195 195 if (MASS==transpose(Js)) 196 { @noObstr=1;dbprint(p-1,"// no obstruction"); } 196 { @noObstr=1;dbprint(p-1,"// no obstruction"); } 197 197 else { @noObstr=0; } 198 198 } … … 204 204 setring `myPx`; 205 205 Js = imap(`myQx`,Js); 206 degBound = @d+1; 206 degBound = @d+1; 207 207 J = std(ideal(Js)); 208 208 m_J = std(J*ideal(Mon)); … … 210 210 //--------------- obtain new base-ring ---------------------------------------- 211 211 kill `myOx`; 212 qring `myOx` = J; 212 qring `myOx` = J; 213 213 matrix Fs,Rs,F_R,Cup,Cup',homFR,New,Rn,Fn; 214 214 module hom'; … … 217 217 //---------------- lift equations F and relations R --------------------------- 218 218 setring `myOx`; 219 Fs = fetch(`myPx`,Fs); 220 Rs = fetch(`myPx`,Rs); 221 F_R = Fs*Rs; 222 F_R = matrix(reduce(ideal(F_R),null)); 219 Fs = fetch(`myPx`,Fs); 220 Rs = fetch(`myPx`,Rs); 221 F_R = Fs*Rs; 222 F_R = matrix(reduce(ideal(F_R),null)); 223 223 tid = 0 + ideal(F_R); 224 if (tid[1]==0) { dbprint(p-1,"// finished"); break;} 225 Cup = (-1)*transpose(jet(F_R,@d,@jv)); 226 homFR = fetch(`myPx`,homFR); 224 if (tid[1]==0) { dbprint(p-1,"// finished"); break;} 225 Cup = (-1)*transpose(jet(F_R,@d,@jv)); 226 homFR = fetch(`myPx`,homFR); 227 227 hom' = fetch(`myPx`,hom'); attrib(hom',"isSB",1); 228 228 Cup' = simplify(reduce(Cup,hom'),10); … … 238 238 Rs = Rs+Rn; 239 239 F_R = Fs*Rs; 240 tid = 0+reduce(ideal(F_R),null); 240 tid = 0+reduce(ideal(F_R),null); 241 241 //---------------- fetch results into other rings ----------------------------- 242 242 setring `myPx`; … … 248 248 m_J = fetch(`myPx`,m_J); attrib(m_J,"isSB",1); 249 249 J = fetch(`myPx`,J); attrib(J,"isSB",1); 250 Js = fetch(`myPx`,Js); 251 tid = fetch(`myOx`,tid); 252 if (tid[1]==0) { dbprint(p-1,"// finished");break;} 250 Js = fetch(`myPx`,Js); 251 tid = fetch(`myOx`,tid); 252 if (tid[1]==0) { dbprint(p-1,"// finished");break;} 253 253 } 254 254 //--------- end loop and final output ---------------------------------------- … … 256 256 if (@out!="no") 257 257 { string out = @out+"_"+string(@d); 258 "// writing file "+out+" with matrix Js, matrix Fs, matrix Rs ready 258 "// writing file "+out+" with matrix Js, matrix Fs, matrix Rs ready 259 259 for reading in rings "+myPx+" or "+myQx; 260 260 write(out,"matrix Js[1][",@t2,"]=",Js,";matrix Fs[1][",@rowR,"]=",Fs, 261 261 ";matrix Rs[",@rowR,"][",@colR,"]=",Rs,";"); 262 } 262 } 263 263 dbprint(p-3,">>> TIME = "+string(timer-time)); 264 264 if (@is_qh != 0) … … 266 266 @degr = @degr[1..t1']; 267 267 dbprint(p-1,"// quasi-homogeneous weights of miniversal base",@degr); 268 } 268 } 269 269 dbprint(p-1, 270 270 "// ___ Equations of miniversal base space ___",Js, … … 277 277 " setring "+myPx+"; show("+myPx+");"," listvar(matrix);", 278 278 "// NOTE: rings "+myQx+", "+myPx+", "+mySo+" are alive!", 279 "// (use 'kill_rings(\""+@my+"\");' to remove)"); 279 "// (use 'kill_rings(\""+@my+"\");' to remove)"); 280 280 return(); 281 281 } … … 286 286 ring r1 = 0,(x,y,z,u,v),ds; 287 287 matrix m[2][4] = x,y,z,u,y,z,u,v; 288 ideal Fo = minor(m,2); 288 ideal Fo = minor(m,2); 289 289 // cone over rational normal curve of degree 4 290 290 versal(Fo); … … 305 305 proc mod_versal(matrix Mo, ideal I, list #) 306 306 " 307 USAGE: mod_versal(Mo,I[,d,any]); I=ideal, M=module, d=int, any =list 307 USAGE: mod_versal(Mo,I[,d,any]); I=ideal, M=module, d=int, any =list 308 308 COMUPTE: miniversal deformation of coker(Mo) over Qo=Po/Io, Po=basering; 309 309 CREATE: Ringsr (exported): … … 314 314 'my'Qx = Px/Io extending Qo (returns as basering), 315 315 'my'Ox = Px/(Io+Js) ring of the versal deformation of coker(Ms), 316 'my'So = embedding-ring of the versal base space. (default 'my'=\"\") 316 'my'So = embedding-ring of the versal base space. (default 'my'=\"\") 317 317 Matrices (in Qx, exported): 318 318 Js = giving the versal base space (obstructions), 319 319 Ms = giving the versal family of Mo, 320 Ls = giving the lifting of syzygies Lo=syz(Mo), 320 Ls = giving the lifting of syzygies Lo=syz(Mo), 321 321 If d is defined (!=0), it computes up to degree d. 322 322 If 'any' is defined and any[1] is no string, interactive version. 323 323 Otherwise 'any' gives predefined strings:\"my\",\"param\",\"order\",\"out\" 324 324 (\"my\" prefix-string, \"param\" is a letter (e.g. \"A\") for the name of 325 first parameter or (e.g. \"A(\") for index parameter variables, \"ord\" 325 first parameter or (e.g. \"A(\") for index parameter variables, \"ord\" 326 326 ordering string for ringextension), \"out\" name of output-file). 327 327 NOTE: printlevel < 0 no output at all, 328 printlevel >=0,1,2,.. informs you, what is going on, 328 printlevel >=0,1,2,.. informs you, what is going on, 329 329 this proc uses 'execute'. 330 330 EXAMPLE:example mod_versal; shows an example … … 337 337 int time = timer; 338 338 intvec @iv,@jv,@is_qh,@degr; 339 d_max = 100; 339 d_max = 100; 340 340 @my = ""; @param="A"; @order="ds"; @out="no"; 341 341 @size = size(#); 342 342 if( @size>0 ) { d_max = #[1]; } 343 if( @size>1 ) 344 { if(typeof(#[2])!="string") 343 if( @size>1 ) 344 { if(typeof(#[2])!="string") 345 345 { string @active; 346 346 @my,@param,@order,@out = interact1(); … … 352 352 if (@size>4) {@out = #[5];} 353 353 } 354 } 354 } 355 355 string myPx = @my+"Px"; 356 356 string myQx = @my+"Qx"; … … 363 363 //-------- compute Ext's ------------------------------------------------------ 364 364 I = std(I); 365 qring Qo = I; 365 qring Qo = I; 366 366 matrix Mo = fetch(Po,Mo); 367 list Lo = compute_ext(Mo,p); 367 list Lo = compute_ext(Mo,p); 368 368 f0,f1,f2,e1,e2,ok_ann=Lo[1]; 369 369 matrix Ls,kb1,lift1 = Lo[2],Lo[3],Lo[4]; … … 373 373 dbprint(p,"// ready: Ext1 and Ext2"); 374 374 //----- test: quasi-homogeneous, choice of inf. def.-------------------------- 375 @degrees = homog_test(@is_qh,Mo,kb1); 375 @degrees = homog_test(@is_qh,Mo,kb1); 376 376 e1' = e1; @jv = 1..e1; 377 if (@degrees != "") 377 if (@degrees != "") 378 378 { dbprint(p-1,"// Ext1 is quasi-homogeneous represented: "+@degrees); 379 379 } 380 380 if (defined(@active)) 381 381 { "// kbase of Ext1:"; 382 print(kb1); 382 print(kb1); 383 383 "// weights of kbase of Ext1 ( empty = 'not qhomog')";@degrees; 384 384 kb1,lift1,e1' = interact2(kb1,@jv,lift1); 385 } 385 } 386 386 //-------- get new rings and objects ------------------------------------------ 387 387 setring Po; … … 392 392 ideal Io = I_J; 393 393 matrix Mon[e1'][1] = maxideal(1); 394 matrix Ms = imap(Qo,Mo); 395 matrix Ls = imap(Qo,Ls); 396 matrix Js[1][e2]; 394 matrix Ms = imap(Qo,Mo); 395 matrix Ls = imap(Qo,Ls); 396 matrix Js[1][e2]; 397 397 setring `myQx`; 398 398 ideal J,I_J,tet,null; attrib(null,"isSB",1); 399 399 ideal m_J = fetch(`myPx`,m_J); attrib(m_J,"isSB",1); 400 400 @jv=0; @jv[e1] = 0; @jv = @jv+1; @jv[nvars(`myPx`)] = 0; 401 matrix Ms = imap(Qo,Mo); export(Ms); 401 matrix Ms = imap(Qo,Mo); export(Ms); 402 402 matrix Ls = imap(Qo,Ls); export(Ls); 403 403 matrix Js[e2][1]; export(Js); 404 matrix MASS; 404 matrix MASS; 405 405 matrix Mon = fetch(`myPx`,Mon); 406 406 matrix Mn,Ln,ML,Cup,Cup',Lift; … … 410 410 matrix D' = imap(Qo,D'); 411 411 module Do = imap(Qo,Do); attrib(Do,"isSB",1); 412 matrix kb2 = imap(Qo,kb2); 412 matrix kb2 = imap(Qo,kb2); 413 413 matrix kb1 = imap(Qo,kb1); 414 414 matrix lift1= imap(Qo,lift1); 415 415 poly X_s = imap(Po,X_s); 416 intvec intv = e1',e1,f0,f1,f2; 417 Ms,Ls= get_inf_def(Ms,Ls,kb1,lift1,X_s); 416 intvec intv = e1',e1,f0,f1,f2; 417 Ms,Ls= get_inf_def(Ms,Ls,kb1,lift1,X_s); 418 418 kill kb1,lift1; 419 419 dbprint(p-1,"// infinitesimal extension",Ms); 420 420 //----------- start the loop -------------------------------------------------- 421 421 for (@d=2;@d<=d_max;@d=@d+1) 422 { 422 { 423 423 dbprint(p-3,">>> time = "+string(timer-time)); 424 424 dbprint(p-3,"==> memory = "+string(memory(0)/1000)+ 425 425 ", allocated = "+string(memory(1)/1000)); 426 dbprint(p,"// start deg = "+string(@d)); 426 dbprint(p,"// start deg = "+string(@d)); 427 427 //-------- get obstruction ---------------------------------------------------- 428 428 Cup = matrix(ideal(Ms*Ls),f0*f2,1); … … 433 433 Cup' = reduce(Cup,Do); 434 434 tet = simplify(ideal(Cup'),10); 435 if (tet[1]!=0) 435 if (tet[1]!=0) 436 436 { dbprint(p-4,"// *"); 437 437 Cup = Cup-Cup'; … … 441 441 { MASS = lift_rel_kb(Cup,ex2,kb2,X_s);} 442 442 else 443 { MASS = reduce(Cup,ex2);} 443 { MASS = reduce(Cup,ex2);} 444 444 dbprint(p-3,"// next MATRIC-MASSEY-products", 445 445 MASS-jet(MASS,@d-1,@jv)); 446 446 if ( MASS==transpose(Js)) 447 447 { @noObstr = 1;dbprint(p-1,"//no obstruction"); } 448 else { @noObstr = 0; } 448 else { @noObstr = 0; } 449 449 //-------- obtain equations of base space ------------------------------------- 450 450 if (@noObstr == 0) … … 458 458 degBound=0; 459 459 I_J = Io,J; attrib(I_J,"isSB",1); 460 //-------- obtain new base ring ----------------------------------------------- 460 //-------- obtain new base ring ----------------------------------------------- 461 461 kill `myOx`; 462 qring `myOx` = I_J; 462 qring `myOx` = I_J; 463 463 ideal null,tet; attrib(null,"isSB",1); 464 464 matrix Ms = imap(`myQx`,Ms); 465 465 matrix Ls = imap(`myQx`,Ls); 466 466 matrix Mn,Ln,ML,Cup,Cup',Lift; 467 matrix C' = imap(Qo,C'); 467 matrix C' = imap(Qo,C'); 468 468 module Co = imap(Qo,Co); attrib(Co,"isSB",1); 469 469 module ex2 = imap(Qo,ex2); attrib(ex2,"isSB",1); 470 470 matrix kb2 = imap(Qo,kb2); 471 471 poly X_s = imap(Po,X_s); 472 } 472 } 473 473 //-------- get lifts ---------------------------------------------------------- 474 474 setring `myOx`; … … 477 477 Cup = jet(Cup,@d,@jv); 478 478 Cup'= reduce(Cup,Co); 479 tet = simplify(ideal(Cup'),10); 480 if (tet[1]!=0) 479 tet = simplify(ideal(Cup'),10); 480 if (tet[1]!=0) 481 481 { dbprint(p-4,"// #"); 482 482 Cup = Cup-Cup'; 483 483 } 484 Lift = lift(C',Cup); 484 Lift = lift(C',Cup); 485 485 Mn = matrix(ideal(Lift),f0,f1); 486 486 Ln = matrix(ideal(Lift[f0*f1+1..nrows(Lift),1]),f1,f2); … … 490 490 dbprint(p-3,"// next extension of syz(Mo)",Ln); 491 491 ML = reduce(ideal(Ms*Ls),null); 492 //--------- test: finished ---------------------------------------------------- 492 //--------- test: finished ---------------------------------------------------- 493 493 tet = simplify(ideal(ML),10); 494 494 if (tet[1]==0) { dbprint(p-1,"// finished in degree ",@d);} … … 496 496 setring `myPx`; 497 497 Ms = fetch(`myOx`,Ms); 498 Ls = fetch(`myOx`,Ls); 498 Ls = fetch(`myOx`,Ls); 499 499 setring `myQx`; 500 500 Ms = fetch(`myOx`,Ms); 501 Ls = fetch(`myOx`,Ls); 501 Ls = fetch(`myOx`,Ls); 502 502 ML = Ms*Ls; 503 ML = matrix(reduce(ideal(ML),null),f0,f2); 503 ML = matrix(reduce(ideal(ML),null),f0,f2); 504 504 tet = imap(`myOx`,tet); 505 505 if (tet[1]==0) { break;} 506 } 507 //------- end of loop, final output ------------------------------------------- 506 } 507 //------- end of loop, final output ------------------------------------------- 508 508 if (@out != "no") 509 509 { string out = @out+"_"+string(@d); 510 "// writing file '"+out+"' with matrix Js, matrix Ms, matrix Ls 510 "// writing file '"+out+"' with matrix Js, matrix Ms, matrix Ls 511 511 ready for reading in rings "+myPx+" or "+myQx; 512 512 write(out,"matrix Js[1][",e2,"]=",Js,";matrix Ms[",f0,"][",f1,"]=",Ms, … … 518 518 @degr = @degr[1..e1']; 519 519 dbprint(p-1,"// quasi-homogeneous weights of miniversal base",@degr); 520 } 520 } 521 521 dbprint(p-1,"// Result belongs to qring "+myQx, 522 522 "// Equations of total space of miniversal deformation are in Js", … … 540 540 mod_versal(Mo,Io); 541 541 printlevel = p; 542 kill Px,Qx,So; 543 } 544 //============================================================================= 542 kill Px,Qx,So; 543 } 544 //============================================================================= 545 545 /////////////////////////////////////////////////////////////////////////////// 546 546 proc kill_rings(list #) 547 547 "USAGE: kill_rings([string]); 548 Sub-procedure: kills exported rings of 'versal' and 548 Sub-procedure: kills exported rings of 'versal' and 549 549 'mod_versal' with prefix 'string' 550 550 " … … 574 574 Sub-procedure: obtain Ext1 and Ext2 and other objects used by mod_versal 575 575 " 576 { 576 { 577 577 int l,f0,f1,f2,f3,e1,e2,ok_ann; 578 578 module Co,Do,ima,ex1,ex2; 579 matrix M0,M1,M2,ker,kb1,lift1,kb2,A,B,C,D; 579 matrix M0,M1,M2,ker,kb1,lift1,kb2,A,B,C,D; 580 580 //------- resM --------------------------------------------------------------- 581 list resM = res(Mo,3); 581 list resM = res(Mo,3); 582 582 M0 = resM[1]; 583 583 M1 = resM[2]; … … 588 588 f3 = ncols(M2); 589 589 //------ compute Ext^2 ------------------------------------------------------ 590 B = kohom(M0,f3); 590 B = kohom(M0,f3); 591 591 A = kontrahom(M2,f0); 592 D = modulo(A,B); 593 Do = std(D); 592 D = modulo(A,B); 593 Do = std(D); 594 594 ima = kohom(M0,f2),kontrahom(M1,f0); 595 595 ex2 = modulo(D,ima); … … 603 603 } 604 604 if (ok_ann==0) 605 { e2 =nrows(ex2); 605 { e2 =nrows(ex2); 606 606 dbprint(p,"// Ann(Ext2) is maximal"); 607 607 } 608 608 //------ compute Ext^1 ------------------------------------------------------- 609 B = kohom(M0,f2); 609 B = kohom(M0,f2); 610 610 A = kontrahom(M1,f0); 611 611 ker = modulo(A,B); 612 ima = kohom(M0,f1),kontrahom(M0,f0); 612 ima = kohom(M0,f1),kontrahom(M0,f0); 613 613 ex1 = modulo(ker,ima); 614 614 ex1 = std(ex1); … … 621 621 //------ compute the liftings of Ext^1 --------------------------------------- 622 622 lift1 = A*kb1; 623 lift1 = lift(B,lift1); 623 lift1 = lift(B,lift1); 624 624 intvec iv = f0,f1,f2,e1,e2,ok_ann; 625 625 list L' = ex2,kb2,C,Co,D,Do; … … 629 629 proc get_rings(ideal Io,int e1,int switch, list #) 630 630 " 631 Sub-procedure: creating ring-extensions 632 " 633 { 634 def Po = basering; 631 Sub-procedure: creating ring-extensions 632 " 633 { 634 def Po = basering; 635 635 string my; 636 636 string my_ord = "ds"; 637 string my_var = "A"; 637 string my_var = "A"; 638 638 if (size(#)>2) 639 639 { … … 642 642 my_var = #[3]; 643 643 } 644 string my_Px = my+"Px"; 645 string my_Qx = my+"Qx"; 646 string my_Ox = my+"Ox"; 647 string my_So = my+"So"; 644 string my_Px = my+"Px"; 645 string my_Qx = my+"Qx"; 646 string my_Ox = my+"Ox"; 647 string my_So = my+"So"; 648 648 extendring(my_Px,e1,my_var,my_ord); 649 649 ideal Io = imap(Po,Io); attrib(Io,"isSB",1); … … 666 666 proc get_inf_def(list #) 667 667 " 668 Sub-procedure: compute infinitesimal family of a module and its syzygies 668 Sub-procedure: compute infinitesimal family of a module and its syzygies 669 669 from a kbase of Ext1 and its lifts 670 670 " … … 687 687 } 688 688 return(Ms,Ls); 689 } 689 } 690 690 ////////////////////////////////////////////////////////////////////////////// 691 691 proc lift_rel_kb (module N, module M, list #) … … 695 695 N, M modules of same rank, 696 696 M depending only on variables not in p and vdim(M) finite in this ring, 697 [ kbaseM the kbase of M in the subring given by variables not in p ] 697 [ kbaseM the kbase of M in the subring given by variables not in p ] 698 698 warning: check that these assumtions are fulfilled! 699 699 RETURN matrix A, whose j-th columnes present the coeff's of N[j] in kbaseM, … … 704 704 poly p = product(maxideal(1)); 705 705 M = std(M); 706 matrix A; 706 matrix A; 707 707 if (size(#)>0) { p=#[2]; module kbaseM=#[1];} 708 else 708 else 709 709 { if (vdim(M)<=0) { "// vdim(M) not finite";return(A);} 710 710 module kbaseM = kbase(M); … … 714 714 A = coeffs(N,kbaseM,p); 715 715 return(A); 716 } 716 } 717 717 example 718 718 { … … 736 736 print(kbase(std(M))*A); 737 737 print(reduce(N,std(M))); 738 } 738 } 739 739 /////////////////////////////////////////////////////////////////////////////// 740 740 proc lift_kbase (N, M) … … 769 769 proc interact1 () 770 770 " 771 Sub_procedure: asking for and reading your input-strings 771 Sub_procedure: asking for and reading your input-strings 772 772 " 773 773 { … … 775 775 string str,out,my_ord,my_var; 776 776 my_ord = "ds"; 777 my_var = "A"; 777 my_var = "A"; 778 778 "INPUT: name of output-file (ENTER = no output, do not use \"my\"!)"; 779 str = read(""); 780 if (size(str)>1) 779 str = read(""); 780 if (size(str)>1) 781 781 { out = str[1..size(str)-1];} 782 782 else 783 783 { out = "no";} 784 784 "INPUT: prefix-string of ring-extension (ENTER = '@')"; 785 str = read(""); 786 if ( size(str) > 1 ) 787 { my = str[1..size(str)-1]; } 788 "INPUT:parameter-string 785 str = read(""); 786 if ( size(str) > 1 ) 787 { my = str[1..size(str)-1]; } 788 "INPUT:parameter-string 789 789 (give a letter corresponding to first new variable followed by the next letters, 790 790 or 'T(' - a letter + '(' - getting a string of indexed variables) 791 791 (ENTER = A) :"; 792 str = read(""); 792 str = read(""); 793 793 if (size(str)>1) { my_var=str[1..size(str)-1]; } 794 794 "INPUT:order-string (local or weighted!) (ENTER = ds) :"; 795 str = read(""); 796 if (size(str)>1) { my_ord=str[1..size(str)-1]; } 795 str = read(""); 796 if (size(str)>1) { my_ord=str[1..size(str)-1]; } 797 797 if( find(my_ord,"s")+find(my_ord,"w") == 0 ) 798 798 { "// ordering must be an local! changed into 'ds'"; … … 816 816 if (size(str)>1) 817 817 { ">> Choose columnes of the matrix"; 818 ">> (Enter = all columnes)"; 818 ">> (Enter = all columnes)"; 819 819 "INPUT (number of columnes to use as integer-list 'i_1,i_2,.. ,i_t' ):"; 820 820 string columnes = read(""); … … 826 826 execute("l1= "+columnes[2*l-1]+";"); 827 827 B[l] = A[l1]; 828 if(flag) { C[l]=D[l1];} 828 if(flag) { C[l]=D[l1];} 829 829 } 830 830 A = matrix(B,nrows(A),size(B)); … … 836 836 proc negative_part(intvec iv) 837 837 " 838 RETURNS intvec of indices of jv having negative entries (or iv, if non) 838 RETURNS intvec of indices of jv having negative entries (or iv, if non) 839 839 " 840 840 { … … 842 842 int l,k; 843 843 for (l=1;l<=size(iv);l=l+1) 844 { if (iv[l]<0) 844 { if (iv[l]<0) 845 845 { k = k+1; 846 846 jv[k]=l; … … 865 865 matrix A = imap(br,A); 866 866 intmat degA[@r][@c]; 867 if (homog(ideal(A))) 867 if (homog(ideal(A))) 868 868 { for (i=1;i<=@r;i=i+1) 869 869 { for(j=1;j<=@c;j=j+1) … … 872 872 } 873 873 setring br; 874 kill nr; 874 kill nr; 875 875 return(degA); 876 876 } … … 878 878 proc homog_test(intvec w_vec, matrix Mo, matrix A) 879 879 " 880 Sub proc: return relative weight string of columnes of A with respect 881 to the given w_vec and to Mo, or \"\" if not qh 880 Sub proc: return relative weight string of columnes of A with respect 881 to the given w_vec and to Mo, or \"\" if not qh 882 882 NOTE: * means weight is not determined 883 883 " … … 888 888 int @r = nrows(A); 889 889 int @c = ncols(A); 890 A = concat(matrix(ideal(Mo),@r,1),A); 891 intmat a = find_ord(A,w_vec); 890 A = concat(matrix(ideal(Mo),@r,1),A); 891 intmat a = find_ord(A,w_vec); 892 892 intmat b[@r][@c]; 893 893 for (l=1;l<=@c;l=l+1) 894 { 894 { 895 895 for (k=1;k<=@r;k=k+1) 896 { if (A[k,l+1]!=0) 896 { if (A[k,l+1]!=0) 897 897 { b[k,l] = a[k,l+1]-a[k,1];} 898 898 } 899 899 tv = 0; 900 900 for (k=1;k<=@r;k=k+1) 901 { if (A[k,l+1]*A[k,1]!=0) 901 { if (A[k,l+1]*A[k,1]!=0) 902 902 {tv = tv,b[k,l];} 903 903 } 904 904 if (size(tv)>1) 905 { k = tv[2]; 905 { k = tv[2]; 906 906 tv = tv[2..size(tv)]; tv = tv -k; 907 if (tv==0) { @nv = @nv+string(-k)+",";} 907 if (tv==0) { @nv = @nv+string(-k)+",";} 908 908 else {return("");} 909 909 } … … 916 916 proc homog_t(intvec d_vec, matrix Fo, matrix A) 917 917 " 918 Sub-procedure: Computing relative (with respect to flatten(Fo)) weight_vec 918 Sub-procedure: Computing relative (with respect to flatten(Fo)) weight_vec 919 919 of columnes of A (return zero if Fo or A not qh) 920 920 " … … 934 934 dv = dv[2..size(dv)]; 935 935 dv = dv-l; 936 setring br; 936 setring br; 937 937 kill nr; 938 938 return(dv);
Note: See TracChangeset
for help on using the changeset viewer.
