1 | // $Id: spcurve.lib,v 1.10 2000-12-07 14:29:52 Singular Exp $ |
---|
2 | // (anne, last modified 31.5.99) |
---|
3 | ///////////////////////////////////////////////////////////////////////////// |
---|
4 | |
---|
5 | version="$Id: spcurve.lib,v 1.10 2000-12-07 14:29:52 Singular Exp $"; |
---|
6 | info=" |
---|
7 | LIBRARY: spcurve.lib PROCEDURES FOR CM CODIMENSION 2 SINGULARITIES |
---|
8 | AUTHOR: Anne Fruehbis-Krueger, anne@mathematik.uni-kl.de |
---|
9 | last modified: 31.5.99 |
---|
10 | |
---|
11 | isCMcod2(i); presentation matrix of the ideal i, if i is CM |
---|
12 | CMtype(i); Cohen-Macaulay type of the ideal i |
---|
13 | matrixT1(M,n); 1st order deformation T1 in matrix description |
---|
14 | semiCMcod2(M,T1); semiuniversal deformation of maximal minors of M |
---|
15 | discr(sem,n); discriminant of semiuniversal deformation |
---|
16 | qhmatrix(M); weights if M is quasihomogeneous |
---|
17 | relweight(N,W,a); relative matrix weight of N w.r.t. weights (W,a) |
---|
18 | posweight(M,T1,i); deformation of coker(M) of non-negative weight |
---|
19 | KSpencerKernel(M); kernel of the Kodaira-Spencer map |
---|
20 | mod2id(M,iv); conversion of a module M to an ideal |
---|
21 | id2mod(i,iv); conversion inverse to mod2id |
---|
22 | subrInterred(i1,i2,iv) interred w.r.t. a subset of variables |
---|
23 | "; |
---|
24 | |
---|
25 | LIB "elim.lib"; |
---|
26 | LIB "homolog.lib"; |
---|
27 | LIB "inout.lib"; |
---|
28 | LIB "poly.lib"; |
---|
29 | ///////////////////////////////////////////////////////////////////////////// |
---|
30 | |
---|
31 | proc isCMcod2(ideal kurve) |
---|
32 | "USAGE: isCMcod2(i); i an ideal |
---|
33 | RETURN: presentation matrix of i, if i is Cohen-Macaulay of codimension2 |
---|
34 | a zero matrix otherwise |
---|
35 | EXAMPLE: example isCMcod2; shows an example" |
---|
36 | { |
---|
37 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
38 | //--------------------------------------------------------------------------- |
---|
39 | // Compute a minimal free resolution of the ideal and check if the |
---|
40 | // resolution has the expected structure |
---|
41 | //--------------------------------------------------------------------------- |
---|
42 | list kurveres=mres(kurve,0); |
---|
43 | matrix M=kurveres[2]; |
---|
44 | if ((size(kurveres)>3) && |
---|
45 | ((size(kurveres[3])>1) || |
---|
46 | ((size(kurveres[3])<=1) && (kurveres[3][1,1]!=0)))) |
---|
47 | { |
---|
48 | dbprint(p,"//not Cohen-Macaulay, codim 2"); |
---|
49 | matrix ret=0; |
---|
50 | return(ret); |
---|
51 | } |
---|
52 | return(M); |
---|
53 | } |
---|
54 | example |
---|
55 | { "EXAMPLE:"; echo=2; |
---|
56 | ring r=32003,(x,y,z),ds; |
---|
57 | ideal i=xz,yz,x^3-y^4; |
---|
58 | print(isCMcod2(i)); |
---|
59 | } |
---|
60 | ///////////////////////////////////////////////////////////////////////////// |
---|
61 | |
---|
62 | proc CMtype(ideal kurve) |
---|
63 | "USAGE: CMtype(i); i an ideal, CM of codimension 2 |
---|
64 | RETURN: Cohen-Macaulay type of i (integer) |
---|
65 | (-1, if i is not Cohen-Macaulay of codimension 2) |
---|
66 | EXAMPLE: example CMtype; shows an example" |
---|
67 | { |
---|
68 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
69 | int gt = -1; |
---|
70 | //--------------------------------------------------------------------------- |
---|
71 | // Compute a minimal free resolution of the ideal and check if the |
---|
72 | // resolution has the expected structure |
---|
73 | //--------------------------------------------------------------------------- |
---|
74 | list kurveres; |
---|
75 | kurveres=mres(kurve,0); |
---|
76 | if ((size(kurveres)>3) && |
---|
77 | ((size(kurveres[3])>1) || |
---|
78 | ((size(kurveres[3])<=1) && (kurveres[3][1,1]!=0)))) |
---|
79 | { |
---|
80 | dbprint(p,"//not Cohen-Macaulay, codim 2"); |
---|
81 | return(gt); |
---|
82 | } |
---|
83 | //--------------------------------------------------------------------------- |
---|
84 | // Return the Cohen-Macaulay type of i |
---|
85 | //--------------------------------------------------------------------------- |
---|
86 | matrix M = matrix(kurveres[2]); |
---|
87 | gt = ncols(M); |
---|
88 | return(gt); |
---|
89 | } |
---|
90 | example |
---|
91 | { "EXAMPLE:"; echo=2; |
---|
92 | ring r=32003,(x,y,z),ds; |
---|
93 | ideal i=xy,xz,yz; |
---|
94 | CMtype(i); |
---|
95 | } |
---|
96 | ///////////////////////////////////////////////////////////////////////////// |
---|
97 | |
---|
98 | proc matrixT1(matrix M ,int n) |
---|
99 | "USAGE: matrixT1(M,n); M matrix, n integer |
---|
100 | ASSUME: M is a presentation matrix of an ideal i, CM of codimension 2; |
---|
101 | consider i as a family of ideals in a ring in the first n |
---|
102 | variables where the remaining variables are considered as |
---|
103 | parameters |
---|
104 | RETURN: list consisting of the k x (k+1) matrix M and a module K_M such that |
---|
105 | T1=Mat(k,k+1;R)/K_M is the space of first order deformations of i |
---|
106 | EXAMPLE: example matrixT1; shows an example" |
---|
107 | { |
---|
108 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
109 | //-------------------------------------------------------------------------- |
---|
110 | // Initialization and sanity checks |
---|
111 | //-------------------------------------------------------------------------- |
---|
112 | int nr=nrows(M); |
---|
113 | int nc=ncols(M); |
---|
114 | if ( nr < nc ) |
---|
115 | { |
---|
116 | M=transpose(M); |
---|
117 | int temp=nc; |
---|
118 | nc=nr; |
---|
119 | nr=temp; |
---|
120 | int tra=1; |
---|
121 | } |
---|
122 | if ( nr != (nc+1) ) |
---|
123 | { |
---|
124 | ERROR("not a k x (k+1) matrix"); |
---|
125 | } |
---|
126 | //--------------------------------------------------------------------------- |
---|
127 | // Construct the denominator - step by step |
---|
128 | // step 1: initialization |
---|
129 | //--------------------------------------------------------------------------- |
---|
130 | int gt=nc; |
---|
131 | int i,j; |
---|
132 | ideal m = M; |
---|
133 | ideal dx; |
---|
134 | ideal rv; |
---|
135 | ideal lv; |
---|
136 | matrix R[gt][gt]=0; |
---|
137 | matrix L[gt+1][gt+1]=0; |
---|
138 | matrix T1[n+gt*gt+(gt+1)*(gt+1)][gt*(gt+1)] = 0; |
---|
139 | //--------------------------------------------------------------------------- |
---|
140 | // step 2: the derivatives of the matrix are generators of the denominator |
---|
141 | //--------------------------------------------------------------------------- |
---|
142 | for( i=1; i<= n; i++ ) |
---|
143 | { |
---|
144 | dx=diff(m,var(i)); |
---|
145 | T1[i,1..gt*(gt+1)] = dx; |
---|
146 | } |
---|
147 | //--------------------------------------------------------------------------- |
---|
148 | // step 3: M*R is a generator as well |
---|
149 | //--------------------------------------------------------------------------- |
---|
150 | for( i=1; i <= gt; i++ ) |
---|
151 | { |
---|
152 | for ( j=1 ; j <= gt ; j++ ) |
---|
153 | { |
---|
154 | R[i,j]=1; |
---|
155 | rv = M * R; |
---|
156 | T1[n+(i-1)*gt+j,1..gt*(gt+1)] = rv; |
---|
157 | R[i,j]=0; |
---|
158 | } |
---|
159 | } |
---|
160 | //--------------------------------------------------------------------------- |
---|
161 | // step 4: so is L*M |
---|
162 | //--------------------------------------------------------------------------- |
---|
163 | for( i=1; i <= (gt+1); i++) |
---|
164 | { |
---|
165 | for( j=1 ; j <= (gt+1);j++ ) |
---|
166 | { |
---|
167 | L[i,j]=1; |
---|
168 | lv = L * M; |
---|
169 | T1[n+gt*gt+(i-1)*(gt+1)+j,1..gt*(gt+1)] = lv; |
---|
170 | L[i,j]=0; |
---|
171 | } |
---|
172 | } |
---|
173 | //--------------------------------------------------------------------------- |
---|
174 | // Compute the vectorspace basis of T1 |
---|
175 | //--------------------------------------------------------------------------- |
---|
176 | module t1 = module(transpose(T1)); |
---|
177 | list result=M,t1; |
---|
178 | return(result); |
---|
179 | } |
---|
180 | example |
---|
181 | { "EXAMPLE:"; echo = 2; |
---|
182 | ring r=32003,(x(1),x(2),x(3)),ds; |
---|
183 | ideal curve=x(1)*x(2),x(1)*x(3),x(2)*x(3); |
---|
184 | matrix M=isCMcod2(curve); |
---|
185 | matrixT1(M,3); |
---|
186 | } |
---|
187 | ///////////////////////////////////////////////////////////////////////////// |
---|
188 | |
---|
189 | proc semiCMcod2(matrix M, module t1) |
---|
190 | "USAGE: semiCMcod2(M,t1); M matrix, t1 module |
---|
191 | ASSUME: M is a presentation matrix of an ideal i, CM of codimension 2, |
---|
192 | and t1 is a presentation of the space of first order deformations |
---|
193 | of i ((M,t1) as returned by the procedure matrixT1) |
---|
194 | CREATE: new basering with name rneu |
---|
195 | RETURN: ideal in rneu describing the semiuniversal deformation of i |
---|
196 | NOTE: The current basering should not contain any variables named |
---|
197 | A(j) where j is some integer! |
---|
198 | EXAMPLE: example semiCMcod2; shows an example" |
---|
199 | { |
---|
200 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
201 | //--------------------------------------------------------------------------- |
---|
202 | // Initialization |
---|
203 | //--------------------------------------------------------------------------- |
---|
204 | module t1erz=kbase(std(t1)); |
---|
205 | int tau=vdim(t1); |
---|
206 | int gt=ncols(M); |
---|
207 | int i; |
---|
208 | def r=basering; |
---|
209 | if(size(M)!=gt*(gt+1)) |
---|
210 | { |
---|
211 | gt=gt-1; |
---|
212 | } |
---|
213 | for(i=1; i<=size(t1erz); i++) |
---|
214 | { |
---|
215 | if(rvar(A(i))) |
---|
216 | { |
---|
217 | int jj=-1; |
---|
218 | break; |
---|
219 | } |
---|
220 | } |
---|
221 | if (defined(jj)>1) |
---|
222 | { |
---|
223 | if (jj==-1) |
---|
224 | { |
---|
225 | ERROR("Your ring contains a variable T(i)!"); |
---|
226 | } |
---|
227 | } |
---|
228 | //--------------------------------------------------------------------------- |
---|
229 | // Definition of the new ring and the image of M and t1 in the new ring |
---|
230 | //--------------------------------------------------------------------------- |
---|
231 | ring rtemp=0,(A(1..tau)),dp; |
---|
232 | def rneu=r+rtemp; |
---|
233 | setring rneu; |
---|
234 | matrix M=imap(r,M); |
---|
235 | ideal m=M; |
---|
236 | module t1erz=imap(r,t1erz); |
---|
237 | //--------------------------------------------------------------------------- |
---|
238 | // Construction of the presentation matrix of the versal deformation |
---|
239 | //--------------------------------------------------------------------------- |
---|
240 | matrix N=matrix(m); |
---|
241 | matrix Mtemp[gt*(gt+1)][1]; |
---|
242 | for( i=1; i<=tau; i++) |
---|
243 | { |
---|
244 | Mtemp=t1erz[i]; |
---|
245 | N=N+A(i)*transpose(Mtemp); |
---|
246 | } |
---|
247 | ideal n=N; |
---|
248 | matrix O[gt+1][gt]=n; |
---|
249 | //--------------------------------------------------------------------------- |
---|
250 | // Construction of the return value |
---|
251 | //--------------------------------------------------------------------------- |
---|
252 | ideal result=minor(O,gt); |
---|
253 | export rneu; |
---|
254 | keepring rneu; |
---|
255 | return(result); |
---|
256 | } |
---|
257 | example |
---|
258 | { "EXAMPLE:"; echo=2; |
---|
259 | ring r=32003,(x(1),x(2),x(3)),ds; |
---|
260 | ideal curve=x(1)*x(2),x(1)*x(3),x(2)*x(3); |
---|
261 | matrix M=isCMcod2(curve); |
---|
262 | list l=matrixT1(M,3); |
---|
263 | semiCMcod2(l[1],std(l[2])); |
---|
264 | } |
---|
265 | ///////////////////////////////////////////////////////////////////////////// |
---|
266 | |
---|
267 | proc discr(ideal kurve, int n) |
---|
268 | "USAGE: discr(sem,n); sem ideal, n integer |
---|
269 | ASSUME: sem is the versal deformation of an ideal of codimension 2 |
---|
270 | the first n variables of the ring are treated as variables |
---|
271 | all the others as parameters |
---|
272 | RETURN: ideal describing the discriminant |
---|
273 | NOTE: This is not a powerful algorithm! |
---|
274 | EXAMPLE: example discr; shows an example" |
---|
275 | { |
---|
276 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
277 | //--------------------------------------------------------------------------- |
---|
278 | // some sanity checks and initialization |
---|
279 | //--------------------------------------------------------------------------- |
---|
280 | int i; |
---|
281 | ideal sem=std(kurve); |
---|
282 | ideal semdiff; |
---|
283 | ideal J2; |
---|
284 | int ncol=ncols(matrix(sem)); |
---|
285 | matrix Jacob[n][ncol]; |
---|
286 | //--------------------------------------------------------------------------- |
---|
287 | // compute the Jacobian matrix |
---|
288 | //--------------------------------------------------------------------------- |
---|
289 | for (i=1; i<=n; i++) |
---|
290 | { |
---|
291 | semdiff=diff(sem,var(i)); |
---|
292 | Jacob[i,1..ncol]=semdiff; |
---|
293 | } |
---|
294 | //--------------------------------------------------------------------------- |
---|
295 | // eliminate the first n variables in the ideal generated by |
---|
296 | // the versal deformation and the 2x2 minors of the Jacobian |
---|
297 | //--------------------------------------------------------------------------- |
---|
298 | semdiff=minor(Jacob,2); |
---|
299 | J2=sem,semdiff; |
---|
300 | J2=std(J2); |
---|
301 | poly eli=1; |
---|
302 | for(i=1; i<=n; i++) |
---|
303 | { |
---|
304 | eli=eli*var(i); |
---|
305 | } |
---|
306 | ideal dis=eliminate(J2,eli); |
---|
307 | return(dis); |
---|
308 | } |
---|
309 | example |
---|
310 | { "EXAMPLE:"; echo=2; |
---|
311 | ring r=32003,(x(1),x(2),x(3)),ds; |
---|
312 | ideal curve=x(1)*x(2),x(1)*x(3),x(2)*x(3); |
---|
313 | matrix M=isCMcod2(curve); |
---|
314 | list l=matrixT1(M,3); |
---|
315 | def sem=semiCMcod2(l[1],std(l[2])); |
---|
316 | basering; |
---|
317 | discr(sem,3); |
---|
318 | } |
---|
319 | ///////////////////////////////////////////////////////////////////////////// |
---|
320 | |
---|
321 | proc qhmatrix(matrix M) |
---|
322 | "USAGE: qhmatrix(M); M a k x (k+1) matrix |
---|
323 | RETURN: list, consisting of an integer vector containing the weights of |
---|
324 | the variables of the basering and an integer matrix giving the |
---|
325 | weights of the entries of M, if M is quasihomogeneous; |
---|
326 | zero integer vector and zero integer matrix, if M is not |
---|
327 | quasihomogeneous, i.e. does not allow row and column weights |
---|
328 | EXAMPLE: example qhmatrix; shows an example" |
---|
329 | { |
---|
330 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
331 | //--------------------------------------------------------------------------- |
---|
332 | // Initialization and sanity checks |
---|
333 | //--------------------------------------------------------------------------- |
---|
334 | def r=basering; |
---|
335 | int i,j,temp; |
---|
336 | int tra=0; |
---|
337 | int nr=nrows(M); |
---|
338 | int nc=ncols(M); |
---|
339 | if ( nr > nc ) |
---|
340 | { |
---|
341 | M=transpose(M); |
---|
342 | temp=nc; |
---|
343 | nc=nr; |
---|
344 | nr=temp; |
---|
345 | tra=1; |
---|
346 | } |
---|
347 | if ( nc != (nr+1) ) |
---|
348 | { |
---|
349 | ERROR("not a k x (k+1) matrix"); |
---|
350 | } |
---|
351 | ideal m=minor(M,nr); |
---|
352 | //--------------------------------------------------------------------------- |
---|
353 | // get the weight using the fact that the matrix is quasihomogeneous, if |
---|
354 | // its maximal minors are, and check, whether M is really quasihomogeneous |
---|
355 | //--------------------------------------------------------------------------- |
---|
356 | intvec a=weight(m); |
---|
357 | string tempstr="ring rneu=" + charstr(r) + ",(" + varstr(r) + "),Ws(" + string(a) + ");"; |
---|
358 | execute(tempstr); |
---|
359 | def M=imap(r,M); |
---|
360 | int difset=0; |
---|
361 | list l; |
---|
362 | int dif; |
---|
363 | int donttest=0; |
---|
364 | int comprow=0; |
---|
365 | intmat W[nr][nc]; |
---|
366 | //--------------------------------------------------------------------------- |
---|
367 | // find a row not containing a 0 |
---|
368 | //--------------------------------------------------------------------------- |
---|
369 | for(i=1; i<=nr; i++) |
---|
370 | { |
---|
371 | if(comprow==0) |
---|
372 | { |
---|
373 | comprow=i; |
---|
374 | for(j=1; j<=nc; j++) |
---|
375 | { |
---|
376 | if(M[i,j]==0) |
---|
377 | { |
---|
378 | comprow=0; |
---|
379 | break; |
---|
380 | } |
---|
381 | } |
---|
382 | } |
---|
383 | } |
---|
384 | //--------------------------------------------------------------------------- |
---|
385 | // get the weights of the comprow'th row or use emergency exit |
---|
386 | //--------------------------------------------------------------------------- |
---|
387 | if(comprow==0) |
---|
388 | { |
---|
389 | intvec v=0; |
---|
390 | intmat V=0 |
---|
391 | list ret=v,V; |
---|
392 | return(ret); |
---|
393 | } |
---|
394 | else |
---|
395 | { |
---|
396 | for(j=1; j<=nc; j++) |
---|
397 | { |
---|
398 | l[j]=deg(lead(M[comprow,j])); |
---|
399 | } |
---|
400 | } |
---|
401 | //--------------------------------------------------------------------------- |
---|
402 | // do the checks |
---|
403 | //--------------------------------------------------------------------------- |
---|
404 | for(i=1; i<=nr; i++) |
---|
405 | { |
---|
406 | if ( i==comprow ) |
---|
407 | { |
---|
408 | // this row should not be tested against itself |
---|
409 | donttest=1; |
---|
410 | } |
---|
411 | else |
---|
412 | { |
---|
413 | // initialize the difference of the rows, but ignore 0-entries |
---|
414 | if (M[i,1]!=0) |
---|
415 | { |
---|
416 | dif=deg(lead(M[i,1]))-l[1]; |
---|
417 | difset=1; |
---|
418 | } |
---|
419 | else |
---|
420 | { |
---|
421 | list memo; |
---|
422 | memo[1]=1; |
---|
423 | } |
---|
424 | } |
---|
425 | // check column by column |
---|
426 | for(j=1; j<=nc; j++) |
---|
427 | { |
---|
428 | if(M[i,j]==0) |
---|
429 | { |
---|
430 | if(defined(memo)!=0) |
---|
431 | { |
---|
432 | memo[size(memo)+1]=j; |
---|
433 | } |
---|
434 | else |
---|
435 | { |
---|
436 | list memo; |
---|
437 | memo[1]=j; |
---|
438 | } |
---|
439 | } |
---|
440 | temp=deg(lead(M[i,j])); |
---|
441 | if((difset!=1) && (donttest!=1) && (M[i,j]!=0)) |
---|
442 | { |
---|
443 | // initialize the difference of the rows, if necessary - still ignore 0s |
---|
444 | dif=deg(lead(M[i,j]))-l[j]; |
---|
445 | difset=1; |
---|
446 | } |
---|
447 | // is M[i,j] quasihomogeneous - else emergency exit |
---|
448 | if(M[i,j]!=jet(M[i,j],temp,a)-jet(M[i,j],temp-1,a)) |
---|
449 | { |
---|
450 | intvec v=0; |
---|
451 | intmat V=0; |
---|
452 | list ret=v,V; |
---|
453 | return(ret); |
---|
454 | } |
---|
455 | if(donttest!=1) |
---|
456 | { |
---|
457 | // check row and column weights - else emergency exit |
---|
458 | if(((temp-l[j])!=dif) && (M[i,j]!=0) && (difset==1)) |
---|
459 | { |
---|
460 | intvec v=0; |
---|
461 | intmat V=0; |
---|
462 | list ret=v,V; |
---|
463 | return(ret); |
---|
464 | } |
---|
465 | } |
---|
466 | // set the weight matrix entry |
---|
467 | W[i,j]=temp; |
---|
468 | } |
---|
469 | // clean up the 0's we left out |
---|
470 | if((difset==1) && (defined(memo)!=0)) |
---|
471 | { |
---|
472 | for(j=1; j<=size(memo); j++) |
---|
473 | { |
---|
474 | W[i,memo[j]]=dif+l[memo[j]]; |
---|
475 | } |
---|
476 | kill memo; |
---|
477 | } |
---|
478 | donttest=0; |
---|
479 | } |
---|
480 | //--------------------------------------------------------------------------- |
---|
481 | // transpose, if M was transposed during initialization, and return the list |
---|
482 | //--------------------------------------------------------------------------- |
---|
483 | if ( tra==1 ) |
---|
484 | { |
---|
485 | W=transpose(W); |
---|
486 | } |
---|
487 | setring r; |
---|
488 | list ret=a,W; |
---|
489 | return(ret); |
---|
490 | } |
---|
491 | example |
---|
492 | { "EXAMPLE:"; echo=2; |
---|
493 | ring r=0,(x,y,z),ds; |
---|
494 | matrix M[3][2]=z,0,y,x,x^3,y; |
---|
495 | qhmatrix(M); |
---|
496 | pmat(M); |
---|
497 | } |
---|
498 | ///////////////////////////////////////////////////////////////////////////// |
---|
499 | |
---|
500 | proc relweight(matrix N, intmat W, intvec a) |
---|
501 | "USAGE: relweight(N,W,a); N matrix, W intmat, a intvec |
---|
502 | ASSUME: N is a non-zero matrix |
---|
503 | W is an integer matrix of the same size as N |
---|
504 | a is an integer vector giving the weights of the variables |
---|
505 | RETURN: integer, max(a-weighted order(N_ij) - W_ij | all entries ij) |
---|
506 | string "ERROR" if sizes do not match |
---|
507 | EXAMPLE: example relweight; shows an example" |
---|
508 | { |
---|
509 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
510 | //--------------------------------------------------------------------------- |
---|
511 | // Initialization and sanity checks |
---|
512 | //--------------------------------------------------------------------------- |
---|
513 | if ((size(N)!=size(W)) || (ncols(N)!=ncols(W))) |
---|
514 | { |
---|
515 | ERROR("matrix size does not match"); |
---|
516 | } |
---|
517 | if (size(a)!=nvars(basering)) |
---|
518 | { |
---|
519 | ERROR("length of weight vector != number of variables"); |
---|
520 | } |
---|
521 | int i,j,temp; |
---|
522 | def r=basering; |
---|
523 | //--------------------------------------------------------------------------- |
---|
524 | // Comparision entry by entry |
---|
525 | //--------------------------------------------------------------------------- |
---|
526 | for(i=1; i<=nrows(N); i++) |
---|
527 | { |
---|
528 | for(j=1; j<=ncols(N); j++) |
---|
529 | { |
---|
530 | if (N[i,j]!=0) |
---|
531 | { |
---|
532 | temp=mindeg1(N[i,j],a)-W[i,j]; |
---|
533 | if (defined(ret)) |
---|
534 | { |
---|
535 | if(temp > ret) |
---|
536 | { |
---|
537 | ret=temp; |
---|
538 | } |
---|
539 | } |
---|
540 | else |
---|
541 | { |
---|
542 | int ret=temp; |
---|
543 | } |
---|
544 | } |
---|
545 | } |
---|
546 | } |
---|
547 | return(ret); |
---|
548 | } |
---|
549 | example |
---|
550 | { "EXAMPLE:"; echo=2; |
---|
551 | ring r=32003,(x,y,z),ds; |
---|
552 | matrix N[2][3]=z,0,y,x,x^3,y; |
---|
553 | intmat W[2][3]=1,1,1,1,1,1; |
---|
554 | intvec a=1,1,1; |
---|
555 | relweight(N,W,a); |
---|
556 | } |
---|
557 | ///////////////////////////////////////////////////////////////////////////// |
---|
558 | |
---|
559 | proc posweight(matrix M, module t1, int choose, list #) |
---|
560 | "USAGE: posweight(M,t1,n[,s]); M matrix, t1 module, n int, s string |
---|
561 | n=0 : all deformations of non-negative weight |
---|
562 | n=1 : only non-constant deformations of non-negative weight |
---|
563 | n=2 : all deformations of positive weight |
---|
564 | As an optional parameter the name of a new ring may be |
---|
565 | specified. |
---|
566 | ASSUME: M is a presentation matrix of a Cohen-Macaulay codimension 2 |
---|
567 | ideal and t1 is its T1 space in matrix notation |
---|
568 | CREATE: new basering (default name: rneu); a different name for this ring |
---|
569 | may be given as a 4th parameter |
---|
570 | RETURN: list, consisting of a presentation matrix describing the deformation |
---|
571 | given by the generators of T1 of non-negative/positive weight |
---|
572 | and the weight vector for the new variables |
---|
573 | NOTE: The current basering should not contain any variables named |
---|
574 | T(i) where i is some integer! |
---|
575 | EXAMPLE: example posweight; shows an example" |
---|
576 | { |
---|
577 | //--------------------------------------------------------------------------- |
---|
578 | // Initialization and sanity checks |
---|
579 | //--------------------------------------------------------------------------- |
---|
580 | if (size(#)>0) |
---|
581 | { |
---|
582 | if (typeof(#[1])=="string") |
---|
583 | { |
---|
584 | string newname=#[1]; |
---|
585 | } |
---|
586 | } |
---|
587 | if (attrib(t1,"isSB")) |
---|
588 | { |
---|
589 | module t1erz=kbase(t1); |
---|
590 | int tau=vdim(t1); |
---|
591 | } |
---|
592 | else |
---|
593 | { module t1erz=kbase(std(t1)); |
---|
594 | int tau=vdim(std(t1)); |
---|
595 | } |
---|
596 | for(int i=1; i<=size(t1erz); i++) |
---|
597 | { |
---|
598 | if(rvar(T(i))) |
---|
599 | { |
---|
600 | int jj=-1; |
---|
601 | break; |
---|
602 | } |
---|
603 | } |
---|
604 | kill i; |
---|
605 | if (defined(jj)) |
---|
606 | { |
---|
607 | if (jj==-1) |
---|
608 | { |
---|
609 | ERROR("Your ring contains a variable T(i)!"); |
---|
610 | } |
---|
611 | } |
---|
612 | int pw=0; |
---|
613 | int i; |
---|
614 | def r=basering; |
---|
615 | list l=qhmatrix(M); |
---|
616 | int gt=ncols(M); |
---|
617 | if(size(M)!=gt*(gt+1)) |
---|
618 | { |
---|
619 | gt=gt-1; |
---|
620 | } |
---|
621 | matrix erzmat[gt+1][gt]; |
---|
622 | list erz; |
---|
623 | if ((size(l[1])==1) && (l[1][1]==0) && (size(l[2])==1) && (l[2][1,1]==0)) |
---|
624 | { |
---|
625 | ERROR("Internal Error: Problem determining the weights."); |
---|
626 | } |
---|
627 | //--------------------------------------------------------------------------- |
---|
628 | // Find the generators of T1 of non-negative weight |
---|
629 | //--------------------------------------------------------------------------- |
---|
630 | int relw; |
---|
631 | list rlw; |
---|
632 | for(i=1; i<=tau; i++) |
---|
633 | { |
---|
634 | erzmat=t1erz[i]; |
---|
635 | kill relw; |
---|
636 | def relw=relweight(erzmat,l[2],l[1]); |
---|
637 | if(typeof(relw)=="int") |
---|
638 | { |
---|
639 | if (((choose==0) && (relw>=0)) |
---|
640 | || ((choose==1) && (relw>=0) && (CMtype(minor(M+erzmat,gt))==gt)) |
---|
641 | || ((choose==2) && (relw > 0))) |
---|
642 | { |
---|
643 | pw++; |
---|
644 | rlw[pw]=relw; |
---|
645 | erz[pw]=erzmat; |
---|
646 | } |
---|
647 | } |
---|
648 | else |
---|
649 | { |
---|
650 | ERROR("Internal Error: Problem determining relative weight."); |
---|
651 | } |
---|
652 | } |
---|
653 | //--------------------------------------------------------------------------- |
---|
654 | // Definition of the new ring and the image of M and erz in the new ring |
---|
655 | //--------------------------------------------------------------------------- |
---|
656 | if(size(rlw)==0) |
---|
657 | { |
---|
658 | ERROR("Internal Error: Problem determining relative weight."); |
---|
659 | } |
---|
660 | intvec iv=rlw[1..size(rlw)]; |
---|
661 | ring rtemp=0,(T(1..pw)),dp; |
---|
662 | def rneu=r+rtemp; |
---|
663 | setring rneu; |
---|
664 | matrix M=imap(r,M); |
---|
665 | ideal m=M; |
---|
666 | // we cannot imap erz, if its size=0 |
---|
667 | if(pw==0) |
---|
668 | { |
---|
669 | list erz1; |
---|
670 | } |
---|
671 | else |
---|
672 | { |
---|
673 | list erz1=imap(r,erz); |
---|
674 | } |
---|
675 | //--------------------------------------------------------------------------- |
---|
676 | // Construction of the presentation matrix of the deformation |
---|
677 | //--------------------------------------------------------------------------- |
---|
678 | matrix N=matrix(m); |
---|
679 | ideal mtemp; |
---|
680 | matrix Mtemp[gt*(gt+1)][1]; |
---|
681 | for( i=1; i<=pw; i++) |
---|
682 | { |
---|
683 | mtemp=erz1[i]; |
---|
684 | Mtemp=mtemp; |
---|
685 | N=N+T(i)*transpose(Mtemp); |
---|
686 | } |
---|
687 | ideal n=N; |
---|
688 | matrix O[gt+1][gt]=n; |
---|
689 | //--------------------------------------------------------------------------- |
---|
690 | // Keep the ring and return the matrix |
---|
691 | //--------------------------------------------------------------------------- |
---|
692 | if (defined(newname)>1) |
---|
693 | { |
---|
694 | def `newname`=rneu; |
---|
695 | setring `newname`; |
---|
696 | export `newname`; |
---|
697 | keepring `newname`; |
---|
698 | } |
---|
699 | else |
---|
700 | { |
---|
701 | export rneu; |
---|
702 | keepring rneu; |
---|
703 | } |
---|
704 | list ret=O,iv; |
---|
705 | return(ret); |
---|
706 | } |
---|
707 | example |
---|
708 | { "EXAMPLE:"; echo=2; |
---|
709 | ring r=32003,(x(1),x(2),x(3)),ds; |
---|
710 | ideal curve=(x(3)-x(1)^2)*x(3),(x(3)-x(1)^2)*x(2),x(2)^2-x(1)^7*x(3); |
---|
711 | matrix M=isCMcod2(curve); |
---|
712 | list l=matrixT1(M,3); |
---|
713 | list li=posweight(l[1],std(l[2]),0); |
---|
714 | pmat(li[1]); |
---|
715 | li[2]; |
---|
716 | } |
---|
717 | ///////////////////////////////////////////////////////////////////////////// |
---|
718 | |
---|
719 | proc KSpencerKernel(matrix M,list #) |
---|
720 | "USAGE: KSpencerKernel(M[,s][,v]); M matrix, s string, v intvec |
---|
721 | optional parameters (please specify in this order, if both are |
---|
722 | present): |
---|
723 | * s = first of the names of the new rings |
---|
724 | e.g. \"R\" leads to ring names R and R1 |
---|
725 | * v of size n(n+1) leads to the following module ordering |
---|
726 | gen(v[1]) > gen(v[2]) > ... > gen(v[n(n+1)]) |
---|
727 | where the matrix entry ij corresponds to gen((i-1)*n+j) |
---|
728 | ASSUME: M is a quasihomogeneous n x (n+1) matrix where the n minors define |
---|
729 | an isolated space curve singularity |
---|
730 | CREATE: 2 new rings (default names: rneu and reneu) |
---|
731 | different ring names may be specified as a 2nd parameter |
---|
732 | RETURN: coefficient matrix representing the kernel of the Kodaira- |
---|
733 | Spencer map of the family of non-negative deformations |
---|
734 | having the given singularity as special fibre |
---|
735 | NOTE: * the initial basering should not contain variables with name |
---|
736 | e(i) or T(i), since those variable names will be internally |
---|
737 | used by the script |
---|
738 | * setting an intvec with 5 entries and name watchProgress |
---|
739 | shows the progress of the computations: |
---|
740 | watchProgress[1]>0 => option(prot) in groebner commands |
---|
741 | watchProgress[2]>0 => trace output for highcorner |
---|
742 | watchProgress[3]>0 => output of deformed matrix |
---|
743 | watchProgress[4]>0 => result of elimination step |
---|
744 | watchProgress[4]>1 => trace output of multiplications with xyz |
---|
745 | and subsequent reductions |
---|
746 | watchProgress[5]>0 => matrix representing the kernel |
---|
747 | using print |
---|
748 | EXAMPLE: example KSpencerKernel; shows an example" |
---|
749 | { |
---|
750 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
751 | //--------------------------------------------------------------------------- |
---|
752 | // Initialization and sanity checks |
---|
753 | //--------------------------------------------------------------------------- |
---|
754 | intvec optvec=option(get); |
---|
755 | if (size(#)>0) |
---|
756 | { |
---|
757 | if (typeof(#[1])=="string") |
---|
758 | { |
---|
759 | string newname=#[1]; |
---|
760 | } |
---|
761 | if (typeof(#[1])=="intvec") |
---|
762 | { |
---|
763 | intvec desiredorder=#[1]; |
---|
764 | } |
---|
765 | if (size(#)>1) |
---|
766 | { |
---|
767 | if (typeof(#[2])=="intvec") |
---|
768 | { |
---|
769 | intvec desiredorder=#[2]; |
---|
770 | } |
---|
771 | } |
---|
772 | } |
---|
773 | if (defined(watchProgress)) |
---|
774 | { |
---|
775 | if ((typeof(watchProgress)!="intvec") || (size(watchProgress)<5)) |
---|
776 | { |
---|
777 | "watchProgress should be an intvec with at least 5 entries"; |
---|
778 | "ignoring watchProgress"; |
---|
779 | def kksave=watchProgress; |
---|
780 | kill watchProgress; |
---|
781 | } |
---|
782 | } |
---|
783 | option(redTail); |
---|
784 | if (nvars(basering) != 3 ) |
---|
785 | { |
---|
786 | ERROR("It should be a curve in 3 space"); |
---|
787 | } |
---|
788 | //--------------------------------------------------------------------------- |
---|
789 | // change to a basering with the correct weihted order |
---|
790 | //--------------------------------------------------------------------------- |
---|
791 | def rt=basering; |
---|
792 | list wl=qhmatrix(M); |
---|
793 | if ((size(wl)!=2) || ((wl[1]==0) && (wl[2]==0))) |
---|
794 | { |
---|
795 | ERROR("The matrix was not n x (n+1) or not quasihomogenous"); |
---|
796 | } |
---|
797 | string ringre=" ring r=" + charstr(rt) + ",(x,y,z), Ws(" + string(wl[1]) + ");"; |
---|
798 | execute(ringre); |
---|
799 | matrix M=imap(rt,M); |
---|
800 | int ne=size(M); |
---|
801 | if (defined(desiredorder)>1) |
---|
802 | { |
---|
803 | intvec iv; |
---|
804 | for(int i=1;i<=size(desiredorder);i++) |
---|
805 | { |
---|
806 | iv[desiredorder[i]]=i; |
---|
807 | } |
---|
808 | } |
---|
809 | else |
---|
810 | { |
---|
811 | intvec iv=1..ne; |
---|
812 | } |
---|
813 | list l=matrixT1(M,3); |
---|
814 | if (dim(std(l[2])) != 0) |
---|
815 | { |
---|
816 | ERROR("The matrix does not define an isolated space curve singularity"); |
---|
817 | } |
---|
818 | module t1qh=l[2]; |
---|
819 | //-------------------------------------------------------------------------- |
---|
820 | // Passing to a new ring with extra variables e(i) corresponding to |
---|
821 | // the module generators gen(i) for weighted standard basis computation |
---|
822 | // accepting weights for the gen(i) |
---|
823 | //-------------------------------------------------------------------------- |
---|
824 | int jj=0; |
---|
825 | for(int i=1; i<=ne; i++) |
---|
826 | { |
---|
827 | if(rvar(e(i))) |
---|
828 | { |
---|
829 | jj=-1; |
---|
830 | } |
---|
831 | } |
---|
832 | if (jj==-1) |
---|
833 | { |
---|
834 | ERROR("Your ring contains a variable e(i)!"); |
---|
835 | } |
---|
836 | if(defined(desiredorder)>1) |
---|
837 | { |
---|
838 | ringre="ring re=" + charstr(r) +",(e(1.." + string(ne) + "),"+ |
---|
839 | varstr(basering) + "),Ws("; |
---|
840 | intvec tempiv=intvec(wl[2]); |
---|
841 | for(i=1;i<=ne;i++) |
---|
842 | { |
---|
843 | ringre=ringre + string((-1)*tempiv[desiredorder[i]]) + ","; |
---|
844 | } |
---|
845 | ringre= ringre + string(wl[1]) + ");"; |
---|
846 | } |
---|
847 | else |
---|
848 | { |
---|
849 | ringre="ring re=" + charstr(r) +",(e(1.." + string(ne) + "),"+ varstr(basering) |
---|
850 | + "),Ws(" + string((-1)*intvec(wl[2])) + "," |
---|
851 | + string(wl[1]) + ");"; |
---|
852 | } |
---|
853 | execute(ringre); |
---|
854 | module temp=imap(r,t1qh); |
---|
855 | ideal t1qh=mod2id(temp,iv); |
---|
856 | if (defined(watchProgress)) |
---|
857 | { |
---|
858 | if (watchProgress[1]!=0) |
---|
859 | { |
---|
860 | option(prot); |
---|
861 | "Protocol output of the groebner computation (quasihomogenous case)"; |
---|
862 | } |
---|
863 | } |
---|
864 | ideal t1qhs=std(t1qh); |
---|
865 | if (defined(watchProgress)) |
---|
866 | { |
---|
867 | if (watchProgress[1]!=0) |
---|
868 | { |
---|
869 | "groebner computation finished"; |
---|
870 | option(noprot); |
---|
871 | } |
---|
872 | } |
---|
873 | ideal t1qhsl=lead(t1qhs); |
---|
874 | module mo=id2mod(t1qhsl,iv); |
---|
875 | //-------------------------------------------------------------------------- |
---|
876 | // Return to the initial ring to compute the kbase and noether there |
---|
877 | // (in the new ring t1qh is of course not of dimension 0 but of dimension 3 |
---|
878 | // so we have to go back) |
---|
879 | //-------------------------------------------------------------------------- |
---|
880 | setring r; |
---|
881 | module mo=imap(re,mo); |
---|
882 | attrib(mo,"isSB",1); // mo is monomial ==> SB |
---|
883 | attrib(mo,"isHomog",intvec(wl[2])); // highcorner has to respect the weights |
---|
884 | vector noe=highcorner(mo); |
---|
885 | if (defined(watchProgress)) |
---|
886 | { |
---|
887 | if (watchProgress[2]!=0) |
---|
888 | { |
---|
889 | "weights corresponding to the entries of the matrix:"; |
---|
890 | wl; |
---|
891 | "leading term of the groebner basis (quasihomogeneous case)"; |
---|
892 | mo; |
---|
893 | "noether"; |
---|
894 | noe; |
---|
895 | } |
---|
896 | } |
---|
897 | //-------------------------------------------------------------------------- |
---|
898 | // Define the family of curves with the same quasihomogeneous initial |
---|
899 | // matrix M, compute T1 and pass again to the ring with the variables e(i) |
---|
900 | //-------------------------------------------------------------------------- |
---|
901 | if (defined(newname)>1) |
---|
902 | { |
---|
903 | list li=posweight(M,mo,2,newname+"1"); |
---|
904 | def rneu=basering; |
---|
905 | } |
---|
906 | else |
---|
907 | { |
---|
908 | list li=posweight(M,mo,2); |
---|
909 | } |
---|
910 | if (size(li)<=1) |
---|
911 | { |
---|
912 | ERROR("Internal Error: Problem determining perturbations of weight > 0.") |
---|
913 | } |
---|
914 | if (defined(watchProgress)) |
---|
915 | { |
---|
916 | if(watchProgress[3]!=0) |
---|
917 | { |
---|
918 | "perturbed matrix and weights of the perturbations:"; |
---|
919 | li; |
---|
920 | } |
---|
921 | } |
---|
922 | list li2=matrixT1(li[1],3); |
---|
923 | module Mpert=transpose(matrix(ideal(li2[1]))); |
---|
924 | module t1pert=li2[2]; |
---|
925 | int nv=nvars(rneu)-nvars(r); |
---|
926 | ring rtemp=0,(T(1..nv)),wp(li[2]); |
---|
927 | def reneu=re+rtemp; |
---|
928 | setring reneu; |
---|
929 | module noe=matrix(imap(r,noe)); |
---|
930 | ideal noet=mod2id(noe,iv); |
---|
931 | module temp=imap(rneu,t1pert); |
---|
932 | ideal t1pert=mod2id(temp,iv); |
---|
933 | //-------------------------------------------------------------------------- |
---|
934 | // Compute the standard basis and select those generators with leading term |
---|
935 | // divisible by some T(i) |
---|
936 | //-------------------------------------------------------------------------- |
---|
937 | noether=noet[size(noet)]; |
---|
938 | if (defined(watchProgress)) |
---|
939 | { |
---|
940 | if (watchProgress[1]!=0) |
---|
941 | { |
---|
942 | "protocol output of the groebner command (perturbed case)"; |
---|
943 | option(prot); |
---|
944 | } |
---|
945 | } |
---|
946 | ideal t1perts=std(t1pert); |
---|
947 | noether=noet[size(noet)]; |
---|
948 | t1perts=interred(t1perts); |
---|
949 | if (defined(Debug)) |
---|
950 | { |
---|
951 | if (watchProgress[1]!=0) |
---|
952 | { |
---|
953 | "groebner computation finished (perturbed case)"; |
---|
954 | option(noprot); |
---|
955 | } |
---|
956 | } |
---|
957 | ideal templ=lead(t1perts); |
---|
958 | for(int j=1;j<=nv;j++) |
---|
959 | { |
---|
960 | templ=subst(templ,T(j),0); |
---|
961 | } |
---|
962 | ideal mx; |
---|
963 | ideal mt; |
---|
964 | for(j=1;j<=size(t1perts);j++) |
---|
965 | { |
---|
966 | if(templ[j]!=0) |
---|
967 | { |
---|
968 | mx=mx,t1perts[j]; |
---|
969 | } |
---|
970 | else |
---|
971 | { |
---|
972 | mt=mt,t1perts[j]; |
---|
973 | } |
---|
974 | } |
---|
975 | //-------------------------------------------------------------------------- |
---|
976 | // multiply by the initial ring variables to shift the generators with |
---|
977 | // leading term divisible by some T(i) and reduce afterwards |
---|
978 | //-------------------------------------------------------------------------- |
---|
979 | // This is obviously no SB, but we have to reduce by |
---|
980 | attrib(mx,"isSB",1); // it and setting isSB suppresses error messages |
---|
981 | noether=noet[size(noet)]; |
---|
982 | ideal ker_gen=reduce(mt,mx); |
---|
983 | ideal ovar=var(ne+1),var(ne+2),var(ne+3); |
---|
984 | j=1; |
---|
985 | noether=noet[size(noet)]; |
---|
986 | if (defined(watchProgress)) |
---|
987 | { |
---|
988 | if (watchProgress[4]!=0) |
---|
989 | { |
---|
990 | "generators of the kernel as a C[T]{x} module:"; |
---|
991 | mt; |
---|
992 | "noether:"; |
---|
993 | noether; |
---|
994 | } |
---|
995 | } |
---|
996 | int zeros; |
---|
997 | templ=ker_gen; |
---|
998 | while(zeros==0) |
---|
999 | { |
---|
1000 | zeros=1; |
---|
1001 | templ=templ*ovar; |
---|
1002 | templ=reduce(templ,mx); |
---|
1003 | if(defined(watchProgress)) |
---|
1004 | { |
---|
1005 | if(watchProgress[4]>1) |
---|
1006 | { |
---|
1007 | templ; |
---|
1008 | } |
---|
1009 | } |
---|
1010 | if (size(templ)!= 0) |
---|
1011 | { |
---|
1012 | zeros=0; |
---|
1013 | ker_gen=ker_gen,templ; |
---|
1014 | } |
---|
1015 | } |
---|
1016 | //------------------------------------------------------------------------- |
---|
1017 | // kill zero entries, keep only one of identical entries |
---|
1018 | //------------------------------------------------------------------------- |
---|
1019 | ovar=var(1); |
---|
1020 | for(i=2;i<=ne;i++) |
---|
1021 | { |
---|
1022 | ovar=ovar,var(i); |
---|
1023 | } |
---|
1024 | ker_gen=ker_gen,ovar^2; |
---|
1025 | noether=noet[size(noet)]; |
---|
1026 | ker_gen=simplify(ker_gen,10); |
---|
1027 | //------------------------------------------------------------------------- |
---|
1028 | // interreduce ker_gen as a k[T]-module |
---|
1029 | //------------------------------------------------------------------------- |
---|
1030 | intvec mgen=1..(ne+3); |
---|
1031 | ideal Mpert=mod2id(imap(rneu,Mpert),iv); |
---|
1032 | templ=0; |
---|
1033 | for(i=1;i<=nv;i++) |
---|
1034 | { |
---|
1035 | templ[i]=diff(Mpert[size(Mpert)],T(i)); |
---|
1036 | } |
---|
1037 | templ=templ,ovar^2; |
---|
1038 | list retl=subrInterred(templ,ker_gen,mgen); |
---|
1039 | // Build up the matrix representing L |
---|
1040 | module retlm=transpose(retl[2]); |
---|
1041 | for(i=1;i<=size(retl[1]);i++) |
---|
1042 | { |
---|
1043 | if(reduce(retl[1][1,i],std(ovar^2))==0) |
---|
1044 | { |
---|
1045 | retlm[i]=0; |
---|
1046 | } |
---|
1047 | } |
---|
1048 | retlm=simplify(transpose(simplify(transpose(retlm),10)),10); |
---|
1049 | if(defined(watchProgress)) |
---|
1050 | { |
---|
1051 | if(watchProgress[5]>0) |
---|
1052 | { |
---|
1053 | print(retlm); |
---|
1054 | } |
---|
1055 | } |
---|
1056 | ker_gen=retl[3]; |
---|
1057 | // we define ret=i(L),(delta_j(t_k))_jk |
---|
1058 | list ret=id2mod(ker_gen,iv),matrix(retlm); |
---|
1059 | // cleanups - define what we previously killed |
---|
1060 | if(defined(kksave)>1) |
---|
1061 | { |
---|
1062 | def watchProgress=kksave; |
---|
1063 | export watch Progress; |
---|
1064 | } |
---|
1065 | option(set,optvec); |
---|
1066 | // make sure that the exported ring has the right name |
---|
1067 | if (defined(newname)>1) |
---|
1068 | { |
---|
1069 | def `newname`=reneu; |
---|
1070 | setring `newname`; |
---|
1071 | export `newname`; |
---|
1072 | keepring `newname`; |
---|
1073 | } |
---|
1074 | else |
---|
1075 | { |
---|
1076 | export reneu; |
---|
1077 | keepring reneu; |
---|
1078 | } |
---|
1079 | return(ret[2]); |
---|
1080 | } |
---|
1081 | example |
---|
1082 | { "EXAMPLE:"; echo=2; |
---|
1083 | ring r=0,(x,y,z),ds; |
---|
1084 | matrix M[3][2]=z-x^7,0,y^2,z,x^9,y; |
---|
1085 | KSpencerKernel(M,"ar"); |
---|
1086 | nameof(basering); |
---|
1087 | basering; |
---|
1088 | } |
---|
1089 | /////////////////////////////////////////////////////////////////////////// |
---|
1090 | |
---|
1091 | proc mod2id(matrix M,intvec vpos) |
---|
1092 | "USAGE: mod2id(M,vpos); M matrix, vpos intvec |
---|
1093 | ASSUME: vpos is an integer vector such that gen(i) corresponds |
---|
1094 | to var(vpos[i]) |
---|
1095 | the basering contains variables var(vpos[i]) which do not occur |
---|
1096 | in M |
---|
1097 | NOTE: this procedure should be used in the following situation: |
---|
1098 | one wants to pass to a ring with new variables, say e(1),..,e(s), |
---|
1099 | which correspond to the components gen(1),..,gen(s) of the |
---|
1100 | module M such that e(i)*e(j)=0 for all i,j |
---|
1101 | the new ring should already exist and be the current ring |
---|
1102 | RETURN: ideal i in which each gen(i) from the module is replaced by |
---|
1103 | var(vpos[i]) and all monomials var(vpos[i])*var(vpos[j]) have |
---|
1104 | been added to the generating set of i |
---|
1105 | EXAMPLE: example mod2id; shows an example" |
---|
1106 | { |
---|
1107 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
1108 | //---------------------------------------------------------------------- |
---|
1109 | // define the ideal generated by the var(vpos[i]) and set up the matrix |
---|
1110 | // for the multiplication |
---|
1111 | //---------------------------------------------------------------------- |
---|
1112 | ideal vars=var(vpos[1]); |
---|
1113 | for(int i=2;i<=size(vpos);i++) |
---|
1114 | { |
---|
1115 | vars=vars,var(vpos[i]); |
---|
1116 | } |
---|
1117 | matrix varm[1][size(vpos)]=vars; |
---|
1118 | if (size(vpos) > nrows(M)) |
---|
1119 | { |
---|
1120 | matrix Mt[size(vpos)][ncols(M)]; |
---|
1121 | Mt[1..nrows(M),1..ncols(M)]=M; |
---|
1122 | kill M; |
---|
1123 | matrix M=Mt; |
---|
1124 | } |
---|
1125 | //---------------------------------------------------------------------- |
---|
1126 | // define the desired ideal |
---|
1127 | //---------------------------------------------------------------------- |
---|
1128 | ideal ret=vars^2,varm*M; |
---|
1129 | return(ret); |
---|
1130 | } |
---|
1131 | example |
---|
1132 | { "EXAMPLE:"; echo=2; |
---|
1133 | ring r=0,(e(1),e(2),x,y,z),(dp(2),ds(3)); |
---|
1134 | module mo=x*gen(1)+y*gen(2); |
---|
1135 | intvec iv=2,1; |
---|
1136 | mod2id(mo,iv); |
---|
1137 | } |
---|
1138 | //////////////////////////////////////////////////////////////////////// |
---|
1139 | |
---|
1140 | proc id2mod(ideal i,intvec vpos) |
---|
1141 | "USAGE: id2mod(I,vpos); I ideal, vpos intvec |
---|
1142 | NOTE: * use this procedure only makes sense if the ideal contains |
---|
1143 | all var(vpos[i])*var(vpos[j]) as monomial generators and |
---|
1144 | all other generators are linear combinations of the |
---|
1145 | var(vpos[i]) over the ring in the other variables |
---|
1146 | * this is the inverse procedure to mod2id and should be applied |
---|
1147 | only to ideals created by mod2id using the same intvec vpos |
---|
1148 | (possibly after a standard basis computation) |
---|
1149 | RETURN: module corresponding to the ideal by replacing var(vpos[i]) by |
---|
1150 | gen(i) and omitting all generators var(vpos[i])*var(vpos[j]) |
---|
1151 | EXAMPLE: example id2mod; shows an example" |
---|
1152 | { |
---|
1153 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
1154 | //--------------------------------------------------------------------- |
---|
1155 | // Initialization |
---|
1156 | //--------------------------------------------------------------------- |
---|
1157 | int n=size(i); |
---|
1158 | int v=size(vpos); |
---|
1159 | matrix tempmat; |
---|
1160 | matrix mm[v][n]; |
---|
1161 | //--------------------------------------------------------------------- |
---|
1162 | // Conversion |
---|
1163 | //--------------------------------------------------------------------- |
---|
1164 | for(int j=1;j<=v;j++) |
---|
1165 | { |
---|
1166 | tempmat=coeffs(i,var(vpos[j])); |
---|
1167 | mm[j,1..n]=tempmat[2,1..n]; |
---|
1168 | } |
---|
1169 | for(j=1;j<=v;j++) |
---|
1170 | { |
---|
1171 | mm=subst(mm,var(vpos[j]),0); |
---|
1172 | } |
---|
1173 | module ret=simplify(mm,10); |
---|
1174 | return(ret); |
---|
1175 | } |
---|
1176 | example |
---|
1177 | { "EXAMPLE:"; echo=2; |
---|
1178 | ring r=0,(e(1),e(2),x,y,z),(dp(2),ds(3)); |
---|
1179 | ideal i=e(2)^2,e(1)*e(2),e(1)^2,e(1)*y+e(2)*x; |
---|
1180 | intvec iv=2,1; |
---|
1181 | id2mod(i,iv); |
---|
1182 | } |
---|
1183 | /////////////////////////////////////////////////////////////////////// |
---|
1184 | |
---|
1185 | proc subrInterred(ideal mon, ideal sm, intvec iv) |
---|
1186 | "USAGE: subrInterred(mon,sm,iv); |
---|
1187 | sm: ideal in a ring r with n + s variables, |
---|
1188 | e.g. x_1,..,x_n and t_1,..,t_s |
---|
1189 | mon: ideal with monomial generators (not divisible by |
---|
1190 | one of the t_i) such that sm is contained in the module |
---|
1191 | k[t_1,..,t_s]*mon[1]+..+k[t_1,..,t_s]*mon[size(mon)] |
---|
1192 | iv: intvec listing the variables which are supposed to be used |
---|
1193 | as x_i |
---|
1194 | RETURN: interreduced system of generators of sm seen as a submodule |
---|
1195 | of k[t_1,..,t_s]*mon[1]+..+k[t_1,..,t_s]*mon[size(mon)] |
---|
1196 | EXAMPLE: example subrInterred; shows an example" |
---|
1197 | { |
---|
1198 | int p = printlevel-voice+3; // p=printlevel+1 (default: p=1) |
---|
1199 | //----------------------------------------------------------------------- |
---|
1200 | // check that mon is really generated by monomials |
---|
1201 | // and sort its generators with respect to the monomial ordering |
---|
1202 | //----------------------------------------------------------------------- |
---|
1203 | int err; |
---|
1204 | for(int i=1;i<=ncols(mon);i++) |
---|
1205 | { |
---|
1206 | if ( size(mon[i]) > 1 ) |
---|
1207 | { |
---|
1208 | err=1; |
---|
1209 | } |
---|
1210 | } |
---|
1211 | if (err==1) |
---|
1212 | { |
---|
1213 | ERROR("mon has to be generated by monomials"); |
---|
1214 | } |
---|
1215 | intvec sv=sortvec(mon); |
---|
1216 | ideal mons; |
---|
1217 | for(i=1;i<=size(sv);i++) |
---|
1218 | { |
---|
1219 | mons[i]=mon[sv[i]]; |
---|
1220 | } |
---|
1221 | ideal itemp=maxideal(1); |
---|
1222 | for(i=1;i<=size(iv);i++) |
---|
1223 | { |
---|
1224 | itemp=subst(itemp,var(iv[i]),0); |
---|
1225 | } |
---|
1226 | itemp=simplify(itemp,10); |
---|
1227 | def r=basering; |
---|
1228 | string tempstr="ring rtemp=" + charstr(basering) + ",(" + string(itemp) |
---|
1229 | + "),(C,dp);"; |
---|
1230 | //----------------------------------------------------------------------- |
---|
1231 | // express m in terms of the generators of mon and check whether m |
---|
1232 | // can be considered as a submodule of k[t_1,..,t_n]*mon |
---|
1233 | //----------------------------------------------------------------------- |
---|
1234 | module motemp; |
---|
1235 | motemp[ncols(sm)]=0; |
---|
1236 | poly ptemp; |
---|
1237 | int j; |
---|
1238 | for(i=1;i<=ncols(mons);i++) |
---|
1239 | { |
---|
1240 | for(j=1;j<=ncols(sm);j++) |
---|
1241 | { |
---|
1242 | ptemp=sm[j]/mons[i]; |
---|
1243 | motemp[j]=motemp[j]+ptemp*gen(i); |
---|
1244 | } |
---|
1245 | } |
---|
1246 | for(i=1;i<=size(iv);i++) |
---|
1247 | { |
---|
1248 | motemp=subst(motemp,var(iv[i]),0); |
---|
1249 | } |
---|
1250 | matrix monmat[1][ncols(mons)]=mons; |
---|
1251 | ideal dummy=monmat*motemp; |
---|
1252 | for(i=1;i<=size(sm);i++) |
---|
1253 | { |
---|
1254 | if(sm[i]-dummy[i]!=0) |
---|
1255 | { |
---|
1256 | ERROR("the second argument is not a submodule of the assumed structure"); |
---|
1257 | } |
---|
1258 | } |
---|
1259 | //---------------------------------------------------------------------- |
---|
1260 | // do the interreduction and convert back |
---|
1261 | //---------------------------------------------------------------------- |
---|
1262 | execute(tempstr); |
---|
1263 | def motemp=imap(r,motemp); |
---|
1264 | motemp=interred(motemp); |
---|
1265 | setring r; |
---|
1266 | kill motemp; |
---|
1267 | def motemp=imap(rtemp,motemp); |
---|
1268 | list ret=monmat,motemp,monmat*motemp; |
---|
1269 | for(i=1;i<=ncols(ret[2]);i++) |
---|
1270 | { |
---|
1271 | ret[2][i]=cleardenom(ret[2][i]); |
---|
1272 | } |
---|
1273 | for(i=1;i<=ncols(ret[3]);i++) |
---|
1274 | { |
---|
1275 | ret[3][i]=cleardenom(ret[3][i]); |
---|
1276 | } |
---|
1277 | return(ret); |
---|
1278 | } |
---|
1279 | example |
---|
1280 | { "EXAMPLE:"; echo=2; |
---|
1281 | ring r=0,(x,y,z),dp; |
---|
1282 | ideal i=x^2+x*y^2,x*y+x^2*y,z; |
---|
1283 | ideal j=x^2+x*y^2,x*y,z; |
---|
1284 | ideal mon=x^2,z,x*y; |
---|
1285 | intvec iv=1,3; |
---|
1286 | subrInterred(mon,i,iv); |
---|
1287 | subrInterred(mon,j,iv); |
---|
1288 | } |
---|
1289 | //////////////////////////////////////////////////////////////////////// |
---|