1 | /////////////////////////////////////////////////////////////////////////////// |
---|
2 | // normal.lib |
---|
3 | // algorithms for computing the normalization based on |
---|
4 | // the ideas of De Jong,Vasconcelos |
---|
5 | // written by Gert-Martin Greuel and Gerhard Pfister |
---|
6 | /////////////////////////////////////////////////////////////////////////////// |
---|
7 | |
---|
8 | version="$Id: normal.lib,v 1.10 1998-08-26 09:56:40 obachman Exp $"; |
---|
9 | info=" |
---|
10 | LIBRARY: normal.lib: PROCEDURE FOR NORMALIZATION (I) |
---|
11 | |
---|
12 | normal(ideal I) |
---|
13 | // computes a set of rings such that their product is the |
---|
14 | // normalization of the reduced basering/I |
---|
15 | "; |
---|
16 | |
---|
17 | LIB "sing.lib"; |
---|
18 | LIB "primdec.lib"; |
---|
19 | LIB "elim.lib"; |
---|
20 | LIB "presolve.lib"; |
---|
21 | /////////////////////////////////////////////////////////////////////////////// |
---|
22 | |
---|
23 | proc isR_HomJR (list Li) |
---|
24 | "USAGE: isR_HomJR (Li); Li = list: ideal SBid, ideal J, poly p |
---|
25 | COMPUTE: module Hom_R(J,R) = R:J and compare with R |
---|
26 | ASSUME: R = P/SBid, P = basering |
---|
27 | SBid = standard basis of an ideal in P, |
---|
28 | J = ideal in P containing the polynomial p, |
---|
29 | p = nonzero divisor of R |
---|
30 | RETURN: 1 if R = R:J, 0 if not |
---|
31 | EXAMPLE: example isR_HomJR; shows an example |
---|
32 | " |
---|
33 | { |
---|
34 | int n, ii; |
---|
35 | def P = basering; |
---|
36 | ideal SBid = Li[1]; |
---|
37 | ideal J = Li[2]; |
---|
38 | poly p = Li[3]; |
---|
39 | attrib(SBid,"isSB",1); |
---|
40 | attrib(p,"isSB",1); |
---|
41 | qring R = SBid; |
---|
42 | ideal J = fetch(P,J); |
---|
43 | poly p = fetch(P,p); |
---|
44 | ideal f = quotient(p,J); |
---|
45 | ideal lp = std(p); |
---|
46 | n=1; |
---|
47 | for (ii=1; ii<=size(f); ii++ ) |
---|
48 | { |
---|
49 | if ( reduce(f[ii],lp) != 0) |
---|
50 | { n = 0; break; } |
---|
51 | } |
---|
52 | return (n); |
---|
53 | //?spaeter hier einen Test ob Hom(I,R) = Hom(I,I)? |
---|
54 | } |
---|
55 | example |
---|
56 | {"EXAMPLE:"; echo = 2; |
---|
57 | ring r = 0,(x,y,z),dp; |
---|
58 | ideal id = y7-x5+z2; |
---|
59 | ideal J = x3,y+z; |
---|
60 | poly p = xy; |
---|
61 | list Li = std(id),J,p; |
---|
62 | isR_HomJR (Li); |
---|
63 | |
---|
64 | ring s = 0,(t,x,y),dp; |
---|
65 | ideal id = x2-y2*(y-t); |
---|
66 | ideal J = jacob(id); |
---|
67 | poly p = J[1]; |
---|
68 | list Li = std(id),J,p; |
---|
69 | isR_HomJR (Li); |
---|
70 | } |
---|
71 | /////////////////////////////////////////////////////////////////////////////// |
---|
72 | |
---|
73 | proc extraweight (list # ) |
---|
74 | "USAGE: extraweight (P); P=name of an existing ring (true name, not a string) |
---|
75 | RETURN: intvec, size=nvars(P), consisting of the weights of the variables of P |
---|
76 | NOTE: This is useful when enlarging P but keeping the weights of the old |
---|
77 | variables |
---|
78 | EXAMPLE: example extraweight; shows an example |
---|
79 | " |
---|
80 | { |
---|
81 | int ii,q,fi,fo,fia; |
---|
82 | intvec rw,nw; |
---|
83 | string os; |
---|
84 | def P = #[1]; |
---|
85 | string osP = ordstr(P); |
---|
86 | fo = 1; |
---|
87 | //------------------------- find weights in ordstr(P) ------------------------- |
---|
88 | fi = find(osP,"(",fo); |
---|
89 | fia = find(osP,"a",fo)+find(osP,"w",fo)+find(osP,"W",fo); |
---|
90 | while ( fia ) |
---|
91 | { |
---|
92 | os = osP[fi+1,find(osP,")",fi)-fi-1]; |
---|
93 | if( find(os,",") ) |
---|
94 | { |
---|
95 | execute "nw = "+os+";"; |
---|
96 | if( size(nw) > ii ) |
---|
97 | { |
---|
98 | rw = rw,nw[ii+1..size(nw)]; |
---|
99 | } |
---|
100 | else { ii = ii - size(nw); } |
---|
101 | |
---|
102 | if( find(osP[1,fi],"a",fo) ) { ii = size(nw); } |
---|
103 | } |
---|
104 | else |
---|
105 | { |
---|
106 | execute "q = "+os+";"; |
---|
107 | if( q > ii ) |
---|
108 | { |
---|
109 | nw = 0; nw[q-ii] = 0; |
---|
110 | nw = nw + 1; //creates an intvec 1,...,1 of length q-ii |
---|
111 | rw = rw,nw; |
---|
112 | } |
---|
113 | else { ii = ii - q; } |
---|
114 | } |
---|
115 | fo = fi+1; |
---|
116 | fi = find(osP,"(",fo); |
---|
117 | fia = find(osP,"a",fo)+find(osP,"w",fo)+find(osP,"W",fo); |
---|
118 | } |
---|
119 | //-------------- adjust weight vector to length = nvars(P) ------------------- |
---|
120 | if( fo > 1 ) |
---|
121 | { // case when weights were found |
---|
122 | rw = rw[2..size(rw)]; |
---|
123 | if( size(rw) > nvars(P) ) |
---|
124 | { |
---|
125 | rw = rw[1..nvars(P)]; |
---|
126 | } |
---|
127 | if( size(rw) < nvars(P) ) |
---|
128 | { |
---|
129 | nw=0; nw[nvars(P)-size(rw)]=0; nw=nw+1; rw=rw,nw; |
---|
130 | } |
---|
131 | } |
---|
132 | else |
---|
133 | { // case when no weights were found |
---|
134 | rw[nvars(P)]= 0; rw=rw+1; |
---|
135 | } |
---|
136 | return(rw); |
---|
137 | } |
---|
138 | example |
---|
139 | {"EXAMPLE:"; echo = 2; |
---|
140 | ring r0 = 0,(x,y,z),dp; |
---|
141 | extraweight(r0); |
---|
142 | ring r1 = 0,x(1..5),(ds(3),wp(2,3)); |
---|
143 | extraweight(r1); |
---|
144 | ring r2 = 0,x(1..5),(a(1,2,3,0),dp); |
---|
145 | extraweight(r2); |
---|
146 | ring r3 = 0,x(1..10),(a(1..5),dp(5),a(10..13),Wp(5..9)); |
---|
147 | extraweight(r3); |
---|
148 | // an example for enlarging the ring: |
---|
149 | intvec v = 6,2,3,4,5; |
---|
150 | ring R = 0,x(1..10),(a(extraweight(r1),v),dp); |
---|
151 | ordstr(R); |
---|
152 | } |
---|
153 | /////////////////////////////////////////////////////////////////////////////// |
---|
154 | |
---|
155 | proc HomJJ (list Li,list #) |
---|
156 | "USAGE: HomJJ (Li); Li = list: SBid,id,J,poly p |
---|
157 | ASSUME: R = P/id, P = basering, a polynomial ring, id an ideal of P, |
---|
158 | SBid = standard basis of id, |
---|
159 | J = ideal of P containing the polynomial p, |
---|
160 | p = nonzero divisor of R |
---|
161 | COMPUTE: Endomorphism ring End_R(J)=Hom_R(J,J) with its ring structure where |
---|
162 | R is the quotient ring of P modulo the standard basis SBid |
---|
163 | RETURN: a list of two objects |
---|
164 | _[1]: a polynomial ring, containing two ideals, 'endid' and 'endphi' |
---|
165 | s.t. _[1]/endid = Hom_R(J,J) and |
---|
166 | endphi describes the canonical map R -> Hom_R(J,J) |
---|
167 | _[2]: an integer which is 1 if phi is an isomorphism, 0 if not |
---|
168 | EXAMPLE: example HomJJ; shows an example |
---|
169 | " |
---|
170 | { |
---|
171 | //---------- initialisation --------------------------------------------------- |
---|
172 | |
---|
173 | int isIso,isPr,isCo,isRe,isEq,ii,jj,q,y; |
---|
174 | intvec rw,rw1; |
---|
175 | list L; |
---|
176 | if( size(#) >=1 ) |
---|
177 | { |
---|
178 | if( typeof(#[1]) == "int" ) { y = #[1]; } |
---|
179 | } |
---|
180 | def P = basering; |
---|
181 | ideal SBid, id, J = Li[1], Li[2], Li[3]; |
---|
182 | poly p = Li[4]; |
---|
183 | attrib(SBid,"isSB",1); |
---|
184 | int homo = homog(Li[2]); //is 1 if id is homogeneous, 0 if not |
---|
185 | |
---|
186 | //---- set attributes for special cases where algorithm can be simplified ----- |
---|
187 | if( homo==1 ) |
---|
188 | { |
---|
189 | rw = extraweight(P); |
---|
190 | } |
---|
191 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
192 | { |
---|
193 | if(attrib(id,"isPrim")==1) { isPr=1; } |
---|
194 | } |
---|
195 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
196 | { |
---|
197 | if(attrib(id,"isIsolatedSingularity")==1) { isIso=1; } |
---|
198 | } |
---|
199 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
200 | { |
---|
201 | if(attrib(id,"isCohenMacaulay")==1) { isCo=1; } |
---|
202 | } |
---|
203 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
204 | { |
---|
205 | if(attrib(id,"isRegInCodim2")==1) { isRe=1; } |
---|
206 | } |
---|
207 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
208 | { |
---|
209 | if(attrib(id,"isEquidimensional")==1) { isEq=1; } |
---|
210 | } |
---|
211 | //-------------------------- go to quotient ring ------------------------------ |
---|
212 | qring R = SBid; |
---|
213 | ideal id = fetch(P,id); |
---|
214 | ideal J = fetch(P,J); |
---|
215 | poly p = fetch(P,p); |
---|
216 | ideal f,rf,f2; |
---|
217 | module syzf; |
---|
218 | |
---|
219 | //---------- computation of p*Hom(J,J) as R-ideal ----------------------------- |
---|
220 | f = quotient(p*J,J); |
---|
221 | if(y==1) |
---|
222 | { |
---|
223 | "the module Hom(rad(J),rad(J)) presented by the values on"; |
---|
224 | "the non-zerodivisor"; |
---|
225 | " "; |
---|
226 | p; |
---|
227 | " "; |
---|
228 | f; |
---|
229 | } |
---|
230 | f2 = std(p); |
---|
231 | |
---|
232 | if(isIso==0) |
---|
233 | { |
---|
234 | ideal f1=std(f); |
---|
235 | attrib(f1,"isSB",1); |
---|
236 | // if( codim(f1,f2) >= 0 ) |
---|
237 | // { |
---|
238 | // dbprint(printlevel-voice+3,"// dimension of non-normal locus is zero"); |
---|
239 | // isIso=1; |
---|
240 | // } |
---|
241 | } |
---|
242 | //---------- Test: Hom(J,J) == R ?, if yes, go home --------------------------- |
---|
243 | rf = interred(reduce(f,f2)); // represents p*Hom(J,J)/p*R = Hom(J,J)/R |
---|
244 | if ( size(rf) == 0 ) |
---|
245 | { |
---|
246 | if ( homog(f) && find(ordstr(basering),"s")==0 ) |
---|
247 | { |
---|
248 | ring newR1 = char(P),(X(1..nvars(P))),(a(rw),dp); |
---|
249 | } |
---|
250 | else |
---|
251 | { |
---|
252 | ring newR1 = char(P),(X(1..nvars(P))),dp; |
---|
253 | } |
---|
254 | ideal endphi = maxideal(1); |
---|
255 | ideal endid = fetch(P,id); |
---|
256 | L=substpart(endid,endphi,homo,rw); |
---|
257 | def lastRing=L[1]; |
---|
258 | setring lastRing; |
---|
259 | |
---|
260 | attrib(endid,"isCohenMacaulay",isCo); |
---|
261 | attrib(endid,"isPrim",isPr); |
---|
262 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
263 | attrib(endid,"isRegInCodim2",isRe); |
---|
264 | attrib(endid,"isEqudimensional",isEq); |
---|
265 | attrib(endid,"isCompleteIntersection",0); |
---|
266 | attrib(endid,"isRad",0); |
---|
267 | // export endid; |
---|
268 | // export endphi; |
---|
269 | // L = newR1; |
---|
270 | L=lastRing; |
---|
271 | L = insert(L,1,1); |
---|
272 | dbprint(printlevel-voice+3,"// case R = Hom(J,J)"); |
---|
273 | if(y==1) |
---|
274 | { |
---|
275 | "R=Hom(rad(J),rad(J))"; |
---|
276 | " "; |
---|
277 | lastRing; |
---|
278 | " "; |
---|
279 | "the new ideal"; |
---|
280 | endid; |
---|
281 | " "; |
---|
282 | "the old ring"; |
---|
283 | " "; |
---|
284 | P; |
---|
285 | " "; |
---|
286 | "the old ideal"; |
---|
287 | " "; |
---|
288 | setring P; |
---|
289 | id; |
---|
290 | " "; |
---|
291 | setring lastRing; |
---|
292 | "the map"; |
---|
293 | " "; |
---|
294 | endphi; |
---|
295 | " "; |
---|
296 | pause; |
---|
297 | } |
---|
298 | setring P; |
---|
299 | return(L); |
---|
300 | } |
---|
301 | if(y==1) |
---|
302 | { |
---|
303 | "R is not equal to Hom(rad(J),rad(J)), we have to try again"; |
---|
304 | pause; |
---|
305 | } |
---|
306 | //---------- Hom(J,j) != R: create new ring and map form old ring ------------- |
---|
307 | // the ring newR1/SBid+syzf will be isomorphic to Hom(J,J) as R-module |
---|
308 | |
---|
309 | f = p,rf; // generates pJ:J mod(p), i.e. p*Hom(J,J)/p*R as R-module |
---|
310 | q = size(f); |
---|
311 | syzf = syz(f); |
---|
312 | |
---|
313 | if ( homo==1 ) |
---|
314 | { |
---|
315 | rw1 = rw,0; |
---|
316 | for ( ii=2; ii<=q; ii++ ) |
---|
317 | { |
---|
318 | rw = rw, deg(f[ii])-deg(f[1]); |
---|
319 | rw1 = rw1, deg(f[ii])-deg(f[1]); |
---|
320 | } |
---|
321 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),(a(rw1),dp); |
---|
322 | } |
---|
323 | else |
---|
324 | { |
---|
325 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),dp; |
---|
326 | } |
---|
327 | |
---|
328 | map psi1 = P,maxideal(1); |
---|
329 | ideal SBid = psi1(SBid); |
---|
330 | attrib(SBid,"isSB",1); |
---|
331 | |
---|
332 | qring newR = std(SBid); |
---|
333 | map psi = R,ideal(X(1..nvars(R))); |
---|
334 | ideal id = psi(id); |
---|
335 | ideal f = psi(f); |
---|
336 | module syzf = psi(syzf); |
---|
337 | ideal pf,Lin,Quad,Q; |
---|
338 | matrix T,A; |
---|
339 | list L1; |
---|
340 | |
---|
341 | //---------- computation of Hom(J,J) as ring ---------------------------------- |
---|
342 | // determine kernel of: R[T1,...,Tq] -> J:J >-> R[1/p]=R[t]/(t*p-1), |
---|
343 | // Ti -> fi/p -> t*fi (p=f1=f[1]), to get ring structure. This is of course |
---|
344 | // the same as the kernel of R[T1,...,Tq] -> pJ:J >-> R, Ti -> fi. |
---|
345 | // It is a fact, that the kernel is generated by the linear and the quadratic |
---|
346 | // relations |
---|
347 | |
---|
348 | pf = f[1]*f; |
---|
349 | T = matrix(ideal(T(1..q)),1,q); |
---|
350 | Lin = ideal(T*syzf); |
---|
351 | if(y==1) |
---|
352 | { |
---|
353 | "the ring structure of Hom(rad(J),rad(J)) as R-algebra"; |
---|
354 | " "; |
---|
355 | "the linear relations"; |
---|
356 | " "; |
---|
357 | Lin; |
---|
358 | " "; |
---|
359 | } |
---|
360 | for (ii=2; ii<=q; ii++ ) |
---|
361 | { |
---|
362 | for ( jj=2; jj<=ii; jj++ ) |
---|
363 | { |
---|
364 | A = lift(pf,f[ii]*f[jj]); |
---|
365 | Quad = Quad, ideal(T(jj)*T(ii) - T*A); // quadratic relations |
---|
366 | } |
---|
367 | } |
---|
368 | if(y==1) |
---|
369 | { |
---|
370 | "the quadratic relations"; |
---|
371 | " "; |
---|
372 | interred(Quad); |
---|
373 | pause; |
---|
374 | } |
---|
375 | Q = Lin+Quad; |
---|
376 | Q = subst(Q,T(1),1); |
---|
377 | Q = interred(reduce(Q,std(0))); |
---|
378 | //---------- reduce number of variables by substitution, if possible ---------- |
---|
379 | if (homo==1) |
---|
380 | { |
---|
381 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),(a(rw),dp); |
---|
382 | } |
---|
383 | else |
---|
384 | { |
---|
385 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),dp; |
---|
386 | } |
---|
387 | |
---|
388 | ideal endid = imap(newR,id)+imap(newR,Q); |
---|
389 | ideal endphi = ideal(X(1..nvars(R))); |
---|
390 | |
---|
391 | L=substpart(endid,endphi,homo,rw); |
---|
392 | def lastRing=L[1]; |
---|
393 | setring lastRing; |
---|
394 | attrib(endid,"isCohenMacaulay",isCo); |
---|
395 | attrib(endid,"isPrim",isPr); |
---|
396 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
397 | attrib(endid,"isRegInCodim2",isRe); |
---|
398 | attrib(endid,"isEquidimensional",isEq); |
---|
399 | attrib(endid,"isCompleteIntersection",0); |
---|
400 | attrib(endid,"isRad",0); |
---|
401 | // export(endid); |
---|
402 | // export(endphi); |
---|
403 | if(y==1) |
---|
404 | { |
---|
405 | "the new ring after reduction of the number of variables"; |
---|
406 | " "; |
---|
407 | lastRing; |
---|
408 | " "; |
---|
409 | "the new ideal"; |
---|
410 | endid; |
---|
411 | " "; |
---|
412 | "the old ring"; |
---|
413 | " "; |
---|
414 | P; |
---|
415 | " "; |
---|
416 | "the old ideal"; |
---|
417 | " "; |
---|
418 | setring P; |
---|
419 | id; |
---|
420 | " "; |
---|
421 | setring lastRing; |
---|
422 | "the map"; |
---|
423 | " "; |
---|
424 | endphi; |
---|
425 | " "; |
---|
426 | pause; |
---|
427 | } |
---|
428 | L = lastRing; |
---|
429 | L = insert(L,0,1); |
---|
430 | return(L); |
---|
431 | } |
---|
432 | example |
---|
433 | {"EXAMPLE:"; echo = 2; |
---|
434 | ring r = 0,(x,y),wp(2,3); |
---|
435 | ideal id = y^2-x^3; |
---|
436 | ideal J = x,y; |
---|
437 | poly p = x; |
---|
438 | list Li = std(id),id,J,p; |
---|
439 | list L = HomJJ(Li); |
---|
440 | def end = L[1]; // defines ring L[1], containing ideals endid and endphi |
---|
441 | setring end; // makes end the basering |
---|
442 | end; |
---|
443 | endid; // end/endid is isomorphic to End(r/id) as ring |
---|
444 | map psi = r,endphi; // defines the canonical map r/id -> End(r/id) |
---|
445 | psi; |
---|
446 | |
---|
447 | ring r = 32003,(x,y,z),dp; |
---|
448 | ideal id = x2-xy-xz+yz; |
---|
449 | ideal J =y-z,x-z; |
---|
450 | poly p = x+16001y+16001z; |
---|
451 | list Li = std(id),id,J,p; |
---|
452 | list L = HomJJ(Li,0); |
---|
453 | def end = L[1]; // defines ring L[1], containing ideals endid and endphi |
---|
454 | setring end; // makes end the basering |
---|
455 | end; |
---|
456 | endid; // end/endid is isomorphic to End(r/id) as ring |
---|
457 | |
---|
458 | } |
---|
459 | |
---|
460 | /////////////////////////////////////////////////////////////////////////////// |
---|
461 | proc normal(ideal id, list #) |
---|
462 | "USAGE: normal(i,choose); i ideal,choose empty or 1 |
---|
463 | in case you choose 1 the factorizing Buchberger algorithm |
---|
464 | is not used which is sometimes more efficient |
---|
465 | RETURN: a list of rings L=R1,...,Rk, in each Ri are two ideals |
---|
466 | Si,Mi such that the product of Ri/Mi is the normalization |
---|
467 | Si is a standardbasis of Mi |
---|
468 | NOTE: to use the rings: def r=L[i];setring r; |
---|
469 | EXAMPLE: example normal; shows an example |
---|
470 | " |
---|
471 | { |
---|
472 | int i,j,y; |
---|
473 | list result,prim,keepresult; |
---|
474 | |
---|
475 | if(size(#)==0) |
---|
476 | { |
---|
477 | prim[1]=id; |
---|
478 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
479 | { |
---|
480 | if(attrib(id,"isEquidimensional")==1) |
---|
481 | { |
---|
482 | attrib(prim[1],"isEquidimensional",1); |
---|
483 | } |
---|
484 | } |
---|
485 | else |
---|
486 | { |
---|
487 | attrib(prim[1],"isEquidimensional",0); |
---|
488 | } |
---|
489 | if( typeof(attrib(id,"isCompleteIntersection"))=="int" ) |
---|
490 | { |
---|
491 | if(attrib(id,"isCompleteIntersection")==1) |
---|
492 | { |
---|
493 | attrib(prim[1],"isCompleteIntersection",1); |
---|
494 | } |
---|
495 | } |
---|
496 | else |
---|
497 | { |
---|
498 | attrib(prim[1],"isCompleteIntersection",0); |
---|
499 | } |
---|
500 | |
---|
501 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
502 | { |
---|
503 | if(attrib(id,"isPrim")==1) {attrib(prim[1],"isPrim",1); } |
---|
504 | } |
---|
505 | else |
---|
506 | { |
---|
507 | attrib(prim[1],"isPrim",0); |
---|
508 | } |
---|
509 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
510 | { |
---|
511 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
512 | {attrib(prim[1],"isIsolatedSingularity",1); } |
---|
513 | } |
---|
514 | else |
---|
515 | { |
---|
516 | attrib(prim[1],"isIsolatedSingularity",0); |
---|
517 | } |
---|
518 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
519 | { |
---|
520 | if(attrib(id,"isCohenMacaulay")==1) |
---|
521 | { attrib(prim[1],"isCohenMacaulay",1); } |
---|
522 | } |
---|
523 | else |
---|
524 | { |
---|
525 | attrib(prim[1],"isCohenMacaulay",0); |
---|
526 | } |
---|
527 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
528 | { |
---|
529 | if(attrib(id,"isRegInCodim2")==1) |
---|
530 | { attrib(prim[1],"isRegInCodim2",1);} |
---|
531 | } |
---|
532 | else |
---|
533 | { |
---|
534 | attrib(prim[1],"isRegInCodim2",0); |
---|
535 | } |
---|
536 | return(normalizationPrimes(prim[1],maxideal(1))); |
---|
537 | } |
---|
538 | else |
---|
539 | { |
---|
540 | if(#[1]==0) |
---|
541 | { |
---|
542 | prim=minAssPrimes(id); |
---|
543 | } |
---|
544 | else |
---|
545 | { |
---|
546 | prim=minAssPrimes(id,1); |
---|
547 | } |
---|
548 | |
---|
549 | if(y==1) |
---|
550 | { |
---|
551 | "we have ";size(prim);"components"; |
---|
552 | } |
---|
553 | for(i=1;i<=size(prim);i++) |
---|
554 | { |
---|
555 | if(y==1) |
---|
556 | { |
---|
557 | "we are in loop";i; |
---|
558 | } |
---|
559 | attrib(prim[i],"isCohenMacaulay",0); |
---|
560 | attrib(prim[i],"isPrim",1); |
---|
561 | attrib(prim[i],"isRegInCodim2",0); |
---|
562 | attrib(prim[i],"isIsolatedSingularity",0); |
---|
563 | attrib(prim[i],"isEquidimensional",0); |
---|
564 | attrib(prim[i],"isCompleteIntersection",0); |
---|
565 | |
---|
566 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
567 | { |
---|
568 | if(attrib(id,"isEquidimensional")==1) |
---|
569 | { |
---|
570 | attrib(prim[i],"isEquidimensional",1); |
---|
571 | } |
---|
572 | } |
---|
573 | else |
---|
574 | { |
---|
575 | attrib(prim[i],"isEquidimensional",0); |
---|
576 | } |
---|
577 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
578 | { |
---|
579 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
580 | {attrib(prim[i],"isIsolatedSingularity",1); } |
---|
581 | } |
---|
582 | else |
---|
583 | { |
---|
584 | attrib(prim[i],"isIsolatedSingularity",0); |
---|
585 | } |
---|
586 | |
---|
587 | keepresult=normalizationPrimes(prim[i],maxideal(1)); |
---|
588 | for(j=1;j<=size(keepresult);j++) |
---|
589 | { |
---|
590 | result=insert(result,keepresult[j]); |
---|
591 | } |
---|
592 | } |
---|
593 | return(result); |
---|
594 | } |
---|
595 | } |
---|
596 | example |
---|
597 | { "EXAMPLE:"; echo = 2; |
---|
598 | ring r = 0,(x,y,z),dp; |
---|
599 | |
---|
600 | } |
---|
601 | |
---|
602 | |
---|
603 | proc normalizationPrimes(ideal i,ideal ihp, list #) |
---|
604 | "USAGE: normalizationPrimes(i); i prime ideal |
---|
605 | RETURN: a list of one ring L=R, in R are two ideals |
---|
606 | S,M such that R/M is the normalization |
---|
607 | S is a standardbasis of M |
---|
608 | NOTE: to use the ring: def r=L[1];setring r; |
---|
609 | EXAMPLE: example normalizationPrimes; shows an example |
---|
610 | " |
---|
611 | { |
---|
612 | int y; |
---|
613 | if(y==1) |
---|
614 | { |
---|
615 | "START one normalization loop with the ideal"; |
---|
616 | " "; |
---|
617 | i; |
---|
618 | " "; |
---|
619 | basering; |
---|
620 | " "; |
---|
621 | pause; |
---|
622 | } |
---|
623 | |
---|
624 | def BAS=basering; |
---|
625 | list result,keepresult1,keepresult2; |
---|
626 | ideal J,SB,MB,KK; |
---|
627 | int depth,lauf,prdim; |
---|
628 | int ti=timer; |
---|
629 | |
---|
630 | if(size(i)==0) |
---|
631 | { |
---|
632 | if(y==1) |
---|
633 | { |
---|
634 | "the ideal was the zero-ideal"; |
---|
635 | } |
---|
636 | execute "ring newR7="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
637 | +ordstr(basering)+");"; |
---|
638 | ideal KK=ideal(0); |
---|
639 | ideal PP=fetch(BAS,ihp); |
---|
640 | export PP; |
---|
641 | export KK; |
---|
642 | result=newR7; |
---|
643 | setring BAS; |
---|
644 | return(result); |
---|
645 | |
---|
646 | } |
---|
647 | |
---|
648 | if(y==1) |
---|
649 | { |
---|
650 | " "; |
---|
651 | " "; |
---|
652 | " SB-computation of the input ideal"; |
---|
653 | " "; |
---|
654 | } |
---|
655 | list SM=mstd(i); |
---|
656 | |
---|
657 | if(y==1) |
---|
658 | { |
---|
659 | " the dimension is "; |
---|
660 | dim(SM[1]); |
---|
661 | " "; |
---|
662 | } |
---|
663 | |
---|
664 | if(size(#)>0) |
---|
665 | { |
---|
666 | list JM=#[1],#[1]; |
---|
667 | attrib(JM[1],"isSB",1); |
---|
668 | if( typeof(attrib(#[1],"isRad"))!="int" ) |
---|
669 | { |
---|
670 | attrib(JM[2],"isRad",0); |
---|
671 | } |
---|
672 | } |
---|
673 | |
---|
674 | if(attrib(i,"isPrim")==1) |
---|
675 | { |
---|
676 | attrib(SM[2],"isPrim",1); |
---|
677 | } |
---|
678 | else |
---|
679 | { |
---|
680 | attrib(SM[2],"isPrim",0); |
---|
681 | } |
---|
682 | if(attrib(i,"isIsolatedSingularity")==1) |
---|
683 | { |
---|
684 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
685 | } |
---|
686 | else |
---|
687 | { |
---|
688 | attrib(SM[2],"isIsolatedSingularity",0); |
---|
689 | } |
---|
690 | if(attrib(i,"isCohenMacaulay")==1) |
---|
691 | { |
---|
692 | attrib(SM[2],"isCohenMacaulay",1); |
---|
693 | } |
---|
694 | else |
---|
695 | { |
---|
696 | attrib(SM[2],"isCohenMacaulay",0); |
---|
697 | } |
---|
698 | if(attrib(i,"isRegInCodim2")==1) |
---|
699 | { |
---|
700 | attrib(SM[2],"isRegInCodim2",1); |
---|
701 | } |
---|
702 | else |
---|
703 | { |
---|
704 | attrib(SM[2],"isRegInCodim2",0); |
---|
705 | } |
---|
706 | if(attrib(i,"isEquidimensional")==1) |
---|
707 | { |
---|
708 | attrib(SM[2],"isEquidimensional",1); |
---|
709 | } |
---|
710 | else |
---|
711 | { |
---|
712 | attrib(SM[2],"isEquidimensional",0); |
---|
713 | } |
---|
714 | if(attrib(i,"isCompleteIntersection")==1) |
---|
715 | { |
---|
716 | attrib(SM[2],"isCompleteIntersection",1); |
---|
717 | } |
---|
718 | else |
---|
719 | { |
---|
720 | attrib(SM[2],"isCompleteIntersection",0); |
---|
721 | } |
---|
722 | |
---|
723 | //the smooth case |
---|
724 | if(size(#)>0) |
---|
725 | { |
---|
726 | if(dim(JM[1])==-1) |
---|
727 | { |
---|
728 | if(y==1) |
---|
729 | { |
---|
730 | "the ideal was smooth"; |
---|
731 | } |
---|
732 | MB=SM[2]; |
---|
733 | intvec rw; |
---|
734 | list LL=substpart(MB,ihp,0,rw); |
---|
735 | def newR6=LL[1]; |
---|
736 | setring newR6; |
---|
737 | ideal KK=endid; |
---|
738 | ideal PP=endphi; |
---|
739 | // execute "ring newR6="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
740 | // +ordstr(basering)+");"; |
---|
741 | // ideal KK=fetch(BAS,MB); |
---|
742 | // ideal PP=fetch(BAS,ihp); |
---|
743 | export PP; |
---|
744 | export KK; |
---|
745 | result=newR6; |
---|
746 | setring BAS; |
---|
747 | return(result); |
---|
748 | } |
---|
749 | } |
---|
750 | |
---|
751 | //the zero-dimensional case |
---|
752 | if((dim(SM[1])==0)&&(homog(SM[2])==1)) |
---|
753 | { |
---|
754 | if(y==1) |
---|
755 | { |
---|
756 | "the ideal was zero-dimensional and homogeneous"; |
---|
757 | } |
---|
758 | MB=maxideal(1); |
---|
759 | intvec rw; |
---|
760 | list LL=substpart(MB,ihp,0,rw); |
---|
761 | def newR5=LL[1]; |
---|
762 | setring newR5; |
---|
763 | ideal KK=endid; |
---|
764 | ideal PP=endphi; |
---|
765 | // execute "ring newR5="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
766 | // +ordstr(basering)+");"; |
---|
767 | // ideal KK=fetch(BAS,MB); |
---|
768 | // ideal PP=fetch(BAS,ihp); |
---|
769 | export PP; |
---|
770 | export KK; |
---|
771 | result=newR5; |
---|
772 | setring BAS; |
---|
773 | return(result); |
---|
774 | } |
---|
775 | |
---|
776 | //the one-dimensional case |
---|
777 | //in this case it is a line because |
---|
778 | //it is irreducible and homogeneous |
---|
779 | if((dim(SM[1])==1)&&(attrib(SM[2],"isPrim")==1) |
---|
780 | &&(homog(SM[2])==1)) |
---|
781 | { |
---|
782 | if(y==1) |
---|
783 | { |
---|
784 | "the ideal defines a line"; |
---|
785 | } |
---|
786 | MB=SM[2]; |
---|
787 | intvec rw; |
---|
788 | list LL=substpart(MB,ihp,0,rw); |
---|
789 | def newR4=LL[1]; |
---|
790 | setring newR4; |
---|
791 | ideal KK=endid; |
---|
792 | ideal PP=endphi; |
---|
793 | // execute "ring newR4="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
794 | // +ordstr(basering)+");"; |
---|
795 | // ideal KK=fetch(BAS,MB); |
---|
796 | // ideal PP=fetch(BAS,ihp); |
---|
797 | export PP; |
---|
798 | export KK; |
---|
799 | result=newR4; |
---|
800 | setring BAS; |
---|
801 | return(result); |
---|
802 | } |
---|
803 | |
---|
804 | //the higher dimensional case |
---|
805 | //we test first of all CohenMacaulay and |
---|
806 | //complete intersection |
---|
807 | if(((size(SM[2])+dim(SM[1]))==nvars(basering))&&(homog(SM[2])==1)) |
---|
808 | { |
---|
809 | //test for complete intersection |
---|
810 | attrib(SM[2],"isCohenMacaulay",1); |
---|
811 | attrib(SM[2],"isCompleteIntersection",1); |
---|
812 | attrib(SM[2],"isEquidimensional",1); |
---|
813 | if(y==1) |
---|
814 | { |
---|
815 | "it is a complete Intersection"; |
---|
816 | } |
---|
817 | } |
---|
818 | // if(attrib(i,"isIsolatedSingularity")==0) |
---|
819 | // { |
---|
820 | // list L=sres(SM[2],0); |
---|
821 | // prdim=ncols(betti(L))-1; |
---|
822 | // depth=nvars(basering)-prdim; |
---|
823 | // } |
---|
824 | |
---|
825 | // if(attrib(SM[2],"isCohenMacaulay")==0) |
---|
826 | // { |
---|
827 | // test for CohenMacaulay |
---|
828 | // if((dim(SM[1]))==depth) |
---|
829 | // { |
---|
830 | // attrib(SM[2],"isCohenMacaulay",1); |
---|
831 | // "it is CohenMacaulay"; |
---|
832 | // } |
---|
833 | // } |
---|
834 | |
---|
835 | //compute the singular locus+lower dimensional components |
---|
836 | if(((attrib(SM[2],"isIsolatedSingularity")==0)||(homog(SM[2])==0)) |
---|
837 | &&(size(#)==0)) |
---|
838 | { |
---|
839 | |
---|
840 | J=minor(jacob(SM[2]),nvars(basering)-dim(SM[1])); |
---|
841 | //ti=timer; |
---|
842 | if(y==1) |
---|
843 | { |
---|
844 | "SB of singular locus will be computed"; |
---|
845 | } |
---|
846 | ideal sin=J+SM[2]; |
---|
847 | |
---|
848 | //kills the embeded components |
---|
849 | // if(homog(SM[2])==1) |
---|
850 | // { |
---|
851 | // sin=sat(sin,maxideal(1))[1]; |
---|
852 | // } |
---|
853 | |
---|
854 | list JM=mstd(sin); |
---|
855 | if(y==1) |
---|
856 | { |
---|
857 | " "; |
---|
858 | "the dimension of the singular locus is"; |
---|
859 | dim(JM[1]); |
---|
860 | " "; |
---|
861 | } |
---|
862 | |
---|
863 | attrib(JM[2],"isRad",0); |
---|
864 | // timer-ti; |
---|
865 | attrib(JM[1],"isSB",1); |
---|
866 | if(dim(JM[1])==-1) |
---|
867 | { |
---|
868 | if(y==1) |
---|
869 | { |
---|
870 | "it is smooth"; |
---|
871 | } |
---|
872 | MB=SM[2]; |
---|
873 | intvec rw; |
---|
874 | list LL=substpart(MB,ihp,0,rw); |
---|
875 | // execute "ring newR3="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
876 | // +ordstr(basering)+");"; |
---|
877 | def newR3=LL[1]; |
---|
878 | setring newR3; |
---|
879 | // ideal KK=fetch(BAS,MB); |
---|
880 | // ideal PP=fetch(BAS,ihp); |
---|
881 | ideal KK=endid; |
---|
882 | ideal PP=endphi; |
---|
883 | export PP; |
---|
884 | export KK; |
---|
885 | result=newR3; |
---|
886 | setring BAS; |
---|
887 | return(result); |
---|
888 | } |
---|
889 | if(dim(JM[1])==0) |
---|
890 | { |
---|
891 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
892 | } |
---|
893 | if(dim(JM[1])<=nvars(basering)-2) |
---|
894 | { |
---|
895 | attrib(SM[2],"isRegInCodim2",1); |
---|
896 | } |
---|
897 | } |
---|
898 | else |
---|
899 | { |
---|
900 | if(size(#)==0) |
---|
901 | { |
---|
902 | list JM=maxideal(1),maxideal(1); |
---|
903 | attrib(JM[1],"isSB",1); |
---|
904 | attrib(SM[2],"isRegInCodim2",1); |
---|
905 | } |
---|
906 | } |
---|
907 | //if it is an isolated singularity things are easier |
---|
908 | if((dim(JM[1])==0)&&(homog(SM[2])==1)) |
---|
909 | { |
---|
910 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
911 | ideal SL=simplify(reduce(maxideal(1),SM[1]),2); |
---|
912 | ideal Ann=quotient(SM[2],SL[1]); |
---|
913 | ideal qAnn=simplify(reduce(Ann,SM[1]),2); |
---|
914 | |
---|
915 | if(size(qAnn)==0) |
---|
916 | { |
---|
917 | if(y==1) |
---|
918 | { |
---|
919 | " "; |
---|
920 | "the ideal rad(J): "; |
---|
921 | " "; |
---|
922 | maxideal(1); |
---|
923 | " "; |
---|
924 | " "; |
---|
925 | } |
---|
926 | //again test for normality |
---|
927 | //Hom(I,R)=R |
---|
928 | list RR; |
---|
929 | // list RR=SM[1],maxideal(1),SL[1]; |
---|
930 | // "test with Hom(I,R)"; |
---|
931 | // ti=timer; |
---|
932 | // if(isR_HomJR(RR)==1) |
---|
933 | // { |
---|
934 | // "it was normal"; |
---|
935 | // timer-ti; |
---|
936 | // SB=SM[1]; |
---|
937 | // SM=SM[2]; |
---|
938 | // export SB,MB; |
---|
939 | // result=BAS; |
---|
940 | // return(result); |
---|
941 | // } |
---|
942 | // timer-ti; |
---|
943 | RR=SM[1],SM[2],maxideal(1),SL[1]; |
---|
944 | ti=timer; |
---|
945 | RR=HomJJ(RR,y); |
---|
946 | // timer-ti; |
---|
947 | if(RR[2]==0) |
---|
948 | { |
---|
949 | def newR=RR[1]; |
---|
950 | setring newR; |
---|
951 | map psi=BAS,endphi; |
---|
952 | // ti=timer; |
---|
953 | list tluser=normalizationPrimes(endid,psi(ihp)); |
---|
954 | |
---|
955 | // timer-ti; |
---|
956 | setring BAS; |
---|
957 | return(tluser); |
---|
958 | } |
---|
959 | MB=SM[2]; |
---|
960 | execute "ring newR7="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
961 | +ordstr(basering)+");"; |
---|
962 | ideal KK=fetch(BAS,MB); |
---|
963 | ideal PP=fetch(BAS,ihp); |
---|
964 | export PP; |
---|
965 | export KK; |
---|
966 | result=newR7; |
---|
967 | setring BAS; |
---|
968 | return(result); |
---|
969 | |
---|
970 | } |
---|
971 | else |
---|
972 | { |
---|
973 | ideal id=qAnn+SM[2]; |
---|
974 | |
---|
975 | attrib(id,"isCohenMacaulay",0); |
---|
976 | attrib(id,"isPrim",0); |
---|
977 | attrib(id,"isIsolatedSingularity",1); |
---|
978 | attrib(id,"isRegInCodim2",0); |
---|
979 | attrib(id,"isCompleteIntersection",0); |
---|
980 | attrib(id,"isEquidimensional",0); |
---|
981 | |
---|
982 | keepresult1=normalizationPrimes(id,ihp); |
---|
983 | ideal id1=quotient(SM[2],Ann)+SM[2]; |
---|
984 | // evtl. qAnn nehmen |
---|
985 | // ideal id=SL[1]+SM[2]; |
---|
986 | |
---|
987 | attrib(id1,"isCohenMacaulay",0); |
---|
988 | attrib(id1,"isPrim",0); |
---|
989 | attrib(id1,"isIsolatedSingularity",1); |
---|
990 | attrib(id1,"isRegInCodim2",0); |
---|
991 | attrib(id1,"isCompleteIntersection",0); |
---|
992 | attrib(id1,"isEquidimensional",0); |
---|
993 | |
---|
994 | keepresult2=normalizationPrimes(id1,ihp); |
---|
995 | |
---|
996 | for(lauf=1;lauf<=size(keepresult2);lauf++) |
---|
997 | { |
---|
998 | keepresult1=insert(keepresult1,keepresult2[lauf]); |
---|
999 | } |
---|
1000 | return(keepresult1); |
---|
1001 | } |
---|
1002 | } |
---|
1003 | |
---|
1004 | //test for non-normality |
---|
1005 | //Hom(I,I)<>R |
---|
1006 | //we can use Hom(I,I) to continue |
---|
1007 | |
---|
1008 | ideal SL=simplify(reduce(JM[2],SM[1]),2); |
---|
1009 | ideal Ann=quotient(SM[2],SL[1]); |
---|
1010 | ideal qAnn=simplify(reduce(Ann,SM[1]),2); |
---|
1011 | |
---|
1012 | if(size(qAnn)==0) |
---|
1013 | { |
---|
1014 | list RR; |
---|
1015 | // "test with Hom(I,I) before the radical computation"; |
---|
1016 | //again test for normality |
---|
1017 | //Hom(I,R)=R |
---|
1018 | // list RR=SM[1],JM[2],SL[1]; |
---|
1019 | // "test with Hom(I,R)"; |
---|
1020 | // ti=timer; |
---|
1021 | // if(isR_HomJR(RR)==1) |
---|
1022 | // { |
---|
1023 | // "it was normal"; |
---|
1024 | // timer-ti; |
---|
1025 | // SB=SM[1]; |
---|
1026 | // SM=SM[2]; |
---|
1027 | // export SB,MB; |
---|
1028 | // result=BAS; |
---|
1029 | // return(result); |
---|
1030 | // } |
---|
1031 | // timer-ti; |
---|
1032 | |
---|
1033 | // list RR=SM[1],SM[2],JM[2],SL[1]; |
---|
1034 | // ti=timer; |
---|
1035 | list RS; |
---|
1036 | // list RS=HomJJ(RR); |
---|
1037 | // timer-ti; |
---|
1038 | // if(RS[2]==0) |
---|
1039 | // { |
---|
1040 | // "Hom(I,I) was sucessfull without radical"; |
---|
1041 | // def newR=RS[1]; |
---|
1042 | // setring newR; |
---|
1043 | // list tluser=normalizationPrimes(SM); |
---|
1044 | // setring BAS; |
---|
1045 | // return(tluser); |
---|
1046 | // } |
---|
1047 | |
---|
1048 | //now we have to compute the radical |
---|
1049 | if(y==1) |
---|
1050 | { |
---|
1051 | "radical computation"; |
---|
1052 | } |
---|
1053 | // ti=timer; |
---|
1054 | |
---|
1055 | |
---|
1056 | if((attrib(JM[2],"isRad")==0)&&(attrib(SM[2],"isEquidimensional")==0)) |
---|
1057 | { |
---|
1058 | //J=radical(JM[2]); |
---|
1059 | J=radical(SM[2]+ideal(SL[1])); |
---|
1060 | |
---|
1061 | // evtl. test auf J=SM[2]+ideal(SL[1]) dann schon normal |
---|
1062 | } |
---|
1063 | if((attrib(JM[2],"isRad")==0)&&(attrib(SM[2],"isEquidimensional")==1)) |
---|
1064 | { |
---|
1065 | ideal JJ=SM[2]+ideal(SL[1]); |
---|
1066 | // evtl. test auf J=SM[2]+ideal(SL[1]) dann schon normal |
---|
1067 | if(attrib(SM[2],"isCompleteIntersection")==0) |
---|
1068 | { |
---|
1069 | J=equiRadical(JM[2]); |
---|
1070 | //J=equiRadical(JJ); |
---|
1071 | } |
---|
1072 | else |
---|
1073 | { |
---|
1074 | //J=radical(JM[2]); |
---|
1075 | J=quotient(JJ,minor(jacob(JJ),size(JJ))); |
---|
1076 | } |
---|
1077 | } |
---|
1078 | // timer-ti; |
---|
1079 | |
---|
1080 | JM=J,J; |
---|
1081 | |
---|
1082 | //evtl. fuer SL[1] anderen Nichtnullteiler aus J waehlen |
---|
1083 | // SL=simplify(reduce(J,SM[1]),2); |
---|
1084 | // Ann=quotient(SM[2],SL[1]); |
---|
1085 | // qAnn=simplify(reduce(Ann,SM[1]),2); |
---|
1086 | // if(size(qAnn)!=0) |
---|
1087 | // { |
---|
1088 | // keepresult1=normalizationPrimes(qAnn+SM[2]); |
---|
1089 | // keepresult2=normalizationPrimes(SL[1]+SM[2]); |
---|
1090 | // for(lauf=1;lauf<=size(keepresult2);j++) |
---|
1091 | // { |
---|
1092 | // keepresult1=insert(keepresult1,keepresult2[lauf]); |
---|
1093 | // } |
---|
1094 | // return(keepresult1); |
---|
1095 | // } |
---|
1096 | RR=SM[1],SM[2],JM[2],SL[1]; |
---|
1097 | |
---|
1098 | // evtl eine geeignete Potenz von JM? |
---|
1099 | if(y==1) |
---|
1100 | { |
---|
1101 | "compute Hom(rad(J),rad(J)):"; |
---|
1102 | } |
---|
1103 | // ti=timer; |
---|
1104 | |
---|
1105 | RS=HomJJ(RR,y); |
---|
1106 | // timer-ti; |
---|
1107 | |
---|
1108 | if(RS[2]==1) |
---|
1109 | { |
---|
1110 | def lastR=RS[1]; |
---|
1111 | setring lastR; |
---|
1112 | ideal KK=endid; |
---|
1113 | ideal PP=endphi; |
---|
1114 | export PP; |
---|
1115 | export KK; |
---|
1116 | setring BAS; |
---|
1117 | // return(RS[1]); |
---|
1118 | return(lastR); |
---|
1119 | } |
---|
1120 | int n=nvars(basering); |
---|
1121 | ideal MJ=JM[2]; |
---|
1122 | def newR=RS[1]; |
---|
1123 | setring newR; |
---|
1124 | |
---|
1125 | map psi=BAS,endphi; |
---|
1126 | list tluser= |
---|
1127 | normalizationPrimes(endid,psi(ihp),simplify(psi(MJ)+endid,4)); |
---|
1128 | // normalizationPrimes(endid); |
---|
1129 | setring BAS; |
---|
1130 | return(tluser); |
---|
1131 | } |
---|
1132 | else |
---|
1133 | { |
---|
1134 | int equi=attrib(SM[2],"isEquidimensional"); |
---|
1135 | ideal new1=qAnn+SM[2]; |
---|
1136 | execute "ring newR1="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1137 | +ordstr(basering)+");"; |
---|
1138 | if(y==1) |
---|
1139 | { |
---|
1140 | "zero-divisor found"; |
---|
1141 | } |
---|
1142 | ideal vid=fetch(BAS,new1); |
---|
1143 | ideal ihp=fetch(BAS,ihp); |
---|
1144 | attrib(vid,"isCohenMacaulay",0); |
---|
1145 | attrib(vid,"isPrim",0); |
---|
1146 | attrib(vid,"isIsolatedSingularity",0); |
---|
1147 | attrib(vid,"isRegInCodim2",0); |
---|
1148 | if(equi==1) |
---|
1149 | { |
---|
1150 | attrib(vid,"isEquidimensional",1); |
---|
1151 | } |
---|
1152 | else |
---|
1153 | { |
---|
1154 | attrib(vid,"isEquidimensional",0); |
---|
1155 | } |
---|
1156 | attrib(vid,"isCompleteIntersection",0); |
---|
1157 | |
---|
1158 | keepresult1=normalizationPrimes(vid,ihp); |
---|
1159 | |
---|
1160 | setring BAS; |
---|
1161 | ideal new2=quotient(SM[2],Ann)+SM[2]; |
---|
1162 | // evtl. qAnn nehmen |
---|
1163 | // ideal new2=SL[1]+SM[2]; |
---|
1164 | execute "ring newR2="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1165 | +ordstr(basering)+");"; |
---|
1166 | |
---|
1167 | ideal vid=fetch(BAS,new2); |
---|
1168 | ideal ihp=fetch(BAS,ihp); |
---|
1169 | attrib(vid,"isCohenMacaulay",0); |
---|
1170 | attrib(vid,"isPrim",0); |
---|
1171 | attrib(vid,"isIsolatedSingularity",0); |
---|
1172 | attrib(vid,"isRegInCodim2",0); |
---|
1173 | if(equi==1) |
---|
1174 | { |
---|
1175 | attrib(vid,"isEquidimensional",1); |
---|
1176 | } |
---|
1177 | else |
---|
1178 | { |
---|
1179 | attrib(vid,"isEquidimensional",0); |
---|
1180 | } |
---|
1181 | attrib(vid,"isCompleteIntersection",0); |
---|
1182 | |
---|
1183 | keepresult2=normalizationPrimes(vid,ihp); |
---|
1184 | |
---|
1185 | setring BAS; |
---|
1186 | for(lauf=1;lauf<=size(keepresult2);lauf++) |
---|
1187 | { |
---|
1188 | keepresult1=insert(keepresult1,keepresult2[lauf]); |
---|
1189 | } |
---|
1190 | return(keepresult1); |
---|
1191 | } |
---|
1192 | } |
---|
1193 | example |
---|
1194 | { "EXAMPLE:";echo = 2; |
---|
1195 | LIB"normal.lib"; |
---|
1196 | //Huneke |
---|
1197 | ring qr=31991,(a,b,c,d,e),dp; |
---|
1198 | ideal i= |
---|
1199 | 5abcde-a5-b5-c5-d5-e5, |
---|
1200 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
1201 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
1202 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
1203 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
1204 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
1205 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
1206 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
1207 | |
---|
1208 | list pr=normal(i); |
---|
1209 | def r1=pr[1]; |
---|
1210 | setring r1; |
---|
1211 | KK; |
---|
1212 | } |
---|
1213 | |
---|
1214 | proc substpart(ideal endid,ideal endphi, int homo, intvec rw) |
---|
1215 | { |
---|
1216 | def newRing=basering; |
---|
1217 | int ii,jj; |
---|
1218 | map phi = basering,maxideal(1); |
---|
1219 | |
---|
1220 | //endid=diagon(endid); |
---|
1221 | |
---|
1222 | list Le = elimpart(endid); |
---|
1223 | //this proc and the next loop try to |
---|
1224 | int q = size(Le[2]); //substitute as many variables as possible |
---|
1225 | intvec rw1 = 0; //indices of substituted variables |
---|
1226 | rw1[nvars(basering)] = 0; |
---|
1227 | rw1 = rw1+1; |
---|
1228 | |
---|
1229 | while( size(Le[2]) != 0 ) |
---|
1230 | { |
---|
1231 | endid = Le[1]; |
---|
1232 | map ps = newRing,Le[5]; |
---|
1233 | |
---|
1234 | phi = ps(phi); |
---|
1235 | for(ii=1;ii<=size(Le[2])-1;ii++) |
---|
1236 | { |
---|
1237 | phi=phi(phi); |
---|
1238 | } |
---|
1239 | //eingefuegt wegen x2-y2z2+z3 |
---|
1240 | kill ps; |
---|
1241 | |
---|
1242 | for( ii=1; ii<=size(rw1); ii++ ) |
---|
1243 | { |
---|
1244 | if( Le[4][ii]==0 ) |
---|
1245 | { |
---|
1246 | rw1[ii]=0; //look for substituted vars |
---|
1247 | } |
---|
1248 | } |
---|
1249 | Le=elimpart(endid); |
---|
1250 | q = q + size(Le[2]); |
---|
1251 | } |
---|
1252 | endphi = phi(endphi); |
---|
1253 | |
---|
1254 | //---------- return ----------------------------------------------------------- |
---|
1255 | // in the homogeneous case put weights for the remaining vars correctly, i.e. |
---|
1256 | // delete from rw those weights for which the corresponding entry of rw1 is 0 |
---|
1257 | |
---|
1258 | if (homo==1 && nvars(newRing)-q >1 && size(endid) >0 ) |
---|
1259 | { |
---|
1260 | jj=1; |
---|
1261 | for( ii=2; ii<size(rw1); ii++) |
---|
1262 | { |
---|
1263 | jj++; |
---|
1264 | if( rw1[ii]==0 ) |
---|
1265 | { |
---|
1266 | rw=rw[1..jj-1],rw[jj+1..size(rw)]; |
---|
1267 | jj=jj-1; |
---|
1268 | } |
---|
1269 | } |
---|
1270 | if( rw1[1]==0 ) { rw=rw[2..size(rw)]; } |
---|
1271 | if( rw1[size(rw1)]==0 ){ rw=rw[1..size(rw)-1]; } |
---|
1272 | |
---|
1273 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),(a(rw),dp); |
---|
1274 | } |
---|
1275 | else |
---|
1276 | { |
---|
1277 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),dp; |
---|
1278 | } |
---|
1279 | |
---|
1280 | ideal lastmap; |
---|
1281 | q = 1; |
---|
1282 | for(ii=1; ii<=size(rw1); ii++ ) |
---|
1283 | { |
---|
1284 | if ( rw1[ii]==1 ) { lastmap[ii] = T(q); q=q+1; } |
---|
1285 | if ( rw1[ii]==0 ) { lastmap[ii] = 0; } |
---|
1286 | } |
---|
1287 | map phi = newRing,lastmap; |
---|
1288 | ideal endid = phi(endid); |
---|
1289 | ideal endphi = phi(endphi); |
---|
1290 | export(endid); |
---|
1291 | export(endphi); |
---|
1292 | list L = lastRing; |
---|
1293 | setring newRing; |
---|
1294 | return(L); |
---|
1295 | } |
---|
1296 | |
---|
1297 | proc diagon(ideal i) |
---|
1298 | { |
---|
1299 | matrix m; |
---|
1300 | option(redSB); |
---|
1301 | ideal j=liftstd(jet(i,1),m); |
---|
1302 | option(noredSB); |
---|
1303 | return(ideal(matrix(i)*m)); |
---|
1304 | } |
---|
1305 | ///////////////////////////////////////////////////////////////////////////// |
---|
1306 | /* |
---|
1307 | LIB"normal.lib"; |
---|
1308 | int aa=timer;list pr=normal(i);timer-aa; |
---|
1309 | |
---|
1310 | |
---|
1311 | |
---|
1312 | //Huneke |
---|
1313 | ring qr=31991,(a,b,c,d,e),dp; |
---|
1314 | ideal i= |
---|
1315 | 5abcde-a5-b5-c5-d5-e5, |
---|
1316 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
1317 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
1318 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
1319 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
1320 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
1321 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
1322 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
1323 | |
---|
1324 | |
---|
1325 | //Vasconcelos |
---|
1326 | ring r=32003,(x,y,z,w,t),dp; |
---|
1327 | ideal i= |
---|
1328 | x2+zw, |
---|
1329 | y3+xwt, |
---|
1330 | xw3+z3t+ywt2, |
---|
1331 | y2w4-xy2z2t-w3t3; |
---|
1332 | |
---|
1333 | //Theo1 |
---|
1334 | ring r=32003,(x,y,z),wp(2,3,6); |
---|
1335 | ideal i=zy2-zx3-x6; |
---|
1336 | |
---|
1337 | //Theo2 |
---|
1338 | ring r=32003,(x,y,z),wp(3,4,12); |
---|
1339 | ideal i=z*(y3-x4)+x8; |
---|
1340 | |
---|
1341 | //Theo2a |
---|
1342 | ring r=32003,(T(1..4)),wp(3,4,12,17); |
---|
1343 | ideal i= |
---|
1344 | T(1)^8-T(1)^4*T(3)+T(2)^3*T(3), |
---|
1345 | T(1)^4*T(2)^2-T(2)^2*T(3)+T(1)*T(4), |
---|
1346 | T(1)^7+T(1)^3*T(2)^3-T(1)^3*T(3)+T(2)*T(4), |
---|
1347 | T(1)^6*T(2)*T(3)+T(1)^2*T(2)^4*T(3)+T(1)^3*T(2)^2*T(4)-T(1)^2*T(2)*T(3)^2+T(4)^2; |
---|
1348 | |
---|
1349 | //Theo3 |
---|
1350 | ring r=32003,(x,y,z),wp(3,5,15); |
---|
1351 | ideal i=z*(y3-x5)+x10; |
---|
1352 | |
---|
1353 | |
---|
1354 | //Theo4 |
---|
1355 | ring r=32003,(x,y,z),dp; |
---|
1356 | ideal i=(x-y)*(x-z)*(y-z); |
---|
1357 | |
---|
1358 | //Theo5 |
---|
1359 | ring r=32003,(x,y,z),wp(2,1,2); |
---|
1360 | ideal i=z3-xy4; |
---|
1361 | |
---|
1362 | //Theo6 |
---|
1363 | ring r=32003,(x,y,z),dp; |
---|
1364 | ideal i=x2y2+x2z2+y2z2; |
---|
1365 | |
---|
1366 | ring r=32003,(a,b,c,d,e,f),dp; |
---|
1367 | ideal i= |
---|
1368 | bf, |
---|
1369 | af, |
---|
1370 | bd, |
---|
1371 | ad; |
---|
1372 | |
---|
1373 | //Beispiel, wo vorher Primaerzerlegung schneller |
---|
1374 | //ist CM |
---|
1375 | //Sturmfels |
---|
1376 | ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
1377 | ideal i= |
---|
1378 | bv+su, |
---|
1379 | bw+tu, |
---|
1380 | sw+tv, |
---|
1381 | by+sx, |
---|
1382 | bz+tx, |
---|
1383 | sz+ty, |
---|
1384 | uy+vx, |
---|
1385 | uz+wx, |
---|
1386 | vz+wy, |
---|
1387 | bvz; |
---|
1388 | |
---|
1389 | //J S/Y |
---|
1390 | ring r=32003,(x,y,z,t),dp; |
---|
1391 | ideal i= |
---|
1392 | x2z+xzt, |
---|
1393 | xyz, |
---|
1394 | xy2-xyt, |
---|
1395 | x2y+xyt; |
---|
1396 | |
---|
1397 | //St_S/Y |
---|
1398 | ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
1399 | ideal i= |
---|
1400 | wy-vz, |
---|
1401 | vx-uy, |
---|
1402 | tv-sw, |
---|
1403 | su-bv, |
---|
1404 | tuy-bvz; |
---|
1405 | |
---|
1406 | //dauert laenger |
---|
1407 | //Horrocks: |
---|
1408 | ring r=32003,(a,b,c,d,e,f),dp; |
---|
1409 | ideal i= |
---|
1410 | adef-16000be2f+16001cef2, |
---|
1411 | ad2f+8002bdef+8001cdf2, |
---|
1412 | abdf-16000b2ef+16001bcf2, |
---|
1413 | a2df+8002abef+8001acf2, |
---|
1414 | ad2e-8000bde2-7999cdef, |
---|
1415 | acde-16000bce2+16001c2ef, |
---|
1416 | a2de-8000abe2-7999acef, |
---|
1417 | acd2+8002bcde+8001c2df, |
---|
1418 | abd2-8000b2de-7999bcdf, |
---|
1419 | a2d2+9603abde-10800b2e2-9601acdf+800bcef+11601c2f2, |
---|
1420 | abde-8000b2e2-acdf-16001bcef-8001c2f2, |
---|
1421 | abcd-16000b2ce+16001bc2f, |
---|
1422 | a2cd+8002abce+8001ac2f, |
---|
1423 | a2bd-8000ab2e-7999abcf, |
---|
1424 | ab3f-3bdf3, |
---|
1425 | a2b2f-2adf3-16000bef3+16001cf4, |
---|
1426 | a3bf+4aef3, |
---|
1427 | ac3e-10668cde3, |
---|
1428 | a2c2e+10667ade3+16001be4+5334ce3f, |
---|
1429 | a3ce+10669ae3f, |
---|
1430 | bc3d+8001cd3e, |
---|
1431 | ac3d+8000bc3e+16001cd2e2+8001c4f, |
---|
1432 | b2c2d+16001ad4+4000bd3e+12001cd3f, |
---|
1433 | b2c2e-10668bc3f-10667cd2ef, |
---|
1434 | abc2e-cde2f, |
---|
1435 | b3cd-8000bd3f, |
---|
1436 | b3ce-10668b2c2f-10667bd2ef, |
---|
1437 | abc2f-cdef2, |
---|
1438 | a2bce-16000be3f+16001ce2f2, |
---|
1439 | ab3d-8000b4e-8001b3cf+16000bd2f2, |
---|
1440 | ab2cf-bdef2, |
---|
1441 | a2bcf-16000be2f2+16001cef3, |
---|
1442 | a4d-8000a3be+8001a3cf-2ae2f2; |
---|
1443 | |
---|
1444 | |
---|
1445 | ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
1446 | |
---|
1447 | ideal k= |
---|
1448 | wy-vz, |
---|
1449 | vx-uy, |
---|
1450 | tv-sw, |
---|
1451 | su-bv, |
---|
1452 | tuy-bvz; |
---|
1453 | ideal j=x2y2+x2z2+y2z2; |
---|
1454 | ideal i=mstd(intersect(j,k))[2]; |
---|
1455 | |
---|
1456 | //22 |
---|
1457 | ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
1458 | ideal i= |
---|
1459 | wx2y3-vx2y2z+wx2yz2+wy3z2-vx2z3-vy2z3, |
---|
1460 | vx3y2-ux2y3+vx3z2-ux2yz2+vxy2z2-uy3z2, |
---|
1461 | tvx2y2-swx2y2+tvx2z2-swx2z2+tvy2z2-swy2z2, |
---|
1462 | sux2y2-bvx2y2+sux2z2-bvx2z2+suy2z2-bvy2z2, |
---|
1463 | tux2y3-bvx2y2z+tux2yz2+tuy3z2-bvx2z3-bvy2z3; |
---|
1464 | |
---|
1465 | |
---|
1466 | //riemenschneider |
---|
1467 | //33 |
---|
1468 | //normal+primary 3 |
---|
1469 | //primary 9 |
---|
1470 | //radical 1 |
---|
1471 | //minAssPrimes 2 |
---|
1472 | ring r=32000,(p,q,s,t,u,v,w,x,y,z),wp(1,1,1,1,1,1,2,1,1,1); |
---|
1473 | ideal i= |
---|
1474 | xz, |
---|
1475 | vx, |
---|
1476 | ux, |
---|
1477 | su, |
---|
1478 | qu, |
---|
1479 | txy, |
---|
1480 | stx, |
---|
1481 | qtx, |
---|
1482 | uv2z-uwz, |
---|
1483 | uv3-uvw, |
---|
1484 | puv2-puw; |
---|
1485 | |
---|
1486 | |
---|
1487 | */ |
---|