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