| 1 | // $Id: deform.lib,v 1.1.1.1 1997-04-25 15:13:25 obachman Exp $ |
|---|
| 2 | //(BM+GMG) |
|---|
| 3 | /////////////////////////////////////////////////////////////////////////////// |
|---|
| 4 | LIBRARY: deform.lib PROCEDURES FOR COMPUTING MINIVERSAL DEFORMATION |
|---|
| 5 | |
|---|
| 6 | miniversal(id[,deg]); miniversal deformation of an isolated singularity id |
|---|
| 7 | |
|---|
| 8 | SUB-PROCEDURES used by main procedure: |
|---|
| 9 | apply_col(A,B); put A into col-nf and apply same col-operations to B |
|---|
| 10 | defining_system(A,B); defining system for next degree of massey products |
|---|
| 11 | reduce_s(i,j,n); add var(1)^(n+ord) to all polys of i and reduce mod j |
|---|
| 12 | lift_kbase(N,M); coef-matrix expressing N as lin. comb. of k-basis of M |
|---|
| 13 | coef_ideal(M,s); coef_matrices with respect to first s variables |
|---|
| 14 | |
|---|
| 15 | LIB "inout.lib"; |
|---|
| 16 | LIB "general.lib"; |
|---|
| 17 | LIB "sing.lib"; |
|---|
| 18 | LIB "matrix.lib"; |
|---|
| 19 | /////////////////////////////////////////////////////////////////////////////// |
|---|
| 20 | |
|---|
| 21 | proc miniversal (ideal id,list #) |
|---|
| 22 | USAGE: miniversal(id[,d,na,va,o,iv]); id=ideal, d=integer, |
|---|
| 23 | na,va,o=strings, iv=intvec of positive integers |
|---|
| 24 | COMUPTE: miniversal deformation of id up to degree d (default d=100) |
|---|
| 25 | CREATE: A ring with name `na` (e.g. R if na="R", default na="Ont") extending |
|---|
| 26 | the basering by new variables given by va (deformation parameters). |
|---|
| 27 | -- The new vars come before the old vars |
|---|
| 28 | -- The characteristic of `na`is the characteristic of the basering. |
|---|
| 29 | -- The new vars are derived from va. If va is a single letter, say |
|---|
| 30 | va="T", and if n<=26 then T and the following n-1 letters from |
|---|
| 31 | T..Z..T (resp. T(1..n) if n>26) are taken as additional variables. |
|---|
| 32 | If va is a single letter followed by (, say va="x(", the new |
|---|
| 33 | variables are x(1),...,x(n) (default va="A"). |
|---|
| 34 | -- The ordering is the product ordering between the ordering of r and |
|---|
| 35 | an ordering derived from `o`, which has to be local!! (default: |
|---|
| 36 | o="ds") [and iv (a weight vector)]. |
|---|
| 37 | Type 'help extendring' for a more detailed explanation of the |
|---|
| 38 | ordering |
|---|
| 39 | -- Even if na,va,o are given, d and/or iv may be ommited. Then the |
|---|
| 40 | default values d=100, iv=0 (i.e. all weights = 1) are used. |
|---|
| 41 | The procedure creates also two ideals: |
|---|
| 42 | ideal jetJ - defining the miniversal base space (in `na`) |
|---|
| 43 | ideal jetF - defining miniversal total space (in `na`) |
|---|
| 44 | NOTE: int printlevel=2; shows what is going on |
|---|
| 45 | int printlevel=3; shows also memory usage |
|---|
| 46 | This proc uses 'execute' or calls a procedure using 'execute'. |
|---|
| 47 | If you use it in your own proc, let the local names of your proc |
|---|
| 48 | start with @ (see the file HelpForProc) |
|---|
| 49 | EXAMPLE: example miniversal; shows an example |
|---|
| 50 | { |
|---|
| 51 | //------- initialisation ------------------------------------------------------ |
|---|
| 52 | int @d,@deg,@t1,@t2,@colR,@noObstr; |
|---|
| 53 | intvec @iv,@jv; |
|---|
| 54 | string @na,@va,@o; |
|---|
| 55 | if( size(#)==0 ) { @deg=100; @na="Ont"; @va="A"; @o="ds"; } |
|---|
| 56 | if( size(#)>=1 ) { if( typeof(#[1])!="int" ) { # = 100,#[1..size(#)]; }} |
|---|
| 57 | if( size(#)==1 ) { @deg=#[1]; @na="Ont"; @va="A"; @o="ds"; } |
|---|
| 58 | if( size(#)==2 ) { @deg=#[1]; @na=#[2]; @va="A"; @o="ds"; } |
|---|
| 59 | if( size(#)==3 ) { @deg=#[1]; @na=#[2]; @va=#[3]; @o="ds";} |
|---|
| 60 | if( size(#)==4 ) { @deg=#[1]; @na=#[2]; @va=#[3]; @o=#[4];} |
|---|
| 61 | if( size(#)==5 ) { @deg=#[1]; @na=#[2]; @va=#[3]; @o=#[4]; @iv=#[5]; } |
|---|
| 62 | if( find(@o,"s")==0 ) |
|---|
| 63 | { "// ordering must be an s-ordering, please change!"; return();} |
|---|
| 64 | |
|---|
| 65 | def @Pn = basering; |
|---|
| 66 | string @ords = ordstr(@Pn); |
|---|
| 67 | id = simplify(id,10); |
|---|
| 68 | int @rowR = size(id); |
|---|
| 69 | if( @rowR<=1 ) |
|---|
| 70 | { |
|---|
| 71 | "// hypersurface, use proc deform from sing.lib"; |
|---|
| 72 | return(); |
|---|
| 73 | } |
|---|
| 74 | //------- change ordering if not correct -------------------------------------- |
|---|
| 75 | @t1=1; |
|---|
| 76 | for( @d=1;@d<=nvars(@Pn);@d++ ) { @t1=@t1*(lead(1+var(@d))==var(@d)); } |
|---|
| 77 | if( @t1==0 ) |
|---|
| 78 | { |
|---|
| 79 | if( @ords[size(@ords)]!="c" and @ords[size(@ords)]!="C" ) |
|---|
| 80 | { |
|---|
| 81 | if( @ords[1]=="c" ) { @ords=@ords[3,size(@ords)-2]+",c"; @t1=1;} |
|---|
| 82 | if( @ords[1]=="C" ) { @ords=@ords[3,size(@ords)-2]+",C"; @t1=1;} |
|---|
| 83 | } |
|---|
| 84 | if( @t1==1 ) |
|---|
| 85 | { |
|---|
| 86 | changeord("@On",@ords,@Pn); |
|---|
| 87 | ideal id = imap(@Pn,id); |
|---|
| 88 | } |
|---|
| 89 | } |
|---|
| 90 | if( defined(@On)==0 ) { def @On=@Pn; setring @On; } |
|---|
| 91 | //------- reproduce T12 ------------------------------------------------------- |
|---|
| 92 | list Ls = T12(id,1); |
|---|
| 93 | matrix Ro = Ls[4]; //syz(i) |
|---|
| 94 | matrix InfD = Ls[3]; //matrix of inf. deformations |
|---|
| 95 | matrix PreO = Ls[5]; //present. mat of Syz/Kos^* |
|---|
| 96 | module PreT = Ls[2]; //present. module of modT2 |
|---|
| 97 | @t1 = Ls[8]; //vdim of T1 |
|---|
| 98 | @t2 = Ls[9]; //vdim of T2 |
|---|
| 99 | kill Ls; |
|---|
| 100 | dbpri(2,"","// ___ matrix of infinitesimal deformations:",InfD); |
|---|
| 101 | @colR = ncols(Ro); |
|---|
| 102 | ideal i0 = std(id); |
|---|
| 103 | qring @Ox = i0; //ring of singularity to deform |
|---|
| 104 | matrix Cup,lCup; module PreT; |
|---|
| 105 | ideal testid; |
|---|
| 106 | matrix Ro = fetch(@On,Ro); |
|---|
| 107 | matrix PreO = fetch(@On,PreO); |
|---|
| 108 | //---- create new ring with @t1=dim T1 additional variables and initialize ---- |
|---|
| 109 | |
|---|
| 110 | extendring(@na,@t1,@va,@o,@iv,0,@On); //ring containing miniversal |
|---|
| 111 | //deformation |
|---|
| 112 | @jv[@t1]=0; @jv=@jv+1; @jv[nvars(basering)]=0; //@jv= |
|---|
| 113 | //weight-vector for calculating |
|---|
| 114 | //rel-jet with resp to def-para |
|---|
| 115 | ideal jetF = imap(@On,id); //(jet)ideal of minversal defor |
|---|
| 116 | export jetF; |
|---|
| 117 | matrix Fo = matrix(jetF); //initial equations |
|---|
| 118 | matrix Rs = imap(@On,Ro); //deformed syzygies |
|---|
| 119 | ideal jetJ; //(jet)ideal of minversal defor |
|---|
| 120 | export jetJ; |
|---|
| 121 | ideal testid,Jo; |
|---|
| 122 | Jo = std(Jo); |
|---|
| 123 | matrix Fs[1][@rowR]; //deformed equations |
|---|
| 124 | matrix F_R[1][@colR]; //product Fs*Rs |
|---|
| 125 | matrix F_r[1][@colR]; //reduced product mod jetJ |
|---|
| 126 | matrix Fn[1][@rowR]; //last homog part of Fs |
|---|
| 127 | matrix Rn[@rowR][@colR]; //last homog part of Rs |
|---|
| 128 | matrix Cup,lCup,Test; //presenting obstructions |
|---|
| 129 | matrix Mon[@t1][1]=maxideal(1); //occuring monomials in deg d |
|---|
| 130 | Fn = transpose(imap(@On,InfD)*Mon); //infinitesimal deformations |
|---|
| 131 | Fs = Fo + Fn; |
|---|
| 132 | jetF= Fs; |
|---|
| 133 | F_R = Fs*Rs; |
|---|
| 134 | if (@t2<=0) { @d=0; } //finished, if "T2=0" |
|---|
| 135 | //------- start the loop ------------------------------------------------------ |
|---|
| 136 | for (@d=1;@d<=@deg;@d++) |
|---|
| 137 | { |
|---|
| 138 | dbpri(2,"","// ___ start computation in degree "+string(@d)+":"); |
|---|
| 139 | dbpri(3,"memory="+string(kmemory())+"k"); |
|---|
| 140 | //------- lift relation to next degree ---------------------------------------- |
|---|
| 141 | F_r = reduce_s(F_R,Jo,@d+1); |
|---|
| 142 | Cup = matrix(jet(F_r,@d,@jv),1,@colR); |
|---|
| 143 | Rn = (-1)*lift(Fo,Cup); |
|---|
| 144 | Rs = Rs + Rn; |
|---|
| 145 | F_R = F_R + Fs*Rn; |
|---|
| 146 | //------- test: already finished? --------------------------------------------- |
|---|
| 147 | testid = simplify(reduce(ideal(F_R),Jo),10); |
|---|
| 148 | if (testid[1]==0) |
|---|
| 149 | { |
|---|
| 150 | "// computation finished in degree "+string(@d); |
|---|
| 151 | if( @d==@deg ) |
|---|
| 152 | {"// degree bound reached, result may not yet be complete!";} |
|---|
| 153 | break; |
|---|
| 154 | } |
|---|
| 155 | //------- compute obstruction-matrix ----------------------------------------- |
|---|
| 156 | F_r = reduce_s(F_R,Jo,@d+1); |
|---|
| 157 | Cup = matrix(jet(F_r,@d+1,@jv),1,@colR); |
|---|
| 158 | Test= Cup; |
|---|
| 159 | dbpri(2,"","// ___ obstruction vector:",ideal(Cup)); |
|---|
| 160 | Cup,Mon = coef_ideal(Cup,@t1); |
|---|
| 161 | //------- express obstructions in kbase of T2 -------------------------------- |
|---|
| 162 | setring @Ox; |
|---|
| 163 | Cup = imap(`@na`,Cup); |
|---|
| 164 | lCup = lift(PreO,Cup); |
|---|
| 165 | PreT = fetch(@On,PreT); |
|---|
| 166 | lCup = lift_kbase(lCup,PreT); |
|---|
| 167 | @t2 = nrows(lCup); |
|---|
| 168 | dbpri(2,"","// ___ obstructions in kbase of T2:",lCup); |
|---|
| 169 | testid = simplify(ideal(lCup),10); // test no obstructions |
|---|
| 170 | if (testid[1]==0) |
|---|
| 171 | { @noObstr=1; } else { @noObstr=0; } |
|---|
| 172 | //------- compute ideal of minversal(its k-jet) ------------------------------- |
|---|
| 173 | setring `@na`; |
|---|
| 174 | if (@noObstr==0) //case of non-zero obstr. |
|---|
| 175 | { |
|---|
| 176 | lCup = imap(@Ox,lCup); |
|---|
| 177 | Jo = lCup*transpose(Mon); |
|---|
| 178 | jetJ = matrix(jetJ,1,@t2)+matrix(Jo,1,@t2); |
|---|
| 179 | dbpri(2,"","// ___ degree-"+string(@d+1)+"-part of ideal of miniversal base"+":",Jo); |
|---|
| 180 | Jo = std(jetJ); |
|---|
| 181 | //------- choose a defining system -------------------------------------------- |
|---|
| 182 | @iv,Cup = defining_system(lCup,Cup); |
|---|
| 183 | dbpri(2,"","// ___ number of cols of defining system:",@iv); |
|---|
| 184 | //------- lift the equations -------------------------------------------------- |
|---|
| 185 | if (sum(@iv)==0) |
|---|
| 186 | { |
|---|
| 187 | "// nothing to lift!"; |
|---|
| 188 | "// miniversal base, defined by jetJ, is a fat point!";break; |
|---|
| 189 | } |
|---|
| 190 | setring @Ox; |
|---|
| 191 | Cup = imap(`@na`,Cup); |
|---|
| 192 | Cup = submat(Cup,1..nrows(Cup),@iv); |
|---|
| 193 | dbpri(2,"","// ___ matrix of defining system:",Cup); |
|---|
| 194 | } |
|---|
| 195 | else // case of zero obstructions |
|---|
| 196 | { |
|---|
| 197 | setring @Ox; |
|---|
| 198 | Cup = imap(`@na`,Cup); |
|---|
| 199 | } |
|---|
| 200 | Cup = lift(transpose(Ro),module(Cup)); |
|---|
| 201 | setring `@na`; |
|---|
| 202 | Cup = imap(@Ox,Cup); |
|---|
| 203 | if (@noObstr==0) |
|---|
| 204 | { Mon = submat(Mon,1..nrows(Mon),@iv); } |
|---|
| 205 | Fn = (-1)*transpose(Cup*transpose(Mon)); |
|---|
| 206 | Fs = Fs+Fn; |
|---|
| 207 | F_R = F_R+Fn*Rs; |
|---|
| 208 | jetF = matrix(Fs); |
|---|
| 209 | dbpri(2,"","// ___ degree-"+string(@d+1)+"-part of deformed equations:",Fn); |
|---|
| 210 | } |
|---|
| 211 | //--------- end loop and final output --------------------------------------- |
|---|
| 212 | ""; |
|---|
| 213 | "// ___ Equations of miniversal base space ___";jetJ; ""; |
|---|
| 214 | "// ___ Equations of miniversal total space ___";jetF; ""; |
|---|
| 215 | "// Result belongs to ring",@na,"(total space of miniversal deformation)."; |
|---|
| 216 | "// Make",@na,"the basering and list objects defined in",@na,"by typing:"; |
|---|
| 217 | " setring",@na,"; show("+@na+");"; |
|---|
| 218 | " listvar(ideal);"; |
|---|
| 219 | kill @On; |
|---|
| 220 | return(); |
|---|
| 221 | } |
|---|
| 222 | example |
|---|
| 223 | { "EXAMPLE:"; echo = 2; |
|---|
| 224 | ring r1=0,(x,y,z,u,v),ds; |
|---|
| 225 | matrix m[2][4]=x,y,z,u,y,z,u,v; |
|---|
| 226 | ideal i=minor(m,2); //cone over rational normal curve of degree 4 |
|---|
| 227 | miniversal(i,"R","T("); |
|---|
| 228 | // hit return-key to continue; |
|---|
| 229 | // pause; |
|---|
| 230 | ring r = 0,(x,y,z),ds; |
|---|
| 231 | ideal i = x2,xy,yz,zx; |
|---|
| 232 | printlevel = 2; |
|---|
| 233 | miniversal(i);""; |
|---|
| 234 | kill printlevel; |
|---|
| 235 | // NOTE: rings R and Ont are still alive! |
|---|
| 236 | } |
|---|
| 237 | /////////////////////////////////////////////////////////////////////////////// |
|---|
| 238 | |
|---|
| 239 | proc apply_col (matrix A, matrix B) |
|---|
| 240 | USAGE: apply_col(A,B); A,B=matrices |
|---|
| 241 | ASSUME: A = constant matrix in row-reduced (upper triangular) normal form, |
|---|
| 242 | B = matrix of same size |
|---|
| 243 | COMUPTE: apply to B those col-operations which reduce A into col-reduced nf |
|---|
| 244 | RETURN: two transformed matrices: col-reduced A, transformed B |
|---|
| 245 | EXAMPLE: example apply_col; shows an example |
|---|
| 246 | { |
|---|
| 247 | int i,j,k; |
|---|
| 248 | poly m; |
|---|
| 249 | int r=nrows(A); |
|---|
| 250 | int c=ncols(A); |
|---|
| 251 | matrix C = concat(transpose(A),transpose(B)); |
|---|
| 252 | module mC = transpose(C); |
|---|
| 253 | for( k=1;k<=r;k++ ) |
|---|
| 254 | { |
|---|
| 255 | j=1; |
|---|
| 256 | while( C[j,k]==0 && j<c ) { j++; } |
|---|
| 257 | for( i=j+1;i<=c;i++ ) |
|---|
| 258 | { |
|---|
| 259 | m = C[i,k]; |
|---|
| 260 | mC[i] = mC[i]-m*mC[j]; |
|---|
| 261 | } |
|---|
| 262 | } |
|---|
| 263 | C = transpose(matrix(mC)); |
|---|
| 264 | matrix a[c][r] = C[1..c,1..r]; |
|---|
| 265 | matrix b[c][nrows(B)] = C[1..c,1+r..ncols(C)]; |
|---|
| 266 | return(transpose(a),transpose(b)); |
|---|
| 267 | } |
|---|
| 268 | example |
|---|
| 269 | { "EXAMPLE:"; echo = 2; |
|---|
| 270 | ring R=0,(x,y,z),dp; |
|---|
| 271 | matrix A[3][3]=1,2,3; |
|---|
| 272 | print(A); |
|---|
| 273 | matrix B[3][3]=x,y,z,x2,y2,z2,xy,xz,yz; |
|---|
| 274 | print(B); |
|---|
| 275 | print(apply_col(A,B)); |
|---|
| 276 | list L=apply_col(A,B); |
|---|
| 277 | print(L[2]); |
|---|
| 278 | } |
|---|
| 279 | /////////////////////////////////////////////////////////////////////////////// |
|---|
| 280 | |
|---|
| 281 | proc defining_system (matrix A,matrix B) |
|---|
| 282 | USAGE: defining_system(A,B); A,B=matrices |
|---|
| 283 | ASSUME: A a constant matrix |
|---|
| 284 | COMPUTE: a defining system for next degree of massey products |
|---|
| 285 | (transform A into row reduced normal form, apply proc 'apply_col' to |
|---|
| 286 | A,B and store indices of 0-columns of A in intvec iv) |
|---|
| 287 | RETURN: two objects: intvec iv, matrix M (the transformed matrix B) |
|---|
| 288 | The columns of M with index from iv are a defining sytem |
|---|
| 289 | EXAMPLE: example defining_system; shows an example |
|---|
| 290 | { |
|---|
| 291 | int k,l; |
|---|
| 292 | ideal id; |
|---|
| 293 | intvec iv; |
|---|
| 294 | A = gauss_row(A); // row-reduced nf of A |
|---|
| 295 | int rg = ncols(A); |
|---|
| 296 | A,B = apply_col(A,B); // special columne-reduction |
|---|
| 297 | for( k=1;k<=rg;k++ ) // collect zero-cols of B |
|---|
| 298 | { |
|---|
| 299 | if( A[k]==0) {l++;iv[l]=k;} // test if kth column is 0 |
|---|
| 300 | } // collect indices of 0-columns in iv |
|---|
| 301 | return(iv,B); |
|---|
| 302 | } |
|---|
| 303 | example |
|---|
| 304 | { "EXAMPLE:"; echo = 2; |
|---|
| 305 | ring R=0,(x,y,z),dp; |
|---|
| 306 | matrix A[3][3]=1,2,3,2,4,6,4,8,12; |
|---|
| 307 | print(A); |
|---|
| 308 | matrix B[3][3]=x,y,z,x2,y2,z2,xy,xz,yz; |
|---|
| 309 | print(B); |
|---|
| 310 | print(defining_system(A,B)); |
|---|
| 311 | } |
|---|
| 312 | /////////////////////////////////////////////////////////////////////////////// |
|---|
| 313 | |
|---|
| 314 | proc reduce_s (ideal i,ideal j,int n) |
|---|
| 315 | USAGE: reduce_s(i,j,n); i,j=ideals, n=integer |
|---|
| 316 | RETURN: add to all polys of i var(1)^(n+ord) and reduce mod std(j) |
|---|
| 317 | (to get correct reduction in s-order) |
|---|
| 318 | NOTE: apply jet(i,n-1) to get correct reduction (n > maxord(i) |
|---|
| 319 | EXAMPLE: example reduce_s; shows an example |
|---|
| 320 | |
|---|
| 321 | { |
|---|
| 322 | int m = ncols(i); |
|---|
| 323 | int d,k; |
|---|
| 324 | ideal j0 = std(j); |
|---|
| 325 | for (k=1;k<=m;k++) |
|---|
| 326 | { |
|---|
| 327 | if (deg(i[k])>=0) |
|---|
| 328 | { |
|---|
| 329 | d = n+deg(i[k])+1; |
|---|
| 330 | i[k]= reduce(i[k]+var(1)^d,j0); |
|---|
| 331 | } |
|---|
| 332 | } |
|---|
| 333 | return(i); |
|---|
| 334 | } |
|---|
| 335 | example |
|---|
| 336 | { "EXAMPLE:"; echo = 2; |
|---|
| 337 | ring r = 0,(x,y),ds; |
|---|
| 338 | poly f = x7+y7+(x-y)^2*x^2*y^2; |
|---|
| 339 | ideal j = jacob(f); |
|---|
| 340 | reduce_s(f,j,10); |
|---|
| 341 | } |
|---|
| 342 | /////////////////////////////////////////////////////////////////////////////// |
|---|
| 343 | |
|---|
| 344 | proc lift_kbase (N, M) |
|---|
| 345 | USAGE: lift_kbase(N,M); N,M=poly/ideal/vector/module |
|---|
| 346 | RETURN: matrix A, coefficient matrix expressing N as linear combination of |
|---|
| 347 | k-basis of M. Let the k-basis have k elements and A c columns. |
|---|
| 348 | Then A satisfies: |
|---|
| 349 | matrix(reduce(N,std(M)),k,c) = matrix(kbase(std(M)))*A |
|---|
| 350 | ASSUME: dim(M)=0 and the monomial ordering is a well ordering or the last |
|---|
| 351 | block of the ordering is c or C |
|---|
| 352 | EXAMPLE: example lift_kbase; shows an example |
|---|
| 353 | { |
|---|
| 354 | //---------- initialisation ------------------------------------------------- |
|---|
| 355 | string ords = ordstr(basering); |
|---|
| 356 | int d,col,k,l; |
|---|
| 357 | module kb; |
|---|
| 358 | matrix testm; |
|---|
| 359 | vector v,p,q; |
|---|
| 360 | //------- check wether ordering is correct ------------------------------------ |
|---|
| 361 | k=1; |
|---|
| 362 | for( l=1;l<=nvars(basering);l++ ) { k=k*(lead(1+var(l))==var(l)); } |
|---|
| 363 | if( k==0 ) |
|---|
| 364 | { |
|---|
| 365 | if( ords[size(ords)]!="c" and ords[size(ords)]!="C" ) |
|---|
| 366 | { |
|---|
| 367 | "// change ordering!"; |
|---|
| 368 | "// ordering "+ordstr(basering)+" not implemented for this proc"; |
|---|
| 369 | return(); |
|---|
| 370 | } |
|---|
| 371 | } |
|---|
| 372 | //---------- check assumtions ----------------------------------------------- |
|---|
| 373 | if( typeof(N)=="poly" ) { ideal J=ideal(N); kill N; module N=J; kill J; } |
|---|
| 374 | if( typeof(M)=="poly" ) { ideal J=ideal(M); kill M; module M=J; } |
|---|
| 375 | M = std(M); |
|---|
| 376 | d = vdim(M); |
|---|
| 377 | if( d<1 ) |
|---|
| 378 | { "// second argument in `lift_kbase` has vdim",d; return(); } |
|---|
| 379 | //---------- compute kbase and reduce(N,M) ----------------------------------- |
|---|
| 380 | kb = kbase(M); |
|---|
| 381 | col = ncols(N); |
|---|
| 382 | N = reduce(N,M); |
|---|
| 383 | //---------- collecting coefficients of reduce(N,M) -------------------------- |
|---|
| 384 | matrix result[d][col]; |
|---|
| 385 | for( l=1;l<=col;l=l+1 ) |
|---|
| 386 | { |
|---|
| 387 | v = N[l]; |
|---|
| 388 | if( size(v)>0 ) |
|---|
| 389 | { |
|---|
| 390 | for( k=1;k<=d;k=k+1 ) |
|---|
| 391 | { |
|---|
| 392 | p = kb[k]; |
|---|
| 393 | q = lead(v); |
|---|
| 394 | if( size(p-q)<2 ) |
|---|
| 395 | { |
|---|
| 396 | result[k,l] = leadcoef(q); |
|---|
| 397 | v = v-q; |
|---|
| 398 | if( size(v)<1 ) { k=d+1; } |
|---|
| 399 | else { k=0; } |
|---|
| 400 | } |
|---|
| 401 | } |
|---|
| 402 | } |
|---|
| 403 | } |
|---|
| 404 | //--------- final test ------------------------------------------------------- |
|---|
| 405 | testm = matrix(N,nrows(kb),ncols(result))- matrix(kb)*result; |
|---|
| 406 | if( size(module(testm))!=0 ) |
|---|
| 407 | { |
|---|
| 408 | "// proc `lift_kbase` did'nt work correctly!"; |
|---|
| 409 | "// Please inform tthe authors"; |
|---|
| 410 | return(); |
|---|
| 411 | } |
|---|
| 412 | return(result); |
|---|
| 413 | } |
|---|
| 414 | example |
|---|
| 415 | { |
|---|
| 416 | "EXAMPLE:"; echo=2; |
|---|
| 417 | ring R=0,(x,y),ds; |
|---|
| 418 | module M=[x2,xy],[y2,xy],[0,xx],[0,yy]; |
|---|
| 419 | module N=[x3+xy,x],[x,x+y2]; |
|---|
| 420 | print(M); |
|---|
| 421 | module kb=kbase(std(M)); |
|---|
| 422 | print(kb); |
|---|
| 423 | print(N); |
|---|
| 424 | matrix A=lift_kbase(N,M); |
|---|
| 425 | print(A); |
|---|
| 426 | matrix(reduce(N,std(M)),nrows(kb),ncols(A)) - matrix(kbase(std(M)))*A; |
|---|
| 427 | } |
|---|
| 428 | /////////////////////////////////////////////////////////////////////////////// |
|---|
| 429 | |
|---|
| 430 | proc coef_ideal (matrix M,int s) |
|---|
| 431 | USAGE: coef_ideal(M,s); M=matrix, s=integer |
|---|
| 432 | ASSUME: M=matrix with only one row and without any constant term |
|---|
| 433 | COMPUTE: coef_matrices with respect to first s variables |
|---|
| 434 | RETURN: 2 matrices: |
|---|
| 435 | matrix of coefficients (each column is formed by the coefficients |
|---|
| 436 | of M with respect to some monomial) |
|---|
| 437 | row-matrix of corresponding monomials |
|---|
| 438 | EXAMPLE: example coef_ideal; shows an example |
|---|
| 439 | { |
|---|
| 440 | int k,l,n,z; |
|---|
| 441 | int cM = ncols(M); |
|---|
| 442 | ideal flatM = M; |
|---|
| 443 | ideal monId,flat; |
|---|
| 444 | poly mon = product(maxideal(1),1..s); |
|---|
| 445 | //--------- collect all monomials (!=1) --------------------------------------- |
|---|
| 446 | for (k=1;k<=cM;k++) |
|---|
| 447 | { |
|---|
| 448 | matrix mci(k) = coef(flatM[k],mon); |
|---|
| 449 | flat = mci(k)[1,1..ncols(mci(k))]; |
|---|
| 450 | if (flat[1]!=1) |
|---|
| 451 | { monId = monId,flat;} |
|---|
| 452 | } |
|---|
| 453 | monId = monId+ideal(0); |
|---|
| 454 | k=size(monId); |
|---|
| 455 | matrix BIG[cM][k]; |
|---|
| 456 | //--------- create coef_matrices -------------------------------------------- |
|---|
| 457 | for (n=1;n<=k;n++) |
|---|
| 458 | { |
|---|
| 459 | for (l=1;l<=cM;l++) |
|---|
| 460 | { |
|---|
| 461 | for (z=1;z<=ncols(mci(l));z++) |
|---|
| 462 | { |
|---|
| 463 | if(mci(l)[1,z]==monId[n]) |
|---|
| 464 | { BIG[l,n] = mci(l)[2,z];} |
|---|
| 465 | } |
|---|
| 466 | } |
|---|
| 467 | } |
|---|
| 468 | return(BIG,matrix(monId)); |
|---|
| 469 | } |
|---|
| 470 | example |
|---|
| 471 | { "EXAMPLE:"; echo = 2; |
|---|
| 472 | ring Z = 0,(A,B,C,x,y,z),ds; |
|---|
| 473 | int s = 3; |
|---|
| 474 | matrix M[1][4]=A+yB,2C,3AA,4BB+5CC; |
|---|
| 475 | print(M); |
|---|
| 476 | matrix Coe,Mon; |
|---|
| 477 | Coe,Mon = coef_ideal(M,s); |
|---|
| 478 | print(Coe); |
|---|
| 479 | print(Mon); |
|---|
| 480 | } |
|---|
| 481 | /////////////////////////////////////////////////////////////////////////////// |
|---|
| 482 | ---------- |
|---|
| 483 | |
|---|
| 484 | "example in r1: i=cone rational normal curve d=4"; |
|---|
| 485 | int d=4; |
|---|
| 486 | ring r1=0,(x,y,z,u,v),ds; |
|---|
| 487 | matrix m[2][4]=x,y,z,u,y,z,u,v; |
|---|
| 488 | ideal i=minor(m,2); |
|---|
| 489 | i=minbase(i); |
|---|
| 490 | i;pause; |
|---|
| 491 | int t=timer;miniversal(i);timer-t; |
|---|
| 492 | ---------- |
|---|
| 493 | |
|---|
| 494 | "example: in r4 i=cone rational normal curve d=5"; |
|---|
| 495 | int d=5; |
|---|
| 496 | ring s=0,(x,y,z,u,v,w),ds; |
|---|
| 497 | matrix m[2][5]=x,y,z,u,v,y,z,u,v,w; |
|---|
| 498 | ideal i=minor(m,2); |
|---|
| 499 | i=minbase(i); |
|---|
| 500 | i;pause; |
|---|
| 501 | |
|---|
| 502 | ---------- |
|---|
| 503 | |
|---|
| 504 | "Example: in r5 i=L_n^n, n=4;"; |
|---|
| 505 | ring r5=0,(x,y,z,u),ds; |
|---|
| 506 | ideal i; |
|---|
| 507 | i=xy,xz,xu,yz,yu,zu; |
|---|
| 508 | i;pause; |
|---|
| 509 | |
|---|
| 510 | ---------- |
|---|
| 511 | |
|---|
| 512 | "Example 1 : cyclic quotient in ws |
|---|
| 513 | (type setring r1;sud(i);)"; |
|---|
| 514 | ring r1=0,(x,y,z,u,v),ws(4,3,2,3,4); |
|---|
| 515 | ideal i=xz-y2,yz2-xu,xv-yzu,yu-z3,z2u-yv,zv-u2; |
|---|
| 516 | i; |
|---|
| 517 | |
|---|
| 518 | "Example 2: same in wp |
|---|
| 519 | (ringr r2)"; |
|---|
| 520 | ring r2=0,(x,y,z,u,v),wp(4,3,2,3,4); |
|---|
| 521 | ideal i=xz-y2,yz2-xu,xv-yzu,yu-z3,z2u-yv,zv-u2; |
|---|
| 522 | i; |
|---|
| 523 | |
|---|
| 524 | "Example 3: same in ls"; |
|---|
| 525 | ring r3=0,(x,y,z,u,v),ls; |
|---|
| 526 | ideal i=xz-y2,yz2-xu,xv-yzu,yu-z3,z2u-yv,zv-u2; |
|---|
| 527 | i; |
|---|
| 528 | |
|---|
| 529 | "Example 4: by chance for testing"; |
|---|
| 530 | ring r4=0,(x,y,z),ds; |
|---|
| 531 | ideal i=xy,yz,xz+y3,x2+y2+z3; |
|---|
| 532 | i; |
|---|
| 533 | |
|---|
