1 | /////////////////////////////////////////////////////////////////////////////// |
---|
2 | version="$Id$"; |
---|
3 | category="Commutative Algebra"; |
---|
4 | info=" |
---|
5 | LIBRARY: normal.lib Normalization of Affine Rings |
---|
6 | AUTHORS: G.-M. Greuel, greuel@mathematik.uni-kl.de, |
---|
7 | @* S. Laplagne, slaplagn@dm.uba.ar, |
---|
8 | @* G. Pfister, pfister@mathematik.uni-kl.de |
---|
9 | |
---|
10 | |
---|
11 | MAIN PROCEDURES: |
---|
12 | normal(I[...]); normalization of an affine ring |
---|
13 | normalP(I,[...]); normalization of an affine ring in positive characteristic |
---|
14 | normalC(I,[...]); normalization of an affine ring through a chain of rings |
---|
15 | HomJJ(L); presentation of End_R(J) as affine ring, J an ideal |
---|
16 | genus(I); computes the geometric genus of a projective curve |
---|
17 | primeClosure(L); integral closure of R/p, p a prime ideal |
---|
18 | closureFrac(L); write a polynomial in integral closure as element of Quot(R/p) |
---|
19 | iMult(L); intersection multiplicity of the ideals of the list L |
---|
20 | |
---|
21 | AUXILIARY PROCEDURES: |
---|
22 | deltaLoc(f,S); sum of delta invariants at conjugated singular points |
---|
23 | locAtZero(I); checks whether the zero set of I is located at 0 |
---|
24 | norTest(I,nor); checks the output of normal, normalP, normalC |
---|
25 | "; |
---|
26 | |
---|
27 | LIB "general.lib"; |
---|
28 | LIB "poly.lib"; |
---|
29 | LIB "sing.lib"; |
---|
30 | LIB "primdec.lib"; |
---|
31 | LIB "elim.lib"; |
---|
32 | LIB "presolve.lib"; |
---|
33 | LIB "inout.lib"; |
---|
34 | LIB "ring.lib"; |
---|
35 | LIB "hnoether.lib"; |
---|
36 | LIB "reesclos.lib"; |
---|
37 | LIB "algebra.lib"; |
---|
38 | |
---|
39 | |
---|
40 | /////////////////////////////////////////////////////////////////////////////// |
---|
41 | |
---|
42 | proc normal(ideal id, list #) |
---|
43 | "USAGE: normal(id [,choose]); id = radical ideal, choose = optional string. @* |
---|
44 | Optional parameters in list choose (can be entered in any order):@* |
---|
45 | Decomposition:@* |
---|
46 | - \"equidim\" -> computes first an equidimensional decomposition, |
---|
47 | and then the normalization of each component (default).@* |
---|
48 | - \"prim\" -> computes first the minimal associated primes, and then |
---|
49 | the normalization of each prime. @* |
---|
50 | - \"noDeco\" -> no preliminary decomposition is done. If the ideal is |
---|
51 | not equidimensional radical, output might be wrong.@* |
---|
52 | - \"isPrim\" -> assumes that the ideal is prime. If this assumption |
---|
53 | does not hold, the output might be wrong.@* |
---|
54 | - \"noFac\" -> factorization is avoided in the computation of the |
---|
55 | minimal associated primes; |
---|
56 | Other:@* |
---|
57 | - \"useRing\" -> uses the original ring ordering.@* |
---|
58 | If this option is set and if the ring ordering is not global, normal |
---|
59 | will change to a global ordering only for computing radicals and prime |
---|
60 | or equidimensional decompositions.@* |
---|
61 | If this option is not set, normal changes to dp ordering and performs |
---|
62 | all computations with respect to this ordering.@* |
---|
63 | - \"withDelta\" (or \"wd\") -> returns also the delta invariants.@* |
---|
64 | If choose is not given or empty, only \"equidim\" but no other option |
---|
65 | is used. |
---|
66 | ASSUME: The ideal must be radical, for non-radical ideals the output may |
---|
67 | be wrong (id=radical(id); makes id radical). However, when using the |
---|
68 | \"prim\" option the minimal associated primes of id are computed first |
---|
69 | and hence normal computes the normalization of the radical of id.@* |
---|
70 | NOTE: \"isPrim\" should only be used if id is known to be prime. |
---|
71 | RETURN: a list, say nor, of size 2 (resp. 3 with option \"withDelta\"). |
---|
72 | @format Let R denote the basering and id the input ideal. |
---|
73 | * nor[1] is a list of r rings, where r is the number of associated |
---|
74 | primes P_i with option \"prim\" (resp. >= no of equidimenensional |
---|
75 | components P_i with option \"equidim\").@* |
---|
76 | Each ring Ri := nor[1][i], i=1..r, contains two ideals with given |
---|
77 | names @code{norid} and @code{normap} such that: @* |
---|
78 | - Ri/norid is the normalization of the i-th component, i.e. the |
---|
79 | integral closure of R/P_i in its field of fractions (as affine ring); |
---|
80 | - @code{normap} gives the normalization map from R/id to |
---|
81 | Ri/norid for each i.@* |
---|
82 | - the direct sum of the rings Ri/norid, i=1,..r, is the normalization |
---|
83 | of R/id as affine algebra; @* |
---|
84 | * nor[2] is a list of size r with information on the normalization of |
---|
85 | the i-th component as module over the basering R:@* |
---|
86 | nor[2][i] is an ideal, say U, in R such that the integral closure |
---|
87 | of basering/P_i is generated as module over R by 1/c * U, with c |
---|
88 | the last element U[size(U)] of U.@* |
---|
89 | * nor[3] (if option \"withDelta\" is set) is a list of an intvec |
---|
90 | of size r, the delta invariants of the r components, and an integer, |
---|
91 | the total delta invariant of basering/id (-1 means infinite, and 0 |
---|
92 | that R/P_i resp. R/id is normal). |
---|
93 | @end format |
---|
94 | THEORY: We use here a general algorithm described in [G.-M.Greuel, S.Laplagne, |
---|
95 | F.Seelisch: Normalization of Rings (2009)].@* |
---|
96 | The procedure computes the R-module structure, the algebra structure |
---|
97 | and the delta invariant of the normalization of R/id:@* |
---|
98 | The normalization of R/id is the integral closure of R/id in its total |
---|
99 | ring of fractions. It is a finitely generated R-module and nor[2] |
---|
100 | computes R-module generators of it. More precisely: If U:=nor[2][i] |
---|
101 | and c:=U[size(U)], then c is a non-zero divisor and U/c is an R-module |
---|
102 | in the total ring of fractions, the integral closure of R/P_i. Since |
---|
103 | U[size(U)]/c is equal to 1, R/P_i resp. R/id is contained in the |
---|
104 | integral closure.@* |
---|
105 | The normalization is also an affine algebra over the ground field |
---|
106 | and nor[1] presents it as such. For geometric considerations nor[1] is |
---|
107 | relevant since the variety of the ideal norid in Ri is the |
---|
108 | normalization of the variety of the ideal P_i in R.@* |
---|
109 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
110 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
111 | id. nor[3] returns the delta invariants of the components P_i and of |
---|
112 | id. |
---|
113 | NOTE: To use the i-th ring type e.g.: @code{def R=nor[1][i]; setring R;}. |
---|
114 | @* Increasing/decreasing printlevel displays more/less comments |
---|
115 | (default: printlevel=0). |
---|
116 | @* Implementation works also for local rings. |
---|
117 | @* Not implemented for quotient rings. |
---|
118 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
119 | be used together with the useRing-option (qhweight(id); computes |
---|
120 | weights). |
---|
121 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
122 | SEE ALSO: normalC, normalP. |
---|
123 | EXAMPLE: example normal; shows an example |
---|
124 | " |
---|
125 | { |
---|
126 | intvec opt = option(get); // Save current options |
---|
127 | |
---|
128 | int i,j; |
---|
129 | int decomp; // Preliminary decomposition: |
---|
130 | // 0 -> no decomposition (id is assumed to be prime) |
---|
131 | // 1 -> no decomposition |
---|
132 | // (id is assumed to be equidimensional radical) |
---|
133 | // 2 -> equidimensional decomposition |
---|
134 | // 3 -> minimal associated primes |
---|
135 | int noFac, useRing, withDelta; |
---|
136 | int dbg = printlevel - voice + 2; |
---|
137 | int nvar = nvars(basering); |
---|
138 | int chara = char(basering); |
---|
139 | list result; |
---|
140 | list keepresult; |
---|
141 | list ringStruc; |
---|
142 | ideal U; |
---|
143 | poly c; |
---|
144 | int sp; // Number of components. |
---|
145 | |
---|
146 | // Default methods: |
---|
147 | noFac = 0; // Use facSTD when computing minimal associated primes |
---|
148 | decomp = 2; // Equidimensional decomposition |
---|
149 | useRing = 0; // Change first to dp ordering, and perform all |
---|
150 | // computations there. |
---|
151 | withDelta = 0; // Do not compute the delta invariant. |
---|
152 | |
---|
153 | //--------------------------- define the method --------------------------- |
---|
154 | string method; //make all options one string in order to use |
---|
155 | //all combinations of options simultaneously |
---|
156 | for ( i=1; i <= size(#); i++ ) |
---|
157 | { |
---|
158 | if ( typeof(#[i]) == "string" ) |
---|
159 | { |
---|
160 | method = method + #[i]; |
---|
161 | } |
---|
162 | } |
---|
163 | |
---|
164 | //--------------------------- choosen methods ----------------------- |
---|
165 | if ( find(method,"isprim") or find(method,"isPrim") ) |
---|
166 | {decomp = 0;} |
---|
167 | |
---|
168 | if ( find(method,"nodeco") or find(method,"noDeco") ) |
---|
169 | {decomp = 1;} |
---|
170 | |
---|
171 | if ( find(method,"prim") ) |
---|
172 | {decomp = 3;} |
---|
173 | |
---|
174 | if ( find(method,"equidim") ) |
---|
175 | {decomp = 2;} |
---|
176 | |
---|
177 | if ( find(method,"nofac") or find(method,"noFac") ) |
---|
178 | {noFac=1;} |
---|
179 | |
---|
180 | if ( (find(method,"useRing") or find(method,"usering")) and (ordstr(basering) != "dp("+string(nvars(basering))+"),C")) |
---|
181 | {useRing = 1;} |
---|
182 | |
---|
183 | if ( find(method,"withDelta") or find(method,"wd") or find(method,"withdelta")) |
---|
184 | { |
---|
185 | if((decomp == 0) or (decomp == 3)) |
---|
186 | { |
---|
187 | withDelta = 1; |
---|
188 | } |
---|
189 | else |
---|
190 | { |
---|
191 | decomp = 3; |
---|
192 | withDelta = 1; |
---|
193 | //Note: the delta invariants cannot be computed with an equidimensional |
---|
194 | //decomposition, hence we compute first the minimal primes |
---|
195 | } |
---|
196 | } |
---|
197 | |
---|
198 | kill #; |
---|
199 | list #; |
---|
200 | |
---|
201 | //------------------------ change ring if required ------------------------ |
---|
202 | // If the ordering is not global, we change to dp ordering for computing the |
---|
203 | // min ass primes. |
---|
204 | // If the ordering is global, but not dp, and useRing = 0, we also change to |
---|
205 | // dp ordering. |
---|
206 | |
---|
207 | int isGlobal = ord_test(basering); // Checks if the original ring has |
---|
208 | // global ordering. |
---|
209 | |
---|
210 | def origR = basering; // origR is the original ring |
---|
211 | // R is the ring where computations will be done |
---|
212 | |
---|
213 | if((useRing == 1) and (isGlobal == 1)) |
---|
214 | { |
---|
215 | def globR = basering; |
---|
216 | } |
---|
217 | else |
---|
218 | { |
---|
219 | // We change to dp ordering. |
---|
220 | list rl = ringlist(origR); |
---|
221 | list origOrd = rl[3]; |
---|
222 | list newOrd = list("dp", intvec(1:nvars(origR))), list("C", 0); |
---|
223 | rl[3] = newOrd; |
---|
224 | def globR = ring(rl); |
---|
225 | setring globR; |
---|
226 | ideal id = fetch(origR, id); |
---|
227 | } |
---|
228 | |
---|
229 | //------------------------ trivial checkings ------------------------ |
---|
230 | id = groebner(id); |
---|
231 | if((size(id) == 0) or (id[1] == 1)) |
---|
232 | { |
---|
233 | // The original ring R/I was normal. Nothing to do. |
---|
234 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
235 | setring origR; |
---|
236 | list lR = ringlist(origR); |
---|
237 | def ROut = ring(lR); |
---|
238 | setring ROut; |
---|
239 | ideal norid = 0; |
---|
240 | ideal normap = maxideal(1); |
---|
241 | export norid; |
---|
242 | export normap; |
---|
243 | setring origR; |
---|
244 | if(withDelta) |
---|
245 | { |
---|
246 | result = list(list(ideal(1), poly(1), ROut), 0); |
---|
247 | } |
---|
248 | else |
---|
249 | { |
---|
250 | result = list(list(ideal(1), poly(1), ROut)); |
---|
251 | } |
---|
252 | return(result); |
---|
253 | } |
---|
254 | |
---|
255 | //------------------------ preliminary decomposition----------------------- |
---|
256 | list prim; |
---|
257 | if(decomp == 2) |
---|
258 | { |
---|
259 | dbprint(dbg, "// Computing the equidimensional decomposition..."); |
---|
260 | prim = equidim(id); |
---|
261 | } |
---|
262 | if((decomp == 0) or (decomp == 1)) |
---|
263 | { |
---|
264 | prim = id; |
---|
265 | } |
---|
266 | if(decomp == 3) |
---|
267 | { |
---|
268 | dbprint(dbg, "// Computing the minimal associated primes..."); |
---|
269 | if( noFac ) |
---|
270 | { prim = minAssGTZ(id,1); } |
---|
271 | else |
---|
272 | { prim = minAssGTZ(id); } |
---|
273 | } |
---|
274 | sp = size(prim); |
---|
275 | if(dbg>=1) |
---|
276 | { |
---|
277 | prim; ""; |
---|
278 | "// number of components is", sp; |
---|
279 | ""; |
---|
280 | } |
---|
281 | |
---|
282 | |
---|
283 | //----------------- back to the original ring if required ------------------ |
---|
284 | // if ring was not global and useRing is on, we go back to the original ring |
---|
285 | if((useRing == 1) and (isGlobal != 1)) |
---|
286 | { |
---|
287 | setring origR; |
---|
288 | def R = basering; |
---|
289 | list prim = fetch(globR, prim); |
---|
290 | } |
---|
291 | else |
---|
292 | { |
---|
293 | def R = basering; |
---|
294 | if(useRing == 0) |
---|
295 | { |
---|
296 | ideal U; |
---|
297 | poly c; |
---|
298 | } |
---|
299 | } |
---|
300 | |
---|
301 | // ---------------- normalization of the components------------------------- |
---|
302 | // calls normalM to compute the normalization of each component. |
---|
303 | |
---|
304 | list norComp; // The normalization of each component. |
---|
305 | int delt; |
---|
306 | int deltI = 0; |
---|
307 | int totalComps = 0; |
---|
308 | |
---|
309 | setring origR; |
---|
310 | def newROrigOrd; |
---|
311 | list newRListO; |
---|
312 | setring R; |
---|
313 | def newR; |
---|
314 | list newRList; |
---|
315 | |
---|
316 | for(i=1; i<=size(prim); i++) |
---|
317 | { |
---|
318 | if(dbg>=2){pause();} |
---|
319 | if(dbg>=1) |
---|
320 | { |
---|
321 | "// start computation of component",i; |
---|
322 | " --------------------------------"; |
---|
323 | } |
---|
324 | if(groebner(prim[i])[1] != 1) |
---|
325 | { |
---|
326 | if(dbg>=2) |
---|
327 | { |
---|
328 | "We compute the normalization in the ring"; basering; |
---|
329 | } |
---|
330 | printlevel = printlevel + 1; |
---|
331 | norComp = normalM(prim[i], decomp, withDelta); |
---|
332 | printlevel = printlevel - 1; |
---|
333 | for(j = 1; j <= size(norComp); j++) |
---|
334 | { |
---|
335 | newR = norComp[j][3]; |
---|
336 | newRList = ringlist(newR); |
---|
337 | U = norComp[j][1]; |
---|
338 | c = norComp[j][2]; |
---|
339 | if(withDelta) |
---|
340 | { |
---|
341 | delt = norComp[j][4]; |
---|
342 | if((delt >= 0) and (deltI >= 0)) |
---|
343 | { |
---|
344 | deltI = deltI + delt; |
---|
345 | } |
---|
346 | else |
---|
347 | { |
---|
348 | deltI = -1; |
---|
349 | } |
---|
350 | } |
---|
351 | // -- incorporate result for this component to the list of results --- |
---|
352 | if(useRing == 0) |
---|
353 | { |
---|
354 | // We go back to the original ring. |
---|
355 | setring origR; |
---|
356 | U = fetch(R, U); |
---|
357 | c = fetch(R, c); |
---|
358 | newRListO = imap(R, newRList); |
---|
359 | // We change the ordering in the new ring. |
---|
360 | if(nvars(newR) > nvars(origR)) |
---|
361 | { |
---|
362 | newRListO[3]=insert(origOrd, newRListO[3][1]); |
---|
363 | } |
---|
364 | else |
---|
365 | { |
---|
366 | newRListO[3] = origOrd; |
---|
367 | } |
---|
368 | newROrigOrd = ring(newRListO); |
---|
369 | setring newROrigOrd; |
---|
370 | ideal norid = imap(newR, norid); |
---|
371 | ideal normap = imap(newR, normap); |
---|
372 | export norid; |
---|
373 | export normap; |
---|
374 | setring origR; |
---|
375 | totalComps++; |
---|
376 | result[totalComps] = list(U, c, newROrigOrd); |
---|
377 | if(withDelta) |
---|
378 | { |
---|
379 | result[totalComps] = insert(result[totalComps], delt, 3); |
---|
380 | } |
---|
381 | setring R; |
---|
382 | } |
---|
383 | else |
---|
384 | { |
---|
385 | setring R; |
---|
386 | totalComps++; |
---|
387 | result[totalComps] = norComp[j]; |
---|
388 | } |
---|
389 | } |
---|
390 | } |
---|
391 | } |
---|
392 | |
---|
393 | // -------------------------- delta computation ---------------------------- |
---|
394 | if(withDelta == 1) |
---|
395 | { |
---|
396 | // Intersection multiplicities of list prim, sp=size(prim). |
---|
397 | if ( dbg >= 1 ) |
---|
398 | { |
---|
399 | "// Sum of delta for all components: ", deltI; |
---|
400 | } |
---|
401 | if(size(prim) > 1) |
---|
402 | { |
---|
403 | dbprint(dbg, "// Computing the sum of the intersection multiplicities of the components..."); |
---|
404 | int mul = iMult(prim); |
---|
405 | if ( mul < 0 ) |
---|
406 | { |
---|
407 | deltI = -1; |
---|
408 | } |
---|
409 | else |
---|
410 | { |
---|
411 | deltI = deltI + mul; |
---|
412 | } |
---|
413 | if ( dbg >= 1 ) |
---|
414 | { |
---|
415 | "// Intersection multiplicity is : ", mul; |
---|
416 | } |
---|
417 | } |
---|
418 | } |
---|
419 | |
---|
420 | // -------------------------- prepare output ------------------------------ |
---|
421 | setring origR; |
---|
422 | |
---|
423 | list RL; // List of rings |
---|
424 | list MG; // Module generators |
---|
425 | intvec DV; // Vector of delta's of each component |
---|
426 | for(i = 1; i <= size(result); i++) |
---|
427 | { |
---|
428 | RL[i] = result[i][3]; |
---|
429 | MG[i] = lineUpLast(result[i][1], result[i][2]); |
---|
430 | if(withDelta) |
---|
431 | { |
---|
432 | DV[i] = result[i][4]; |
---|
433 | } |
---|
434 | } |
---|
435 | list resultNew; |
---|
436 | |
---|
437 | if(withDelta) |
---|
438 | { |
---|
439 | resultNew = list(RL, MG, list(DV, deltI)); |
---|
440 | } |
---|
441 | else |
---|
442 | { |
---|
443 | resultNew = list(RL, MG); |
---|
444 | } |
---|
445 | |
---|
446 | sp = size(RL); //RL = list of rings |
---|
447 | option(set, opt); |
---|
448 | |
---|
449 | if ( dbg >= 0 ) |
---|
450 | { |
---|
451 | ""; |
---|
452 | if(!withDelta) |
---|
453 | { |
---|
454 | "// 'normal' created a list, say nor, of two elements."; |
---|
455 | } |
---|
456 | else |
---|
457 | { |
---|
458 | "// 'normal' created a list, say nor, of three elements."; |
---|
459 | } |
---|
460 | "// To see the list type"; |
---|
461 | " nor;"; |
---|
462 | ""; |
---|
463 | "// * nor[1] is a list of", sp, "ring(s)."; |
---|
464 | "// To access the i-th ring nor[1][i], give it a name, say Ri, and type"; |
---|
465 | " def R1 = nor[1][1]; setring R1; norid; normap;"; |
---|
466 | "// For the other rings type first (if R is the name of your base ring)"; |
---|
467 | " setring R;"; |
---|
468 | "// and then continue as for R1."; |
---|
469 | "// Ri/norid is the affine algebra of the normalization of R/P_i where"; |
---|
470 | "// P_i is the i-th component of a decomposition of the input ideal id"; |
---|
471 | "// and normap the normalization map from R to Ri/norid."; |
---|
472 | ""; |
---|
473 | "// * nor[2] is a list of", sp, "ideal(s). Let ci be the last generator"; |
---|
474 | "// of the ideal nor[2][i]. Then the integral closure of R/P_i is"; |
---|
475 | "// generated as R-submodule of the total ring of fractions by"; |
---|
476 | "// 1/ci * nor[2][i]."; |
---|
477 | |
---|
478 | if(withDelta) |
---|
479 | { ""; |
---|
480 | "// * nor[3] is a list of an intvec of size", sp, "the delta invariants "; |
---|
481 | "// of the components, and an integer, the total delta invariant "; |
---|
482 | "// of R/id (-1 means infinite, and 0 that R/P_i resp. R/id is normal)."; |
---|
483 | } |
---|
484 | } |
---|
485 | return(resultNew); |
---|
486 | } |
---|
487 | |
---|
488 | example |
---|
489 | { "EXAMPLE:"; |
---|
490 | printlevel = printlevel+1; |
---|
491 | echo = 2; |
---|
492 | ring s = 0,(x,y),dp; |
---|
493 | ideal i = (x2-y3)*(x2+y2)*x; |
---|
494 | list nor = normal(i, "withDelta", "prim"); |
---|
495 | nor; |
---|
496 | |
---|
497 | // 2 branches have delta = 1, and 1 branch has delta = 0 |
---|
498 | // the total delta invariant is 13 |
---|
499 | |
---|
500 | def R2 = nor[1][2]; setring R2; |
---|
501 | norid; normap; |
---|
502 | |
---|
503 | echo = 0; |
---|
504 | printlevel = printlevel-1; |
---|
505 | pause(" hit return to continue"); echo=2; |
---|
506 | |
---|
507 | ring r = 2,(x,y,z),dp; |
---|
508 | ideal i = z3-xy4; |
---|
509 | list nor = normal(i, "withDelta", "prim"); nor; |
---|
510 | // the delta invariant is infinite |
---|
511 | // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module |
---|
512 | // in its quotient field Quot(r/i) |
---|
513 | |
---|
514 | // the normalization as affine algebra over the ground field: |
---|
515 | def R = nor[1][1]; setring R; |
---|
516 | norid; normap; |
---|
517 | } |
---|
518 | |
---|
519 | /////////////////////////////////////////////////////////////////////////////// |
---|
520 | |
---|
521 | proc HomJJ (list Li) |
---|
522 | "USAGE: HomJJ (Li); Li = list: ideal SBid, ideal id, ideal J, poly p |
---|
523 | ASSUME: R = P/id, P = basering, a polynomial ring, id an ideal of P, |
---|
524 | @* SBid = standard basis of id, |
---|
525 | @* J = ideal of P containing the polynomial p, |
---|
526 | @* p = nonzero divisor of R |
---|
527 | COMPUTE: Endomorphism ring End_R(J)=Hom_R(J,J) with its ring structure as |
---|
528 | affine ring, together with the map R --> Hom_R(J,J) of affine rings, |
---|
529 | where R is the quotient ring of P modulo the standard basis SBid. |
---|
530 | RETURN: a list l of three objects |
---|
531 | @format |
---|
532 | l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi' |
---|
533 | such that l[1]/endid = Hom_R(J,J) and |
---|
534 | endphi describes the canonical map R -> Hom_R(J,J) |
---|
535 | l[2] : an integer which is 1 if phi is an isomorphism, 0 if not |
---|
536 | l[3] : an integer, = dim_K(Hom_R(J,J)/R) (the contribution to delta) |
---|
537 | if the dimension is finite, -1 otherwise |
---|
538 | @end format |
---|
539 | NOTE: printlevel >=1: display comments (default: printlevel=0) |
---|
540 | EXAMPLE: example HomJJ; shows an example |
---|
541 | " |
---|
542 | { |
---|
543 | //---------- initialisation --------------------------------------------------- |
---|
544 | int isIso,isPr,isHy,isCo,isRe,isEq,oSAZ,ii,jj,q,y; |
---|
545 | intvec rw,rw1; |
---|
546 | list L; |
---|
547 | y = printlevel-voice+2; // y=printlevel (default: y=0) |
---|
548 | def P = basering; |
---|
549 | ideal SBid, id, J = Li[1], Li[2], Li[3]; |
---|
550 | poly p = Li[4]; |
---|
551 | int noRed = 0; |
---|
552 | if(size(Li) > 4) |
---|
553 | { |
---|
554 | if(Li[5] == 1) { noRed = 1; } |
---|
555 | } |
---|
556 | |
---|
557 | attrib(SBid,"isSB",1); |
---|
558 | int homo = homog(Li[2]); //is 1 if id is homogeneous, 0 if not |
---|
559 | |
---|
560 | //---- set attributes for special cases where algorithm can be simplified ----- |
---|
561 | if( homo==1 ) |
---|
562 | { |
---|
563 | rw = ringweights(P); |
---|
564 | } |
---|
565 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
566 | { |
---|
567 | if(attrib(id,"isPrim")==1) { isPr=1; } |
---|
568 | } |
---|
569 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
570 | { |
---|
571 | if(attrib(id,"onlySingularAtZero")==1){oSAZ=1; } |
---|
572 | } |
---|
573 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
574 | { |
---|
575 | if(attrib(id,"isIsolatedSingularity")==1) { isIso=1; } |
---|
576 | } |
---|
577 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
578 | { |
---|
579 | if(attrib(id,"isCohenMacaulay")==1) { isCo=1; } |
---|
580 | } |
---|
581 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
582 | { |
---|
583 | if(attrib(id,"isRegInCodim2")==1) { isRe=1; } |
---|
584 | } |
---|
585 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
586 | { |
---|
587 | if(attrib(id,"isEquidimensional")==1) { isEq=1; } |
---|
588 | } |
---|
589 | //-------------------------- go to quotient ring ------------------------------ |
---|
590 | qring R = SBid; |
---|
591 | ideal id = fetch(P,id); |
---|
592 | ideal J = fetch(P,J); |
---|
593 | poly p = fetch(P,p); |
---|
594 | ideal f,rf,f2; |
---|
595 | module syzf; |
---|
596 | //---------- computation of p*Hom(J,J) as R-ideal ----------------------------- |
---|
597 | if ( y>=1 ) |
---|
598 | { |
---|
599 | "// compute p*Hom(J,J) = p*J:J"; |
---|
600 | "// the ideal J:";J; |
---|
601 | } |
---|
602 | f = quotient(p*J,J); |
---|
603 | |
---|
604 | //### (neu GMG 4.10.08) divide by the greatest common divisor: |
---|
605 | poly gg = gcd( f[1],p ); |
---|
606 | for(ii=2; ii <=ncols(f); ii++) |
---|
607 | { |
---|
608 | gg=gcd(gg,f[ii]); |
---|
609 | } |
---|
610 | for(ii=1; ii<=ncols(f); ii++) |
---|
611 | { |
---|
612 | f[ii]=f[ii]/gg; |
---|
613 | } |
---|
614 | p = p/gg; |
---|
615 | |
---|
616 | if ( y>=1 ) |
---|
617 | { |
---|
618 | "// the non-zerodivisor p:"; p; |
---|
619 | "// the module p*Hom(J,J) = p*J:J :"; f; |
---|
620 | ""; |
---|
621 | } |
---|
622 | f2 = std(p); |
---|
623 | |
---|
624 | //---------- Test: Hom(J,J) == R ?, if yes, go home --------------------------- |
---|
625 | |
---|
626 | //rf = interred(reduce(f,f2)); |
---|
627 | //### interred hier weggelassen, unten zugefgt |
---|
628 | rf = reduce(f,f2); //represents p*Hom(J,J)/p*R = Hom(J,J)/R |
---|
629 | if ( size(rf) == 0 ) |
---|
630 | { |
---|
631 | if ( homog(f) && find(ordstr(basering),"s")==0 ) |
---|
632 | { |
---|
633 | ring newR1 = char(P),(X(1..nvars(P))),(a(rw),dp); |
---|
634 | } |
---|
635 | else |
---|
636 | { |
---|
637 | ring newR1 = char(P),(X(1..nvars(P))),dp; |
---|
638 | } |
---|
639 | ideal endphi = maxideal(1); |
---|
640 | ideal endid = fetch(P,id); |
---|
641 | endid = simplify(endid,2); |
---|
642 | L = substpart(endid,endphi,homo,rw); //## hier substpart |
---|
643 | def lastRing = L[1]; |
---|
644 | setring lastRing; |
---|
645 | |
---|
646 | attrib(endid,"onlySingularAtZero",oSAZ); |
---|
647 | attrib(endid,"isCohenMacaulay",isCo); |
---|
648 | attrib(endid,"isPrim",isPr); |
---|
649 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
650 | attrib(endid,"isRegInCodim2",isRe); |
---|
651 | attrib(endid,"isEqudimensional",isEq); |
---|
652 | attrib(endid,"isHypersurface",0); |
---|
653 | attrib(endid,"isCompleteIntersection",0); |
---|
654 | attrib(endid,"isRadical",0); |
---|
655 | L=lastRing; |
---|
656 | L = insert(L,1,1); |
---|
657 | dbprint(y,"// case R = Hom(J,J)"); |
---|
658 | if(y>=1) |
---|
659 | { |
---|
660 | "// R=Hom(J,J)"; |
---|
661 | lastRing; |
---|
662 | "// the new ideal"; |
---|
663 | endid; |
---|
664 | " "; |
---|
665 | "// the old ring"; |
---|
666 | P; |
---|
667 | "// the old ideal"; |
---|
668 | setring P; |
---|
669 | id; |
---|
670 | " "; |
---|
671 | setring lastRing; |
---|
672 | "// the map to the new ring"; |
---|
673 | endphi; |
---|
674 | " "; |
---|
675 | pause(); |
---|
676 | ""; |
---|
677 | } |
---|
678 | setring P; |
---|
679 | L[3]=0; |
---|
680 | return(L); |
---|
681 | } |
---|
682 | if(y>=1) |
---|
683 | { |
---|
684 | "// R is not equal to Hom(J,J), we have to try again"; |
---|
685 | pause(); |
---|
686 | ""; |
---|
687 | } |
---|
688 | //---------- Hom(J,J) != R: create new ring and map from old ring ------------- |
---|
689 | // the ring newR1/SBid+syzf will be isomorphic to Hom(J,J) as R-module |
---|
690 | // f2=p (i.e. ideal generated by p) |
---|
691 | |
---|
692 | //f = mstd(f)[2]; //### gendert GMG 04.10.08 |
---|
693 | //ideal ann = quotient(f2,f); //### f durch rf ersetzt |
---|
694 | rf = mstd(rf)[2]; //rf = NF(f,p), hence <p,rf> = <p,f> |
---|
695 | ideal ann = quotient(f2,rf); //p:f = p:rf |
---|
696 | |
---|
697 | //------------- compute the contribution to delta ---------- |
---|
698 | //delt=dim_K(Hom(JJ)/R (or -1 if infinite) |
---|
699 | |
---|
700 | int delt=vdim(std(modulo(f,ideal(p)))); |
---|
701 | |
---|
702 | f = p,rf; // generates pJ:J mod(p), i.e. p*Hom(J,J)/p*R as R-module |
---|
703 | q = size(f); |
---|
704 | syzf = syz(f); |
---|
705 | |
---|
706 | if ( homo==1 ) |
---|
707 | { |
---|
708 | rw1 = rw,0; |
---|
709 | for ( ii=2; ii<=q; ii++ ) |
---|
710 | { |
---|
711 | rw = rw, deg(f[ii])-deg(f[1]); |
---|
712 | rw1 = rw1, deg(f[ii])-deg(f[1]); |
---|
713 | } |
---|
714 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),(a(rw1),dp); |
---|
715 | } |
---|
716 | else |
---|
717 | { |
---|
718 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),dp; |
---|
719 | } |
---|
720 | |
---|
721 | //map psi1 = P,maxideal(1); //### psi1 durch fetch ersetzt |
---|
722 | //ideal SBid = psi1(SBid); |
---|
723 | ideal SBid = fetch(P,SBid); |
---|
724 | attrib(SBid,"isSB",1); |
---|
725 | |
---|
726 | qring newR = std(SBid); |
---|
727 | |
---|
728 | //map psi = R,ideal(X(1..nvars(R))); //### psi durch fetch ersetzt |
---|
729 | //ideal id = psi(id); |
---|
730 | //ideal f = psi(f); |
---|
731 | //module syzf = psi(syzf); |
---|
732 | ideal id = fetch(R,id); |
---|
733 | ideal f = fetch(R,f); |
---|
734 | module syzf = fetch(R,syzf); |
---|
735 | ideal pf,Lin,Quad,Q; |
---|
736 | matrix T,A; |
---|
737 | list L1; |
---|
738 | |
---|
739 | //---------- computation of Hom(J,J) as affine ring --------------------------- |
---|
740 | // determine kernel of: R[T1,...,Tq] -> J:J >-> R[1/p]=R[t]/(t*p-1), |
---|
741 | // Ti -> fi/p -> t*fi (p=f1=f[1]), to get ring structure. This is of course |
---|
742 | // the same as the kernel of R[T1,...,Tq] -> pJ:J >-> R, Ti -> fi. |
---|
743 | // It is a fact, that the kernel is generated by the linear and the quadratic |
---|
744 | // relations |
---|
745 | // f=p,rf, rf=reduce(f,p), generates pJ:J mod(p), |
---|
746 | // i.e. p*Hom(J,J)/p*R as R-module |
---|
747 | |
---|
748 | pf = f[1]*f; |
---|
749 | T = matrix(ideal(T(1..q)),1,q); |
---|
750 | Lin = ideal(T*syzf); |
---|
751 | if(y>=1) |
---|
752 | { |
---|
753 | "// the ring structure of Hom(J,J) as R-algebra"; |
---|
754 | "// the linear relations:"; |
---|
755 | Lin; |
---|
756 | } |
---|
757 | |
---|
758 | poly ff; |
---|
759 | for (ii=2; ii<=q; ii++ ) |
---|
760 | { |
---|
761 | for ( jj=2; jj<=ii; jj++ ) |
---|
762 | { |
---|
763 | ff = NF(f[ii]*f[jj],std(0)); //this makes lift much faster |
---|
764 | A = lift(pf,ff); //ff lin. comb. of elts of pf mod I |
---|
765 | Quad = Quad, ideal(T(jj)*T(ii) - T*A); //quadratic relations |
---|
766 | } |
---|
767 | } |
---|
768 | |
---|
769 | if(y>=1) |
---|
770 | { |
---|
771 | "// the quadratic relations"; |
---|
772 | Quad; |
---|
773 | pause(); |
---|
774 | newline; |
---|
775 | } |
---|
776 | Q = Lin,Quad; |
---|
777 | Q = subst(Q,T(1),1); |
---|
778 | //Q = mstd(Q)[2]; //### sehr aufwendig, daher weggelassen (GMG) |
---|
779 | //### ev das neue interred |
---|
780 | //mstd dient nur zum verkleinern, die SB-Eigenschaft geht spaeter verloren |
---|
781 | //da in neuen Ring abgebildet und mit id vereinigt |
---|
782 | |
---|
783 | //---------- reduce number of variables by substitution, if possible ---------- |
---|
784 | if (homo==1) |
---|
785 | { |
---|
786 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),(a(rw),dp); |
---|
787 | } |
---|
788 | else |
---|
789 | { |
---|
790 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),dp; |
---|
791 | } |
---|
792 | |
---|
793 | ideal endid = imap(newR,id),imap(newR,Q); |
---|
794 | //hier wird Q weiterverwendet, die SB-Eigenschaft wird nicht verwendet. |
---|
795 | endid = simplify(endid,2); |
---|
796 | ideal endphi = ideal(X(1..nvars(R))); |
---|
797 | |
---|
798 | |
---|
799 | if(noRed == 0) |
---|
800 | { |
---|
801 | L = substpart(endid,endphi,homo,rw); |
---|
802 | def lastRing=L[1]; |
---|
803 | setring lastRing; |
---|
804 | //return(lastRing); |
---|
805 | } |
---|
806 | else |
---|
807 | { |
---|
808 | list RL = ringlist(newRing); |
---|
809 | def lastRing = ring(RL); |
---|
810 | setring lastRing; |
---|
811 | ideal endid = fetch(newRing, endid); |
---|
812 | ideal endphi = fetch(newRing, endphi); |
---|
813 | export(endid); |
---|
814 | export(endphi); |
---|
815 | //def lastRing = newRing; |
---|
816 | //setring R; |
---|
817 | //return(newR); |
---|
818 | } |
---|
819 | |
---|
820 | |
---|
821 | // L = substpart(endid,endphi,homo,rw); |
---|
822 | |
---|
823 | // def lastRing=L[1]; |
---|
824 | // setring lastRing; |
---|
825 | |
---|
826 | attrib(endid,"onlySingularAtZero",0); |
---|
827 | map sigma=R,endphi; |
---|
828 | ideal an=sigma(ann); |
---|
829 | export(an); //noetig? |
---|
830 | //ideal te=an,endid; |
---|
831 | //if(isIso && (size(reduce(te,std(maxideal(1))))==0)) //#### ok??? |
---|
832 | // { |
---|
833 | // attrib(endid,"onlySingularAtZero",oSAZ); |
---|
834 | // } |
---|
835 | //kill te; |
---|
836 | attrib(endid,"isCohenMacaulay",isCo); //#### ok??? |
---|
837 | attrib(endid,"isPrim",isPr); |
---|
838 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
839 | attrib(endid,"isRegInCodim2",isRe); |
---|
840 | attrib(endid,"isEquidimensional",isEq); |
---|
841 | attrib(endid,"isHypersurface",0); |
---|
842 | attrib(endid,"isCompleteIntersection",0); |
---|
843 | attrib(endid,"isRadical",0); |
---|
844 | if(y>=1) |
---|
845 | { |
---|
846 | "// the new ring after reduction of the number of variables"; |
---|
847 | lastRing; |
---|
848 | "// the new ideal"; |
---|
849 | endid; ""; |
---|
850 | "// the old ring"; |
---|
851 | P; |
---|
852 | "// the old ideal"; |
---|
853 | setring P; |
---|
854 | id; |
---|
855 | " "; |
---|
856 | setring lastRing; |
---|
857 | "// the map to the new ring"; |
---|
858 | endphi; |
---|
859 | " "; |
---|
860 | pause(); |
---|
861 | ""; |
---|
862 | } |
---|
863 | L = lastRing; |
---|
864 | L = insert(L,0,1); |
---|
865 | L[3] = delt; |
---|
866 | return(L); |
---|
867 | } |
---|
868 | example |
---|
869 | {"EXAMPLE:"; echo = 2; |
---|
870 | ring r = 0,(x,y),wp(2,3); |
---|
871 | ideal id = y^2-x^3; |
---|
872 | ideal J = x,y; |
---|
873 | poly p = x; |
---|
874 | list Li = std(id),id,J,p; |
---|
875 | list L = HomJJ(Li); |
---|
876 | def end = L[1]; // defines ring L[1], containing ideals endid, endphi |
---|
877 | setring end; // makes end the basering |
---|
878 | end; |
---|
879 | endid; // end/endid is isomorphic to End(r/id) as ring |
---|
880 | map psi = r,endphi;// defines the canonical map r/id -> End(r/id) |
---|
881 | psi; |
---|
882 | L[3]; // contribution to delta |
---|
883 | } |
---|
884 | |
---|
885 | |
---|
886 | /////////////////////////////////////////////////////////////////////////////// |
---|
887 | //compute intersection multiplicities as needed for delta(I) in |
---|
888 | //normalizationPrimes and normalP: |
---|
889 | |
---|
890 | proc iMult (list prim) |
---|
891 | "USAGE: iMult(L); L a list of ideals |
---|
892 | RETURN: int, the intersection multiplicity of the ideals of L; |
---|
893 | if iMult(L) is infinite, -1 is returned. |
---|
894 | THEORY: If r=size(L)=2 then iMult(L) = vdim(std(L[1]+L[2])) and in general |
---|
895 | iMult(L) = sum{ iMult(L[j],Lj) | j=1..r-1 } with Lj the intersection |
---|
896 | of L[j+1],...,L[r]. If I is the intersection of all ideals in L then |
---|
897 | we have delta(I) = delta(L[1])+...+delta(L[r]) + iMult(L) where |
---|
898 | delta(I) = vdim (normalisation(R/I)/(R/I)), R the basering. |
---|
899 | EXAMPLE: example iMult; shows an example |
---|
900 | " |
---|
901 | { int i,mul,mu; |
---|
902 | int sp = size(prim); |
---|
903 | int y = printlevel-voice+2; |
---|
904 | if ( sp > 1 ) |
---|
905 | { |
---|
906 | ideal I(sp-1) = prim[sp]; |
---|
907 | mu = vdim(std(I(sp-1)+prim[sp-1])); |
---|
908 | mul = mu; |
---|
909 | if ( y>=1 ) |
---|
910 | { |
---|
911 | "// intersection multiplicity of component",sp,"with",sp-1,":"; mu; |
---|
912 | } |
---|
913 | if ( mu >= 0 ) |
---|
914 | { |
---|
915 | for (i=sp-2; i>=1 ; i--) |
---|
916 | { |
---|
917 | ideal I(i) = intersect(I(i+1),prim[i+1]); |
---|
918 | mu = vdim(std(I(i)+prim[i])); |
---|
919 | if ( mu < 0 ) |
---|
920 | { |
---|
921 | break; |
---|
922 | } |
---|
923 | mul = mul + mu; |
---|
924 | if ( y>=1 ) |
---|
925 | { |
---|
926 | "// intersection multiplicity of components",sp,"...",i+1,"with",i; mu; |
---|
927 | } |
---|
928 | } |
---|
929 | } |
---|
930 | } |
---|
931 | return(mul); |
---|
932 | } |
---|
933 | example |
---|
934 | { "EXAMPLE:"; echo = 2; |
---|
935 | ring s = 23,(x,y),dp; |
---|
936 | list L = (x-y),(x3+y2); |
---|
937 | iMult(L); |
---|
938 | L = (x-y),(x3+y2),(x3-y4); |
---|
939 | iMult(L); |
---|
940 | } |
---|
941 | /////////////////////////////////////////////////////////////////////////////// |
---|
942 | //check if I has a singularity only at zero, as needed in normalizationPrimes |
---|
943 | |
---|
944 | proc locAtZero (ideal I) |
---|
945 | "USAGE: locAtZero(I); I = ideal |
---|
946 | RETURN: int, 1 if I has only one point which is located at zero, 0 otherwise |
---|
947 | ASSUME: I is given as a standard bases in the basering |
---|
948 | NOTE: only useful in affine rings, in local rings vdim does the check |
---|
949 | EXAMPLE: example locAtZero; shows an example |
---|
950 | " |
---|
951 | { |
---|
952 | int ii,jj, caz; //caz: conzentrated at zero |
---|
953 | int dbp = printlevel-voice+2; |
---|
954 | int nva = nvars(basering); |
---|
955 | int vdi = vdim(I); |
---|
956 | if ( vdi < 0 ) |
---|
957 | { |
---|
958 | if (dbp >=1) |
---|
959 | { "// non-isolated singularitiy";""; } |
---|
960 | return(caz); |
---|
961 | } |
---|
962 | |
---|
963 | //Now the ideal is 0-dim |
---|
964 | //First an easy test |
---|
965 | //If I is homogenous and not constant it is concentrated at 0 |
---|
966 | if( homog(I)==1 && size(jet(I,0))==0) |
---|
967 | { |
---|
968 | caz=1; |
---|
969 | if (dbp >=1) |
---|
970 | { "// isolated singularity and homogeneous";""; } |
---|
971 | return(caz); |
---|
972 | } |
---|
973 | |
---|
974 | //Now the general case with I 0-dim. Choose an appropriate power pot, |
---|
975 | //and check each variable x whether x^pot is in I. |
---|
976 | int mi1 = mindeg1(lead(I)); |
---|
977 | int pot = vdi; |
---|
978 | if ( (mi1+(mi1==1))^2 < vdi ) |
---|
979 | { |
---|
980 | pot = (mi1+(mi1==1))^2; //### alternativ: pot = vdi lassen |
---|
981 | } |
---|
982 | |
---|
983 | while ( 1 ) |
---|
984 | { |
---|
985 | caz = 1; |
---|
986 | for ( ii=1; ii<= nva; ii++ ) |
---|
987 | { |
---|
988 | if ( NF(var(ii)^pot,I) != 0 ) |
---|
989 | { |
---|
990 | caz = 0; break; |
---|
991 | } |
---|
992 | } |
---|
993 | if ( caz == 1 || pot >= vdi ) |
---|
994 | { |
---|
995 | if (dbp >=1) |
---|
996 | { |
---|
997 | "// mindeg, exponent, vdim used in 'locAtZero':", mi1,pot,vdi; ""; |
---|
998 | } |
---|
999 | return(caz); |
---|
1000 | } |
---|
1001 | else |
---|
1002 | { |
---|
1003 | if ( pot^2 < vdi ) |
---|
1004 | { pot = pot^2; } |
---|
1005 | else |
---|
1006 | { pot = vdi; } |
---|
1007 | } |
---|
1008 | } |
---|
1009 | } |
---|
1010 | example |
---|
1011 | { "EXAMPLE:"; echo = 2; |
---|
1012 | ring r = 0,(x,y,z),dp; |
---|
1013 | poly f = z5+y4+x3+xyz; |
---|
1014 | ideal i = jacob(f),f; |
---|
1015 | i=std(i); |
---|
1016 | locAtZero(i); |
---|
1017 | i= std(i*ideal(x-1,y,z)); |
---|
1018 | locAtZero(i); |
---|
1019 | } |
---|
1020 | |
---|
1021 | /////////////////////////////////////////////////////////////////////////////// |
---|
1022 | |
---|
1023 | //The next procedure normalizationPrimes computes the normalization of an |
---|
1024 | //irreducible or an equidimensional ideal i. |
---|
1025 | //- If i is irreducuble, then the returned list, say nor, has size 2 |
---|
1026 | //with nor[1] the normalization ring and nor[2] the delta invariant. |
---|
1027 | //- If i is equidimensional, than the "splitting tools" can create a |
---|
1028 | //decomposition of i and nor can have more than 1 ring. |
---|
1029 | |
---|
1030 | static proc normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #) |
---|
1031 | "USAGE: normalizationPrimes(i,ihp,delt[,si]); i = equidimensional ideal, |
---|
1032 | ihp = map (partial normalization), delt = partial delta-invariant, |
---|
1033 | si = ideal s.t. V(si) contains singular locus (optional) |
---|
1034 | RETURN: a list of rings, say nor, and an integer, the delta-invariant |
---|
1035 | at the end of the list. |
---|
1036 | each ring nor[j], j = 1..size(nor)-1, contains two ideals |
---|
1037 | with given names norid and normap such that |
---|
1038 | - the direct sum of the rings nor[j]/norid is |
---|
1039 | the normalization of basering/i; |
---|
1040 | - normap gives the normalization map from basering/id |
---|
1041 | to nor[j]/norid (for each j) |
---|
1042 | nor[size(nor)] = dim_K(normalisation(P/i) / (P/i)) is the |
---|
1043 | delta-invariant, where P is the basering. |
---|
1044 | EXAMPLE: example normalizationPrimes; shows an example |
---|
1045 | " |
---|
1046 | { |
---|
1047 | //Note: this procedure calls itself as long as the test for |
---|
1048 | //normality, i.e if R==Hom(J,J), is negative. |
---|
1049 | |
---|
1050 | int printlev = printlevel; //store printlevel in order to reset it later |
---|
1051 | int y = printlevel-voice+2; // y=printlevel (default: y=0) |
---|
1052 | if(y>=1) |
---|
1053 | { |
---|
1054 | ""; |
---|
1055 | "// START a normalization loop with the ideal"; |
---|
1056 | i; ""; |
---|
1057 | "// in the ring:"; |
---|
1058 | basering; ""; |
---|
1059 | pause(); |
---|
1060 | ""; |
---|
1061 | } |
---|
1062 | |
---|
1063 | def BAS=basering; |
---|
1064 | list result,keepresult1,keepresult2,JM,gnirlist; |
---|
1065 | ideal J,SB,MB; |
---|
1066 | int depth,lauf,prdim,osaz; |
---|
1067 | int ti=timer; |
---|
1068 | |
---|
1069 | gnirlist = ringlist(BAS); |
---|
1070 | |
---|
1071 | //----------- the trivial case of a zero ideal as input, RETURN ------------ |
---|
1072 | if(size(i)==0) |
---|
1073 | { |
---|
1074 | if(y>=1) |
---|
1075 | { |
---|
1076 | "// the ideal was the zero-ideal"; |
---|
1077 | } |
---|
1078 | // execute("ring newR7="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1079 | // +ordstr(basering)+");"); |
---|
1080 | def newR7 = ring(gnirlist); |
---|
1081 | setring newR7; |
---|
1082 | ideal norid=ideal(0); |
---|
1083 | ideal normap=fetch(BAS,ihp); |
---|
1084 | export norid; |
---|
1085 | export normap; |
---|
1086 | result=newR7; |
---|
1087 | result[size(result)+1]=list(delt,delti); |
---|
1088 | setring BAS; |
---|
1089 | return(result); |
---|
1090 | } |
---|
1091 | |
---|
1092 | //--------------- General NOTATION, compute SB of input ----------------- |
---|
1093 | // SM is a list, the result of mstd(i) |
---|
1094 | // SM[1] = SB of input ideal i, |
---|
1095 | // SM[2] = (minimal) generators for i. |
---|
1096 | // We work with SM and will copy the attributes from i to SM[2] |
---|
1097 | // JM will be a list, either JM[1]=maxideal(1),JM[2]=maxideal(1) |
---|
1098 | // in case i has onlySingularAtZero, or JM = mstd(si) where si = #[1], |
---|
1099 | // or JM = mstd(J) where J is the ideal of the singular locus |
---|
1100 | // JM[2] must be (made) radical |
---|
1101 | |
---|
1102 | if(y>=1) |
---|
1103 | { |
---|
1104 | "// SB-computation of the ideal"; |
---|
1105 | } |
---|
1106 | |
---|
1107 | list SM = mstd(i); //Now the work starts |
---|
1108 | int dimSM = dim(SM[1]); //dimension of variety to normalize |
---|
1109 | if(y>=1) |
---|
1110 | { |
---|
1111 | "// the dimension is:"; dimSM; |
---|
1112 | } |
---|
1113 | //----------------- the general case, set attributes ---------------- |
---|
1114 | //Note: onlySingularAtZero is NOT preserved under the ring extension |
---|
1115 | //basering --> Hom(J,J) (in contrast to isIsolatedSingularity), |
---|
1116 | //therefore we reset it: |
---|
1117 | |
---|
1118 | attrib(i,"onlySingularAtZero",0); |
---|
1119 | |
---|
1120 | if(attrib(i,"isPrim")==1) |
---|
1121 | { |
---|
1122 | attrib(SM[2],"isPrim",1); |
---|
1123 | } |
---|
1124 | else |
---|
1125 | { |
---|
1126 | attrib(SM[2],"isPrim",0); |
---|
1127 | } |
---|
1128 | if(attrib(i,"isIsolatedSingularity")==1) |
---|
1129 | { |
---|
1130 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
1131 | } |
---|
1132 | else |
---|
1133 | { |
---|
1134 | attrib(SM[2],"isIsolatedSingularity",0); |
---|
1135 | } |
---|
1136 | if(attrib(i,"isCohenMacaulay")==1) |
---|
1137 | { |
---|
1138 | attrib(SM[2],"isCohenMacaulay",1); |
---|
1139 | } |
---|
1140 | else |
---|
1141 | { |
---|
1142 | attrib(SM[2],"isCohenMacaulay",0); |
---|
1143 | } |
---|
1144 | if(attrib(i,"isRegInCodim2")==1) |
---|
1145 | { |
---|
1146 | attrib(SM[2],"isRegInCodim2",1); |
---|
1147 | } |
---|
1148 | else |
---|
1149 | { |
---|
1150 | attrib(SM[2],"isRegInCodim2",0); |
---|
1151 | } |
---|
1152 | if(attrib(i,"isEquidimensional")==1) |
---|
1153 | { |
---|
1154 | attrib(SM[2],"isEquidimensional",1); |
---|
1155 | } |
---|
1156 | else |
---|
1157 | { |
---|
1158 | attrib(SM[2],"isEquidimensional",0); |
---|
1159 | } |
---|
1160 | if(attrib(i,"isCompleteIntersection")==1) |
---|
1161 | { |
---|
1162 | attrib(SM[2],"isCompleteIntersection",1); |
---|
1163 | } |
---|
1164 | else |
---|
1165 | { |
---|
1166 | attrib(SM[2],"isCompleteIntersection",0); |
---|
1167 | } |
---|
1168 | if(attrib(i,"isHypersurface")==1) |
---|
1169 | { |
---|
1170 | attrib(SM[2],"isHypersurface",1); |
---|
1171 | } |
---|
1172 | else |
---|
1173 | { |
---|
1174 | attrib(SM[2],"isHypersurface",0); |
---|
1175 | } |
---|
1176 | |
---|
1177 | if(attrib(i,"onlySingularAtZero")==1) |
---|
1178 | { |
---|
1179 | attrib(SM[2],"onlySingularAtZero",1); |
---|
1180 | } |
---|
1181 | else |
---|
1182 | { |
---|
1183 | attrib(SM[2],"onlySingularAtZero",0); |
---|
1184 | } |
---|
1185 | |
---|
1186 | //------- an easy and cheap test for onlySingularAtZero --------- |
---|
1187 | if( (attrib(SM[2],"isIsolatedSingularity")==1) && (homog(SM[2])==1) ) |
---|
1188 | { |
---|
1189 | attrib(SM[2],"onlySingularAtZero",1); |
---|
1190 | } |
---|
1191 | |
---|
1192 | //-------------------- Trivial cases, in each case RETURN ------------------ |
---|
1193 | // input ideal is the ideal of a partial normalization |
---|
1194 | |
---|
1195 | // ------------ Trivial case: input ideal contains a unit --------------- |
---|
1196 | if( dimSM == -1) |
---|
1197 | { ""; |
---|
1198 | " // A unit ideal was found."; |
---|
1199 | " // Stop with partial result computed so far";""; |
---|
1200 | |
---|
1201 | MB=SM[2]; |
---|
1202 | intvec rw; |
---|
1203 | list LL=substpart(MB,ihp,0,rw); |
---|
1204 | def newR6=LL[1]; |
---|
1205 | setring newR6; |
---|
1206 | ideal norid=endid; |
---|
1207 | ideal normap=endphi; |
---|
1208 | kill endid,endphi; |
---|
1209 | export norid; |
---|
1210 | export normap; |
---|
1211 | result=newR6; |
---|
1212 | result[size(result)+1]=list(delt,delti); |
---|
1213 | setring BAS; |
---|
1214 | return(result); |
---|
1215 | } |
---|
1216 | |
---|
1217 | // --- Trivial case: input ideal is zero-dimensional and homog --- |
---|
1218 | if( (dim(SM[1])==0) && (homog(SM[2])==1) ) |
---|
1219 | { |
---|
1220 | if(y>=1) |
---|
1221 | { |
---|
1222 | "// the ideal was zero-dimensional and homogeneous"; |
---|
1223 | } |
---|
1224 | MB=maxideal(1); |
---|
1225 | intvec rw; |
---|
1226 | list LL=substpart(MB,ihp,0,rw); |
---|
1227 | def newR5=LL[1]; |
---|
1228 | setring newR5; |
---|
1229 | ideal norid=endid; |
---|
1230 | ideal normap=endphi; |
---|
1231 | kill endid,endphi; |
---|
1232 | export norid; |
---|
1233 | export normap; |
---|
1234 | result=newR5; |
---|
1235 | result[size(result)+1]=list(delt,delti); |
---|
1236 | setring BAS; |
---|
1237 | return(result); |
---|
1238 | } |
---|
1239 | |
---|
1240 | // --- Trivial case: input ideal defines a line --- |
---|
1241 | //the one-dimensional, homogeneous case and degree 1 case |
---|
1242 | if( (dim(SM[1])==1) && (maxdeg1(SM[2])==1) && (homog(SM[2])==1) ) |
---|
1243 | { |
---|
1244 | if(y>=1) |
---|
1245 | { |
---|
1246 | "// the ideal defines a line"; |
---|
1247 | } |
---|
1248 | MB=SM[2]; |
---|
1249 | intvec rw; |
---|
1250 | list LL=substpart(MB,ihp,0,rw); |
---|
1251 | def newR4=LL[1]; |
---|
1252 | setring newR4; |
---|
1253 | ideal norid=endid; |
---|
1254 | ideal normap=endphi; |
---|
1255 | kill endid,endphi; |
---|
1256 | export norid; |
---|
1257 | export normap; |
---|
1258 | result=newR4; |
---|
1259 | result[size(result)+1]=list(delt,delti); |
---|
1260 | setring BAS; |
---|
1261 | return(result); |
---|
1262 | } |
---|
1263 | |
---|
1264 | //---------------------- The non-trivial cases start ------------------- |
---|
1265 | //the higher dimensional case |
---|
1266 | //we test first hypersurface, CohenMacaulay and complete intersection |
---|
1267 | |
---|
1268 | if( ((size(SM[2])+dim(SM[1])) == nvars(basering)) ) |
---|
1269 | { |
---|
1270 | //the test for complete intersection |
---|
1271 | attrib(SM[2],"isCohenMacaulay",1); |
---|
1272 | attrib(SM[2],"isCompleteIntersection",1); |
---|
1273 | attrib(SM[2],"isEquidimensional",1); |
---|
1274 | if(y>=1) |
---|
1275 | { |
---|
1276 | "// the ideal is a complete intersection"; |
---|
1277 | } |
---|
1278 | } |
---|
1279 | if( size(SM[2]) == 1 ) |
---|
1280 | { |
---|
1281 | attrib(SM[2],"isHypersurface",1); |
---|
1282 | if(y>=1) |
---|
1283 | { |
---|
1284 | "// the ideal is a hypersurface"; |
---|
1285 | } |
---|
1286 | } |
---|
1287 | |
---|
1288 | //------------------- compute the singular locus ------------------- |
---|
1289 | // Computation if singular locus is critical |
---|
1290 | // Notation: J ideal of singular locus or (if given) containing it |
---|
1291 | // JM = mstd(J) or maxideal(1),maxideal(1) |
---|
1292 | // JM[1] SB of singular locus, JM[2] minbasis, dimJ = dim(JM[1]) |
---|
1293 | // SM[1] SB of the input ideal i, SM[2] minbasis |
---|
1294 | // Computation if singular locus is critical, because it determines the |
---|
1295 | // size of the ring Hom_R(J,J). We only need a test ideal contained in J. |
---|
1296 | |
---|
1297 | //----------------------- onlySingularAtZero ------------------------- |
---|
1298 | if( attrib(SM[2],"onlySingularAtZero") ) |
---|
1299 | { |
---|
1300 | JM = maxideal(1),maxideal(1); |
---|
1301 | attrib(JM[1],"isSB",1); |
---|
1302 | attrib(JM[2],"isRadical",1); |
---|
1303 | if( dim(SM[1]) >=2 ) |
---|
1304 | { |
---|
1305 | attrib(SM[2],"isRegInCodim2",1); |
---|
1306 | } |
---|
1307 | } |
---|
1308 | |
---|
1309 | //-------------------- not onlySingularAtZero ------------------------- |
---|
1310 | if( attrib(SM[2],"onlySingularAtZero") == 0 ) |
---|
1311 | { |
---|
1312 | //--- the case where an ideal #[1] is given: |
---|
1313 | if( size(#)>0 ) |
---|
1314 | { |
---|
1315 | J = #[1],SM[2]; |
---|
1316 | JM = mstd(J); |
---|
1317 | if( typeof(attrib(#[1],"isRadical"))!="int" ) |
---|
1318 | { |
---|
1319 | attrib(JM[2],"isRadical",0); |
---|
1320 | } |
---|
1321 | } |
---|
1322 | |
---|
1323 | //--- the case where an ideal #[1] is not given: |
---|
1324 | if( (size(#)==0) ) |
---|
1325 | { |
---|
1326 | if(y >=1 ) |
---|
1327 | { |
---|
1328 | "// singular locus will be computed"; |
---|
1329 | } |
---|
1330 | |
---|
1331 | J = SM[1],minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]); |
---|
1332 | if( y >=1 ) |
---|
1333 | { |
---|
1334 | "// SB of singular locus will be computed"; |
---|
1335 | } |
---|
1336 | JM = mstd(J); |
---|
1337 | } |
---|
1338 | |
---|
1339 | int dimJ = dim(JM[1]); |
---|
1340 | attrib(JM[1],"isSB",1); |
---|
1341 | if( y>=1 ) |
---|
1342 | { |
---|
1343 | "// the dimension of the singular locus is"; dimJ ; ""; |
---|
1344 | } |
---|
1345 | |
---|
1346 | if(dim(JM[1]) <= dim(SM[1])-2) |
---|
1347 | { |
---|
1348 | attrib(SM[2],"isRegInCodim2",1); |
---|
1349 | } |
---|
1350 | |
---|
1351 | //------------------ the smooth case, RETURN ------------------- |
---|
1352 | if( dimJ == -1 ) |
---|
1353 | { |
---|
1354 | if(y>=1) |
---|
1355 | { |
---|
1356 | "// the ideal is smooth"; |
---|
1357 | } |
---|
1358 | MB=SM[2]; |
---|
1359 | intvec rw; |
---|
1360 | list LL=substpart(MB,ihp,0,rw); |
---|
1361 | def newR3=LL[1]; |
---|
1362 | setring newR3; |
---|
1363 | ideal norid=endid; |
---|
1364 | ideal normap=endphi; |
---|
1365 | kill endid,endphi; |
---|
1366 | export norid; |
---|
1367 | export normap; |
---|
1368 | result=newR3; |
---|
1369 | result[size(result)+1]=list(delt,delti); |
---|
1370 | setring BAS; |
---|
1371 | return(result); |
---|
1372 | } |
---|
1373 | |
---|
1374 | //------- extra check for onlySingularAtZero, relatively cheap ---------- |
---|
1375 | //it uses the procedure 'locAtZero' from for testing |
---|
1376 | //if an ideal is concentrated at 0 |
---|
1377 | if(y>=1) |
---|
1378 | { |
---|
1379 | "// extra test for onlySingularAtZero:"; |
---|
1380 | } |
---|
1381 | if ( locAtZero(JM[1]) ) |
---|
1382 | { |
---|
1383 | attrib(SM[2],"onlySingularAtZero",1); |
---|
1384 | JM = maxideal(1),maxideal(1); |
---|
1385 | attrib(JM[1],"isSB",1); |
---|
1386 | attrib(JM[2],"isRadical",1); |
---|
1387 | } |
---|
1388 | else |
---|
1389 | { |
---|
1390 | attrib(SM[2],"onlySingularAtZero",0); |
---|
1391 | } |
---|
1392 | } |
---|
1393 | |
---|
1394 | //displaying the attributes: |
---|
1395 | if(y>=2) |
---|
1396 | { |
---|
1397 | "// the attributes of the ideal are:"; |
---|
1398 | "// isCohenMacaulay:", attrib(SM[2],"isCohenMacaulay"); |
---|
1399 | "// isCompleteIntersection:", attrib(SM[2],"isCompleteIntersection"); |
---|
1400 | "// isHypersurface:", attrib(SM[2],"isHypersurface"); |
---|
1401 | "// isEquidimensional:", attrib(SM[2],"isEquidimensional"); |
---|
1402 | "// isPrim:", attrib(SM[2],"isPrim"); |
---|
1403 | "// isRegInCodim2:", attrib(SM[2],"isRegInCodim2"); |
---|
1404 | "// isIsolatedSingularity:", attrib(SM[2],"isIsolatedSingularity"); |
---|
1405 | "// onlySingularAtZero:", attrib(SM[2],"onlySingularAtZero"); |
---|
1406 | "// isRad:", attrib(SM[2],"isRad");""; |
---|
1407 | } |
---|
1408 | |
---|
1409 | //------------- case: CohenMacaulay in codim 2, RETURN --------------- |
---|
1410 | if( (attrib(SM[2],"isRegInCodim2")==1) && |
---|
1411 | (attrib(SM[2],"isCohenMacaulay")==1) ) |
---|
1412 | { |
---|
1413 | if(y>=1) |
---|
1414 | { |
---|
1415 | "// the ideal was CohenMacaulay and regular in codim 2, hence normal"; |
---|
1416 | } |
---|
1417 | MB=SM[2]; |
---|
1418 | intvec rw; |
---|
1419 | list LL=substpart(MB,ihp,0,rw); |
---|
1420 | def newR6=LL[1]; |
---|
1421 | setring newR6; |
---|
1422 | ideal norid=endid; |
---|
1423 | ideal normap=endphi; |
---|
1424 | kill endid,endphi; |
---|
1425 | export norid; |
---|
1426 | export normap; |
---|
1427 | result=newR6; |
---|
1428 | result[size(result)+1]=list(delt,delti); |
---|
1429 | setring BAS; |
---|
1430 | return(result); |
---|
1431 | } |
---|
1432 | |
---|
1433 | //---------- case: isolated singularity only at 0, RETURN ------------ |
---|
1434 | // In this case things are easier, we can use the maximal ideal as radical |
---|
1435 | // of the singular locus; |
---|
1436 | // JM mstd of ideal of singular locus, SM mstd of input ideal |
---|
1437 | |
---|
1438 | if( attrib(SM[2],"onlySingularAtZero") ) |
---|
1439 | { |
---|
1440 | //------ check variables for being a non zero-divizor ------ |
---|
1441 | // SL = ideal of vars not contained in ideal SM[1]: |
---|
1442 | |
---|
1443 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
1444 | ideal SL = simplify(reduce(maxideal(1),SM[1]),2); |
---|
1445 | ideal Ann = quotient(SM[2],SL[1]); |
---|
1446 | ideal qAnn = simplify(reduce(Ann,SM[1]),2); |
---|
1447 | //NOTE: qAnn=0 if and only if first var (=SL[1]) not in SM is a nzd of R/SM |
---|
1448 | |
---|
1449 | //------------- We found a non-zerodivisor of R/SM ----------------------- |
---|
1450 | // here the enlarging of the ring via Hom_R(J,J) starts |
---|
1451 | |
---|
1452 | if( size(qAnn)==0 ) |
---|
1453 | { |
---|
1454 | if(y>=1) |
---|
1455 | { |
---|
1456 | ""; |
---|
1457 | "// the ideal rad(J):"; maxideal(1); |
---|
1458 | ""; |
---|
1459 | } |
---|
1460 | |
---|
1461 | // ------------- test for normality, compute Hom_R(J,J) ------------- |
---|
1462 | // Note: |
---|
1463 | // HomJJ (ideal SBid, ideal id, ideal J, poly p) with |
---|
1464 | // SBid = SB of id, J = radical ideal of basering P with: |
---|
1465 | // nonNormal(R) is in V(J), J contains the nonzero divisor p |
---|
1466 | // of R = P/id (J = test ideal) |
---|
1467 | // returns a list l of three objects |
---|
1468 | // l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi' |
---|
1469 | // s.t. l[1]/endid = Hom_R(J,J) and endphi= map R -> Hom_R(J,J) |
---|
1470 | // l[2] : an integer which is 1 if phi is an isomorphism, 0 if not |
---|
1471 | // l[3] : an integer, = dim_K(Hom_R(J,J)/R) if finite, -1 otherwise |
---|
1472 | |
---|
1473 | list RR; |
---|
1474 | RR = SM[1],SM[2],maxideal(1),SL[1]; |
---|
1475 | RR = HomJJ(RR,y); |
---|
1476 | // --------------------- non-normal case ------------------ |
---|
1477 | //RR[2]==0 means that the test for normality is negative |
---|
1478 | if( RR[2]==0 ) |
---|
1479 | { |
---|
1480 | def newR=RR[1]; |
---|
1481 | setring newR; |
---|
1482 | map psi=BAS,endphi; |
---|
1483 | list JM = psi(JM); //### |
---|
1484 | ideal J = JM[2]; |
---|
1485 | if ( delt>=0 && RR[3]>=0 ) |
---|
1486 | { |
---|
1487 | delt = delt+RR[3]; |
---|
1488 | } |
---|
1489 | else |
---|
1490 | { delt = -1; } |
---|
1491 | delti[size(delti)]=delt; |
---|
1492 | |
---|
1493 | // ---------- recursive call of normalizationPrimes ----------- |
---|
1494 | //normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #) |
---|
1495 | //ihp = (partial) normalisation map from basering |
---|
1496 | //#[1] ideal s.t. V(#[1]) contains singular locus of i (test ideal) |
---|
1497 | |
---|
1498 | if ( y>=1 ) |
---|
1499 | { |
---|
1500 | "// case: onlySingularAtZero, non-zerodivisor found"; |
---|
1501 | "// contribution of delta in ringextension R -> Hom_R(J,J):"; delt; |
---|
1502 | } |
---|
1503 | |
---|
1504 | //intvec atr=getAttrib(endid); |
---|
1505 | //"//### case: isolated singularity only at 0, recursive"; |
---|
1506 | //"size endid:", size(endid), size(string(endid)); |
---|
1507 | //"interred:"; |
---|
1508 | //endid = interred(endid); |
---|
1509 | //endid = setAttrib(endid,atr); |
---|
1510 | //"size endid:", size(endid), size(string(endid)); |
---|
1511 | |
---|
1512 | printlevel=printlevel+1; |
---|
1513 | list tluser = |
---|
1514 | normalizationPrimes(endid,psi(ihp),delt,delti); |
---|
1515 | //list tluser = |
---|
1516 | // normalizationPrimes(endid,psi(ihp),delt,delti,J); |
---|
1517 | //#### ??? improvement: give also the old ideal of sing locus??? |
---|
1518 | |
---|
1519 | printlevel = printlev; //reset printlevel |
---|
1520 | setring BAS; |
---|
1521 | return(tluser); |
---|
1522 | } |
---|
1523 | |
---|
1524 | // ------------------ the normal case, RETURN ----------------- |
---|
1525 | // Now RR[2] must be 1, hence the test for normality was positive |
---|
1526 | MB=SM[2]; |
---|
1527 | //execute("ring newR7="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1528 | // +ordstr(basering)+");"); |
---|
1529 | def newR7 = ring(gnirlist); |
---|
1530 | setring newR7; |
---|
1531 | ideal norid=fetch(BAS,MB); |
---|
1532 | ideal normap=fetch(BAS,ihp); |
---|
1533 | if ( delt>=0 && RR[3]>=0 ) |
---|
1534 | { |
---|
1535 | delt = delt+RR[3]; |
---|
1536 | } |
---|
1537 | else |
---|
1538 | { delt = -1; } |
---|
1539 | delti[size(delti)]=delt; |
---|
1540 | |
---|
1541 | intvec atr = getAttrib(norid); |
---|
1542 | |
---|
1543 | //"//### case: isolated singularity only at 0, final"; |
---|
1544 | //"size norid:", size(norid), size(string(norid)); |
---|
1545 | //"interred:"; |
---|
1546 | //norid = interred(norid); |
---|
1547 | //norid = setAttrib(norid,atr); |
---|
1548 | //"size norid:", size(norid), size(string(norid)); |
---|
1549 | |
---|
1550 | export norid; |
---|
1551 | export normap; |
---|
1552 | result=newR7; |
---|
1553 | result[size(result)+1]=list(delt,delti); |
---|
1554 | setring BAS; |
---|
1555 | return(result); |
---|
1556 | } |
---|
1557 | |
---|
1558 | //------ zerodivisor of R/SM was found, gives a splitting ------------ |
---|
1559 | //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM |
---|
1560 | //and we have found a splitting: id and id1 |
---|
1561 | //id = Ann defines components of R/SM in the complement of V(SL[1]) |
---|
1562 | //id1 defines components of R/SM in the complement of V(id) |
---|
1563 | |
---|
1564 | else |
---|
1565 | { |
---|
1566 | ideal id = Ann; |
---|
1567 | attrib(id,"isCohenMacaulay",0); |
---|
1568 | attrib(id,"isPrim",0); |
---|
1569 | attrib(id,"isIsolatedSingularity",1); |
---|
1570 | attrib(id,"isRegInCodim2",0); |
---|
1571 | attrib(id,"isHypersurface",0); |
---|
1572 | attrib(id,"isCompleteIntersection",0); |
---|
1573 | attrib(id,"isEquidimensional",0); |
---|
1574 | attrib(id,"onlySingularAtZero",1); |
---|
1575 | |
---|
1576 | ideal id1 = quotient(SM[2],Ann); |
---|
1577 | attrib(id1,"isCohenMacaulay",0); |
---|
1578 | attrib(id1,"isPrim",0); |
---|
1579 | attrib(id1,"isIsolatedSingularity",1); |
---|
1580 | attrib(id1,"isRegInCodim2",0); |
---|
1581 | attrib(id1,"isHypersurface",0); |
---|
1582 | attrib(id1,"isCompleteIntersection",0); |
---|
1583 | attrib(id1,"isEquidimensional",0); |
---|
1584 | attrib(id1,"onlySingularAtZero",1); |
---|
1585 | |
---|
1586 | // ---------- recursive call of normalizationPrimes ----------- |
---|
1587 | if ( y>=1 ) |
---|
1588 | { |
---|
1589 | "// case: onlySingularAtZero, zerodivisor found, splitting:"; |
---|
1590 | "// total delta before splitting:", delt; |
---|
1591 | "// splitting in two components:"; |
---|
1592 | } |
---|
1593 | |
---|
1594 | printlevel = printlevel+1; //to see comments in normalizationPrimes |
---|
1595 | keepresult1 = normalizationPrimes(id,ihp,0,0); //1st split factor |
---|
1596 | keepresult2 = normalizationPrimes(id1,ihp,0,0); //2nd split factor |
---|
1597 | printlevel = printlev; //reset printlevel |
---|
1598 | |
---|
1599 | int delt1 = keepresult1[size(keepresult1)][1]; |
---|
1600 | int delt2 = keepresult2[size(keepresult2)][1]; |
---|
1601 | intvec delti1 = keepresult1[size(keepresult1)][2]; |
---|
1602 | intvec delti2 = keepresult2[size(keepresult2)][2]; |
---|
1603 | |
---|
1604 | if( delt>=0 && delt1>=0 && delt2>=0 ) |
---|
1605 | { ideal idid1=id,id1; |
---|
1606 | int mul = vdim(std(idid1)); |
---|
1607 | if ( mul>=0 ) |
---|
1608 | { |
---|
1609 | delt = delt+mul+delt1+delt2; |
---|
1610 | } |
---|
1611 | else |
---|
1612 | { |
---|
1613 | delt = -1; |
---|
1614 | } |
---|
1615 | } |
---|
1616 | if ( y>=1 ) |
---|
1617 | { |
---|
1618 | "// delta of first component:", delt1; |
---|
1619 | "// delta of second componenet:", delt2; |
---|
1620 | "// intersection multiplicity of both components:", mul; |
---|
1621 | "// total delta after splitting:", delt; |
---|
1622 | } |
---|
1623 | |
---|
1624 | else |
---|
1625 | { |
---|
1626 | delt = -1; |
---|
1627 | } |
---|
1628 | for(lauf=1;lauf<=size(keepresult2)-1;lauf++) |
---|
1629 | { |
---|
1630 | keepresult1=insert(keepresult1,keepresult2[lauf]); |
---|
1631 | } |
---|
1632 | keepresult1[size(keepresult1)]=list(delt,delti); |
---|
1633 | |
---|
1634 | return(keepresult1); |
---|
1635 | } |
---|
1636 | } |
---|
1637 | // Case "onlySingularAtZero" has finished and returned result |
---|
1638 | |
---|
1639 | //-------------- General case, not onlySingularAtZero, RETURN --------------- |
---|
1640 | //test for non-normality, i.e. if Hom(I,I)<>R |
---|
1641 | //we can use Hom(I,I) to continue |
---|
1642 | |
---|
1643 | //------ check variables for being a non zero-divizor ------ |
---|
1644 | // SL = ideal of vars not contained in ideal SM[1]: |
---|
1645 | |
---|
1646 | ideal SL = simplify(reduce(JM[2],SM[1]),2); |
---|
1647 | ideal Ann = quotient(SM[2],SL[1]); |
---|
1648 | ideal qAnn = simplify(reduce(Ann,SM[1]),2); |
---|
1649 | //NOTE: qAnn=0 <==> first var (=SL[1]) not contained in SM is a nzd of R/SM |
---|
1650 | |
---|
1651 | //------------- We found a non-zerodivisor of R/SM ----------------------- |
---|
1652 | //SM = mstd of ideal of variety, JM = mstd of ideal of singular locus |
---|
1653 | |
---|
1654 | if( size(qAnn)==0 ) |
---|
1655 | { |
---|
1656 | list RR; |
---|
1657 | list RS; |
---|
1658 | // ----------------- Computation of the radical ----------------- |
---|
1659 | if(y>=1) |
---|
1660 | { |
---|
1661 | "// radical computation of singular locus"; |
---|
1662 | } |
---|
1663 | J = radical(JM[2]); //the radical of singular locus |
---|
1664 | JM = mstd(J); |
---|
1665 | |
---|
1666 | if(y>=1) |
---|
1667 | { |
---|
1668 | "// radical is equal to:";""; JM[2]; |
---|
1669 | ""; |
---|
1670 | } |
---|
1671 | // ------------ choose non-zerodivisor of smaller degree ---------- |
---|
1672 | //### evtl. fuer SL[1] anderen Nichtnullteiler aus J waehlen ? |
---|
1673 | if( deg(SL[1]) > deg(J[1]) ) |
---|
1674 | { |
---|
1675 | Ann=quotient(SM[2],J[1]); |
---|
1676 | qAnn=simplify(reduce(Ann,SM[1]),2); |
---|
1677 | if(size(qAnn)==0) |
---|
1678 | { |
---|
1679 | SL[1]=J[1]; |
---|
1680 | } |
---|
1681 | } |
---|
1682 | |
---|
1683 | // --------------- computation of Hom(rad(J),rad(J)) -------------- |
---|
1684 | RR=SM[1],SM[2],JM[2],SL[1]; |
---|
1685 | |
---|
1686 | if(y>=1) |
---|
1687 | { |
---|
1688 | "// compute Hom(rad(J),rad(J))"; |
---|
1689 | } |
---|
1690 | |
---|
1691 | RS=HomJJ(RR,y); //most important subprocedure |
---|
1692 | |
---|
1693 | // ------------------ the normal case, RETURN ----------------- |
---|
1694 | // RS[2]==1 means that the test for normality was positive |
---|
1695 | if(RS[2]==1) |
---|
1696 | { |
---|
1697 | def lastR=RS[1]; |
---|
1698 | setring lastR; |
---|
1699 | map psi1=BAS,endphi; |
---|
1700 | ideal norid=endid; |
---|
1701 | ideal normap=psi1(ihp); |
---|
1702 | kill endid,endphi; |
---|
1703 | |
---|
1704 | intvec atr=getAttrib(norid); |
---|
1705 | |
---|
1706 | //"//### general case: not isolated singularity only at 0, final"; |
---|
1707 | //"size norid:", size(norid), size(string(norid)); |
---|
1708 | //"interred:"; |
---|
1709 | //norid = interred(norid); |
---|
1710 | //norid = setAttrib(norid,atr); |
---|
1711 | //"size norid:", size(norid), size(string(norid)); |
---|
1712 | |
---|
1713 | export norid; |
---|
1714 | export normap; |
---|
1715 | result=lastR; |
---|
1716 | if ( y>=1 ) |
---|
1717 | { |
---|
1718 | "// case: not onlySingularAtZero, last ring Hom_R(J,J) computed"; |
---|
1719 | "// delta before last ring:", delt; |
---|
1720 | } |
---|
1721 | |
---|
1722 | if ( delt>=0 && RS[3]>=0 ) |
---|
1723 | { |
---|
1724 | delt = delt+RS[3]; |
---|
1725 | } |
---|
1726 | else |
---|
1727 | { delt = -1; } |
---|
1728 | |
---|
1729 | // delti = delti,delt; |
---|
1730 | delti[size(delti)]=delt; |
---|
1731 | |
---|
1732 | if ( y>=1 ) |
---|
1733 | { |
---|
1734 | "// delta of last ring:", delt; |
---|
1735 | } |
---|
1736 | |
---|
1737 | result[size(result)+1]=list(delt,delti); |
---|
1738 | setring BAS; |
---|
1739 | return(result); |
---|
1740 | } |
---|
1741 | |
---|
1742 | // ----- the non-normal case, recursive call of normalizationPrimes ------- |
---|
1743 | // RS=HomJJ(RR,y) was computed above, RS[1] contains endid and endphi |
---|
1744 | // RS[1] = new ring Hom_R(J,J), RS[2]= 0 or 1, RS[2]=contribution to delta |
---|
1745 | // now RS[2]must be 0, i.e. the test for normality was negative |
---|
1746 | |
---|
1747 | int n = nvars(basering); |
---|
1748 | ideal MJ = JM[2]; |
---|
1749 | |
---|
1750 | def newR=RS[1]; |
---|
1751 | setring newR; |
---|
1752 | map psi=BAS,endphi; |
---|
1753 | if ( y>=1 ) |
---|
1754 | { |
---|
1755 | "// case: not onlySingularAtZero, compute new ring = Hom_R(J,J)"; |
---|
1756 | "// delta of old ring:", delt; |
---|
1757 | } |
---|
1758 | if ( delt>=0 && RS[3]>=0 ) |
---|
1759 | { |
---|
1760 | delt = delt+RS[3]; |
---|
1761 | } |
---|
1762 | else |
---|
1763 | { delt = -1; } |
---|
1764 | if ( y>=1 ) |
---|
1765 | { |
---|
1766 | "// delta of new ring:", delt; |
---|
1767 | } |
---|
1768 | |
---|
1769 | delti[size(delti)]=delt; |
---|
1770 | intvec atr=getAttrib(endid); |
---|
1771 | |
---|
1772 | //"//### general case: not isolated singularity only at 0, recursive"; |
---|
1773 | //"size endid:", size(endid), size(string(endid)); |
---|
1774 | //"interred:"; |
---|
1775 | //endid = interred(endid); |
---|
1776 | //endid = setAttrib(endid,atr); |
---|
1777 | //"size endid:", size(endid), size(string(endid)); |
---|
1778 | |
---|
1779 | printlevel = printlevel+1; |
---|
1780 | list tluser= |
---|
1781 | normalizationPrimes(endid,psi(ihp),delt,delti,psi(MJ)); |
---|
1782 | printlevel = printlev; //reset printlevel |
---|
1783 | setring BAS; |
---|
1784 | return(tluser); |
---|
1785 | } |
---|
1786 | |
---|
1787 | //---- A whole singular component was found, RETURN ----- |
---|
1788 | if( Ann == 1) |
---|
1789 | { |
---|
1790 | "// Input appeared not to be a radical ideal!"; |
---|
1791 | "// A (everywhere singular) component with ideal"; |
---|
1792 | "// equal to its Jacobian ideal was found"; |
---|
1793 | "// Procedure will stop with partial result computed so far";""; |
---|
1794 | |
---|
1795 | MB=SM[2]; |
---|
1796 | intvec rw; |
---|
1797 | list LL=substpart(MB,ihp,0,rw); |
---|
1798 | def newR6=LL[1]; |
---|
1799 | setring newR6; |
---|
1800 | ideal norid=endid; |
---|
1801 | ideal normap=endphi; |
---|
1802 | kill endid,endphi; |
---|
1803 | export norid; |
---|
1804 | export normap; |
---|
1805 | result=newR6; |
---|
1806 | result[size(result)+1]=lst(delt,delti); |
---|
1807 | setring BAS; |
---|
1808 | return(result); |
---|
1809 | } |
---|
1810 | |
---|
1811 | //------ zerodivisor of R/SM was found, gives a splitting ------------ |
---|
1812 | //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM |
---|
1813 | //and we have found a splitting: new1 and new2 |
---|
1814 | //id = Ann defines components of R/SM in the complement of V(SL[1]) |
---|
1815 | //id1 defines components of R/SM in the complement of V(id) |
---|
1816 | |
---|
1817 | else |
---|
1818 | { |
---|
1819 | if(y>=1) |
---|
1820 | { |
---|
1821 | "// zero-divisor found"; |
---|
1822 | } |
---|
1823 | int equi = attrib(SM[2],"isEquidimensional"); |
---|
1824 | int oSAZ = attrib(SM[2],"onlySingularAtZero"); |
---|
1825 | int isIs = attrib(SM[2],"isIsolatedSingularity"); |
---|
1826 | |
---|
1827 | ideal new1 = Ann; |
---|
1828 | ideal new2 = quotient(SM[2],Ann); |
---|
1829 | //ideal new2=SL[1],SM[2]; |
---|
1830 | |
---|
1831 | //execute("ring newR1="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1832 | // +ordstr(basering)+");"); |
---|
1833 | def newR1 = ring(gnirlist); |
---|
1834 | setring newR1; |
---|
1835 | |
---|
1836 | ideal vid = fetch(BAS,new1); |
---|
1837 | ideal ihp = fetch(BAS,ihp); |
---|
1838 | attrib(vid,"isCohenMacaulay",0); |
---|
1839 | attrib(vid,"isPrim",0); |
---|
1840 | attrib(vid,"isIsolatedSingularity",isIs); |
---|
1841 | attrib(vid,"isRegInCodim2",0); |
---|
1842 | attrib(vid,"onlySingularAtZero",oSAZ); |
---|
1843 | attrib(vid,"isEquidimensional",equi); |
---|
1844 | attrib(vid,"isHypersurface",0); |
---|
1845 | attrib(vid,"isCompleteIntersection",0); |
---|
1846 | |
---|
1847 | // ---------- recursive call of normalizationPrimes ----------- |
---|
1848 | if ( y>=1 ) |
---|
1849 | { |
---|
1850 | "// total delta before splitting:", delt; |
---|
1851 | "// splitting in two components:"; |
---|
1852 | } |
---|
1853 | printlevel = printlevel+1; |
---|
1854 | keepresult1 = |
---|
1855 | normalizationPrimes(vid,ihp,0,0); //1st split factor |
---|
1856 | |
---|
1857 | list delta1 = keepresult1[size(keepresult1)]; |
---|
1858 | |
---|
1859 | setring BAS; |
---|
1860 | //execute("ring newR2="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1861 | // +ordstr(basering)+");"); |
---|
1862 | def newR2 = ring(gnirlist); |
---|
1863 | setring newR2; |
---|
1864 | |
---|
1865 | ideal vid = fetch(BAS,new2); |
---|
1866 | ideal ihp = fetch(BAS,ihp); |
---|
1867 | attrib(vid,"isCohenMacaulay",0); |
---|
1868 | attrib(vid,"isPrim",0); |
---|
1869 | attrib(vid,"isIsolatedSingularity",isIs); |
---|
1870 | attrib(vid,"isRegInCodim2",0); |
---|
1871 | attrib(vid,"isEquidimensional",equi); |
---|
1872 | attrib(vid,"isHypersurface",0); |
---|
1873 | attrib(vid,"isCompleteIntersection",0); |
---|
1874 | attrib(vid,"onlySingularAtZero",oSAZ); |
---|
1875 | |
---|
1876 | keepresult2 = |
---|
1877 | normalizationPrimes(vid,ihp,0,0); |
---|
1878 | list delta2 = keepresult2[size(keepresult2)]; //2nd split factor |
---|
1879 | printlevel = printlev; //reset printlevel |
---|
1880 | |
---|
1881 | setring BAS; |
---|
1882 | |
---|
1883 | //compute intersection multiplicity of both components: |
---|
1884 | new1 = new1,new2; |
---|
1885 | int mul=vdim(std(new1)); |
---|
1886 | |
---|
1887 | // ----- normalizationPrimes finished, add up results, RETURN -------- |
---|
1888 | for(lauf=1;lauf<=size(keepresult2)-1;lauf++) |
---|
1889 | { |
---|
1890 | keepresult1 = insert(keepresult1,keepresult2[lauf]); |
---|
1891 | } |
---|
1892 | if ( delt >=0 && delta1[1] >=0 && delta2[1] >=0 && mul >=0 ) |
---|
1893 | { |
---|
1894 | delt = delt+mul+delta1[1]+delta2[1]; |
---|
1895 | } |
---|
1896 | else |
---|
1897 | { delt = -1; } |
---|
1898 | delti = -2; |
---|
1899 | |
---|
1900 | if ( y>=1 ) |
---|
1901 | { |
---|
1902 | "// zero divisor produced a splitting into two components"; |
---|
1903 | "// delta of first component:", delta1; |
---|
1904 | "// delta of second componenet:", delta2; |
---|
1905 | "// intersection multiplicity of both components:", mul; |
---|
1906 | "// total delta after splitting:", delt; |
---|
1907 | } |
---|
1908 | keepresult1[size(keepresult1)] = list(delt,delti); |
---|
1909 | return(keepresult1); |
---|
1910 | } |
---|
1911 | } |
---|
1912 | example |
---|
1913 | { "EXAMPLE:";echo = 2; |
---|
1914 | // Huneke |
---|
1915 | ring qr=31991,(a,b,c,d,e),dp; |
---|
1916 | ideal i= |
---|
1917 | 5abcde-a5-b5-c5-d5-e5, |
---|
1918 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
1919 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
1920 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
1921 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
1922 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
1923 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
1924 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
1925 | |
---|
1926 | list pr=normalizationPrimes(i); |
---|
1927 | def r1 = pr[1]; |
---|
1928 | setring r1; |
---|
1929 | norid; |
---|
1930 | normap; |
---|
1931 | } |
---|
1932 | |
---|
1933 | /////////////////////////////////////////////////////////////////////////////// |
---|
1934 | static proc substpart(ideal endid, ideal endphi, int homo, intvec rw) |
---|
1935 | |
---|
1936 | "//Repeated application of elimpart to endid, until no variables can be |
---|
1937 | //directy substituded. homo=1 if input is homogeneous, rw contains |
---|
1938 | //original weights, endphi (partial) normalization map"; |
---|
1939 | |
---|
1940 | //NOTE concerning iteration of maps: Let phi: x->f(y,z), y->g(x,z) then |
---|
1941 | //phi: x+y+z->f(y,z)+g(x,z)+z, phi(phi):x+y+z->f(g(x,z),z)+g(f(y,z),z)+z |
---|
1942 | //and so on: none of the x or y will be eliminated |
---|
1943 | //Now subst: first x and then y: x+y+z->f(g(x,z),z)+g(x,z)+z eliminates y |
---|
1944 | //further subst replaces x by y, makes no sense (objects more compicated). |
---|
1945 | //Subst first y and then x eliminates x |
---|
1946 | //In our situation we have triangular form: x->f(y,z), y->g(z). |
---|
1947 | //phi: x+y+z->f(y,z)+g(z)+z, phi(phi):x+y+z->f(g(z),z)+g(z)+z eliminates x,y |
---|
1948 | //subst x,y: x+y+z->f(g(z),z)+g(z)+z, eliminates x,y |
---|
1949 | //subst y,x: x+y+z->f(y,z)+g(z)+z eliminates only x |
---|
1950 | //HENCE: substitute vars depending on most other vars first |
---|
1951 | //However, if the sytem xi-fi is reduced then xi does not appear in any of the |
---|
1952 | //fj and hence the order does'nt matter when substitutinp xi by fi |
---|
1953 | |
---|
1954 | { |
---|
1955 | def newRing = basering; |
---|
1956 | int ii,jj; |
---|
1957 | map phi = newRing,maxideal(1); //identity map |
---|
1958 | list Le = elimpart(endid); |
---|
1959 | //this proc and the next loop try to substitute as many variables as |
---|
1960 | //possible indices of substituted variables |
---|
1961 | |
---|
1962 | int q = size(Le[2]); //q vars, stored in Le[2], have been substitutet |
---|
1963 | intvec rw1 = 0; //will become indices of substituted variables |
---|
1964 | rw1[nvars(basering)] = 0; |
---|
1965 | rw1 = rw1+1; //rw1=1,..,1 (as many 1 as nvars(basering)) |
---|
1966 | |
---|
1967 | while( size(Le[2]) != 0 ) |
---|
1968 | { |
---|
1969 | endid = Le[1]; |
---|
1970 | if ( defined(ps) ) |
---|
1971 | { kill ps; } |
---|
1972 | map ps = newRing,Le[5]; |
---|
1973 | phi = ps(phi); |
---|
1974 | for(ii=1;ii<=size(Le[2]);ii++) |
---|
1975 | { |
---|
1976 | phi=phi(phi); |
---|
1977 | } |
---|
1978 | //eingefuegt wegen x2-y2z2+z3 |
---|
1979 | |
---|
1980 | for( ii=1; ii<=size(rw1); ii++ ) |
---|
1981 | { |
---|
1982 | if( Le[4][ii]==0 ) //ii = index of var which was substituted |
---|
1983 | { |
---|
1984 | rw1[ii]=0; //substituted vars have entry 0 in rw1 |
---|
1985 | } |
---|
1986 | } |
---|
1987 | Le=elimpart(endid); //repeated application of elimpart |
---|
1988 | q = q + size(Le[2]); |
---|
1989 | } |
---|
1990 | endphi = phi(endphi); |
---|
1991 | //---------- return ----------------------------------------------------------- |
---|
1992 | // first the trivial case, where all variable have been eliminated |
---|
1993 | if( nvars(newRing) == q ) |
---|
1994 | { |
---|
1995 | ring lastRing = char(basering),T(1),dp; |
---|
1996 | ideal endid = T(1); |
---|
1997 | ideal endphi = T(1); |
---|
1998 | for(ii=2; ii<=q; ii++ ) |
---|
1999 | { |
---|
2000 | endphi[ii] = 0; |
---|
2001 | } |
---|
2002 | export(endid,endphi); |
---|
2003 | list L = lastRing; |
---|
2004 | setring newRing; |
---|
2005 | return(L); |
---|
2006 | } |
---|
2007 | |
---|
2008 | // in the homogeneous case put weights for the remaining vars correctly, i.e. |
---|
2009 | // delete from rw those weights for which the corresponding entry of rw1 is 0 |
---|
2010 | |
---|
2011 | if (homo==1 && nvars(newRing)-q >1 && size(endid) >0 ) |
---|
2012 | { |
---|
2013 | jj=1; |
---|
2014 | for( ii=2; ii<size(rw1); ii++) |
---|
2015 | { |
---|
2016 | jj++; |
---|
2017 | if( rw1[ii]==0 ) |
---|
2018 | { |
---|
2019 | rw=rw[1..jj-1],rw[jj+1..size(rw)]; |
---|
2020 | jj=jj-1; |
---|
2021 | } |
---|
2022 | } |
---|
2023 | if( rw1[1]==0 ) { rw=rw[2..size(rw)]; } |
---|
2024 | if( rw1[size(rw1)]==0 ){ rw=rw[1..size(rw)-1]; } |
---|
2025 | |
---|
2026 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),(a(rw),dp); |
---|
2027 | } |
---|
2028 | else |
---|
2029 | { |
---|
2030 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),dp; |
---|
2031 | } |
---|
2032 | ideal lastmap; |
---|
2033 | jj = 1; |
---|
2034 | |
---|
2035 | for(ii=1; ii<=size(rw1); ii++ ) |
---|
2036 | { |
---|
2037 | if ( rw1[ii]==1 ) { lastmap[ii] = T(jj); jj=jj+1; } |
---|
2038 | if ( rw1[ii]==0 ) { lastmap[ii] = 0; } |
---|
2039 | } |
---|
2040 | map phi1 = newRing,lastmap; |
---|
2041 | ideal endid = phi1(endid); //### bottelneck |
---|
2042 | ideal endphi = phi1(endphi); |
---|
2043 | |
---|
2044 | /* |
---|
2045 | Versuch: subst statt phi |
---|
2046 | for(ii=1; ii<=size(rw1); ii++ ) |
---|
2047 | { |
---|
2048 | if ( rw1[ii]==1 ) { endid = subst(endid,var(ii),T(jj)); } |
---|
2049 | if ( rw1[ii]==0 ) { endid = subst(endid,var(ii),0); } |
---|
2050 | } |
---|
2051 | */ |
---|
2052 | export(endid); |
---|
2053 | export(endphi); |
---|
2054 | list L = lastRing; |
---|
2055 | setring newRing; |
---|
2056 | return(L); |
---|
2057 | } |
---|
2058 | /////////////////////////////////////////////////////////////////////////////// |
---|
2059 | |
---|
2060 | proc genus(ideal I,list #) |
---|
2061 | "USAGE: genus(i) or genus(i,1); I a 1-dimensional ideal |
---|
2062 | RETURN: an integer, the geometric genus p_g = p_a - delta of the projective |
---|
2063 | curve defined by i, where p_a is the arithmetic genus. |
---|
2064 | NOTE: delta is the sum of all local delta-invariants of the singularities, |
---|
2065 | i.e. dim(R'/R), R' the normalization of the local ring R of the |
---|
2066 | singularity. @* |
---|
2067 | genus(i,1) uses the normalization to compute delta. Usually genus(i,1) |
---|
2068 | is slower than genus(i) but sometimes not. |
---|
2069 | EXAMPLE: example genus; shows an example |
---|
2070 | " |
---|
2071 | { |
---|
2072 | int w = printlevel-voice+2; // w=printlevel (default: w=0) |
---|
2073 | |
---|
2074 | def R0=basering; |
---|
2075 | if(char(basering)>0) |
---|
2076 | { |
---|
2077 | def R1=changeord("dp"); |
---|
2078 | setring R1; |
---|
2079 | ideal J=std(imap(R0,I)); |
---|
2080 | if(dim(J)!=1){ERROR("ideal defines not a curve");} |
---|
2081 | def S=changevar(varstr(R)+",@t"); |
---|
2082 | setring S; |
---|
2083 | ideal J=imap(R1,J); |
---|
2084 | J=std(homog(J,@t)); |
---|
2085 | int pa=1-hilbPoly(J)[1]; |
---|
2086 | setring R0; |
---|
2087 | list nor=normalP(I); |
---|
2088 | return(pa-nor[2][2]); |
---|
2089 | } |
---|
2090 | I=std(I); |
---|
2091 | if(dim(I)!=1) |
---|
2092 | { |
---|
2093 | if(((homog(I))&&(dim(I)!=2))||(!homog(I))) |
---|
2094 | { |
---|
2095 | // ERROR("This is not a curve"); |
---|
2096 | if(w==1){"** WARNING: Input does not define a curve **"; "";} |
---|
2097 | } |
---|
2098 | } |
---|
2099 | list L=elimpart(I); |
---|
2100 | if(size(L[2])!=0) |
---|
2101 | { |
---|
2102 | map psi=R0,L[5]; |
---|
2103 | I=std(psi(I)); |
---|
2104 | } |
---|
2105 | if(size(I)==0) |
---|
2106 | { |
---|
2107 | return(0); |
---|
2108 | } |
---|
2109 | list N=findvars(I,0); |
---|
2110 | if(size(N[1])==1) |
---|
2111 | { |
---|
2112 | |
---|
2113 | poly p=I[1]; |
---|
2114 | // if(deg(squarefree(p))<deg(p)){ERROR("Curve is not reduced");} |
---|
2115 | return(-deg(p)+1); |
---|
2116 | } |
---|
2117 | if(size(N[1]) < nvars(R0)) |
---|
2118 | { |
---|
2119 | string newvar=string(N[1]); |
---|
2120 | execute("ring R=("+charstr(R0)+"),("+newvar+"),dp;"); |
---|
2121 | ideal I =imap(R0,I); |
---|
2122 | attrib(I,"isSB",1); |
---|
2123 | } |
---|
2124 | else |
---|
2125 | { |
---|
2126 | def R=basering; |
---|
2127 | } |
---|
2128 | if(dim(I)==2) |
---|
2129 | { |
---|
2130 | def newR=basering; |
---|
2131 | } |
---|
2132 | else |
---|
2133 | { |
---|
2134 | if(dim(I)==0) |
---|
2135 | { |
---|
2136 | execute("ring Rhelp=("+charstr(R0)+"),(@s,@t),dp;"); |
---|
2137 | } |
---|
2138 | else |
---|
2139 | { |
---|
2140 | execute("ring Rhelp=("+charstr(R0)+"),(@s),dp;"); |
---|
2141 | } |
---|
2142 | def newR=R+Rhelp; |
---|
2143 | setring newR; |
---|
2144 | ideal I=imap(R,I); |
---|
2145 | I=homog(I,@s); |
---|
2146 | attrib(I,"isSB",1); |
---|
2147 | } |
---|
2148 | |
---|
2149 | if((nvars(basering)<=3)&&(size(I)>1)) |
---|
2150 | { |
---|
2151 | ERROR("This is not equidimensional"); |
---|
2152 | } |
---|
2153 | |
---|
2154 | intvec hp=hilbPoly(I); |
---|
2155 | int p_a=1-hp[1]; |
---|
2156 | int d=hp[2]; |
---|
2157 | |
---|
2158 | if(w>=1) |
---|
2159 | { |
---|
2160 | "";"The ideal of the projective curve:";"";I;""; |
---|
2161 | "The coefficients of the Hilbert polynomial";hp; |
---|
2162 | "arithmetic genus:";p_a; |
---|
2163 | "degree:";d;""; |
---|
2164 | } |
---|
2165 | |
---|
2166 | intvec v = hilb(I,1); |
---|
2167 | int i,o; |
---|
2168 | if(nvars(basering)>3) |
---|
2169 | { |
---|
2170 | map phi=newR,maxideal(1); |
---|
2171 | int de; |
---|
2172 | ideal K,L1; |
---|
2173 | matrix M; |
---|
2174 | poly m=var(4); |
---|
2175 | poly he; |
---|
2176 | for(i=5;i<=nvars(basering);i++){m=m*var(i);} |
---|
2177 | K=eliminate(I,m,v); |
---|
2178 | if(size(K)==1){de=deg(K[1]);} |
---|
2179 | m=var(1); |
---|
2180 | for(i=2;i<=nvars(basering)-3;i++){m=m*var(i);} |
---|
2181 | i=0; |
---|
2182 | while(d!=de) |
---|
2183 | { |
---|
2184 | o=1; |
---|
2185 | i++; |
---|
2186 | K=phi(I); |
---|
2187 | K=eliminate(K,m,v); |
---|
2188 | if(size(K)==1){de=deg(K[1]);} |
---|
2189 | if((i==5)&&(d!=de)) |
---|
2190 | { |
---|
2191 | K=reduce(equidimMax(I),I); |
---|
2192 | if(size(K)!=0){ERROR("This is not equidimensional");} |
---|
2193 | } |
---|
2194 | if(i==10) |
---|
2195 | { |
---|
2196 | J;K; |
---|
2197 | ERROR("genus: did not find a good projection for to |
---|
2198 | the plain"); |
---|
2199 | } |
---|
2200 | if(i<5) |
---|
2201 | { |
---|
2202 | M=sparsetriag(nvars(newR),nvars(newR),80-5*i,i); |
---|
2203 | } |
---|
2204 | else |
---|
2205 | { |
---|
2206 | if(i<8) |
---|
2207 | { |
---|
2208 | M=transpose(sparsetriag(nvars(newR),nvars(newR),80-5*i,i)); |
---|
2209 | } |
---|
2210 | else |
---|
2211 | { |
---|
2212 | he=0; |
---|
2213 | while(he==0) |
---|
2214 | { |
---|
2215 | M=randommat(nvars(newR),nvars(newR),ideal(1),20); |
---|
2216 | he=det(M); |
---|
2217 | } |
---|
2218 | } |
---|
2219 | } |
---|
2220 | L1=M*transpose(maxideal(1)); |
---|
2221 | phi=newR,L1; |
---|
2222 | } |
---|
2223 | I=K; |
---|
2224 | } |
---|
2225 | poly p=I[1]; |
---|
2226 | |
---|
2227 | execute("ring S=("+charstr(R)+"),(x,y,t),dp;"); |
---|
2228 | ideal L=maxideal(1); |
---|
2229 | execute("ring C=("+charstr(R)+"),(x,y),ds;"); |
---|
2230 | ideal I; |
---|
2231 | execute("ring A=("+charstr(R)+"),(x,t),dp;"); |
---|
2232 | map phi=S,1,x,t; |
---|
2233 | map psi=S,x,1,t; |
---|
2234 | poly g,h; |
---|
2235 | ideal I,I1; |
---|
2236 | execute("ring B=("+charstr(R)+"),(x,t),ds;"); |
---|
2237 | |
---|
2238 | setring S; |
---|
2239 | if(o) |
---|
2240 | { |
---|
2241 | for(i=1;i<=nvars(newR)-3;i++){L[i]=0;} |
---|
2242 | L=L,maxideal(1); |
---|
2243 | } |
---|
2244 | map sigma=newR,L; |
---|
2245 | poly F=sigma(p); |
---|
2246 | if(w>=1){"the projected curve:";"";F;"";} |
---|
2247 | |
---|
2248 | kill newR; |
---|
2249 | |
---|
2250 | int genus=(d-1)*(d-2)/2; |
---|
2251 | if(w>=1){"the arithmetic genus of the plane curve:";genus;pause();} |
---|
2252 | |
---|
2253 | int delt,deltaloc,deltainf,tau,tauinf,cusps,iloc,iglob,l,nsing, |
---|
2254 | tauloc,tausing,k,rat,nbranchinf,nbranch,nodes,cuspsinf,nodesinf; |
---|
2255 | list inv; |
---|
2256 | |
---|
2257 | if(w>=1) |
---|
2258 | {"";"analyse the singularities at oo";"";"singular locus at (1,x,0):";"";} |
---|
2259 | setring A; |
---|
2260 | g=phi(F); |
---|
2261 | h=psi(F); |
---|
2262 | I=g,jacob(g),var(2); |
---|
2263 | I=std(I); |
---|
2264 | if(deg(I[1])>0) |
---|
2265 | { |
---|
2266 | list qr=minAssGTZ(I); |
---|
2267 | if(w>=1){qr;"";} |
---|
2268 | |
---|
2269 | for(k=1;k<=size(qr);k++) |
---|
2270 | { |
---|
2271 | if(w>=1){ nsing=nsing+vdim(std(qr[k]));} |
---|
2272 | inv=deltaLoc(g,qr[k]); |
---|
2273 | deltainf=deltainf+inv[1]; |
---|
2274 | tauinf=tauinf+inv[2]; |
---|
2275 | l=vdim(std(qr[k])); |
---|
2276 | if(inv[2]==l){nodesinf=nodesinf+l;} |
---|
2277 | if(inv[2]==2*l){cuspsinf=cuspsinf+l;} |
---|
2278 | nbranchinf=nbranchinf+inv[3]; |
---|
2279 | } |
---|
2280 | } |
---|
2281 | else |
---|
2282 | { |
---|
2283 | if(w>=1){" the curve is smooth at (1,x,0)";"";} |
---|
2284 | } |
---|
2285 | if(w>=1){"singular locus at (0,1,0):";"";} |
---|
2286 | inv=deltaLoc(h,maxideal(1)); |
---|
2287 | if((w>=1)&&(inv[2]!=0)){ nsing++;} |
---|
2288 | deltainf=deltainf+inv[1]; |
---|
2289 | tauinf=tauinf+inv[2]; |
---|
2290 | if(inv[2]==1){nodesinf++;} |
---|
2291 | if(inv[2]==2){cuspsinf++;} |
---|
2292 | |
---|
2293 | if((w>=1)&&(inv[2]==0)){" the curve is smooth at (0,1,0)";"";} |
---|
2294 | if(inv[2]>0){nbranchinf=nbranchinf+inv[3];} |
---|
2295 | |
---|
2296 | if(w>=1) |
---|
2297 | { |
---|
2298 | if(tauinf==0) |
---|
2299 | { |
---|
2300 | " the curve is smooth at oo";""; |
---|
2301 | } |
---|
2302 | else |
---|
2303 | { |
---|
2304 | "number of singularities at oo:";nsing; |
---|
2305 | "nodes at oo:";nodesinf; |
---|
2306 | "cusps at oo:";cuspsinf; |
---|
2307 | "branches at oo:";nbranchinf; |
---|
2308 | "Tjurina number at oo:";tauinf; |
---|
2309 | "delta at oo:";deltainf; |
---|
2310 | "Milnor number at oo:";2*deltainf-nbranchinf+nsing; |
---|
2311 | pause(); |
---|
2312 | } |
---|
2313 | "singularities at (x,y,1):";""; |
---|
2314 | } |
---|
2315 | execute("ring newR=("+charstr(R)+"),(x,y),dp;"); |
---|
2316 | //the singularities at the affine part |
---|
2317 | map sigma=S,var(1),var(2),1; |
---|
2318 | ideal I=sigma(F); |
---|
2319 | |
---|
2320 | if(size(#)!=0) |
---|
2321 | { //uses the normalization to compute delta |
---|
2322 | list nor=normal(I); |
---|
2323 | delt=nor[size(nor)][2]; |
---|
2324 | genus=genus-delt-deltainf; |
---|
2325 | setring R0; |
---|
2326 | return(genus); |
---|
2327 | } |
---|
2328 | |
---|
2329 | ideal I1=jacob(I); |
---|
2330 | matrix Hess[2][2]=jacob(I1); |
---|
2331 | ideal ID=I+I1+ideal(det(Hess));//singular locus of I+I1 |
---|
2332 | |
---|
2333 | ideal radID=std(radical(ID));//the non-nodal locus |
---|
2334 | if(w>=1){"the non-nodal locus:";"";radID;pause();"";} |
---|
2335 | if(deg(radID[1])==0) |
---|
2336 | { |
---|
2337 | ideal IDsing=1; |
---|
2338 | } |
---|
2339 | else |
---|
2340 | { |
---|
2341 | ideal IDsing=minor(jacob(ID),2)+radID;//singular locus of ID |
---|
2342 | } |
---|
2343 | |
---|
2344 | iglob=vdim(std(IDsing)); |
---|
2345 | |
---|
2346 | if(iglob!=0)//computation of the radical of IDsing |
---|
2347 | { |
---|
2348 | ideal radIDsing=reduce(IDsing,radID); |
---|
2349 | if(size(radIDsing)==0) |
---|
2350 | { |
---|
2351 | radIDsing=radID; |
---|
2352 | attrib(radIDsing,"isSB",1); |
---|
2353 | } |
---|
2354 | else |
---|
2355 | { |
---|
2356 | radIDsing=std(radical(IDsing)); |
---|
2357 | } |
---|
2358 | iglob=vdim(radIDsing); |
---|
2359 | if((w>=1)&&(iglob)) |
---|
2360 | {"the non-nodal-cuspidal locus:";radIDsing;pause();"";} |
---|
2361 | } |
---|
2362 | cusps=vdim(radID)-iglob; |
---|
2363 | nsing=nsing+cusps; |
---|
2364 | |
---|
2365 | if(iglob==0) |
---|
2366 | { |
---|
2367 | if(w>=1){" there are only cusps and nodes";"";} |
---|
2368 | tau=vdim(std(I+jacob(I))); |
---|
2369 | tauinf=tauinf+tau; |
---|
2370 | nodes=tau-2*cusps; |
---|
2371 | delt=nodes+cusps; |
---|
2372 | nbranch=2*tau-3*cusps; |
---|
2373 | nsing=nsing+nodes; |
---|
2374 | } |
---|
2375 | else |
---|
2376 | { |
---|
2377 | if(w>=1){"the non-nodal-cuspidal singularities";"";} |
---|
2378 | setring C; |
---|
2379 | ideal I1=imap(newR,IDsing); |
---|
2380 | iloc=vdim(std(I1)); |
---|
2381 | if(iglob==iloc) |
---|
2382 | { |
---|
2383 | if(w>=1){"only cusps and nodes outside (0,0,1)";} |
---|
2384 | setring newR; |
---|
2385 | tau=vdim(std(I+jacob(I))); |
---|
2386 | tauinf=tauinf+tau; |
---|
2387 | inv=deltaLoc(I[1],maxideal(1)); |
---|
2388 | delt=inv[1]; |
---|
2389 | tauloc=inv[2]; |
---|
2390 | nodes=tau-tauloc-2*cusps; |
---|
2391 | nsing=nsing+nodes; |
---|
2392 | nbranch=inv[3]+ 2*nodes+cusps; |
---|
2393 | delt=delt+nodes+cusps; |
---|
2394 | if((w>=1)&&(inv[2]==0)){"smooth at (0,0,1)";} |
---|
2395 | } |
---|
2396 | else |
---|
2397 | { |
---|
2398 | setring newR; |
---|
2399 | list pr=minAssGTZ(IDsing); |
---|
2400 | if(w>=1){pr;} |
---|
2401 | |
---|
2402 | for(k=1;k<=size(pr);k++) |
---|
2403 | { |
---|
2404 | if(w>=1){nsing=nsing+vdim(std(pr[k]));} |
---|
2405 | inv=deltaLoc(I[1],pr[k]); |
---|
2406 | delt=delt+inv[1]; |
---|
2407 | tausing=tausing+inv[2]; |
---|
2408 | nbranch=nbranch+inv[3]; |
---|
2409 | } |
---|
2410 | tau=vdim(std(I+jacob(I))); |
---|
2411 | tauinf=tauinf+tau; |
---|
2412 | nodes=tau-tausing-2*cusps; |
---|
2413 | nsing=nsing+nodes; |
---|
2414 | delt=delt+nodes+cusps; |
---|
2415 | nbranch=nbranch+2*nodes+cusps; |
---|
2416 | } |
---|
2417 | } |
---|
2418 | genus=genus-delt-deltainf; |
---|
2419 | if(w>=1) |
---|
2420 | { |
---|
2421 | "The projected plane curve has locally:";""; |
---|
2422 | "singularities:";nsing; |
---|
2423 | "branches:";nbranch+nbranchinf; |
---|
2424 | "nodes:"; nodes+nodesinf; |
---|
2425 | "cusps:";cusps+cuspsinf; |
---|
2426 | "Tjurina number:";tauinf; |
---|
2427 | "Milnor number:";2*(delt+deltainf)-nbranch-nbranchinf+nsing; |
---|
2428 | "delta of the projected curve:";delt+deltainf; |
---|
2429 | "delta of the curve:";p_a-genus; |
---|
2430 | "genus:";genus; |
---|
2431 | "===================================================="; |
---|
2432 | ""; |
---|
2433 | } |
---|
2434 | setring R0; |
---|
2435 | return(genus); |
---|
2436 | } |
---|
2437 | example |
---|
2438 | { "EXAMPLE:"; echo = 2; |
---|
2439 | ring r=0,(x,y),dp; |
---|
2440 | ideal i=y^9 - x^2*(x - 1)^9; |
---|
2441 | genus(i); |
---|
2442 | } |
---|
2443 | |
---|
2444 | /////////////////////////////////////////////////////////////////////////////// |
---|
2445 | proc deltaLoc(poly f,ideal singL) |
---|
2446 | "USAGE: deltaLoc(f,J); f poly, J ideal |
---|
2447 | ASSUME: f is reduced bivariate polynomial; basering has exactly two variables; |
---|
2448 | J is irreducible prime component of the singular locus of f (e.g., one |
---|
2449 | entry of the output of @code{minAssGTZ(I);}, I = <f,jacob(f)>). |
---|
2450 | RETURN: list L: |
---|
2451 | @texinfo |
---|
2452 | @table @asis |
---|
2453 | @item @code{L[1]}; int: |
---|
2454 | the sum of (local) delta invariants of f at the (conjugated) singular |
---|
2455 | points given by J. |
---|
2456 | @item @code{L[2]}; int: |
---|
2457 | the sum of (local) Tjurina numbers of f at the (conjugated) singular |
---|
2458 | points given by J. |
---|
2459 | @item @code{L[3]}; int: |
---|
2460 | the sum of (local) number of branches of f at the (conjugated) |
---|
2461 | singular points given by J. |
---|
2462 | @end table |
---|
2463 | @end texinfo |
---|
2464 | NOTE: procedure makes use of @code{execute}; increasing printlevel displays |
---|
2465 | more comments (default: printlevel=0). |
---|
2466 | SEE ALSO: delta, tjurina |
---|
2467 | KEYWORDS: delta invariant; Tjurina number |
---|
2468 | EXAMPLE: example deltaLoc; shows an example |
---|
2469 | " |
---|
2470 | { |
---|
2471 | option(redSB); |
---|
2472 | def R=basering; |
---|
2473 | execute("ring S=("+charstr(R)+"),(x,y),lp;"); |
---|
2474 | map phi=R,x,y; |
---|
2475 | ideal singL=phi(singL); |
---|
2476 | singL=simplify(std(singL),1); |
---|
2477 | attrib(singL,"isSB",1); |
---|
2478 | int d=vdim(singL); |
---|
2479 | poly f=phi(f); |
---|
2480 | int i; |
---|
2481 | int w = printlevel-voice+2; // w=printlevel (default: w=0) |
---|
2482 | if(d==1) |
---|
2483 | { |
---|
2484 | map alpha=S,var(1)-singL[2][2],var(2)-singL[1][2]; |
---|
2485 | f=alpha(f); |
---|
2486 | execute("ring C=("+charstr(S)+"),("+varstr(S)+"),ds;"); |
---|
2487 | poly f=imap(S,f); |
---|
2488 | ideal singL=imap(S,singL); |
---|
2489 | if((w>=1)&&(ord(f)>=2)) |
---|
2490 | { |
---|
2491 | "local analysis of the singularities";""; |
---|
2492 | basering; |
---|
2493 | singL; |
---|
2494 | f; |
---|
2495 | pause(); |
---|
2496 | } |
---|
2497 | } |
---|
2498 | else |
---|
2499 | { |
---|
2500 | poly p; |
---|
2501 | poly c; |
---|
2502 | map psi; |
---|
2503 | number co; |
---|
2504 | |
---|
2505 | while((deg(lead(singL[1]))>1)&&(deg(lead(singL[2]))>1)) |
---|
2506 | { |
---|
2507 | psi=S,x,y+random(-100,100)*x; |
---|
2508 | singL=psi(singL); |
---|
2509 | singL=std(singL); |
---|
2510 | f=psi(f); |
---|
2511 | } |
---|
2512 | |
---|
2513 | if(deg(lead(singL[2]))==1) |
---|
2514 | { |
---|
2515 | p=singL[1]; |
---|
2516 | c=singL[2]-lead(singL[2]); |
---|
2517 | co=leadcoef(singL[2]); |
---|
2518 | } |
---|
2519 | if(deg(lead(singL[1]))==1) |
---|
2520 | { |
---|
2521 | psi=S,y,x; |
---|
2522 | f=psi(f); |
---|
2523 | singL=psi(singL); |
---|
2524 | p=singL[2]; |
---|
2525 | c=singL[1]-lead(singL[1]); |
---|
2526 | co=leadcoef(singL[1]); |
---|
2527 | } |
---|
2528 | |
---|
2529 | execute("ring B=("+charstr(S)+"),a,dp;"); |
---|
2530 | map beta=S,a,a; |
---|
2531 | poly p=beta(p); |
---|
2532 | |
---|
2533 | execute("ring C=("+charstr(S)+",a),("+varstr(S)+"),ds;"); |
---|
2534 | number p=number(imap(B,p)); |
---|
2535 | |
---|
2536 | minpoly=p; |
---|
2537 | map iota=S,a,a; |
---|
2538 | number c=number(iota(c)); |
---|
2539 | number co=iota(co); |
---|
2540 | |
---|
2541 | map alpha=S,x-c/co,y+a; |
---|
2542 | poly f=alpha(f); |
---|
2543 | f=cleardenom(f); |
---|
2544 | if((w>=1)&&(ord(f)>=2)) |
---|
2545 | { |
---|
2546 | "local analysis of the singularities";""; |
---|
2547 | basering; |
---|
2548 | alpha; |
---|
2549 | f; |
---|
2550 | pause(); |
---|
2551 | ""; |
---|
2552 | } |
---|
2553 | } |
---|
2554 | option(noredSB); |
---|
2555 | ideal fstd=std(ideal(f)+jacob(f)); |
---|
2556 | poly hc=highcorner(fstd); |
---|
2557 | int tau=vdim(fstd); |
---|
2558 | int o=ord(f); |
---|
2559 | int delt,nb; |
---|
2560 | |
---|
2561 | if(tau==0) //smooth case |
---|
2562 | { |
---|
2563 | setring R; |
---|
2564 | return(list(0,0,1)); |
---|
2565 | } |
---|
2566 | if((char(basering)>=181)||(char(basering)==0)) |
---|
2567 | { |
---|
2568 | if(o==2) //A_k-singularity |
---|
2569 | { |
---|
2570 | if(w>=1){"A_k-singularity";"";} |
---|
2571 | setring R; |
---|
2572 | delt=(tau+1)/2; |
---|
2573 | return(list(d*delt,d*tau,d*(2*delt-tau+1))); |
---|
2574 | } |
---|
2575 | if((lead(f)==var(1)*var(2)^2)||(lead(f)==var(1)^2*var(2))) |
---|
2576 | { |
---|
2577 | if(w>=1){"D_k- singularity";"";} |
---|
2578 | |
---|
2579 | setring R; |
---|
2580 | delt=(tau+2)/2; |
---|
2581 | return(list(d*delt,d*tau,d*(2*delt-tau+1))); |
---|
2582 | } |
---|
2583 | |
---|
2584 | int mu=vdim(std(jacob(f))); |
---|
2585 | poly g=f+var(1)^mu+var(2)^mu; //to obtain a convenient Newton-polygon |
---|
2586 | |
---|
2587 | list NP=newtonpoly(g); |
---|
2588 | if(w>=1){"Newton-Polygon:";NP;"";} |
---|
2589 | int s=size(NP); |
---|
2590 | |
---|
2591 | if(is_NND(f,mu,NP)) |
---|
2592 | { // the Newton-polygon is non-degenerate |
---|
2593 | // compute nb, the number of branches |
---|
2594 | for(i=1;i<=s-1;i++) |
---|
2595 | { |
---|
2596 | nb=nb+gcd(NP[i][2]-NP[i+1][2],NP[i][1]-NP[i+1][1]); |
---|
2597 | } |
---|
2598 | if(w>=1){"Newton-Polygon is non-degenerated";"";} |
---|
2599 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
2600 | } |
---|
2601 | |
---|
2602 | if(w>=1){"Newton-Polygon is degenerated";"";} |
---|
2603 | |
---|
2604 | // the following can certainly be made more efficient when replacing |
---|
2605 | // 'hnexpansion' (used only for computing number of branches) by |
---|
2606 | // successive blowing-up + test if Newton polygon degenerate: |
---|
2607 | if(s>2) // splitting of f |
---|
2608 | { |
---|
2609 | if(w>=1){"Newton polygon can be used for splitting";"";} |
---|
2610 | intvec v=NP[1][2]-NP[2][2],NP[2][1]; |
---|
2611 | int de=w_deg(g,v); |
---|
2612 | int st=w_deg(hc,v)+v[1]+v[2]; |
---|
2613 | poly f1=var(2)^NP[2][2]; |
---|
2614 | poly f2=jet(g,de,v)/var(2)^NP[2][2]; |
---|
2615 | poly h=g-f1*f2; |
---|
2616 | de=w_deg(h,v); |
---|
2617 | poly k; |
---|
2618 | ideal wi=var(2)^NP[2][2],f2; |
---|
2619 | matrix li; |
---|
2620 | while(de<st) |
---|
2621 | { |
---|
2622 | k=jet(h,de,v); |
---|
2623 | li=lift(wi,k); |
---|
2624 | f1=f1+li[2,1]; |
---|
2625 | f2=f2+li[1,1]; |
---|
2626 | h=g-f1*f2; |
---|
2627 | de=w_deg(h,v); |
---|
2628 | } |
---|
2629 | nb=deltaLoc(f1,maxideal(1))[3]+deltaLoc(f2,maxideal(1))[3]; |
---|
2630 | setring R; |
---|
2631 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
2632 | } |
---|
2633 | |
---|
2634 | f=jet(f,deg(hc)+2); |
---|
2635 | if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";} |
---|
2636 | ideal fac=factorize(f,1); |
---|
2637 | if(size(fac)>1) |
---|
2638 | { |
---|
2639 | nb=0; |
---|
2640 | for(i=1;i<=size(fac);i++) |
---|
2641 | { |
---|
2642 | nb=nb+deltaLoc(fac[i],maxideal(1))[3]; |
---|
2643 | } |
---|
2644 | setring R; |
---|
2645 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
2646 | } |
---|
2647 | list HNEXP=hnexpansion(f); |
---|
2648 | if (typeof(HNEXP[1])=="ring") { |
---|
2649 | def altring = basering; |
---|
2650 | def HNEring = HNEXP[1]; setring HNEring; |
---|
2651 | nb=size(hne); |
---|
2652 | setring R; |
---|
2653 | kill HNEring; |
---|
2654 | } |
---|
2655 | else |
---|
2656 | { |
---|
2657 | nb=size(HNEXP); |
---|
2658 | } |
---|
2659 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
2660 | } |
---|
2661 | else //the case of small characteristic |
---|
2662 | { |
---|
2663 | f=jet(f,deg(hc)+2); |
---|
2664 | if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";} |
---|
2665 | delt=delta(f); |
---|
2666 | return(list(d*delt,d*tau,d)); |
---|
2667 | } |
---|
2668 | } |
---|
2669 | example |
---|
2670 | { "EXAMPLE:"; echo = 2; |
---|
2671 | ring r=0,(x,y),dp; |
---|
2672 | poly f=(x2+y^2-1)^3 +27x2y2; |
---|
2673 | ideal I=f,jacob(f); |
---|
2674 | I=std(I); |
---|
2675 | list qr=minAssGTZ(I); |
---|
2676 | size(qr); |
---|
2677 | // each component of the singular locus either describes a cusp or a pair |
---|
2678 | // of conjugated nodes: |
---|
2679 | deltaLoc(f,qr[1]); |
---|
2680 | deltaLoc(f,qr[2]); |
---|
2681 | deltaLoc(f,qr[3]); |
---|
2682 | deltaLoc(f,qr[4]); |
---|
2683 | deltaLoc(f,qr[5]); |
---|
2684 | deltaLoc(f,qr[6]); |
---|
2685 | } |
---|
2686 | /////////////////////////////////////////////////////////////////////////////// |
---|
2687 | // compute the weighted degree of p |
---|
2688 | static proc w_deg(poly p, intvec v) |
---|
2689 | { |
---|
2690 | if(p==0){return(-1);} |
---|
2691 | int d=0; |
---|
2692 | while(jet(p,d,v)==0){d++;} |
---|
2693 | d=(transpose(leadexp(jet(p,d,v)))*v)[1]; |
---|
2694 | return(d); |
---|
2695 | } |
---|
2696 | |
---|
2697 | //proc hilbPoly(ideal J) |
---|
2698 | //{ |
---|
2699 | // poly hp; |
---|
2700 | // int i; |
---|
2701 | // if(!attrib(J,"isSB")){J=std(J);} |
---|
2702 | // intvec v = hilb(J,2); |
---|
2703 | // for(i=1; i<=size(v); i++){ hp=hp+v[i]*(var(1)-i+2);} |
---|
2704 | // return(hp); |
---|
2705 | //} |
---|
2706 | |
---|
2707 | |
---|
2708 | ////////////////////////////////////////////////////////////////////////////// |
---|
2709 | |
---|
2710 | proc primeClosure (list L, list #) |
---|
2711 | "USAGE: primeClosure(L [,c]); L a list of a ring containing a prime ideal |
---|
2712 | ker, c an optional integer |
---|
2713 | RETURN: a list L (of size n+1) consisting of rings L[1],...,L[n] such that |
---|
2714 | - L[1] is a copy of (not a reference to!) the input ring L[1] |
---|
2715 | - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi |
---|
2716 | such that |
---|
2717 | L[1]/ker --> ... --> L[n]/ker |
---|
2718 | are injections given by the corresponding ideals phi, and L[n]/ker |
---|
2719 | is the integral closure of L[1]/ker in its quotient field. |
---|
2720 | - all rings L[i] contain a polynomial nzd such that elements of |
---|
2721 | L[i]/ker are quotients of elements of L[i-1]/ker with denominator |
---|
2722 | nzd via the injection phi. |
---|
2723 | L[n+1] is the delta invariant |
---|
2724 | NOTE: - L is constructed by recursive calls of primeClosure itself. |
---|
2725 | - c determines the choice of nzd: |
---|
2726 | - c not given or equal to 0: first generator of the ideal SL, |
---|
2727 | the singular locus of Spec(L[i]/ker) |
---|
2728 | - c<>0: the generator of SL with least number of monomials. |
---|
2729 | EXAMPLE: example primeClosure; shows an example |
---|
2730 | " |
---|
2731 | { |
---|
2732 | //---- Start with a consistency check: |
---|
2733 | |
---|
2734 | if (!(typeof(L[1])=="ring")) |
---|
2735 | { |
---|
2736 | "// Parameter must be a ring or a list containing a ring!"; |
---|
2737 | return(-1); |
---|
2738 | } |
---|
2739 | |
---|
2740 | int dblvl = printlevel-voice+2; |
---|
2741 | list gnirlist = ringlist(basering); |
---|
2742 | |
---|
2743 | //---- Some auxiliary variables: |
---|
2744 | int delt; //finally the delta invariant |
---|
2745 | if ( size(L) == 1 ) |
---|
2746 | { |
---|
2747 | L[2] = delt; //set delta to 0 |
---|
2748 | } |
---|
2749 | int n = size(L)-1; //L without delta invariant |
---|
2750 | |
---|
2751 | //---- How to choose the non-zerodivisor later on? |
---|
2752 | |
---|
2753 | int nzdoption=0; |
---|
2754 | if (size(#)>0) |
---|
2755 | { |
---|
2756 | nzdoption=#[1]; |
---|
2757 | } |
---|
2758 | |
---|
2759 | // R0 below is the ring to work with, if we are in step one, make a copy of the |
---|
2760 | // input ring, so that all objects are created in the copy, not in the original |
---|
2761 | // ring (therefore a copy, not a reference is defined). |
---|
2762 | |
---|
2763 | if (n==1) |
---|
2764 | { |
---|
2765 | def R = L[1]; |
---|
2766 | list Rlist = ringlist(R); |
---|
2767 | def BAS = basering; |
---|
2768 | setring R; |
---|
2769 | if (!(typeof(ker)=="ideal")) |
---|
2770 | { |
---|
2771 | "// No ideal ker in the input ring!"; |
---|
2772 | return (-1); |
---|
2773 | } |
---|
2774 | ker=simplify(interred(ker),15); |
---|
2775 | //execute ("ring R0="+charstr(R)+",("+varstr(R)+"),("+ordstr(R)+");"); |
---|
2776 | // Rlist may be not defined in this new ring, so we define it again. |
---|
2777 | list Rlist2 = ringlist(R); |
---|
2778 | def R0 = ring(Rlist2); |
---|
2779 | setring R0; |
---|
2780 | ideal ker=fetch(R,ker); |
---|
2781 | // check whether we compute the normalization of the blow up of |
---|
2782 | // an isolated singularity at the origin (checked in normalI) |
---|
2783 | |
---|
2784 | if (typeof(attrib(L[1],"iso_sing_Rees"))=="int") |
---|
2785 | { |
---|
2786 | attrib(R0,"iso_sing_Rees",attrib(L[1],"iso_sing_Rees")); |
---|
2787 | } |
---|
2788 | L[1]=R0; |
---|
2789 | } |
---|
2790 | else |
---|
2791 | { |
---|
2792 | def R0 = L[n]; |
---|
2793 | setring R0; |
---|
2794 | } |
---|
2795 | |
---|
2796 | // In order to apply HomJJ from normal.lib, we need the radical of the singular |
---|
2797 | // locus of ker, J:=rad(ker): |
---|
2798 | |
---|
2799 | list SM=mstd(ker); |
---|
2800 | |
---|
2801 | // In the first iteration, we have to compute the singular locus "from |
---|
2802 | // scratch". |
---|
2803 | // In further iterations, we can fetch it from the previous one but |
---|
2804 | // have to compute its radical |
---|
2805 | // the next rings R1 contain already the (fetched) ideal |
---|
2806 | |
---|
2807 | if (n==1) //we are in R0=L[1] |
---|
2808 | { |
---|
2809 | if (typeof(attrib(R0,"iso_sing_Rees"))=="int") |
---|
2810 | { |
---|
2811 | ideal J; |
---|
2812 | for (int s=1;s<=attrib(R0,"iso_sing_Rees");s++) |
---|
2813 | { |
---|
2814 | J=J,var(s); |
---|
2815 | } |
---|
2816 | J = J,SM[2]; |
---|
2817 | list JM = mstd(J); |
---|
2818 | } |
---|
2819 | else |
---|
2820 | { |
---|
2821 | if ( dblvl >= 1 ) |
---|
2822 | {""; |
---|
2823 | "// compute the singular locus"; |
---|
2824 | } |
---|
2825 | //### Berechnung des singulren Orts gendert (ist so schneller) |
---|
2826 | ideal J = minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]); |
---|
2827 | J = J,SM[2]; |
---|
2828 | list JM = mstd(J); |
---|
2829 | } |
---|
2830 | |
---|
2831 | if ( dblvl >= 1 ) |
---|
2832 | {""; |
---|
2833 | "// dimension of singular locus is", dim(JM[1]); |
---|
2834 | if ( dblvl >= 2 ) |
---|
2835 | {""; |
---|
2836 | "// the singular locus is:"; JM[2]; |
---|
2837 | } |
---|
2838 | } |
---|
2839 | |
---|
2840 | if ( dblvl >= 1 ) |
---|
2841 | {""; |
---|
2842 | "// compute radical of singular locus"; |
---|
2843 | } |
---|
2844 | |
---|
2845 | J = simplify(radical(JM[2]),2); |
---|
2846 | if ( dblvl >= 1 ) |
---|
2847 | {""; |
---|
2848 | "// radical of singular locus is:"; J; |
---|
2849 | pause(); |
---|
2850 | } |
---|
2851 | } |
---|
2852 | else |
---|
2853 | { |
---|
2854 | if ( dblvl >= 1 ) |
---|
2855 | {""; |
---|
2856 | "// compute radical of test ideal in ideal of singular locus"; |
---|
2857 | } |
---|
2858 | J = simplify(radical(J),2); |
---|
2859 | if ( dblvl >= 1 ) |
---|
2860 | {""; |
---|
2861 | "// radical of test ideal is:"; J; |
---|
2862 | pause(); |
---|
2863 | } |
---|
2864 | } |
---|
2865 | |
---|
2866 | // having computed the radical J of/in the ideal of the singular locus, |
---|
2867 | // we now need to pick an element nzd of J; |
---|
2868 | // NOTE: nzd must be a non-zero divisor mod ker, i.e. not contained in ker |
---|
2869 | |
---|
2870 | poly nzd = J[1]; |
---|
2871 | poly nzd1 = NF(nzd,SM[1]); |
---|
2872 | if (nzd1 != 0) |
---|
2873 | { |
---|
2874 | if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) ) |
---|
2875 | { |
---|
2876 | nzd = nzd1; |
---|
2877 | } |
---|
2878 | } |
---|
2879 | |
---|
2880 | if (nzdoption || nzd1==0) |
---|
2881 | { |
---|
2882 | for (int ii=2;ii<=ncols(J);ii++) |
---|
2883 | { |
---|
2884 | nzd1 = NF(J[ii],SM[1]); |
---|
2885 | if ( nzd1 != 0 ) |
---|
2886 | { |
---|
2887 | if ( (deg(nzd)>=deg(J[ii])) && (size(nzd)>size(J[ii])) ) |
---|
2888 | { |
---|
2889 | nzd=J[ii]; |
---|
2890 | } |
---|
2891 | if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) ) |
---|
2892 | { |
---|
2893 | nzd = nzd1; |
---|
2894 | } |
---|
2895 | } |
---|
2896 | } |
---|
2897 | } |
---|
2898 | |
---|
2899 | export nzd; |
---|
2900 | // In this case we do not eliminate variables, so that the maps |
---|
2901 | // are well defined. |
---|
2902 | list RR = SM[1],SM[2],J,nzd,1; |
---|
2903 | |
---|
2904 | if ( dblvl >= 1 ) |
---|
2905 | {""; |
---|
2906 | "// compute the first ring extension:"; |
---|
2907 | "RR: "; |
---|
2908 | RR; |
---|
2909 | } |
---|
2910 | |
---|
2911 | list RS = HomJJ(RR); |
---|
2912 | //NOTE: HomJJ creates new ring with variables X(i) and T(j) |
---|
2913 | //------------------------------------------------------------------------- |
---|
2914 | // If we've reached the integral closure (as determined by the result of |
---|
2915 | // HomJJ), then we are done, otherwise we have to prepare the next iteration. |
---|
2916 | |
---|
2917 | if (RS[2]==1) // we've reached the integral closure, we are still in R0 |
---|
2918 | { |
---|
2919 | kill J; |
---|
2920 | if ( n== 1) |
---|
2921 | { |
---|
2922 | def R1 = RS[1]; |
---|
2923 | setring R1; |
---|
2924 | ideal norid, normap = endid, endphi; |
---|
2925 | kill endid, endphi; |
---|
2926 | |
---|
2927 | //"//### case: primeClosure, final"; |
---|
2928 | //"size norid:", size(norid), size(string(norid)); |
---|
2929 | //"interred:"; |
---|
2930 | //norid = interred(norid); |
---|
2931 | //"size norid:", size(norid), size(string(norid)); |
---|
2932 | |
---|
2933 | export (norid, normap); |
---|
2934 | L[1] = R1; |
---|
2935 | } |
---|
2936 | return(L); |
---|
2937 | } |
---|
2938 | else // prepare the next iteration |
---|
2939 | { |
---|
2940 | if (n==1) // In the first iteration: keep only the data |
---|
2941 | { // needed later on. |
---|
2942 | kill RR,SM; |
---|
2943 | export(ker); |
---|
2944 | } |
---|
2945 | if ( dblvl >= 1 ) |
---|
2946 | {""; |
---|
2947 | "// computing the next ring extension, we are in loop"; n+1; |
---|
2948 | } |
---|
2949 | |
---|
2950 | def R1 = RS[1]; // The data of the next ring R1: |
---|
2951 | delt = RS[3]; // the delta invariant of the ring extension |
---|
2952 | setring R1; // keep only what is necessary and kill |
---|
2953 | ideal ker=endid; // everything else. |
---|
2954 | export(ker); |
---|
2955 | ideal norid=endid; |
---|
2956 | |
---|
2957 | //"//### case: primeClosure, loop", n+1; |
---|
2958 | //"size norid:", size(norid), size(string(norid)); |
---|
2959 | //"interred:"; |
---|
2960 | //norid = interred(norid); //???? |
---|
2961 | //"size norid:", size(norid), size(string(norid)); |
---|
2962 | |
---|
2963 | export(norid); |
---|
2964 | kill endid; |
---|
2965 | |
---|
2966 | map phi = R0,endphi; // fetch the singular locus |
---|
2967 | ideal J = mstd(simplify(phi(J)+ker,4))[2]; // ideal J in R1 |
---|
2968 | export(J); |
---|
2969 | if(n>1) |
---|
2970 | { |
---|
2971 | ideal normap=phi(normap); |
---|
2972 | } |
---|
2973 | else |
---|
2974 | { |
---|
2975 | ideal normap=endphi; |
---|
2976 | } |
---|
2977 | export(normap); |
---|
2978 | kill phi; // we save phi as ideal, not as map, so that |
---|
2979 | ideal phi=endphi; // we have more flexibility in the ring names |
---|
2980 | kill endphi; // later on. |
---|
2981 | export(phi); |
---|
2982 | L=insert(L,R1,n); // Add the new ring R1 and go on with the |
---|
2983 | // next iteration |
---|
2984 | if ( L[size(L)] >= 0 && delt >= 0 ) |
---|
2985 | { |
---|
2986 | delt = L[size(L)] + delt; |
---|
2987 | } |
---|
2988 | else |
---|
2989 | { |
---|
2990 | delt = -1; |
---|
2991 | } |
---|
2992 | L[size(L)] = delt; |
---|
2993 | |
---|
2994 | if (size(#)>0) |
---|
2995 | { |
---|
2996 | return (primeClosure(L,#)); |
---|
2997 | } |
---|
2998 | else |
---|
2999 | { |
---|
3000 | return(primeClosure(L)); // next iteration. |
---|
3001 | } |
---|
3002 | } |
---|
3003 | } |
---|
3004 | example |
---|
3005 | { |
---|
3006 | "EXAMPLE:"; echo=2; |
---|
3007 | ring R=0,(x,y),dp; |
---|
3008 | ideal I=x4,y4; |
---|
3009 | def K=ReesAlgebra(I)[1]; // K contains ker such that K/ker=R[It] |
---|
3010 | list L=primeClosure(K); |
---|
3011 | def R(1)=L[1]; // L[4] contains ker, L[4]/ker is the |
---|
3012 | def R(4)=L[4]; // integral closure of L[1]/ker |
---|
3013 | setring R(1); |
---|
3014 | R(1); |
---|
3015 | ker; |
---|
3016 | setring R(4); |
---|
3017 | R(4); |
---|
3018 | ker; |
---|
3019 | } |
---|
3020 | |
---|
3021 | /////////////////////////////////////////////////////////////////////////////// |
---|
3022 | |
---|
3023 | proc closureFrac(list L) |
---|
3024 | "USAGE: closureFrac (L); L a list of size n+1 as in the result of |
---|
3025 | primeClosure, L[n] contains an additional polynomial f |
---|
3026 | CREATE: a list fraction of two elements of L[1], such that |
---|
3027 | f=fraction[1]/fraction[2] via the injections phi L[i]-->L[i+1]. |
---|
3028 | EXAMPLE: example closureFrac; shows an example |
---|
3029 | " |
---|
3030 | { |
---|
3031 | // Define some auxiliary variables: |
---|
3032 | |
---|
3033 | int n=size(L)-1; |
---|
3034 | int i,j,k,l,n2,n3; |
---|
3035 | intvec V; |
---|
3036 | string mapstr; |
---|
3037 | for (i=1; i<=n; i++) { def R(i) = L[i]; } |
---|
3038 | |
---|
3039 | // The quotient representing f is computed as in 'closureGenerators' with |
---|
3040 | // the differences that |
---|
3041 | // - the loop is done twice: for the numerator and for the denominator; |
---|
3042 | // - the result is stored in the list fraction and |
---|
3043 | // - we have to make sure that no more objects of the rings R(i) survive. |
---|
3044 | |
---|
3045 | for (j=1; j<=2; j++) |
---|
3046 | { |
---|
3047 | setring R(n); |
---|
3048 | if (j==1) |
---|
3049 | { |
---|
3050 | poly p=f; |
---|
3051 | } |
---|
3052 | else |
---|
3053 | { |
---|
3054 | p=1; |
---|
3055 | } |
---|
3056 | |
---|
3057 | for (k=n; k>1; k--) |
---|
3058 | { |
---|
3059 | if (j==1) |
---|
3060 | { |
---|
3061 | map phimap=R(k-1),phi; |
---|
3062 | } |
---|
3063 | |
---|
3064 | p=p*phimap(nzd); |
---|
3065 | |
---|
3066 | if (j==2) |
---|
3067 | { |
---|
3068 | kill phimap; |
---|
3069 | } |
---|
3070 | |
---|
3071 | if (j==1) |
---|
3072 | { |
---|
3073 | //### noch abfragen ob Z(i) definiert ist |
---|
3074 | list gnirlist = ringlist(R(k)); |
---|
3075 | n2 = size(gnirlist[2]); |
---|
3076 | n3 = size(gnirlist[3]); |
---|
3077 | for( i=1; i<=ncols(phi); i++) |
---|
3078 | { |
---|
3079 | gnirlist[2][n2+i] = "Z("+string(i)+")"; |
---|
3080 | } |
---|
3081 | V=0; |
---|
3082 | V[ncols(phi)]=0; V=V+1; |
---|
3083 | gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1); |
---|
3084 | def S(k) = ring(gnirlist); |
---|
3085 | setring S(k); |
---|
3086 | |
---|
3087 | //execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+", |
---|
3088 | // Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k))) |
---|
3089 | // +"),dp("+string(ncols(phi))+"));"); |
---|
3090 | |
---|
3091 | ideal phi = imap(R(k),phi); |
---|
3092 | ideal J = imap (R(k),ker); |
---|
3093 | for (l=1;l<=ncols(phi);l++) |
---|
3094 | { |
---|
3095 | J=J+(Z(l)-phi[l]); |
---|
3096 | } |
---|
3097 | J=groebner(J); |
---|
3098 | poly h=NF(imap(R(k),p),J); |
---|
3099 | } |
---|
3100 | else |
---|
3101 | { |
---|
3102 | setring S(k); |
---|
3103 | h=NF(imap(R(k),p),J); |
---|
3104 | setring R(k); |
---|
3105 | kill p; |
---|
3106 | } |
---|
3107 | |
---|
3108 | setring R(k-1); |
---|
3109 | |
---|
3110 | if (j==1) |
---|
3111 | { |
---|
3112 | ideal maxi; |
---|
3113 | maxi[nvars(R(k))] = 0; |
---|
3114 | maxi = maxi,maxideal(1); |
---|
3115 | map backmap = S(k),maxi; |
---|
3116 | |
---|
3117 | //mapstr=" map backmap = S(k),"; |
---|
3118 | //for (l=1;l<=nvars(R(k));l++) |
---|
3119 | //{ |
---|
3120 | // mapstr=mapstr+"0,"; |
---|
3121 | //} |
---|
3122 | //execute (mapstr+"maxideal(1);"); |
---|
3123 | poly p; |
---|
3124 | } |
---|
3125 | p=NF(backmap(h),std(ker)); |
---|
3126 | if (j==2) |
---|
3127 | { |
---|
3128 | kill backmap; |
---|
3129 | } |
---|
3130 | } |
---|
3131 | |
---|
3132 | if (j==1) |
---|
3133 | { |
---|
3134 | if (defined(fraction)) |
---|
3135 | { |
---|
3136 | kill fraction; |
---|
3137 | list fraction=p; |
---|
3138 | } |
---|
3139 | else |
---|
3140 | { |
---|
3141 | list fraction=p; |
---|
3142 | } |
---|
3143 | } |
---|
3144 | else |
---|
3145 | { |
---|
3146 | fraction=insert(fraction,p,1); |
---|
3147 | } |
---|
3148 | } |
---|
3149 | export(fraction); |
---|
3150 | return (); |
---|
3151 | } |
---|
3152 | example |
---|
3153 | { |
---|
3154 | "EXAMPLE:"; echo=2; |
---|
3155 | ring R=0,(x,y),dp; |
---|
3156 | ideal ker=x2+y2; |
---|
3157 | export ker; |
---|
3158 | list L=primeClosure(R); // We normalize R/ker |
---|
3159 | for (int i=1;i<=size(L);i++) { def R(i)=L[i]; } |
---|
3160 | setring R(2); |
---|
3161 | kill R; |
---|
3162 | phi; // The map R(1)-->R(2) |
---|
3163 | poly f=T(2); // We will get a representation of f |
---|
3164 | export f; |
---|
3165 | L[2]=R(2); |
---|
3166 | closureFrac(L); |
---|
3167 | setring R(1); |
---|
3168 | kill R(2); |
---|
3169 | fraction; // f=fraction[1]/fraction[2] via phi |
---|
3170 | kill R(1); |
---|
3171 | } |
---|
3172 | |
---|
3173 | /////////////////////////////////////////////////////////////////////////////// |
---|
3174 | // closureGenerators is called inside proc normal (option "withGens" ) |
---|
3175 | // |
---|
3176 | |
---|
3177 | // INPUT is the output of proc primeClosure (except for the last element, the |
---|
3178 | // delta invariant) : hence input is a list L consisting of rings |
---|
3179 | // L[1],...,L[n] (denoted R(1)...R(n) below) such that |
---|
3180 | // - L[1] is a copy of (not a reference to!) the input ring L[1] |
---|
3181 | // - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi |
---|
3182 | // such that |
---|
3183 | // L[1]/ker --> ... --> L[n]/ker |
---|
3184 | // are injections given by the corresponding ideals phi, and L[n]/ker |
---|
3185 | // is the integral closure of L[1]/ker in its quotient field. |
---|
3186 | // - all rings L[i] contain a polynomial nzd such that elements of |
---|
3187 | // L[i]/ker are quotients of elements of L[i-1]/ker with denominator |
---|
3188 | // nzd via the injection phi. |
---|
3189 | |
---|
3190 | // COMPUTE: In the list L of rings R(1),...,R(n), compute representations of |
---|
3191 | // the ring variables of the last ring R(n) as fractions of elements of R(1): |
---|
3192 | // The proc returns an ideal preim s.t. preim[i]/preim[size(preim)] expresses |
---|
3193 | // the ith variable of R(n) as fraction of elements of the basering R(1) |
---|
3194 | // preim[size(preim)] is a non-zero divisor of basering/i. |
---|
3195 | |
---|
3196 | proc closureGenerators(list L); |
---|
3197 | { |
---|
3198 | def Rees=basering; // when called inside normalI (in reesclos.lib) |
---|
3199 | // the Rees Algebra is the current basering |
---|
3200 | |
---|
3201 | // ------- First of all we need some variable declarations ----------- |
---|
3202 | int n = size(L); // the number of rings R(1)-->...-->R(n) |
---|
3203 | int length = nvars(L[n]); // the number of variables of the last ring |
---|
3204 | int j,k,l,n2,n3; |
---|
3205 | intvec V; |
---|
3206 | string mapstr; |
---|
3207 | list preimages; |
---|
3208 | //Note: the empty list belongs to no ring, hence preimages can be used |
---|
3209 | //later in R(1) |
---|
3210 | //this is not possible for ideals (belong always to some ring) |
---|
3211 | |
---|
3212 | for (int i=1; i<=n; i++) |
---|
3213 | { |
---|
3214 | def R(i)=L[i]; //give the rings from L a name |
---|
3215 | } |
---|
3216 | |
---|
3217 | // For each variable (counter j) and for each intermediate ring (counter k): |
---|
3218 | // Find a preimage of var_j*phi(nzd(k-1)) in R(k-1). |
---|
3219 | // Finally, do the same for nzd. |
---|
3220 | |
---|
3221 | for (j=1; j <= length+1; j++ ) |
---|
3222 | { |
---|
3223 | setring R(n); |
---|
3224 | if (j==1) |
---|
3225 | { |
---|
3226 | poly p; |
---|
3227 | } |
---|
3228 | if (j <= length ) |
---|
3229 | { |
---|
3230 | p=var(j); |
---|
3231 | } |
---|
3232 | else |
---|
3233 | { |
---|
3234 | p=1; |
---|
3235 | } |
---|
3236 | //i.e. p=j-th var of R(n) for j<=length and p=1 for j=length+1 |
---|
3237 | |
---|
3238 | for (k=n; k>1; k--) |
---|
3239 | { |
---|
3240 | |
---|
3241 | if (j==1) |
---|
3242 | { |
---|
3243 | map phimap=R(k-1),phi; //phimap:R(k-1)-->R(n), k=2..n, is the map |
---|
3244 | //belonging to phi in R(n) |
---|
3245 | } |
---|
3246 | |
---|
3247 | p = p*phimap(nzd); |
---|
3248 | |
---|
3249 | // Compute the preimage of [p mod ker(k)] under phi in R(k-1): |
---|
3250 | // As p is an element of Image(phi), there is a polynomial h such |
---|
3251 | // that h is mapped to [p mod ker(k)], and h can be computed as the |
---|
3252 | // normal form of p w.r.t. a Groebner basis of |
---|
3253 | // J(k) := <ker(k),Z(l)-phi(k)(l)> in R(k)[Z]=:S(k) |
---|
3254 | |
---|
3255 | if (j==1) // In the first iteration: Create S(k), fetch phi and |
---|
3256 | // ker(k) and construct the ideal J(k). |
---|
3257 | { |
---|
3258 | //### noch abfragen ob Z(i) definiert ist |
---|
3259 | list gnirlist = ringlist(R(k)); |
---|
3260 | n2 = size(gnirlist[2]); |
---|
3261 | n3 = size(gnirlist[3]); |
---|
3262 | for( i=1; i<=ncols(phi); i++) |
---|
3263 | { |
---|
3264 | gnirlist[2][n2+i] = "Z("+string(i)+")"; |
---|
3265 | } |
---|
3266 | V=0; |
---|
3267 | V[ncols(phi)]=0; |
---|
3268 | V=V+1; |
---|
3269 | gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1); |
---|
3270 | def S(k) = ring(gnirlist); |
---|
3271 | setring S(k); |
---|
3272 | |
---|
3273 | // execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+", |
---|
3274 | // Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k))) |
---|
3275 | // +"),dp("+string(ncols(phi))+"));"); |
---|
3276 | |
---|
3277 | ideal phi = imap(R(k),phi); |
---|
3278 | ideal J = imap (R(k),ker); |
---|
3279 | for ( l=1; l<=ncols(phi); l++ ) |
---|
3280 | { |
---|
3281 | J=J+(Z(l)-phi[l]); |
---|
3282 | } |
---|
3283 | J = groebner(J); |
---|
3284 | poly h = NF(imap(R(k),p),J); |
---|
3285 | } |
---|
3286 | else |
---|
3287 | { |
---|
3288 | setring S(k); |
---|
3289 | h = NF(imap(R(k),p),J); |
---|
3290 | } |
---|
3291 | |
---|
3292 | setring R(k-1); |
---|
3293 | |
---|
3294 | if (j==1) // In the first iteration: Compute backmap:S(k)-->R(k-1) |
---|
3295 | { |
---|
3296 | ideal maxi; |
---|
3297 | maxi[nvars(R(k))] = 0; |
---|
3298 | maxi = maxi,maxideal(1); |
---|
3299 | map backmap = S(k),maxi; |
---|
3300 | |
---|
3301 | //mapstr=" map backmap = S(k),"; |
---|
3302 | //for (l=1;l<=nvars(R(k));l++) |
---|
3303 | //{ |
---|
3304 | // mapstr=mapstr+"0,"; |
---|
3305 | //} |
---|
3306 | //execute (mapstr+"maxideal(1);"); |
---|
3307 | |
---|
3308 | poly p; |
---|
3309 | } |
---|
3310 | p = NF(backmap(h),std(ker)); |
---|
3311 | } |
---|
3312 | // Whe are down to R(1), store here the result in the list preimages |
---|
3313 | preimages = insert(preimages,p,j-1); |
---|
3314 | } |
---|
3315 | ideal preim; //make the list preimages to an ideal preim |
---|
3316 | for ( i=1; i<=size(preimages); i++ ) |
---|
3317 | { |
---|
3318 | preim[i] = preimages[i]; |
---|
3319 | } |
---|
3320 | // R(1) was a copy of Rees, so we have to get back to the basering Rees from |
---|
3321 | // the beginning and fetch the result (the ideal preim) to this ring. |
---|
3322 | setring Rees; |
---|
3323 | return (fetch(R(1),preim)); |
---|
3324 | } |
---|
3325 | |
---|
3326 | /////////////////////////////////////////////////////////////////////////////// |
---|
3327 | // From here: procedures for char p with Frobenius |
---|
3328 | /////////////////////////////////////////////////////////////////////////////// |
---|
3329 | |
---|
3330 | proc normalP(ideal id,list #) |
---|
3331 | "USAGE: normalP(id [,choose]); id = radical ideal, = optional string. |
---|
3332 | Optional parameters in list choose (can be entered in any order):@* |
---|
3333 | list of optional strings \"withRing\", \"isPrim\", \"noFac\", |
---|
3334 | \"noRed\", where@* |
---|
3335 | - \"noFac\" -> factorization is avoided during the computation |
---|
3336 | of the minimal associated primes.@* |
---|
3337 | - \"isPrim\" -> assumes that the ideal is prime. If the assumption |
---|
3338 | does not hold, output might be wrong.@* |
---|
3339 | - \"withRing\" -> the ring structure of the normalization is |
---|
3340 | computed. The number of variables in the new ring is reduced as much |
---|
3341 | as possible.@* |
---|
3342 | - \"noRed\" -> when computing the ring structure, no reduction on the |
---|
3343 | number of variables is done, it creates one new variable for every |
---|
3344 | new module generator of the integral closure in the quotient field.@* |
---|
3345 | ASSUME: The characteristic of the ground field must be positive. If the |
---|
3346 | option \"isPrim\" is not set, the minimal associated primes of id |
---|
3347 | are computed first and hence normal computes the normalization of |
---|
3348 | the radical of id. If option \"isPrim\" is set, the ideal must be |
---|
3349 | a prime ideal otherwise the result may be wrong. |
---|
3350 | RETURN: a list, say 'nor' of size 2 (resp. 3 if \"withRing\" is set).@* |
---|
3351 | ** If option \"withRing\" is not set: @* |
---|
3352 | Only the module structure is computed: @* |
---|
3353 | * nor[1] is a list of ideals Ii, i=1..r, in the basering R where r |
---|
3354 | is the number of minimal associated prime ideals P_i of the input |
---|
3355 | ideal id, describing the module structure:@* |
---|
3356 | If Ii is given by polynomials g_1,...,g_k in R, then c:=g_k is |
---|
3357 | non-zero in the ring R/P_i and g_1/c,...,g_k/c generate the integral |
---|
3358 | closure of R/P_i as R-module in the quotient field of R/P_i.@* |
---|
3359 | * nor[2] shows the delta invariants: it is a list of an intvec |
---|
3360 | of size r, the delta invariants of the r components, and an integer, |
---|
3361 | the total delta invariant of R/id |
---|
3362 | (-1 means infinite, and 0 that R/P_i resp. R/id is normal). @* |
---|
3363 | ** If option \"withRing\" is set: @* |
---|
3364 | The ring structure is also computed, and in this case:@* |
---|
3365 | * nor[1] is a list of r rings.@* |
---|
3366 | Each ring Ri = nor[1][i], i=1..r, contains two ideals with given |
---|
3367 | names @code{norid} and @code{normap} such that @* |
---|
3368 | - Ri/norid is the normalization of R/P_i, i.e. isomorphic as |
---|
3369 | K-algebra (K the ground field) to the integral closure of R/P_i in |
---|
3370 | the field of fractions of R/P_i; @* |
---|
3371 | - the direct sum of the rings Ri/norid is the normalization |
---|
3372 | of R/id; @* |
---|
3373 | - @code{normap} gives the normalization map from R to Ri/norid.@* |
---|
3374 | * nor[2] gives the module generators of the normalization of R/P_i, |
---|
3375 | it is the same as nor[1] if \"withRing\" is not set.@* |
---|
3376 | * nor[3] shows the delta invariants, it is the same as nor[2] if |
---|
3377 | \"withRing\" is not set. |
---|
3378 | THEORY: normalP uses the Leonard-Pellikaan-Singh-Swanson algorithm (using the |
---|
3379 | Frobenius) cf. [A. K. Singh, I. Swanson: An algorithm for computing |
---|
3380 | the integral closure, arXiv:0901.0871]. |
---|
3381 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
3382 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
3383 | id. The procedure returns the delta invariants of the components P_i |
---|
3384 | and of id. |
---|
3385 | NOTE: To use the i-th ring type: @code{def R=nor[1][i]; setring R;}. |
---|
3386 | @* Increasing/decreasing printlevel displays more/less comments |
---|
3387 | (default: printlevel = 0). |
---|
3388 | @* Not implemented for local or mixed orderings or quotient rings. |
---|
3389 | For local or mixed orderings use proc 'normal'. |
---|
3390 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
3391 | be used (qhweight(id); computes weights). |
---|
3392 | @* Works only in characteristic p > 0, use proc normal in char 0. |
---|
3393 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
3394 | SEE ALSO: normal, normalC |
---|
3395 | EXAMPLE: example normalP; shows an example |
---|
3396 | " |
---|
3397 | { |
---|
3398 | int i,j,y, sr, del, co; |
---|
3399 | intvec deli; |
---|
3400 | list resu, Resu, prim, Gens, mstdid; |
---|
3401 | ideal gens; |
---|
3402 | |
---|
3403 | // Default options |
---|
3404 | int wring = 0; // The ring structure is not computed. |
---|
3405 | int noRed = 0; // No reduction is done in the ring structure |
---|
3406 | int isPrim = 0; // Ideal is not assumed to be prime |
---|
3407 | int noFac = 0; // Use facstd when computing the decomposition |
---|
3408 | |
---|
3409 | |
---|
3410 | y = printlevel-voice+2; |
---|
3411 | |
---|
3412 | if ( ord_test(basering) != 1) |
---|
3413 | { |
---|
3414 | ""; |
---|
3415 | "// Not implemented for this ordering,"; |
---|
3416 | "// please change to global ordering!"; |
---|
3417 | return(resu); |
---|
3418 | } |
---|
3419 | if ( char(basering) <= 0) |
---|
3420 | { |
---|
3421 | ""; |
---|
3422 | "// Algorithm works only in positive characteristic,"; |
---|
3423 | "// use procedure 'normal' if the characteristic is 0"; |
---|
3424 | return(resu); |
---|
3425 | } |
---|
3426 | |
---|
3427 | //--------------------------- define the method --------------------------- |
---|
3428 | string method; //make all options one string in order to use |
---|
3429 | //all combinations of options simultaneously |
---|
3430 | for ( i=1; i<= size(#); i++ ) |
---|
3431 | { |
---|
3432 | if ( typeof(#[i]) == "string" ) |
---|
3433 | { |
---|
3434 | method = method + #[i]; |
---|
3435 | } |
---|
3436 | } |
---|
3437 | |
---|
3438 | if ( find(method,"withring") or find(method,"withRing") ) |
---|
3439 | { |
---|
3440 | wring=1; |
---|
3441 | } |
---|
3442 | if ( find(method,"noRed") or find(method,"nored") ) |
---|
3443 | { |
---|
3444 | noRed=1; |
---|
3445 | } |
---|
3446 | if ( find(method,"isPrim") or find(method,"isprim") ) |
---|
3447 | { |
---|
3448 | isPrim=1; |
---|
3449 | } |
---|
3450 | if ( find(method,"noFac") or find(method,"nofac")) |
---|
3451 | { |
---|
3452 | noFac=1; |
---|
3453 | } |
---|
3454 | |
---|
3455 | kill #; |
---|
3456 | list #; |
---|
3457 | //--------------------------- start computation --------------------------- |
---|
3458 | ideal II,K1,K2; |
---|
3459 | |
---|
3460 | //----------- check first (or ignore) if input id is prime ------------- |
---|
3461 | |
---|
3462 | if ( isPrim ) |
---|
3463 | { |
---|
3464 | prim[1] = id; |
---|
3465 | if( y >= 0 ) |
---|
3466 | { ""; |
---|
3467 | "// ** WARNING: result is correct if ideal is prime (not checked) **"; |
---|
3468 | "// disable option \"isPrim\" to decompose ideal into prime components";""; |
---|
3469 | } |
---|
3470 | } |
---|
3471 | else |
---|
3472 | { |
---|
3473 | if(y>=1) |
---|
3474 | { "// compute minimal associated primes"; } |
---|
3475 | |
---|
3476 | if( noFac ) |
---|
3477 | { prim = minAssGTZ(id,1); } |
---|
3478 | else |
---|
3479 | { prim = minAssGTZ(id); } |
---|
3480 | |
---|
3481 | if(y>=1) |
---|
3482 | { |
---|
3483 | prim;""; |
---|
3484 | "// number of irreducible components is", size(prim); |
---|
3485 | } |
---|
3486 | } |
---|
3487 | |
---|
3488 | //----------- compute integral closure for every component ------------- |
---|
3489 | |
---|
3490 | for(i=1; i<=size(prim); i++) |
---|
3491 | { |
---|
3492 | if(y>=1) |
---|
3493 | { |
---|
3494 | ""; pause(); ""; |
---|
3495 | "// start computation of component",i; |
---|
3496 | " --------------------------------"; |
---|
3497 | } |
---|
3498 | if(y>=1) |
---|
3499 | { "// compute SB of ideal"; |
---|
3500 | } |
---|
3501 | mstdid = mstd(prim[i]); |
---|
3502 | if(y>=1) |
---|
3503 | { "// dimension of component is", dim(mstdid[1]);"";} |
---|
3504 | |
---|
3505 | //------- 1-st main subprocedure: compute module generators ---------- |
---|
3506 | printlevel = printlevel+1; |
---|
3507 | II = normalityTest(mstdid); |
---|
3508 | |
---|
3509 | //------ compute also the ringstructure if "withRing" is given ------- |
---|
3510 | if ( wring ) |
---|
3511 | { |
---|
3512 | //------ 2-nd main subprocedure: compute ring structure ----------- |
---|
3513 | if(noRed == 0){ |
---|
3514 | resu = list(computeRing(II,prim[i])) + resu; |
---|
3515 | } else { |
---|
3516 | resu = list(computeRing(II,prim[i], "noRed")) + resu; |
---|
3517 | } |
---|
3518 | } |
---|
3519 | printlevel = printlevel-1; |
---|
3520 | |
---|
3521 | //----- rearrange module generators s.t. denominator comes last ------ |
---|
3522 | gens=0; |
---|
3523 | for( j=2; j<=size(II); j++ ) |
---|
3524 | { |
---|
3525 | gens[j-1]=II[j]; |
---|
3526 | } |
---|
3527 | gens[size(gens)+1]=II[1]; |
---|
3528 | Gens = list(gens) + Gens; |
---|
3529 | //------------------------------ compute delta ----------------------- |
---|
3530 | K1 = mstdid[1]+II; |
---|
3531 | K1 = std(K1); |
---|
3532 | K2 = mstdid[1]+II[1]; |
---|
3533 | K2 = std(K2); |
---|
3534 | // K1 = std(mstdid[1],II); //### besser |
---|
3535 | // K2 = std(mstdid[1],II[1]); //### besser: Hannes, fixen! |
---|
3536 | co = codim(K1,K2); |
---|
3537 | deli = co,deli; |
---|
3538 | if ( co >= 0 && del >= 0 ) |
---|
3539 | { |
---|
3540 | del = del + co; |
---|
3541 | } |
---|
3542 | else |
---|
3543 | { del = -1; } |
---|
3544 | } |
---|
3545 | |
---|
3546 | if ( del >= 0 ) |
---|
3547 | { |
---|
3548 | int mul = iMult(prim); |
---|
3549 | del = del + mul; |
---|
3550 | } |
---|
3551 | else |
---|
3552 | { del = -1; } |
---|
3553 | |
---|
3554 | deli = deli[1..size(deli)-1]; |
---|
3555 | if ( wring ) |
---|
3556 | { Resu = resu,Gens,list(deli,del); } |
---|
3557 | else |
---|
3558 | { Resu = Gens,list(deli,del); } |
---|
3559 | |
---|
3560 | sr = size(prim); |
---|
3561 | |
---|
3562 | //-------------------- Finally print comments and return -------------------- |
---|
3563 | if(y >= 0) |
---|
3564 | {""; |
---|
3565 | if ( wring ) |
---|
3566 | { |
---|
3567 | "// 'normalP' created a list, say nor, of three lists: |
---|
3568 | // To see the result, type |
---|
3569 | nor; |
---|
3570 | |
---|
3571 | // * nor[1] is a list of",sr,"ring(s): |
---|
3572 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
3573 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
3574 | // for the other rings type first setring R; (if R is the name of your |
---|
3575 | // original basering) and then continue as for R1; |
---|
3576 | // Ri/norid is the affine algebra of the normalization of the i-th |
---|
3577 | // component R/P_i (where P_i is a min. associated prime of the input ideal) |
---|
3578 | // and normap the normalization map from R to Ri/norid; |
---|
3579 | |
---|
3580 | // * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of |
---|
3581 | // elements g1..gk of r such that the gj/gk generate the integral |
---|
3582 | // closure of R/P_i as R-module in the quotient field of R/P_i. |
---|
3583 | |
---|
3584 | // * nor[3] shows the delta-invariant of each component and of the input |
---|
3585 | // ideal (-1 means infinite, and 0 that r/P_i is normal)."; |
---|
3586 | } |
---|
3587 | else |
---|
3588 | { |
---|
3589 | "// 'normalP' computed a list, say nor, of two lists: |
---|
3590 | // To see the result, type |
---|
3591 | nor; |
---|
3592 | |
---|
3593 | // * nor[1] is a list of",sr,"ideal(s), where each ideal nor[1][i] consists |
---|
3594 | // of elements g1..gk of the basering R such that gj/gk generate the integral |
---|
3595 | // closure of R/P_i (where P_i is a min. associated prime of the input ideal) |
---|
3596 | // as R-module in the quotient field of R/P_i; |
---|
3597 | |
---|
3598 | // * nor[2] shows the delta-invariant of each component and of the input ideal |
---|
3599 | // (-1 means infinite, and 0 that R/P_i is normal)."; |
---|
3600 | } |
---|
3601 | } |
---|
3602 | |
---|
3603 | return(Resu); |
---|
3604 | } |
---|
3605 | example |
---|
3606 | { "EXAMPLE:"; echo = 2; |
---|
3607 | ring r = 11,(x,y,z),wp(2,1,2); |
---|
3608 | ideal i = x*(z3 - xy4 + x2); |
---|
3609 | list nor= normalP(i); nor; |
---|
3610 | //the result says that both components of i are normal, but i itself |
---|
3611 | //has infinite delta |
---|
3612 | pause("hit return to continue"); |
---|
3613 | |
---|
3614 | ring s = 2,(x,y),dp; |
---|
3615 | ideal i = y*((x-y^2)^2 - x^3); |
---|
3616 | list nor = normalP(i,"withRing"); nor; |
---|
3617 | |
---|
3618 | def R2 = nor[1][2]; setring R2; |
---|
3619 | norid; normap; |
---|
3620 | } |
---|
3621 | |
---|
3622 | /////////////////////////////////////////////////////////////////////////////// |
---|
3623 | // Assume: mstdid is the result of mstd(prim[i]), prim[i] a prime component of |
---|
3624 | // the input ideal id of normalP. |
---|
3625 | // Output is an ideal U s.t. U[i]/U[1] are module generators. |
---|
3626 | |
---|
3627 | static proc normalityTest(list mstdid) |
---|
3628 | { |
---|
3629 | int y = printlevel-voice+2; |
---|
3630 | intvec op = option(get); |
---|
3631 | option(redSB); |
---|
3632 | def R = basering; |
---|
3633 | int n, p = nvars(R), char(R); |
---|
3634 | int ii; |
---|
3635 | |
---|
3636 | ideal J = mstdid[1]; //J is the SB of I |
---|
3637 | ideal I = mstdid[2]; |
---|
3638 | int h = n-dim(J); //codimension of V(I), I is a prime ideal |
---|
3639 | |
---|
3640 | //-------------------------- compute singular locus ---------------------- |
---|
3641 | qring Q = J; //pass to quotient ring |
---|
3642 | ideal I = imap(R,I); |
---|
3643 | ideal J = imap(R,J); |
---|
3644 | attrib(J,"isSB",1); |
---|
3645 | if ( y >= 1) |
---|
3646 | { "start normality test"; "compute singular locus";} |
---|
3647 | |
---|
3648 | ideal M = minor(jacob(I),h,J); //use the command minor modulo J (hence J=0) |
---|
3649 | M = std(M); //this makes M much smaller |
---|
3650 | //keep only minors which are not 0 mod I (!) this is important since we |
---|
3651 | //need a nzd mod I |
---|
3652 | |
---|
3653 | //---------------- choose nzd from ideal of singular locus -------------- |
---|
3654 | ideal D = M[1]; |
---|
3655 | for( ii=2; ii<=size(M); ii++ ) //look for the shortest one |
---|
3656 | { |
---|
3657 | if( size(M[ii]) < size(D[1]) ) |
---|
3658 | { |
---|
3659 | D = M[ii]; |
---|
3660 | } |
---|
3661 | } |
---|
3662 | |
---|
3663 | //--------------- start p-th power algorithm and return ---------------- |
---|
3664 | ideal F = var(1)^p; |
---|
3665 | for(ii=2; ii<=n; ii++) |
---|
3666 | { |
---|
3667 | F=F,var(ii)^p; |
---|
3668 | } |
---|
3669 | |
---|
3670 | ideal Dp=D^(p-1); |
---|
3671 | ideal U=1; |
---|
3672 | ideal K,L; |
---|
3673 | map phi=Q,F; |
---|
3674 | if ( y >= 1) |
---|
3675 | { "compute module generators of integral closure"; |
---|
3676 | "denominator D is:"; D; |
---|
3677 | pause(); |
---|
3678 | } |
---|
3679 | |
---|
3680 | ii=0; |
---|
3681 | list LK; |
---|
3682 | while(1) |
---|
3683 | { |
---|
3684 | ii=ii+1; |
---|
3685 | if ( y >= 1) |
---|
3686 | { "iteration", ii; } |
---|
3687 | L = U*Dp + I; |
---|
3688 | //### L=interred(L) oder msdt(L)[2]? |
---|
3689 | //Wird dadurch kleiner aber string(L) wird groesser |
---|
3690 | K = preimage(Q,phi,L); //### Improvement by block ordering? |
---|
3691 | option(returnSB); |
---|
3692 | K = intersect(U,K); //K is the new U, it is a SB |
---|
3693 | LK = mstd(K); |
---|
3694 | K = LK[2]; |
---|
3695 | |
---|
3696 | //---------------------------- simplify output -------------------------- |
---|
3697 | if(size(reduce(U,LK[1]))==0) //previous U coincides with new U |
---|
3698 | { //i.e. we reached the integral closure |
---|
3699 | U=simplify(reduce(U,groebner(D)),2); |
---|
3700 | U = D,U; |
---|
3701 | poly gg = gcd(U[1],U[size(U)]); |
---|
3702 | for(ii=2; ii<=size(U)-1 ;ii++) |
---|
3703 | { |
---|
3704 | gg = gcd(gg,U[ii]); |
---|
3705 | } |
---|
3706 | for(ii=1; ii<=size(U); ii++) |
---|
3707 | { |
---|
3708 | U[ii]=U[ii]/gg; |
---|
3709 | } |
---|
3710 | U = simplify(U,6); |
---|
3711 | //if ( y >= 1) |
---|
3712 | //{ "module generators are U[i]/U[1], with U:"; U; |
---|
3713 | // ""; pause(); } |
---|
3714 | option(set,op); |
---|
3715 | setring R; |
---|
3716 | ideal U = imap(Q,U); |
---|
3717 | return(U); |
---|
3718 | } |
---|
3719 | U=K; |
---|
3720 | } |
---|
3721 | } |
---|
3722 | |
---|
3723 | /////////////////////////////////////////////////////////////////////////////// |
---|
3724 | |
---|
3725 | static proc substpartSpecial(ideal endid, ideal endphi) |
---|
3726 | { |
---|
3727 | //Note: newRing is of the form (R the original basering): |
---|
3728 | //char(R),(T(1..N),X(1..nvars(R))),(dp(N),...); |
---|
3729 | |
---|
3730 | int ii,jj,kk; |
---|
3731 | def BAS = basering; |
---|
3732 | int n = nvars(basering); |
---|
3733 | |
---|
3734 | list Le = elimpart(endid); |
---|
3735 | int q = size(Le[2]); //q variables have been substituted |
---|
3736 | //Le;""; |
---|
3737 | if ( q == 0 ) |
---|
3738 | { |
---|
3739 | ideal normap = endphi; |
---|
3740 | ideal norid = endid; |
---|
3741 | export(norid); |
---|
3742 | export(normap); |
---|
3743 | list L = BAS; |
---|
3744 | return(L); |
---|
3745 | } |
---|
3746 | |
---|
3747 | list gnirlist = ringlist(basering); |
---|
3748 | endid = Le[1]; |
---|
3749 | //endphi;""; |
---|
3750 | for( ii=1; ii<=n; ii++) |
---|
3751 | { |
---|
3752 | if( Le[4][ii] == 0 ) //ii=index of substituted var |
---|
3753 | { |
---|
3754 | endphi = subst(endphi,var(ii),Le[5][ii]); |
---|
3755 | } |
---|
3756 | } |
---|
3757 | //endphi;""; |
---|
3758 | list g2 = gnirlist[2]; //the varlist |
---|
3759 | list g3 = gnirlist[3]; //contains blocks of orderings |
---|
3760 | int n3 = size(g3); |
---|
3761 | |
---|
3762 | //----------------- first identify module ordering ------------------ |
---|
3763 | if ( g3[n3][1]== "c" or g3[n3][1] == "C" ) |
---|
3764 | { |
---|
3765 | list gm = g3[n3]; //last blockis module ordering |
---|
3766 | g3 = delete(g3,n3); |
---|
3767 | int m = 0; |
---|
3768 | } |
---|
3769 | else |
---|
3770 | { |
---|
3771 | list gm = g3[1]; //first block is module ordering |
---|
3772 | g3 = delete(g3,1); |
---|
3773 | int m = 1; |
---|
3774 | } |
---|
3775 | //---- delete variables which were substituted and weights -------- |
---|
3776 | intvec V; |
---|
3777 | int n(0); |
---|
3778 | list newg2; |
---|
3779 | list newg3; |
---|
3780 | for ( ii=1; ii<=n3-1; ii++ ) |
---|
3781 | { |
---|
3782 | // If order is a matrix ordering, it is replaced by dp ordering. |
---|
3783 | // TODO: replace it only when some of the original |
---|
3784 | // variables are eliminated. |
---|
3785 | if(g3[ii][1] == "M"){ |
---|
3786 | g3[ii][1] = "dp"; |
---|
3787 | g3[ii][2] = (1..sqroot(size(g3[ii][2])))*0+1; |
---|
3788 | } |
---|
3789 | V = V,g3[ii][2]; //copy weights for ordering in each block |
---|
3790 | if ( ii==1 ) //into one intvector |
---|
3791 | { |
---|
3792 | V = V[2..size(V)]; |
---|
3793 | } |
---|
3794 | // int n(ii) = size(g3[ii][2]); |
---|
3795 | int n(ii) = size(V); |
---|
3796 | intvec V(ii); |
---|
3797 | |
---|
3798 | for ( jj = n(ii-1)+1; jj<=n(ii); jj++) |
---|
3799 | { |
---|
3800 | if( Le[4][jj] !=0 ) //jj=index of var which was not substituted |
---|
3801 | { |
---|
3802 | kk=kk+1; |
---|
3803 | newg2[kk] = g2[jj]; //not substituted var from varlist |
---|
3804 | V(ii)=V(ii),V[jj]; //weight of not substituted variable |
---|
3805 | } |
---|
3806 | } |
---|
3807 | if ( size(V(ii)) >= 2 ) |
---|
3808 | { |
---|
3809 | V(ii) = V(ii)[2..size(V(ii))]; |
---|
3810 | list g3(ii)=g3[ii][1],V(ii); |
---|
3811 | newg3 = insert(newg3,g3(ii),size(newg3)); |
---|
3812 | //"newg3"; newg3; |
---|
3813 | } |
---|
3814 | } |
---|
3815 | //"newg3"; newg3; |
---|
3816 | //newg3 = delete(newg3,1); //delete empty list |
---|
3817 | |
---|
3818 | /* |
---|
3819 | //### neue Ordnung, 1 Block fuer alle vars, aber Gewichte erhalten; |
---|
3820 | //vorerst nicht realisiert, da bei leonhard1 alte Version (neue Variable T(i) |
---|
3821 | //ein neuer Block) ein kuerzeres Ergebnis liefert |
---|
3822 | kill g3; |
---|
3823 | list g3; |
---|
3824 | V=0; |
---|
3825 | for ( ii= 1; ii<=n3-1; ii++ ) |
---|
3826 | { |
---|
3827 | V=V,V(ii); |
---|
3828 | } |
---|
3829 | V = V[2..size(V)]; |
---|
3830 | |
---|
3831 | if ( V==1 ) |
---|
3832 | { |
---|
3833 | g3[1] = list("dp",V); |
---|
3834 | } |
---|
3835 | else |
---|
3836 | { |
---|
3837 | g3[1] = lis("wp",V); |
---|
3838 | } |
---|
3839 | newg3 = g3; |
---|
3840 | |
---|
3841 | //"newg3";newg3;""; |
---|
3842 | //### Ende neue Ordnung |
---|
3843 | */ |
---|
3844 | |
---|
3845 | if ( m == 0 ) |
---|
3846 | { |
---|
3847 | newg3 = insert(newg3,gm,size(newg3)); |
---|
3848 | } |
---|
3849 | else |
---|
3850 | { |
---|
3851 | newg3 = insert(newg3,gm); |
---|
3852 | } |
---|
3853 | gnirlist[2] = newg2; |
---|
3854 | gnirlist[3] = newg3; |
---|
3855 | |
---|
3856 | //gnirlist; |
---|
3857 | def newBAS = ring(gnirlist); //change of ring to less vars |
---|
3858 | setring newBAS; |
---|
3859 | ideal normap = imap(BAS,endphi); |
---|
3860 | //normap = simplify(normap,2); |
---|
3861 | ideal norid = imap(BAS,endid); |
---|
3862 | export(norid); |
---|
3863 | export(normap); |
---|
3864 | list L = newBAS; |
---|
3865 | return(L); |
---|
3866 | |
---|
3867 | //Hier scheint interred gut zu sein, da es Ergebnis relativ schnell |
---|
3868 | //verkleinert. Hier wird z.B. bei leonard1 size(norid) verkleinert aber |
---|
3869 | //size(string(norid)) stark vergroessert, aber es hat keine Auswirkungen |
---|
3870 | //da keine map mehr folgt. |
---|
3871 | //### Bei Leonard2 haengt interred (BUG) |
---|
3872 | //mstd[2] verkleinert norid nocheinmal um die Haelfte, dauert aber 3.71 sec |
---|
3873 | //### Ev. Hinweis auf mstd in der Hilfe? |
---|
3874 | |
---|
3875 | } |
---|
3876 | |
---|
3877 | /////////////////////////////////////////////////////////////////////////////// |
---|
3878 | // Computes the ring structure of a ring given by module generators. |
---|
3879 | // Assume: J[i]/J[1] are the module generators in the quotient field |
---|
3880 | // with J[1] as universal denominator. |
---|
3881 | // If option "noRed" is not given, a reduction in the number of variables is |
---|
3882 | // attempted. |
---|
3883 | static proc computeRing(ideal J, ideal I, list #) |
---|
3884 | { |
---|
3885 | int i, ii,jj; |
---|
3886 | intvec V; // to be used for variable weights |
---|
3887 | int y = printlevel-voice+2; |
---|
3888 | def R = basering; |
---|
3889 | poly c = J[1]; // the denominator |
---|
3890 | list gnirlist = ringlist(basering); |
---|
3891 | string svars = varstr(basering); |
---|
3892 | int nva = nvars(basering); |
---|
3893 | string svar; |
---|
3894 | ideal maxid = maxideal(1); |
---|
3895 | |
---|
3896 | int noRed = 0; // By default, we try to reduce the number of generators. |
---|
3897 | if(size(#) > 0){ |
---|
3898 | if ( typeof(#[1]) == "string" ) |
---|
3899 | { |
---|
3900 | if (#[1] == "noRed"){noRed = 1;} |
---|
3901 | } |
---|
3902 | } |
---|
3903 | |
---|
3904 | if ( y >= 1){"// computing the ring structure...";} |
---|
3905 | |
---|
3906 | if(c==1) |
---|
3907 | { |
---|
3908 | if( defined(norid) ) { kill norid; } |
---|
3909 | if( defined(normap) ) { kill normap; } |
---|
3910 | ideal norid = I; |
---|
3911 | ideal normap = maxid; |
---|
3912 | export norid; |
---|
3913 | export normap; |
---|
3914 | if(noRed == 1){ |
---|
3915 | setring R; |
---|
3916 | return(R); |
---|
3917 | } else { |
---|
3918 | list L = substpartSpecial(norid,normap); |
---|
3919 | def lastRing = L[1]; |
---|
3920 | setring R; |
---|
3921 | return(lastRing); |
---|
3922 | } |
---|
3923 | } |
---|
3924 | |
---|
3925 | |
---|
3926 | //-------------- Enlarge ring by creating new variables ------------------ |
---|
3927 | //check first whether variables T(i) and then whether Z(i),...,A(i) exist |
---|
3928 | //old variable names are not touched |
---|
3929 | |
---|
3930 | if ( find(svars,"T(") == 0 ) |
---|
3931 | { |
---|
3932 | svar = "T"; |
---|
3933 | } |
---|
3934 | else |
---|
3935 | { |
---|
3936 | for (ii=90; ii>=65; ii--) |
---|
3937 | { |
---|
3938 | if ( find(svars,ASCII(ii)+"(") == 0 ) |
---|
3939 | { |
---|
3940 | svar = ASCII(ii); break; |
---|
3941 | } |
---|
3942 | } |
---|
3943 | } |
---|
3944 | |
---|
3945 | int q = size(J)-1; |
---|
3946 | if ( size(svar) != 0 ) |
---|
3947 | { |
---|
3948 | for ( ii=q; ii>=1; ii-- ) |
---|
3949 | { |
---|
3950 | gnirlist[2] = insert(gnirlist[2],svar+"("+string(ii)+")"); |
---|
3951 | } |
---|
3952 | } |
---|
3953 | else |
---|
3954 | { |
---|
3955 | for ( ii=q; ii>=1; ii-- ) |
---|
3956 | { |
---|
3957 | gnirlist[2] = insert(gnirlist[2],"T("+string(100*nva+ii)+")"); |
---|
3958 | } |
---|
3959 | } |
---|
3960 | |
---|
3961 | V[q]=0; //create intvec of variable weights |
---|
3962 | V=V+1; |
---|
3963 | gnirlist[3] = insert(gnirlist[3],list("dp",V)); |
---|
3964 | |
---|
3965 | //this is a block ordering with one dp-block (1st block) for new vars |
---|
3966 | //the remaining weights and blocks for old vars are kept |
---|
3967 | //### perhaps better to make only one block, keeping weights ? |
---|
3968 | //this might effect syz below |
---|
3969 | //alt: ring newR = char(R),(X(1..nvars(R)),T(1..q)),dp; |
---|
3970 | //Reihenfolge gendert:neue Variablen kommen zuerst, Namen ev. nicht T(i) |
---|
3971 | |
---|
3972 | def newR = ring(gnirlist); |
---|
3973 | setring newR; //new extended ring |
---|
3974 | ideal I = imap(R,I); |
---|
3975 | |
---|
3976 | //------------- Compute linear and quadratic relations --------------- |
---|
3977 | if(y>=1) |
---|
3978 | { |
---|
3979 | "// compute linear relations:"; |
---|
3980 | } |
---|
3981 | qring newQ = std(I); |
---|
3982 | |
---|
3983 | ideal f = imap(R,J); |
---|
3984 | module syzf = syz(f); |
---|
3985 | ideal pf = f[1]*f; |
---|
3986 | //f[1] is the denominator D from normalityTest, a non zero divisor of R/I |
---|
3987 | |
---|
3988 | ideal newT = maxideal(1); |
---|
3989 | newT = 1,newT[1..q]; |
---|
3990 | //matrix T = matrix(ideal(1,T(1..q)),1,q+1); //alt |
---|
3991 | matrix T = matrix(newT,1,q+1); |
---|
3992 | ideal Lin = ideal(T*syzf); |
---|
3993 | //Lin=interred(Lin); |
---|
3994 | //### interred reduziert ev size aber size(string(LIN)) wird groesser |
---|
3995 | |
---|
3996 | if(y>=1) |
---|
3997 | { |
---|
3998 | if(y>=3) |
---|
3999 | { |
---|
4000 | "// the linear relations:"; Lin; pause();""; |
---|
4001 | } |
---|
4002 | "// the ring structure of the normalization as affine algebra"; |
---|
4003 | "// number of linear relations:", size(Lin); |
---|
4004 | } |
---|
4005 | |
---|
4006 | if(y>=1) |
---|
4007 | { |
---|
4008 | "// compute quadratic relations:"; |
---|
4009 | } |
---|
4010 | matrix A; |
---|
4011 | ideal Quad; |
---|
4012 | poly ff; |
---|
4013 | newT = newT[2..size(newT)]; |
---|
4014 | matrix u; // The units for non-global orderings. |
---|
4015 | |
---|
4016 | // Quadratic relations |
---|
4017 | for (ii=2; ii<=q+1; ii++ ) |
---|
4018 | { |
---|
4019 | for ( jj=2; jj<=ii; jj++ ) |
---|
4020 | { |
---|
4021 | ff = NF(f[ii]*f[jj],std(0)); // this makes lift much faster |
---|
4022 | // For non-global orderings, we have to take care of the units. |
---|
4023 | if(ord_test(basering) != 1){ |
---|
4024 | A = lift(pf, ff, u); |
---|
4025 | Quad = Quad,ideal(newT[jj-1]*newT[ii-1] * u[1, 1]- T*A); |
---|
4026 | } else { |
---|
4027 | A = lift(pf,ff); // ff lin. comb. of elts of pf mod I |
---|
4028 | Quad = Quad,ideal(newT[jj-1]*newT[ii-1] - T*A); |
---|
4029 | } |
---|
4030 | //A = lift(pf, f[ii]*f[jj]); |
---|
4031 | //Quad = Quad, ideal(T(jj-1)*T(ii-1) - T*A); |
---|
4032 | } |
---|
4033 | } |
---|
4034 | Quad = Quad[2..ncols(Quad)]; |
---|
4035 | |
---|
4036 | if(y>=1) |
---|
4037 | { |
---|
4038 | if(y>=3) |
---|
4039 | { |
---|
4040 | "// the quadratic relations"; Quad; pause();""; |
---|
4041 | } |
---|
4042 | "// number of quadratic relations:", size(Quad); |
---|
4043 | } |
---|
4044 | ideal Q1 = Lin,Quad; //elements of Q1 are in NF w.r.t. I |
---|
4045 | |
---|
4046 | //Q1 = mstd(Q1)[2]; |
---|
4047 | //### weglassen, ist sehr zeitaufwendig. |
---|
4048 | //Ebenso interred, z.B. bei Leonard1 (1. Komponente von Leonard): |
---|
4049 | //"size Q1:", size(Q1), size(string(Q1)); //75 60083 |
---|
4050 | //Q1 = interred(Q1); |
---|
4051 | //"size Q1:", size(Q1), size(string(Q1)); //73 231956 (!) |
---|
4052 | //### Speicherueberlauf bei substpartSpecial bei 'ideal norid = phi1(endid)' |
---|
4053 | //Beispiel fuer Hans um map zu testen! |
---|
4054 | |
---|
4055 | setring newR; |
---|
4056 | ideal endid = imap(newQ,Q1),I; |
---|
4057 | ideal endphi = imap(R,maxid); |
---|
4058 | |
---|
4059 | if(noRed == 0){ |
---|
4060 | list L=substpartSpecial(endid,endphi); |
---|
4061 | def lastRing=L[1]; |
---|
4062 | if(y>=1) |
---|
4063 | { |
---|
4064 | "// number of substituted variables:", nvars(newR)-nvars(lastRing); |
---|
4065 | pause();""; |
---|
4066 | } |
---|
4067 | return(lastRing); |
---|
4068 | } else { |
---|
4069 | ideal norid = endid; |
---|
4070 | ideal normap = endphi; |
---|
4071 | export(norid); |
---|
4072 | export(normap); |
---|
4073 | setring R; |
---|
4074 | return(newR); |
---|
4075 | } |
---|
4076 | } |
---|
4077 | |
---|
4078 | // Up to here: procedures for char p with Frobenius |
---|
4079 | /////////////////////////////////////////////////////////////////////////////// |
---|
4080 | |
---|
4081 | /////////////////////////////////////////////////////////////////////////////// |
---|
4082 | // From here: subprocedures for normal |
---|
4083 | |
---|
4084 | static proc normalM(ideal I, int decomp, int withDelta){ |
---|
4085 | // Computes the normalization of a ring R / I using the module structure as far |
---|
4086 | // as possible. |
---|
4087 | // The ring R is the basering. |
---|
4088 | // Input: ideal I |
---|
4089 | // Output: a list of 3 elements (resp 4 if withDelta = 1), say nor. |
---|
4090 | // - nor[1] = U, an ideal of R. |
---|
4091 | // - nor[2] = c, an element of R. |
---|
4092 | // U and c satisfy that 1/c * U is the normalization of R / I in the |
---|
4093 | // quotient field Q(R/I). |
---|
4094 | // - nor[3] = ring say T, containing two ideals norid and normap such that |
---|
4095 | // normap gives the normalization map from R / I to T / norid. |
---|
4096 | // - nor[4] = the delta invariant, if withDelta = 1. |
---|
4097 | |
---|
4098 | // Details: |
---|
4099 | // -------- |
---|
4100 | // Computes the ideal of the minors in the first step and then reuses it in all |
---|
4101 | // steps. |
---|
4102 | // In step s, the denominator is D^s, where D is a nzd of the original quotient |
---|
4103 | // ring, contained in the radical of the singular locus. |
---|
4104 | // This denominator is used except when the degree of D^i is greater than the |
---|
4105 | // degree of a conductor. |
---|
4106 | // The nzd is taken as the smallest degree polynomial in the radical of the |
---|
4107 | // singular locus. |
---|
4108 | |
---|
4109 | // It assumes that the ideal I is equidimensional radical. This is not checked |
---|
4110 | // in the procedure! |
---|
4111 | // If decomp = 0 or decomp = 3 it assumes further that I is prime. Therefore |
---|
4112 | // any non-zero element in the jacobian ideal is assumed to be a |
---|
4113 | // non-zerodivisor. |
---|
4114 | |
---|
4115 | // It works over the given basering. |
---|
4116 | // If it has a non-global ordering, it changes it to dp global only for |
---|
4117 | // computing radical. |
---|
4118 | |
---|
4119 | // The delta invariant is only computed if withDelta = 1, and decomp = 0 or |
---|
4120 | // decomp = 3 (meaning that the ideal is prime). |
---|
4121 | |
---|
4122 | option("redSB"); |
---|
4123 | option("returnSB"); |
---|
4124 | int step = 0; // Number of steps. (for debugging) |
---|
4125 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4126 | int i; // counter |
---|
4127 | int isGlobal = ord_test(basering); |
---|
4128 | |
---|
4129 | poly c; // The common denominator. |
---|
4130 | |
---|
4131 | def R = basering; |
---|
4132 | |
---|
4133 | //------------------------ Groebner bases and dimension of I----------------- |
---|
4134 | if(isGlobal == 1){ |
---|
4135 | list IM = mstd(I); |
---|
4136 | I = IM[1]; |
---|
4137 | ideal IMin = IM[2]; // A minimal set of generators in the groebner basis. |
---|
4138 | } else { |
---|
4139 | // The minimal set of generators is not computed by mstd for |
---|
4140 | // non-global orderings. |
---|
4141 | I = groebner(I); |
---|
4142 | ideal IMin = I; |
---|
4143 | } |
---|
4144 | int d = dim(I); |
---|
4145 | |
---|
4146 | // ---------------- computation of the singular locus --------------------- |
---|
4147 | // We compute the radical of the ideal of minors modulo the original ideal. |
---|
4148 | // This is done only in the first step. |
---|
4149 | qring Q = I; // We work in the quotient by the groebner base of the ideal I |
---|
4150 | option("redSB"); |
---|
4151 | option("returnSB"); |
---|
4152 | ideal I = fetch(R, I); |
---|
4153 | attrib(I, "isSB", 1); |
---|
4154 | ideal IMin = fetch(R, IMin); |
---|
4155 | |
---|
4156 | dbprint(dbg, "Computing the jacobian ideal..."); |
---|
4157 | |
---|
4158 | ideal J = minor(jacob(IMin), nvars(basering) - d, I); |
---|
4159 | J = groebner(J); |
---|
4160 | |
---|
4161 | //------------------ We check if the singular locus is empty ------------- |
---|
4162 | if(J[1] == 1){ |
---|
4163 | // The original ring R/I was normal. Nothing to do. |
---|
4164 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
4165 | setring R; |
---|
4166 | list lR = ringlist(R); |
---|
4167 | def ROut = ring(lR); |
---|
4168 | setring ROut; |
---|
4169 | ideal norid = fetch(R, I); |
---|
4170 | ideal normap = maxideal(1); |
---|
4171 | export norid; |
---|
4172 | export normap; |
---|
4173 | setring R; |
---|
4174 | if(withDelta){ |
---|
4175 | list output = ideal(1), poly(1), ROut, 0; |
---|
4176 | } else { |
---|
4177 | list output = ideal(1), poly(1), ROut; |
---|
4178 | } |
---|
4179 | return(list(output)); |
---|
4180 | } |
---|
4181 | |
---|
4182 | |
---|
4183 | // -------------------- election of the conductor ------------------------- |
---|
4184 | poly condu = getSmallest(J); // Choses the polynomial of smallest degree |
---|
4185 | // of J as universal denominator. |
---|
4186 | if(dbg >= 1){ |
---|
4187 | ""; |
---|
4188 | "The universal denominator is ", condu; |
---|
4189 | } |
---|
4190 | |
---|
4191 | // --------- splitting the ideal by the conductor (if possible) ----------- |
---|
4192 | // If the ideal is equidimensional, but not necessarily prime, we check if |
---|
4193 | // the conductor is a non-zerodivisor of R/I. |
---|
4194 | // If not, we split I. |
---|
4195 | if((decomp == 1) or (decomp == 2)){ |
---|
4196 | ideal Id1 = quotient(0, condu); |
---|
4197 | if(size(Id1) > 0){ |
---|
4198 | // We have to split. |
---|
4199 | if(dbg >= 1){ |
---|
4200 | "A zerodivisor was found. We split the ideal. The zerodivisor is ", condu; |
---|
4201 | } |
---|
4202 | setring R; |
---|
4203 | ideal Id1 = fetch(Q, Id1), I; |
---|
4204 | Id1 = groebner(Id1); |
---|
4205 | ideal Id2 = quotient(I, Id1); |
---|
4206 | // I = I1 \cap I2 |
---|
4207 | printlevel = printlevel + 1; |
---|
4208 | list nor1 = normalM(Id1, decomp, withDelta)[1]; |
---|
4209 | list nor2 = normalM(Id2, decomp, withDelta)[1]; |
---|
4210 | printlevel = printlevel - 1; |
---|
4211 | return(list(nor1, nor2)); |
---|
4212 | } |
---|
4213 | } |
---|
4214 | |
---|
4215 | // --------------- computation of the first test ideal --------------------- |
---|
4216 | // To compute the radical we go back to the original ring. |
---|
4217 | // If we are using a non-global ordering, we must change to the global |
---|
4218 | // ordering. |
---|
4219 | if(isGlobal == 1){ |
---|
4220 | setring R; |
---|
4221 | ideal J = fetch(Q, J); |
---|
4222 | J = J, I; |
---|
4223 | if(dbg >= 1){ |
---|
4224 | "The original singular locus is"; |
---|
4225 | groebner(J); |
---|
4226 | if(dbg >= 2){pause();} |
---|
4227 | ""; |
---|
4228 | } |
---|
4229 | // We check if the only singular point is the origin. |
---|
4230 | // If so, the radical is the maximal ideal at the origin. |
---|
4231 | J = groebner(J); |
---|
4232 | if(locAtZero(J)){ |
---|
4233 | J = maxideal(1); |
---|
4234 | } else { |
---|
4235 | J = radical(J); |
---|
4236 | } |
---|
4237 | } else { |
---|
4238 | // We change to global dp ordering. |
---|
4239 | list rl = ringlist(R); |
---|
4240 | list origOrd = rl[3]; |
---|
4241 | list newOrd = list("dp", intvec(1:nvars(R))), list("C", 0); |
---|
4242 | rl[3] = newOrd; |
---|
4243 | def globR = ring(rl); |
---|
4244 | setring globR; |
---|
4245 | ideal J = fetch(Q, J); |
---|
4246 | ideal I = fetch(R, I); |
---|
4247 | J = J, I; |
---|
4248 | if(dbg >= 1){ |
---|
4249 | "The original singular locus is"; |
---|
4250 | groebner(J); |
---|
4251 | if(dbg>=2){pause();} |
---|
4252 | ""; |
---|
4253 | } |
---|
4254 | J = radical(J); |
---|
4255 | setring R; |
---|
4256 | ideal J = fetch(globR, J); |
---|
4257 | } |
---|
4258 | |
---|
4259 | if(dbg >= 1){ |
---|
4260 | "The radical of the original singular locus is"; |
---|
4261 | J; |
---|
4262 | if(dbg>=2){pause();} |
---|
4263 | } |
---|
4264 | |
---|
4265 | // ---------------- election of the non zero divisor --------------------- |
---|
4266 | setring Q; |
---|
4267 | J = fetch(R, J); |
---|
4268 | J = interred(J); |
---|
4269 | poly D = getSmallest(J); // Chooses the polynomial of smallest degree as |
---|
4270 | // non-zerodivisor. |
---|
4271 | if(dbg >= 1){ |
---|
4272 | "The non zero divisor is ", D; |
---|
4273 | ""; |
---|
4274 | } |
---|
4275 | |
---|
4276 | // ------- splitting the ideal by the non-zerodivisor (if possible) -------- |
---|
4277 | // If the ideal is equidimensional, but not necessarily prime, we check if D |
---|
4278 | // is actually a non-zerodivisor of R/I. |
---|
4279 | // If not, we split I. |
---|
4280 | if((decomp == 1) or (decomp == 2)){ |
---|
4281 | // We check if D is actually a non-zerodivisor of R/I. |
---|
4282 | // If not, we split I. |
---|
4283 | Id1 = quotient(0, D); |
---|
4284 | if(size(Id1) > 0){ |
---|
4285 | // We have to split. |
---|
4286 | if(dbg >= 1){ |
---|
4287 | "A zerodivisor was found. We split the ideal. The zerodivisor is ", D; |
---|
4288 | } |
---|
4289 | setring R; |
---|
4290 | ideal Id1 = fetch(Q, Id1), I; |
---|
4291 | Id1 = groebner(Id1); |
---|
4292 | ideal Id2 = quotient(I, Id1); |
---|
4293 | // I = Id1 \cap Id2 |
---|
4294 | printlevel = printlevel + 1; |
---|
4295 | |
---|
4296 | list nor1 = normalM(Id1, decomp, withDelta)[1]; |
---|
4297 | list nor2 = normalM(Id2, decomp, withDelta)[1]; |
---|
4298 | printlevel = printlevel - 1; |
---|
4299 | return(list(nor1, nor2)); |
---|
4300 | } |
---|
4301 | } |
---|
4302 | |
---|
4303 | // --------------------- normalization ------------------------------------ |
---|
4304 | // We call normalMEqui to compute the normalization. |
---|
4305 | setring R; |
---|
4306 | poly D = fetch(Q, D); |
---|
4307 | poly condu = fetch(Q, condu); |
---|
4308 | J = fetch(Q, J); |
---|
4309 | printlevel = printlevel + 1; |
---|
4310 | list result = normalMEqui(I, J, condu, D, withDelta); |
---|
4311 | printlevel = printlevel - 1; |
---|
4312 | return(list(result)); |
---|
4313 | } |
---|
4314 | |
---|
4315 | /////////////////////////////////////////////////////////////////////////////// |
---|
4316 | |
---|
4317 | static proc normalMEqui(ideal I, ideal origJ, poly condu, poly D, int withDelta) |
---|
4318 | // Here is where the normalization is actually computed. |
---|
4319 | |
---|
4320 | // Computes the normalization of R/I. (basering is R) |
---|
4321 | // I is assumed to be radical and equidimensional. |
---|
4322 | // origJ is the first test ideal. |
---|
4323 | // D is a non-zerodivisor of R/I. |
---|
4324 | // condu is a non-zerodivisor in the conductor. |
---|
4325 | // If withDelta = 1, computes the delta invariant. |
---|
4326 | { |
---|
4327 | int step = 0; // Number of steps. (for debugging) |
---|
4328 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4329 | int i; // counter |
---|
4330 | int isNormal = 0; // check for exiting the loop |
---|
4331 | int isGlobal = ord_test(basering); |
---|
4332 | int delt; |
---|
4333 | |
---|
4334 | def R = basering; |
---|
4335 | poly c = D; |
---|
4336 | ideal U; |
---|
4337 | ideal cJ; |
---|
4338 | list testOut; // Output of proc testIdeal |
---|
4339 | // (the test ideal and the ring structure) |
---|
4340 | |
---|
4341 | qring Q = groebner(I); |
---|
4342 | option("redSB"); |
---|
4343 | option("returnSB"); |
---|
4344 | ideal J = imap(R, origJ); |
---|
4345 | poly c = imap(R, c); |
---|
4346 | poly D = imap(R, D); |
---|
4347 | poly condu = imap(R, condu); |
---|
4348 | ideal cJ; |
---|
4349 | ideal cJMod; |
---|
4350 | |
---|
4351 | dbprint(dbg, "Preliminar step begins."); |
---|
4352 | |
---|
4353 | // --------------------- computation of A1 ------------------------------- |
---|
4354 | dbprint(dbg, "Computing the quotient (DJ : J)..."); |
---|
4355 | ideal U = groebner(quotient(D*J, J)); |
---|
4356 | ideal oldU = 1; |
---|
4357 | |
---|
4358 | if(dbg >= 2) { "The quotient is"; U; } |
---|
4359 | |
---|
4360 | // ----------------- Grauer-Remmert criterion check ----------------------- |
---|
4361 | // We check if the equality in Grauert - Remmert criterion is satisfied. |
---|
4362 | isNormal = checkInclusions(D*oldU, U); |
---|
4363 | if(isNormal == 0) |
---|
4364 | { |
---|
4365 | if(dbg >= 1) |
---|
4366 | { |
---|
4367 | "In this step, we have the ring 1/c * U, with c =", c; |
---|
4368 | "and U = "; U; |
---|
4369 | } |
---|
4370 | } |
---|
4371 | else |
---|
4372 | { |
---|
4373 | // The original ring R/I was normal. Nothing to do. |
---|
4374 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
4375 | setring R; |
---|
4376 | list lR = ringlist(R); |
---|
4377 | def ROut = ring(lR); |
---|
4378 | setring ROut; |
---|
4379 | ideal norid = fetch(R, I); |
---|
4380 | ideal normap = maxideal(1); |
---|
4381 | export norid; |
---|
4382 | export normap; |
---|
4383 | setring R; |
---|
4384 | if(withDelta) |
---|
4385 | { |
---|
4386 | list output = ideal(1), poly(1), ROut, 0; |
---|
4387 | } |
---|
4388 | else |
---|
4389 | { |
---|
4390 | list output = ideal(1), poly(1), ROut; |
---|
4391 | } |
---|
4392 | return(output); |
---|
4393 | } |
---|
4394 | |
---|
4395 | // ----- computation of the chain of ideals A1 c A2 c ... c An ------------ |
---|
4396 | while(isNormal == 0) |
---|
4397 | { |
---|
4398 | step++; |
---|
4399 | if(dbg >= 1) { ""; "Step ", step, " begins."; } |
---|
4400 | dbprint(dbg, "Computing the test ideal..."); |
---|
4401 | |
---|
4402 | // --------------- computation of the test ideal ------------------------ |
---|
4403 | // Computes a test ideal for the new ring. |
---|
4404 | // The test ideal will be the radical in the new ring of the original |
---|
4405 | // test ideal. |
---|
4406 | setring R; |
---|
4407 | U = imap(Q, U); |
---|
4408 | c = imap(Q, c); |
---|
4409 | testOut = testIdeal(I, U, origJ, c, D); |
---|
4410 | cJ = testOut[1]; |
---|
4411 | |
---|
4412 | setring Q; |
---|
4413 | cJ = imap(R, cJ); |
---|
4414 | cJ = groebner(cJ); |
---|
4415 | |
---|
4416 | // cJ / c is now the ideal mapped back. |
---|
4417 | // We have the generators as an ideal in the new ring, |
---|
4418 | // but we want the generators as an ideal in the original ring. |
---|
4419 | cJMod = getGenerators(cJ, U, c); |
---|
4420 | |
---|
4421 | if(dbg >= 2) { "The test ideal in this step is "; cJMod; } |
---|
4422 | |
---|
4423 | cJ = cJMod; |
---|
4424 | |
---|
4425 | // ------------- computation of the quotient (DJ : J)-------------------- |
---|
4426 | oldU = U; |
---|
4427 | dbprint(dbg, "Computing the quotient (c*D*cJ : cJ)..."); |
---|
4428 | U = quotient(c*D*cJ, cJ); |
---|
4429 | if(dbg >= 2){"The quotient is "; U;} |
---|
4430 | |
---|
4431 | // ------------- Grauert - Remmert criterion check ---------------------- |
---|
4432 | // We check if the equality in Grauert - Remmert criterion is satisfied. |
---|
4433 | isNormal = checkInclusions(D*oldU, U); |
---|
4434 | |
---|
4435 | if(isNormal == 1) |
---|
4436 | { |
---|
4437 | // We go one step back. In the last step we didnt get antyhing new, |
---|
4438 | // we just verified that the ring was already normal. |
---|
4439 | dbprint(dbg, "The ring in the previous step was already normal."); |
---|
4440 | dbprint(dbg, ""); |
---|
4441 | U = oldU; |
---|
4442 | } |
---|
4443 | else |
---|
4444 | { |
---|
4445 | // ------------- preparation for next iteration ---------------------- |
---|
4446 | // We have to go on. |
---|
4447 | // The new denominator is chosen. |
---|
4448 | c = D * c; |
---|
4449 | if(deg(c) > deg(condu)) |
---|
4450 | { |
---|
4451 | U = changeDenominatorQ(U, c, condu); |
---|
4452 | c = condu; |
---|
4453 | } |
---|
4454 | if(dbg >= 1) |
---|
4455 | { |
---|
4456 | "In this step, we have the ring 1/c * U, with c =", c; |
---|
4457 | "and U = "; |
---|
4458 | U; |
---|
4459 | if(dbg>=2){pause();} |
---|
4460 | } |
---|
4461 | } |
---|
4462 | } |
---|
4463 | |
---|
4464 | // ------------------------- delta computation ---------------------------- |
---|
4465 | if(withDelta) |
---|
4466 | { |
---|
4467 | ideal UD = groebner(U); |
---|
4468 | delt = vdim(std(modulo(UD, c))); |
---|
4469 | } |
---|
4470 | |
---|
4471 | // -------------------------- prepare output ----------------------------- |
---|
4472 | setring R; |
---|
4473 | U = fetch(Q, U); |
---|
4474 | c = fetch(Q, c); |
---|
4475 | |
---|
4476 | // Ring structure of the new ring |
---|
4477 | def ere = testOut[2]; |
---|
4478 | if(withDelta) |
---|
4479 | { |
---|
4480 | list output = U, c, ere, delt; |
---|
4481 | } |
---|
4482 | else |
---|
4483 | { |
---|
4484 | list output = U, c, ere; |
---|
4485 | } |
---|
4486 | return(output); |
---|
4487 | } |
---|
4488 | |
---|
4489 | /////////////////////////////////////////////////////////////////////////////// |
---|
4490 | |
---|
4491 | static proc lineUpLast(ideal U, poly c) |
---|
4492 | // Sets c as the last generator of U. |
---|
4493 | { |
---|
4494 | int i; |
---|
4495 | ideal newU; |
---|
4496 | for (i = 1; i <= ncols(U); i++) |
---|
4497 | { |
---|
4498 | if(U[i] != c) |
---|
4499 | { |
---|
4500 | if(size(newU) == 0) |
---|
4501 | { newU = U[i]; } |
---|
4502 | else |
---|
4503 | { newU = newU, U[i]; } |
---|
4504 | } |
---|
4505 | } |
---|
4506 | if(size(newU) == 0) |
---|
4507 | { newU = c; } |
---|
4508 | else |
---|
4509 | { newU = newU, c; } |
---|
4510 | return(newU); |
---|
4511 | } |
---|
4512 | |
---|
4513 | /////////////////////////////////////////////////////////////////////////////// |
---|
4514 | |
---|
4515 | static proc lineUp(ideal U, poly c) |
---|
4516 | // Sets c as the first generator of U. |
---|
4517 | { |
---|
4518 | int i; |
---|
4519 | ideal newU = c; |
---|
4520 | for (i = 1; i <= ncols(U); i++) |
---|
4521 | { |
---|
4522 | if(U[i] != c) |
---|
4523 | { |
---|
4524 | newU = newU, U[i]; |
---|
4525 | } |
---|
4526 | } |
---|
4527 | return(newU); |
---|
4528 | } |
---|
4529 | |
---|
4530 | /////////////////////////////////////////////////////////////////////////////// |
---|
4531 | |
---|
4532 | static proc getSmallest(ideal J) |
---|
4533 | { |
---|
4534 | // Computes the polynomial of smallest degree of J. |
---|
4535 | // If there are more than one, it chooses the one with smallest number |
---|
4536 | // of monomials. |
---|
4537 | int i; |
---|
4538 | poly p = J[1]; |
---|
4539 | int d = deg(p); |
---|
4540 | int di; |
---|
4541 | for(i = 2; i <= ncols(J); i++) |
---|
4542 | { |
---|
4543 | if(J[i] != 0) |
---|
4544 | { |
---|
4545 | di = deg(J[i]); |
---|
4546 | if(di < d) |
---|
4547 | { |
---|
4548 | p = J[i]; |
---|
4549 | d = di; |
---|
4550 | } |
---|
4551 | else |
---|
4552 | { |
---|
4553 | if(di == d) |
---|
4554 | { |
---|
4555 | if(size(J[i]) < size(p)) |
---|
4556 | { |
---|
4557 | p = J[i]; |
---|
4558 | } |
---|
4559 | } |
---|
4560 | } |
---|
4561 | } |
---|
4562 | } |
---|
4563 | return(p); |
---|
4564 | } |
---|
4565 | |
---|
4566 | /////////////////////////////////////////////////////////////////////////////// |
---|
4567 | |
---|
4568 | static proc getGenerators(ideal J, ideal U, poly c) |
---|
4569 | { |
---|
4570 | // Computes the generators of J as an ideal in the original ring, |
---|
4571 | // where J is given by generators in the new ring. |
---|
4572 | |
---|
4573 | // The new ring is given by 1/c * U in the total ring of fractions. |
---|
4574 | |
---|
4575 | int i, j; // counters; |
---|
4576 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4577 | poly p; // The lifted polynomial |
---|
4578 | ideal JGr = groebner(J); // Groebner base of J |
---|
4579 | |
---|
4580 | if(dbg>1){"Checking for new generators...";} |
---|
4581 | for(i = 1; i <= ncols(J); i++) |
---|
4582 | { |
---|
4583 | for(j = 1; j <= ncols(U); j++) |
---|
4584 | { |
---|
4585 | p = lift(c, J[i]*U[j])[1,1]; |
---|
4586 | p = reduce(p, JGr); |
---|
4587 | if(p != 0) |
---|
4588 | { |
---|
4589 | if(dbg>1) |
---|
4590 | { |
---|
4591 | "New polynoial added:", p; |
---|
4592 | if(dbg>4) {pause();} |
---|
4593 | } |
---|
4594 | JGr = JGr, p; |
---|
4595 | JGr = groebner(JGr); |
---|
4596 | J = J, p; |
---|
4597 | } |
---|
4598 | } |
---|
4599 | } |
---|
4600 | return(J); |
---|
4601 | } |
---|
4602 | |
---|
4603 | /////////////////////////////////////////////////////////////////////////////// |
---|
4604 | |
---|
4605 | static proc testIdeal(ideal I, ideal U, ideal origJ, poly c, poly D) |
---|
4606 | { |
---|
4607 | // Internal procedure, used in normalM. |
---|
4608 | // Computes the test ideal in the new ring. |
---|
4609 | // It takes the original test ideal and computes the radical of it in the |
---|
4610 | // new ring. |
---|
4611 | |
---|
4612 | // The new ring is 1/c * U. |
---|
4613 | // The original test ideal is origJ. |
---|
4614 | // The original ring is R / I, where R is the basering. |
---|
4615 | int i; // counter |
---|
4616 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4617 | def R = basering; // We dont work in the quo |
---|
4618 | ideal J = origJ; |
---|
4619 | |
---|
4620 | // ---------- computation of the ring structure of 1/c * U ---------------- |
---|
4621 | U = lineUp(U, c); |
---|
4622 | |
---|
4623 | if(dbg > 1){"Computing the new ring structure...";} |
---|
4624 | list ele = computeRing(U, I, "noRed"); |
---|
4625 | |
---|
4626 | def origEre = ele[1]; |
---|
4627 | setring origEre; |
---|
4628 | if(dbg > 1){"The relations are"; norid;} |
---|
4629 | |
---|
4630 | // ---------------- setting the ring to work in -------------------------- |
---|
4631 | int isGlobal = ord_test(origEre); // Checks if the original ring has |
---|
4632 | // global ordering. |
---|
4633 | if(isGlobal != 1) |
---|
4634 | { |
---|
4635 | list rl = ringlist(origEre); |
---|
4636 | list origOrd = rl[3]; |
---|
4637 | list newOrd = list("dp", intvec(1:nvars(origEre))), list("C", 0); |
---|
4638 | rl[3] = newOrd; |
---|
4639 | def ere = ring(rl); // globR is the original ring but |
---|
4640 | // with a global ordering. |
---|
4641 | setring ere; |
---|
4642 | ideal norid = imap(origEre, norid); |
---|
4643 | } |
---|
4644 | else |
---|
4645 | { |
---|
4646 | def ere = origEre; |
---|
4647 | } |
---|
4648 | |
---|
4649 | ideal I = imap(R, I); |
---|
4650 | ideal J = imap(R, J); |
---|
4651 | J = J, norid, I; |
---|
4652 | |
---|
4653 | |
---|
4654 | // ----- computation of the test ideal using the ring structure of Ai ----- |
---|
4655 | option("redSB"); |
---|
4656 | option("returnSB"); |
---|
4657 | |
---|
4658 | if(dbg > 1){"Computing the radical of J...";} |
---|
4659 | J = radical(J); |
---|
4660 | if(dbg > 1){"Computing the interreduction of the radical...";} |
---|
4661 | J = groebner(J); |
---|
4662 | //J = interred(J); |
---|
4663 | if(dbg > 1) |
---|
4664 | { |
---|
4665 | "The radical in the generated ring is"; |
---|
4666 | J; |
---|
4667 | if(dbg>4){pause();} |
---|
4668 | } |
---|
4669 | |
---|
4670 | setring ere; |
---|
4671 | |
---|
4672 | // -------------- map from Ai to the total ring of fractions --------------- |
---|
4673 | // Now we must map back this ideal J to U_i / c in the total ring of |
---|
4674 | // fractions. |
---|
4675 | // The map sends T_j -> u_j / c. |
---|
4676 | // The map is built by the following steps: |
---|
4677 | // 1) We compute the degree of the generators of J with respect to the |
---|
4678 | // new variables T_j. |
---|
4679 | // 2) For each generator, we multiply each term by a power of c, as if |
---|
4680 | // taking c^n as a common denominator (considering the new variables as |
---|
4681 | // a polynomial in the old variables divided by c). |
---|
4682 | // 3) We replace the new variables T_j by the corresponding numerator u_j. |
---|
4683 | // 4) We lift the resulting polynomial to change the denominator |
---|
4684 | // from c^n to c. |
---|
4685 | int nNewVars = nvars(ere) - nvars(R); // Number of new variables |
---|
4686 | poly c = imap(R, c); |
---|
4687 | intvec @v = 1..nNewVars; // Vector of the new variables. |
---|
4688 | // They must be the first ones. |
---|
4689 | if(dbg > 1){"The indices of the new variables are", @v;} |
---|
4690 | |
---|
4691 | // ---------------------- step 1 of the mapping --------------------------- |
---|
4692 | intvec degs; |
---|
4693 | for(i = 1; i<=ncols(J); i++) |
---|
4694 | { |
---|
4695 | degs[i] = degSubring(J[i], @v); |
---|
4696 | } |
---|
4697 | if(dbg > 1) |
---|
4698 | { |
---|
4699 | "The degrees with respect to the new variables are"; |
---|
4700 | degs; |
---|
4701 | } |
---|
4702 | |
---|
4703 | // ---------------------- step 2 of the mapping --------------------------- |
---|
4704 | ideal mapJ = mapBackIdeal(J, c, @v); |
---|
4705 | |
---|
4706 | setring R; |
---|
4707 | |
---|
4708 | // ---------------------- step 3 of the mapping --------------------------- |
---|
4709 | ideal z; // The variables of the original ring in order. |
---|
4710 | for(i = 1; i<=nvars(R); i++) |
---|
4711 | { |
---|
4712 | z[i] = var(i); |
---|
4713 | } |
---|
4714 | |
---|
4715 | map f = ere, U[2..ncols(U)], z[1..ncols(z)]; // The map to the original ring. |
---|
4716 | if(dbg > 1) |
---|
4717 | { |
---|
4718 | "The map is "; |
---|
4719 | f; |
---|
4720 | if(dbg>4){pause();} |
---|
4721 | } |
---|
4722 | |
---|
4723 | if(dbg > 1){ "Computing the map..."; } |
---|
4724 | |
---|
4725 | J = f(mapJ); |
---|
4726 | if(dbg > 1) |
---|
4727 | { |
---|
4728 | "The ideal J mapped back (before lifting) is"; |
---|
4729 | J; |
---|
4730 | if(dbg>4){pause();} |
---|
4731 | } |
---|
4732 | |
---|
4733 | // ---------------------- step 4 of the mapping --------------------------- |
---|
4734 | qring Q = groebner(I); |
---|
4735 | ideal J = imap(R, J); |
---|
4736 | poly c = imap(R, c); |
---|
4737 | for(i = 1; i<=ncols(J); i++) |
---|
4738 | { |
---|
4739 | if(degs[i]>1) |
---|
4740 | { |
---|
4741 | J[i] = lift(c^(degs[i]-1), J[i])[1,1]; |
---|
4742 | } |
---|
4743 | else |
---|
4744 | { |
---|
4745 | if(degs[i]==0) { J[i] = c*J[i]; } |
---|
4746 | } |
---|
4747 | } |
---|
4748 | |
---|
4749 | if(dbg > 1) |
---|
4750 | { |
---|
4751 | "The ideal J lifted is"; |
---|
4752 | J; |
---|
4753 | if(dbg>4){pause();} |
---|
4754 | } |
---|
4755 | |
---|
4756 | // --------------------------- prepare output ---------------------------- |
---|
4757 | J = groebner(J); |
---|
4758 | |
---|
4759 | setring R; |
---|
4760 | J = imap(Q, J); |
---|
4761 | |
---|
4762 | return(list(J, ele[1])); |
---|
4763 | } |
---|
4764 | |
---|
4765 | /////////////////////////////////////////////////////////////////////////////// |
---|
4766 | |
---|
4767 | static proc changeDenominator(ideal U1, poly c1, poly c2, ideal I) |
---|
4768 | { |
---|
4769 | // Given a ring in the form 1/c1 * U, it computes a new ideal U2 such that the |
---|
4770 | // ring is 1/c2 * U2. |
---|
4771 | // The base ring is R, but the computations are to be done in R / I. |
---|
4772 | int a; // counter |
---|
4773 | def R = basering; |
---|
4774 | qring Q = I; |
---|
4775 | ideal U1 = fetch(R, U1); |
---|
4776 | poly c1 = fetch(R, c1); |
---|
4777 | poly c2 = fetch(R, c2); |
---|
4778 | ideal U2 = changeDenominatorQ(U1, c1, c2); |
---|
4779 | setring R; |
---|
4780 | ideal U2 = fetch(Q, U2); |
---|
4781 | return(U2); |
---|
4782 | } |
---|
4783 | |
---|
4784 | /////////////////////////////////////////////////////////////////////////////// |
---|
4785 | |
---|
4786 | static proc changeDenominatorQ(ideal U1, poly c1, poly c2) |
---|
4787 | { |
---|
4788 | // Given a ring in the form 1/c1 * U, it computes a new U2 st the ring |
---|
4789 | // is 1/c2 * U2. |
---|
4790 | // The base ring is already a quotient ring R / I. |
---|
4791 | int a; // counter |
---|
4792 | ideal U2; |
---|
4793 | poly p; |
---|
4794 | for(a = 1; a <= ncols(U1); a++) |
---|
4795 | { |
---|
4796 | p = lift(c1, c2*U1[a])[1,1]; |
---|
4797 | U2[a] = p; |
---|
4798 | } |
---|
4799 | return(U2); |
---|
4800 | } |
---|
4801 | |
---|
4802 | /////////////////////////////////////////////////////////////////////////////// |
---|
4803 | |
---|
4804 | static proc checkInclusions(ideal U1, ideal U2) |
---|
4805 | { |
---|
4806 | // Checks if the identity A = Hom(J, J) of Grauert-Remmert criterion is |
---|
4807 | // satisfied. |
---|
4808 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4809 | list reduction1; |
---|
4810 | list reduction2; |
---|
4811 | |
---|
4812 | // ---------------------- inclusion Hom(J, J) c A ------------------------- |
---|
4813 | if(dbg > 1){"Checking the inclusion Hom(J, J) c A:";} |
---|
4814 | // This interred is used only because a bug in groebner! |
---|
4815 | U1 = groebner(U1); |
---|
4816 | reduction1 = reduce(U2, U1); |
---|
4817 | if(dbg > 1){reduction1[1];} |
---|
4818 | |
---|
4819 | // ---------------------- inclusion A c Hom(J, J) ------------------------- |
---|
4820 | // The following check should always be satisfied. |
---|
4821 | // This is only used for debugging. |
---|
4822 | if(dbg > 1) |
---|
4823 | { |
---|
4824 | "and the inclusion A c Hom(J, J): (this should always be satisfied)"; |
---|
4825 | // This interred is used only because a bug in groebner! |
---|
4826 | U2 = groebner(U2); |
---|
4827 | reduction2 = reduce(U1, groebner(U2)); |
---|
4828 | reduction2[1]; |
---|
4829 | if(size(reduction2[1]) > 0) |
---|
4830 | { |
---|
4831 | "Something went wrong... (this inclusion should always be satisfied)"; |
---|
4832 | ~; |
---|
4833 | } |
---|
4834 | else |
---|
4835 | { |
---|
4836 | if(dbg>4){pause();} |
---|
4837 | } |
---|
4838 | } |
---|
4839 | |
---|
4840 | if(size(reduction1[1]) == 0) |
---|
4841 | { |
---|
4842 | // We are done! The ring computed in the last step was normal. |
---|
4843 | return(1); |
---|
4844 | } |
---|
4845 | else |
---|
4846 | { |
---|
4847 | return(0); |
---|
4848 | } |
---|
4849 | } |
---|
4850 | |
---|
4851 | /////////////////////////////////////////////////////////////////////////////// |
---|
4852 | |
---|
4853 | static proc degSubring(poly p, intvec @v) |
---|
4854 | { |
---|
4855 | // Computes the degree of a polynomial taking only some variables as variables |
---|
4856 | // and the others as parameters. |
---|
4857 | |
---|
4858 | // The degree is taken w.r.t. the variables indicated in v. |
---|
4859 | int i; // Counter |
---|
4860 | int d = 0; // The degree |
---|
4861 | int e; // Degree (auxiliar variable) |
---|
4862 | for(i = 1; i <= size(p); i++) |
---|
4863 | { |
---|
4864 | e = sum(leadexp(p[i]), @v); |
---|
4865 | if(e > d){d = e;} |
---|
4866 | } |
---|
4867 | return(d); |
---|
4868 | } |
---|
4869 | |
---|
4870 | /////////////////////////////////////////////////////////////////////////////// |
---|
4871 | |
---|
4872 | static proc mapBackIdeal(ideal I, poly c, intvec @v) |
---|
4873 | { |
---|
4874 | // Modifies all polynomials in I so that a map x(i) -> y(i)/c can be |
---|
4875 | // carried out. |
---|
4876 | |
---|
4877 | // v indicates wicih variables x(i) of the ring will be mapped to y(i)/c. |
---|
4878 | |
---|
4879 | int i; // counter |
---|
4880 | for(i = 1; i <= ncols(I); i++) |
---|
4881 | { |
---|
4882 | I[i] = mapBackPoly(I[i], c, @v); |
---|
4883 | } |
---|
4884 | return(I); |
---|
4885 | } |
---|
4886 | |
---|
4887 | /////////////////////////////////////////////////////////////////////////////// |
---|
4888 | |
---|
4889 | static proc mapBackPoly(poly p, poly c, intvec @v) |
---|
4890 | { |
---|
4891 | // Multiplies each monomial of p by a power of c so that a map x(i) -> y(i)/c |
---|
4892 | // can be carried out. |
---|
4893 | |
---|
4894 | // v indicates wicih variables x(i) of the ring will be mapped to y(i)/c. |
---|
4895 | int i; // counter |
---|
4896 | int e; // exponent |
---|
4897 | int d = degSubring(p, @v); |
---|
4898 | poly g = 0; |
---|
4899 | int size_p=size(p); |
---|
4900 | for(i = 1; i <= size_p; i++) |
---|
4901 | { |
---|
4902 | e = sum(leadexp(p[i]), @v); |
---|
4903 | g = g + p[i] * c^(d-e); |
---|
4904 | } |
---|
4905 | return(g); |
---|
4906 | } |
---|
4907 | |
---|
4908 | // End procedures for normal |
---|
4909 | /////////////////////////////////////////////////////////////////////////////// |
---|
4910 | |
---|
4911 | |
---|
4912 | /////////////////////////////////////////////////////////////////////////////// |
---|
4913 | // Begin procedures for normalC |
---|
4914 | |
---|
4915 | // We first define resp. copy some attributes to be used in proc normal and |
---|
4916 | // static proc normalizationPrimes, and ..., to speed up computation in |
---|
4917 | // special cases |
---|
4918 | //NOTE: We use the following attributes: |
---|
4919 | // 1 attrib(id,"isCohenMacaulay"); //--- Cohen Macaulay |
---|
4920 | // 2 attrib(id,"isCompleteIntersection"); //--- complete intersection |
---|
4921 | // 3 attrib(id,"isHypersurface"); //--- hypersurface |
---|
4922 | // 4 attrib(id,"isEquidimensional"); //--- equidimensional ideal |
---|
4923 | // 5 attrib(id,"isPrim"); //--- prime ideal |
---|
4924 | // 6 attrib(id,"isRegInCodim2"); //--- regular in codimension 2 |
---|
4925 | // 7 attrib(id,"isIsolatedSingularity"); //--- isolated singularities |
---|
4926 | // 8 attrib(id,"onlySingularAtZero"); //--- only singular at 0 |
---|
4927 | // 9 attrib(id,"isRadical"); //--- radical ideal |
---|
4928 | //Recall: (attrib(id,"xy"),1) sets attrib xy to TRUE and |
---|
4929 | // (attrib(id,"xy"),0) to FALSE |
---|
4930 | |
---|
4931 | static proc getAttrib (ideal id) |
---|
4932 | "USAGE: getAttrib(id); id=ideal |
---|
4933 | COMPUTE: check attributes for id. If the attributes above are defined, |
---|
4934 | take its value, otherwise define it and set it to 0 |
---|
4935 | RETURN: intvec of size 9, with entries 0 or 1, values of attributes defined |
---|
4936 | above (in this order) |
---|
4937 | EXAMPLE: no example |
---|
4938 | " |
---|
4939 | { |
---|
4940 | int isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad; |
---|
4941 | |
---|
4942 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
4943 | { |
---|
4944 | if( attrib(id,"isCohenMacaulay")==1 ) |
---|
4945 | { isCoM=1; isEq=1; } |
---|
4946 | } |
---|
4947 | |
---|
4948 | if( typeof(attrib(id,"isCompleteIntersection"))=="int" ) |
---|
4949 | { |
---|
4950 | if(attrib(id,"isCompleteIntersection")==1) |
---|
4951 | { isCoI=1; isCoM=1; isEq=1; } |
---|
4952 | } |
---|
4953 | |
---|
4954 | if( typeof(attrib(id,"isHypersurface"))=="int" ) |
---|
4955 | { |
---|
4956 | if(attrib(id,"isHypersurface")==1) |
---|
4957 | { isHy=1; isCoI=1; isCoM=1; isEq=1; } |
---|
4958 | } |
---|
4959 | |
---|
4960 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
4961 | { |
---|
4962 | if(attrib(id,"isEquidimensional")==1) |
---|
4963 | { isEq=1; } |
---|
4964 | } |
---|
4965 | |
---|
4966 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
4967 | { |
---|
4968 | if(attrib(id,"isPrim")==1) |
---|
4969 | { isPr=1; } |
---|
4970 | } |
---|
4971 | |
---|
4972 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
4973 | { |
---|
4974 | if(attrib(id,"isRegInCodim2")==1) |
---|
4975 | { isReg=1; } |
---|
4976 | } |
---|
4977 | |
---|
4978 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
4979 | { |
---|
4980 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
4981 | { isIso=1; } |
---|
4982 | } |
---|
4983 | |
---|
4984 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
4985 | { |
---|
4986 | if(attrib(id,"onlySingularAtZero")==1) |
---|
4987 | { oSAZ=1; } |
---|
4988 | } |
---|
4989 | |
---|
4990 | if( typeof(attrib(id,"isRad"))=="int" ) |
---|
4991 | { |
---|
4992 | if(attrib(id,"isRad")==1) |
---|
4993 | { isRad=1; } |
---|
4994 | } |
---|
4995 | |
---|
4996 | intvec atr = isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad; |
---|
4997 | return(atr); |
---|
4998 | } |
---|
4999 | |
---|
5000 | /////////////////////////////////////////////////////////////////////////////// |
---|
5001 | |
---|
5002 | static proc setAttrib (ideal id, intvec atr) |
---|
5003 | "USAGE: setAttrib(id,atr); id ideal, atr intvec |
---|
5004 | COMPUTE: set attributes to id specified by atr |
---|
5005 | RETURN: id, with assigned attributes from atr |
---|
5006 | EXAMPLE: no example |
---|
5007 | " |
---|
5008 | { |
---|
5009 | attrib(id,"isCohenMacaulay",atr[1]); //--- Cohen Macaulay |
---|
5010 | attrib(id,"isCompleteIntersection",atr[2]); //--- complete intersection |
---|
5011 | attrib(id,"isHypersurface",atr[3]); //--- hypersurface |
---|
5012 | attrib(id,"isEquidimensional",atr[4]); //--- equidimensional ideal |
---|
5013 | attrib(id,"isPrim",atr[5]); //--- prime ideal |
---|
5014 | attrib(id,"isRegInCodim2",atr[6]); //--- regular in codimension 2 |
---|
5015 | attrib(id,"isIsolatedSingularity",atr[7]); //--- isolated singularities |
---|
5016 | attrib(id,"onlySingularAtZero",atr[8]); //--- only singular at 0 |
---|
5017 | attrib(id,"isRadical",atr[9]); //--- radical ideal |
---|
5018 | |
---|
5019 | return(id); |
---|
5020 | } |
---|
5021 | |
---|
5022 | /////////////////////////////////////////////////////////////////////////////// |
---|
5023 | // copyAttribs is not used anywhere so far |
---|
5024 | |
---|
5025 | static proc copyAttribs (ideal id1, ideal id) |
---|
5026 | "USAGE: copyAttribs(id1,id); id1, id ideals |
---|
5027 | COMPUTE: copy attributes from id1 to id |
---|
5028 | RETURN: id, with assigned attributes from id1 |
---|
5029 | EXAMPLE: no example |
---|
5030 | " |
---|
5031 | { |
---|
5032 | if( typeof(attrib(id1,"isCohenMacaulay"))=="int" ) |
---|
5033 | { |
---|
5034 | if( attrib(id1,"isCohenMacaulay")==1 ) |
---|
5035 | { |
---|
5036 | attrib(id,"isEquidimensional",1); |
---|
5037 | } |
---|
5038 | } |
---|
5039 | else |
---|
5040 | { |
---|
5041 | attrib(id,"isCohenMacaulay",0); |
---|
5042 | } |
---|
5043 | |
---|
5044 | if( typeof(attrib(id1,"isCompleteIntersection"))=="int" ) |
---|
5045 | { |
---|
5046 | if(attrib(id1,"isCompleteIntersection")==1) |
---|
5047 | { |
---|
5048 | attrib(id,"isCohenMacaulay",1); |
---|
5049 | attrib(id,"isEquidimensional",1); |
---|
5050 | } |
---|
5051 | } |
---|
5052 | else |
---|
5053 | { |
---|
5054 | attrib(id,"isCompleteIntersection",0); |
---|
5055 | } |
---|
5056 | |
---|
5057 | if( typeof(attrib(id1,"isHypersurface"))=="int" ) |
---|
5058 | { |
---|
5059 | if(attrib(id1,"isHypersurface")==1) |
---|
5060 | { |
---|
5061 | attrib(id,"isCompleteIntersection",1); |
---|
5062 | attrib(id,"isCohenMacaulay",1); |
---|
5063 | attrib(id,"isEquidimensional",1); |
---|
5064 | } |
---|
5065 | } |
---|
5066 | else |
---|
5067 | { |
---|
5068 | attrib(id,"isHypersurface",0); |
---|
5069 | } |
---|
5070 | |
---|
5071 | if( (typeof(attrib(id1,"isEquidimensional"))=="int") ) |
---|
5072 | { |
---|
5073 | if(attrib(id1,"isEquidimensional")==1) |
---|
5074 | { |
---|
5075 | attrib(id,"isEquidimensional",1); |
---|
5076 | } |
---|
5077 | } |
---|
5078 | else |
---|
5079 | { |
---|
5080 | attrib(id,"isEquidimensional",0); |
---|
5081 | } |
---|
5082 | |
---|
5083 | if( typeof(attrib(id1,"isPrim"))=="int" ) |
---|
5084 | { |
---|
5085 | if(attrib(id1,"isPrim")==1) |
---|
5086 | { |
---|
5087 | attrib(id,"isEquidimensional",1); |
---|
5088 | } |
---|
5089 | } |
---|
5090 | else |
---|
5091 | { |
---|
5092 | attrib(id,"isPrim",0); |
---|
5093 | } |
---|
5094 | |
---|
5095 | if( (typeof(attrib(id1,"isRegInCodim2"))=="int") ) |
---|
5096 | { |
---|
5097 | if(attrib(id1,"isRegInCodim2")==1) |
---|
5098 | { |
---|
5099 | attrib(id,"isRegInCodim2",1); |
---|
5100 | } |
---|
5101 | } |
---|
5102 | else |
---|
5103 | { |
---|
5104 | attrib(id,"isRegInCodim2",0); |
---|
5105 | } |
---|
5106 | |
---|
5107 | if( (typeof(attrib(id1,"isIsolatedSingularity"))=="int") ) |
---|
5108 | { |
---|
5109 | if(attrib(id1,"isIsolatedSingularity")==1) |
---|
5110 | { |
---|
5111 | attrib(id,"isIsolatedSingularity",1); |
---|
5112 | } |
---|
5113 | } |
---|
5114 | else |
---|
5115 | { |
---|
5116 | attrib(id,"isIsolatedSingularity",0); |
---|
5117 | } |
---|
5118 | |
---|
5119 | if( typeof(attrib(id1,"onlySingularAtZero"))=="int" ) |
---|
5120 | { |
---|
5121 | if(attrib(id1,"onlySingularAtZero")==1) |
---|
5122 | { |
---|
5123 | attrib(id,"isIsolatedSingularity",1); |
---|
5124 | } |
---|
5125 | } |
---|
5126 | else |
---|
5127 | { |
---|
5128 | attrib(id,"onlySingularAtZero",0); |
---|
5129 | } |
---|
5130 | |
---|
5131 | if( typeof(attrib(id1,"isRad"))=="int" ) |
---|
5132 | { |
---|
5133 | if(attrib(id1,"isRad")==1) |
---|
5134 | { |
---|
5135 | attrib(id,"isRad",1); |
---|
5136 | } |
---|
5137 | } |
---|
5138 | else |
---|
5139 | { |
---|
5140 | attrib(id,"isRad",0); |
---|
5141 | } |
---|
5142 | return(id); |
---|
5143 | } |
---|
5144 | /////////////////////////////////////////////////////////////////////////////// |
---|
5145 | |
---|
5146 | proc normalC(ideal id, list #) |
---|
5147 | "USAGE: normalC(id [,choose]); id = radical ideal, choose = optional string. |
---|
5148 | Optional parameters in list choose (can be entered in any order):@* |
---|
5149 | Decomposition:@* |
---|
5150 | - \"equidim\" -> computes first an equidimensional decomposition, |
---|
5151 | and then the normalization of each component (default).@* |
---|
5152 | - \"prim\" -> computes first the minimal associated primes, and then |
---|
5153 | the normalization of each prime. @* |
---|
5154 | - \"noDeco\" -> no preliminary decomposition is done. If the ideal is |
---|
5155 | not equidimensional radical, output might be wrong.@* |
---|
5156 | - \"isPrim\" -> assumes that the ideal is prime. If the assumption does |
---|
5157 | not hold, output might be wrong.@* |
---|
5158 | - \"noFac\" -> factorization is avoided in the computation of the |
---|
5159 | minimal associated primes; |
---|
5160 | Other:@* |
---|
5161 | - \"withGens\" -> the minimal associated primes P_i of id are |
---|
5162 | computed and for each P_i, algebra generators of the integral closure |
---|
5163 | of basering/P_i are computed as elements of its quotient field;@* |
---|
5164 | If choose is not given or empty, the default options are used.@* |
---|
5165 | ASSUME: The ideal must be radical, for non-radical ideals the output may |
---|
5166 | be wrong (id=radical(id); makes id radical). However, if option |
---|
5167 | \"prim\" is set the minimal associated primes are computed first |
---|
5168 | and hence normalC computes the normalization of the radical of id. |
---|
5169 | \"isPrim\" should only be used if id is known to be irreducible. |
---|
5170 | RETURN: a list, say nor, of size 2 (resp. 3 if option \"withGens\" is set).@* |
---|
5171 | * nor[1] is always a of r rings, where r is the number of associated |
---|
5172 | primes with option \"prim\" (resp. >= no of equidimenensional |
---|
5173 | components with option \"equidim\").@* |
---|
5174 | Each ring Ri=nor[1][i], i=1..r, contains two ideals with given |
---|
5175 | names @code{norid} and @code{normap} such that @* |
---|
5176 | - Ri/norid is the normalization of the i-th component, i.e. the |
---|
5177 | integral closure in its field of fractions as affine ring, i.e. Ri is |
---|
5178 | given in the form K[X(1..p),T(1..q)], where K is the ground field; |
---|
5179 | - normap gives the normalization map from basering/id to |
---|
5180 | Ri/norid for each i (the j-th element of normap is mapped to the |
---|
5181 | j-th variable of R).@* |
---|
5182 | - the direct sum of the rings Ri/norid is the normalization |
---|
5183 | of basering/id; @* |
---|
5184 | ** If option \"withGens\" is not set: @* |
---|
5185 | * nor[2] shows the delta invariants: nor[2] is a list of an intvec of |
---|
5186 | size r, the delta invariants of the r components, and an integer, the |
---|
5187 | delta invariant of basering/id. (-1 means infinite, 0 that basering/P_i |
---|
5188 | resp. basering/input is normal, -2 means that delta resp. delta of one |
---|
5189 | of the components is not computed (which may happen if \"equidim\" is |
---|
5190 | given). @* |
---|
5191 | ** If option \"withGens\" is set: |
---|
5192 | * nor[2] is a list of ideals Ii=nor[2][i], i=1..r, in the basering, |
---|
5193 | generating the integral closure of basering/P_i in its quotient field |
---|
5194 | as K-algebra (K the ground field):@* |
---|
5195 | If Ii is given by polynomials g_1,...,g_k, then c:=g_k is a non-zero |
---|
5196 | divisor and the j-th variables of the ring Ri satisfies var(j)=g_j/c, |
---|
5197 | j=1..k-1, as element in the quotient field of basering/P_i. The |
---|
5198 | g_j/g_k+1 are K-algebra generators of the integral closure of |
---|
5199 | basering/P_i.@* |
---|
5200 | * nor[3] shows the delta invariant as above. |
---|
5201 | THEORY: We use the Grauert-Remmert-de Jong algorithm [c.f. G.-M. Greuel, |
---|
5202 | G. Pfister: A SINGULAR Introduction to Commutative Algebra, 2nd Edition. |
---|
5203 | Springer Verlag (2007)]. |
---|
5204 | The procedure computes the algebra structure and the delta invariant of |
---|
5205 | the normalization of R/id:@* |
---|
5206 | The normalization is an affine algebra over the ground field K |
---|
5207 | and nor[1] presents it as such: Ri = K[X(1..p),T(1..q)] and Ri/norid |
---|
5208 | is the integral closure of R/P_i; if option \"withGens\" is set the |
---|
5209 | X(j) and T(j) are expressed as quotients in the total ring of |
---|
5210 | fractions. Note that the X(j) and T(j) generate the integral closure |
---|
5211 | as K-algebra, but not necessarily as R-module (since relations of the |
---|
5212 | form X(1)=T(1)*T(2) may have been eliminated). Geometrically the |
---|
5213 | algebra structure is relevant since the variety of the ideal norid in |
---|
5214 | Ri is the normalization of the variety of the ideal P_i in R.@* |
---|
5215 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
5216 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
5217 | id. nor[3] returns the delta invariants of the components P_i and of |
---|
5218 | id. |
---|
5219 | NOTE: To use the i-th ring type: @code{def R=nor[1][i]; setring R;}. |
---|
5220 | @* Increasing/decreasing printlevel displays more/less comments |
---|
5221 | (default: printlevel=0). |
---|
5222 | @* Not implemented for local or mixed orderings or quotient rings. |
---|
5223 | For local or mixed orderings use proc 'normal'. |
---|
5224 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
5225 | be used (qhweight(id); computes weights). |
---|
5226 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
5227 | SEE ALSO: normal, normalP. |
---|
5228 | EXAMPLE: example normalC; shows an example |
---|
5229 | " |
---|
5230 | { |
---|
5231 | int i,j; |
---|
5232 | int withGens, withEqui, withPrim, isPrim, noFac; |
---|
5233 | int dbg = printlevel-voice+2; |
---|
5234 | int nvar = nvars(basering); |
---|
5235 | int chara = char(basering); |
---|
5236 | list result, prim, keepresult; |
---|
5237 | |
---|
5238 | int decomp; // Preliminar decomposition: |
---|
5239 | // 0 -> no decomposition (id is assumed to be prime) |
---|
5240 | // 1 -> no decomposition |
---|
5241 | // (id is assumed to be equidimensional radical) |
---|
5242 | // 2 -> equidimensional decomposition |
---|
5243 | // 3 -> minimal associated primes |
---|
5244 | |
---|
5245 | // Default methods: |
---|
5246 | noFac = 0; // Use facstd when computing minimal associated primes |
---|
5247 | decomp = 2; // Equidimensional decomposition for nvar > 2 |
---|
5248 | if (nvar <= 2) |
---|
5249 | { decomp = 3; } // Compute minimal associated primes if nvar <= 2 |
---|
5250 | |
---|
5251 | if ( ord_test(basering) != 1 ) |
---|
5252 | { |
---|
5253 | ""; |
---|
5254 | "// Not implemented for this ordering,"; |
---|
5255 | "// please change to global ordering or use proc normal"; |
---|
5256 | return(result); |
---|
5257 | } |
---|
5258 | |
---|
5259 | //--------------------------- define the method --------------------------- |
---|
5260 | string method; //make all options one string in order to use |
---|
5261 | //all combinations of options simultaneously |
---|
5262 | for ( i=1; i <= size(#); i++ ) |
---|
5263 | { |
---|
5264 | if ( typeof(#[i]) == "string" ) |
---|
5265 | { |
---|
5266 | method = method + #[i]; |
---|
5267 | } |
---|
5268 | } |
---|
5269 | |
---|
5270 | //--------------------------- choosen methods ----------------------- |
---|
5271 | // "withGens": computes algebra generators for each irreducible component |
---|
5272 | // ### the extra code for withGens should be incorporated in the general case |
---|
5273 | |
---|
5274 | if ( find(method,"withgens") or find(method,"withGens")) |
---|
5275 | { |
---|
5276 | withGens = 1; |
---|
5277 | } |
---|
5278 | |
---|
5279 | // the general case: either equidim or minAssGTZ or no decomposition |
---|
5280 | |
---|
5281 | if ( find(method,"isprim") or find(method,"isPrim") ) |
---|
5282 | {decomp = 0; isPrim=1;} |
---|
5283 | |
---|
5284 | if ( find(method,"nodeco") or find(method,"noDeco") ) |
---|
5285 | {decomp = 1;} |
---|
5286 | |
---|
5287 | if ( find(method,"equidim") ) |
---|
5288 | { decomp = 2; } |
---|
5289 | |
---|
5290 | if ( find(method,"prim") ) |
---|
5291 | { decomp = 3; } |
---|
5292 | |
---|
5293 | if ( find(method,"nofac") or find(method,"noFac") ) |
---|
5294 | { noFac = 1; } |
---|
5295 | |
---|
5296 | kill #; |
---|
5297 | list #; |
---|
5298 | |
---|
5299 | //------- Special algorithm with computation of the generators, RETURN ------- |
---|
5300 | //--------------------- method "withGens" ---------------------------------- |
---|
5301 | //the integral closure is computed in proc primeClosure. In the general case |
---|
5302 | //it is computed in normalizationPrimes. The main difference is that in |
---|
5303 | //primeClosure the singular locus is only computed in the first iteration, |
---|
5304 | //that no attributes are used, and that the generators are computed. |
---|
5305 | //In primeClosure the (algebra) generators for each irreducible component |
---|
5306 | //are computed in the static proc closureGenerators |
---|
5307 | |
---|
5308 | if( withGens ) |
---|
5309 | { |
---|
5310 | if( dbg >= 1 ) |
---|
5311 | { ""; |
---|
5312 | "// We use method 'withGens'"; |
---|
5313 | } |
---|
5314 | if ( decomp == 0 or decomp == 1 ) |
---|
5315 | { |
---|
5316 | prim[1] = id; |
---|
5317 | if( dbg >= 0 ) |
---|
5318 | { |
---|
5319 | ""; |
---|
5320 | "// ** WARNING: result is correct if ideal is prime (not checked) **"; |
---|
5321 | "// if procedure is called with string \"prim\", primality is checked"; |
---|
5322 | } |
---|
5323 | } |
---|
5324 | else |
---|
5325 | { |
---|
5326 | if(dbg >= 1) |
---|
5327 | { "// Computing minimal associated primes..."; } |
---|
5328 | |
---|
5329 | if( noFac ) |
---|
5330 | { prim = minAssGTZ(id,1); } |
---|
5331 | else |
---|
5332 | { prim = minAssGTZ(id); } |
---|
5333 | |
---|
5334 | if(dbg >= 2) |
---|
5335 | { prim;""; } |
---|
5336 | if(dbg >= 1) |
---|
5337 | { |
---|
5338 | "// number of irreducible components is", size(prim); |
---|
5339 | } |
---|
5340 | } |
---|
5341 | //----------- compute integral closure for every component ------------- |
---|
5342 | int del; |
---|
5343 | intvec deli; |
---|
5344 | list Gens,l,resu,Resu; |
---|
5345 | ideal gens; |
---|
5346 | def R = basering; |
---|
5347 | poly gg; |
---|
5348 | |
---|
5349 | for(i=1; i<=size(prim); i++) |
---|
5350 | { |
---|
5351 | if(dbg>=1) |
---|
5352 | { |
---|
5353 | ""; pause(); ""; |
---|
5354 | "// Computing normalization of component",i; |
---|
5355 | " ---------------------------------------"; |
---|
5356 | } |
---|
5357 | |
---|
5358 | if( defined(ker) ) { kill ker; } |
---|
5359 | ideal ker = prim[i]; |
---|
5360 | export(ker); |
---|
5361 | l = R; |
---|
5362 | l = primeClosure(l,1); //here the work is done |
---|
5363 | // primeClosure is called with list l consisting of the basering |
---|
5364 | //### ausprobieren ob primeClosure(l,1) schneller als primeClosure(l) |
---|
5365 | // 1 bedeutet: krzester nzd |
---|
5366 | // l[size(l)] is the delta invariant |
---|
5367 | |
---|
5368 | if ( l[size(l)] >= 0 && del >= 0 ) |
---|
5369 | { |
---|
5370 | del = del + l[size(l)]; |
---|
5371 | } |
---|
5372 | else |
---|
5373 | { del = -1; } |
---|
5374 | deli = l[size(l)],deli; |
---|
5375 | |
---|
5376 | l = l[1..size(l)-1]; |
---|
5377 | resu = list(l[size(l)]) + resu; |
---|
5378 | gens = closureGenerators(l); //computes algebra(!) generators |
---|
5379 | |
---|
5380 | //NOTE: gens[i]/gens[size(gens)] expresses the ith variable of resu[1] |
---|
5381 | //(the normalization) as fraction of elements of the basering; |
---|
5382 | //the variables of resu[1] are algebra generators. |
---|
5383 | //gens[size(gens)] is a non-zero divisor of basering/i |
---|
5384 | |
---|
5385 | //divide by the greatest common divisor: |
---|
5386 | gg = gcd( gens[1],gens[size(gens)] ); |
---|
5387 | for(j=2; j<=size(gens)-1; j++) |
---|
5388 | { |
---|
5389 | gg=gcd(gg,gens[j]); |
---|
5390 | } |
---|
5391 | for(j=1; j<=size(gens); j++) |
---|
5392 | { |
---|
5393 | gens[j]=gens[j]/gg; |
---|
5394 | } |
---|
5395 | Gens = list(gens) + Gens; |
---|
5396 | |
---|
5397 | /* ### Da die gens Algebra-Erzeuger sind, ist reduce nach Bestimmung |
---|
5398 | der Algebra-Variablen T(i) nicht zulssig! |
---|
5399 | for(i=1;i<=size(gens)-1;i++) |
---|
5400 | { |
---|
5401 | gens[i]= reduce(gens[i],std(gens[size(gens)])); |
---|
5402 | } |
---|
5403 | for(i=size(gens)-1; i>=1; i--) |
---|
5404 | { |
---|
5405 | if(gens[i]==0) |
---|
5406 | { gens = delete(gens,i); } |
---|
5407 | } |
---|
5408 | */ |
---|
5409 | if( defined(ker) ) { kill ker; } |
---|
5410 | } |
---|
5411 | |
---|
5412 | if ( del >= 0 ) |
---|
5413 | { |
---|
5414 | int mul = iMult(prim); |
---|
5415 | del = del + mul; |
---|
5416 | } |
---|
5417 | else |
---|
5418 | { del = -1; } |
---|
5419 | deli = deli[1..size(deli)-1]; |
---|
5420 | Resu = resu,Gens,list(deli,del); |
---|
5421 | int sr = size(resu); |
---|
5422 | |
---|
5423 | if ( dbg >= 0 ) |
---|
5424 | {""; |
---|
5425 | "// 'normalC' created a list, say nor, of three lists: |
---|
5426 | // To see the list type |
---|
5427 | nor; |
---|
5428 | |
---|
5429 | // * nor[1] is a list of",sr,"ring(s) |
---|
5430 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
5431 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
5432 | // For the other rings type first (if R is the name of your original basering) |
---|
5433 | setring R; |
---|
5434 | // and then continue as for R1. |
---|
5435 | // Ri/norid is the affine algebra of the normalization of the i-th |
---|
5436 | // component R/P_i (where P_i is an associated prime of the input ideal id) |
---|
5437 | // and normap the normalization map from R to Ri/norid. |
---|
5438 | |
---|
5439 | // * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of |
---|
5440 | // elements g1..gk of R such that the gj/gk generate the integral |
---|
5441 | // closure of R/P_i as sub-algebra in the quotient field of R/P_i, with |
---|
5442 | // gj/gk being mapped by normap to the j-th variable of Ri; |
---|
5443 | |
---|
5444 | // * nor[3] shows the delta-invariant of each component and of id |
---|
5445 | // (-1 means infinite, and 0 that R/P_i resp. R/id is normal)."; |
---|
5446 | } |
---|
5447 | return(Resu); |
---|
5448 | } |
---|
5449 | //----------------- end method "withGens" -------------------------------- |
---|
5450 | |
---|
5451 | //-------- The general case without computation of the generators ----------- |
---|
5452 | // (attrib(id,"xy"),1) sets attrib xy to TRUE and (attrib(id,"xy"),0) to FALSE |
---|
5453 | // We use the following attributes: |
---|
5454 | // attrib(id,"isCohenMacaulay"); //--- Cohen Macaulay |
---|
5455 | // attrib(id,"isCompleteIntersection"); //--- complete intersection |
---|
5456 | // attrib(id,"isHypersurface"); //--- hypersurface |
---|
5457 | // attrib(id,"isEquidimensional",-1); //--- equidimensional ideal |
---|
5458 | // attrib(id,"isPrim"); //--- prime ideal |
---|
5459 | // attrib(id,"isRegInCodim2"); //--- regular in codimension 2 |
---|
5460 | // attrib(id,"isIsolatedSingularity"; //--- isolated singularities |
---|
5461 | // attrib(id,"onlySingularAtZero"); //--- only singular at 0 |
---|
5462 | |
---|
5463 | //------------------- first set the attributes ---------------------- |
---|
5464 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
5465 | { |
---|
5466 | if( attrib(id,"isCohenMacaulay")==1 ) |
---|
5467 | { |
---|
5468 | attrib(id,"isEquidimensional",1); |
---|
5469 | } |
---|
5470 | } |
---|
5471 | else |
---|
5472 | { |
---|
5473 | attrib(id,"isCohenMacaulay",0); |
---|
5474 | } |
---|
5475 | |
---|
5476 | if( typeof(attrib(id,"isCompleteIntersection"))=="int" ) |
---|
5477 | { |
---|
5478 | if(attrib(id,"isCompleteIntersection")==1) |
---|
5479 | { |
---|
5480 | attrib(id,"isCohenMacaulay",1); |
---|
5481 | attrib(id,"isEquidimensional",1); |
---|
5482 | } |
---|
5483 | } |
---|
5484 | else |
---|
5485 | { |
---|
5486 | attrib(id,"isCompleteIntersection",0); |
---|
5487 | } |
---|
5488 | |
---|
5489 | if( typeof(attrib(id,"isHypersurface"))=="int" ) |
---|
5490 | { |
---|
5491 | if(attrib(id,"isHypersurface")==1) |
---|
5492 | { |
---|
5493 | attrib(id,"isCompleteIntersection",1); |
---|
5494 | attrib(id,"isCohenMacaulay",1); |
---|
5495 | attrib(id,"isEquidimensional",1); |
---|
5496 | } |
---|
5497 | } |
---|
5498 | else |
---|
5499 | { |
---|
5500 | attrib(id,"isHypersurface",0); |
---|
5501 | } |
---|
5502 | |
---|
5503 | if( ! (typeof(attrib(id,"isEquidimensional"))=="int") ) |
---|
5504 | { |
---|
5505 | attrib(id,"isEquidimensional",0); |
---|
5506 | } |
---|
5507 | |
---|
5508 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
5509 | { |
---|
5510 | if(attrib(id,"isPrim")==1) |
---|
5511 | { |
---|
5512 | attrib(id,"isEquidimensional",1); |
---|
5513 | } |
---|
5514 | } |
---|
5515 | else |
---|
5516 | { |
---|
5517 | attrib(id,"isPrim",0); |
---|
5518 | } |
---|
5519 | |
---|
5520 | if( ! (typeof(attrib(id,"isRegInCodim2"))=="int") ) |
---|
5521 | { |
---|
5522 | attrib(id,"isRegInCodim2",0); |
---|
5523 | } |
---|
5524 | |
---|
5525 | if( ! (typeof(attrib(id,"isIsolatedSingularity"))=="int") ) |
---|
5526 | { |
---|
5527 | attrib(id,"isIsolatedSingularity",0); |
---|
5528 | } |
---|
5529 | |
---|
5530 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
5531 | { |
---|
5532 | if(attrib(id,"onlySingularAtZero")==1) |
---|
5533 | { |
---|
5534 | attrib(id,"isIsolatedSingularity",1); |
---|
5535 | } |
---|
5536 | } |
---|
5537 | else |
---|
5538 | { |
---|
5539 | attrib(id,"onlySingularAtZero",0); |
---|
5540 | } |
---|
5541 | |
---|
5542 | //-------------- compute equidimensional decomposition -------------------- |
---|
5543 | //If the method "equidim" is given, compute the equidim decomposition |
---|
5544 | //and goto the next step (no normalization |
---|
5545 | //ACHTUNG: equidim berechnet bei nicht reduzierten id die eingebetteten |
---|
5546 | //Komponenten als niederdim Komponenten, waehrend diese bei primdecGTZ |
---|
5547 | //nicht auftauchen: ideal(x,y)*xy |
---|
5548 | //this is default for nvars > 2 |
---|
5549 | |
---|
5550 | if( decomp == 2 ) |
---|
5551 | { |
---|
5552 | withPrim = 0; //this is used to check later that prim |
---|
5553 | //contains equidim but not prime components |
---|
5554 | if( dbg >= 1 ) |
---|
5555 | { |
---|
5556 | "// We use method 'equidim'"; |
---|
5557 | } |
---|
5558 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
5559 | { |
---|
5560 | if(attrib(id,"isEquidimensional")==1) |
---|
5561 | { |
---|
5562 | prim[1] = id; |
---|
5563 | } |
---|
5564 | else |
---|
5565 | { |
---|
5566 | prim = equidim(id); |
---|
5567 | } |
---|
5568 | } |
---|
5569 | else |
---|
5570 | { |
---|
5571 | prim = equidim(id); |
---|
5572 | } |
---|
5573 | if(dbg>=1) |
---|
5574 | { ""; |
---|
5575 | "// number of equidimensional components:", size(prim); |
---|
5576 | } |
---|
5577 | if ( !noFac ) |
---|
5578 | { |
---|
5579 | intvec opt = option(get); |
---|
5580 | option(redSB); |
---|
5581 | for(j=1; j<=size(prim); j++) |
---|
5582 | { |
---|
5583 | keepresult = keepresult+facstd(prim[j]); |
---|
5584 | } |
---|
5585 | prim = keepresult; |
---|
5586 | if ( size(prim) == 0 ) |
---|
5587 | { |
---|
5588 | prim=ideal(0); //Bug in facstd, liefert leere Liste bei 0-Ideal |
---|
5589 | } |
---|
5590 | |
---|
5591 | if(dbg>=1) |
---|
5592 | { ""; |
---|
5593 | "// number of components after application of facstd:", size(prim); |
---|
5594 | } |
---|
5595 | option(set,opt); |
---|
5596 | } |
---|
5597 | } |
---|
5598 | |
---|
5599 | //------------------- compute associated primes ------------------------- |
---|
5600 | //the case where withEqui = 0, here the min. ass. primes are computed |
---|
5601 | //start with the computation of the minimal associated primes: |
---|
5602 | |
---|
5603 | else |
---|
5604 | { |
---|
5605 | if( isPrim ) |
---|
5606 | { |
---|
5607 | if( dbg >= 0 ) |
---|
5608 | { |
---|
5609 | "// ** WARNING: result is correct if ideal is prime"; |
---|
5610 | "// or equidimensional (not checked) **"; |
---|
5611 | "// disable option \"isPrim\" to decompose ideal into prime"; |
---|
5612 | "// or equidimensional components";""; |
---|
5613 | } |
---|
5614 | if( dbg >= 1 ) |
---|
5615 | { |
---|
5616 | "// We use method 'isPrim'";""; |
---|
5617 | } |
---|
5618 | prim[1]=id; |
---|
5619 | } |
---|
5620 | else |
---|
5621 | { |
---|
5622 | withPrim = 1; //this is used to check later that prim |
---|
5623 | //contains prime but not equidim components |
---|
5624 | if( dbg >= 1 ) |
---|
5625 | { |
---|
5626 | "// We use method 'prim'"; |
---|
5627 | } |
---|
5628 | |
---|
5629 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
5630 | { |
---|
5631 | if(attrib(id,"isPrim")==1) |
---|
5632 | { |
---|
5633 | prim[1]=id; |
---|
5634 | } |
---|
5635 | else |
---|
5636 | { |
---|
5637 | if( noFac ) |
---|
5638 | { prim=minAssGTZ(id,1); } //does not use factorizing groebner |
---|
5639 | else |
---|
5640 | { prim=minAssGTZ(id); } //uses factorizing groebner |
---|
5641 | } |
---|
5642 | } |
---|
5643 | else |
---|
5644 | { |
---|
5645 | if( noFac ) |
---|
5646 | { prim=minAssGTZ(id,1); } |
---|
5647 | else |
---|
5648 | { prim=minAssGTZ(id); } |
---|
5649 | } |
---|
5650 | if(dbg>=1) |
---|
5651 | { ""; |
---|
5652 | "// number of irreducible components:", size(prim); |
---|
5653 | } |
---|
5654 | } |
---|
5655 | } |
---|
5656 | |
---|
5657 | //----- for each component (equidim or irred) compute normalization ----- |
---|
5658 | int sr, skr, del; |
---|
5659 | intvec deli; |
---|
5660 | int sp = size(prim); //size of list prim (# irred or equidim comp) |
---|
5661 | |
---|
5662 | for(i=1; i<=sp; i++) |
---|
5663 | { |
---|
5664 | if(dbg>=1) |
---|
5665 | { ""; |
---|
5666 | "// computing the normalization of component",i; |
---|
5667 | " ----------------------------------------"; |
---|
5668 | } |
---|
5669 | //-------------- first set attributes for components ------------------ |
---|
5670 | attrib(prim[i],"isEquidimensional",1); |
---|
5671 | if( withPrim ) |
---|
5672 | { |
---|
5673 | attrib(prim[i],"isPrim",1); |
---|
5674 | } |
---|
5675 | else |
---|
5676 | { attrib(prim[i],"isPrim",0); } |
---|
5677 | |
---|
5678 | if(attrib(id,"onlySingularAtZero")==1) |
---|
5679 | { attrib(prim[i],"onlySingularAtZero",1); } |
---|
5680 | else |
---|
5681 | { attrib(prim[i],"onlySingularAtZero",0); } |
---|
5682 | |
---|
5683 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
5684 | { attrib(prim[i],"isIsolatedSingularity",1); } |
---|
5685 | else |
---|
5686 | { attrib(prim[i],"isIsolatedSingularity",0); } |
---|
5687 | |
---|
5688 | if( attrib(id,"isHypersurface")==1 ) |
---|
5689 | { |
---|
5690 | attrib(prim[i],"isHypersurface",1); |
---|
5691 | attrib(prim[i],"isCompleteIntersection",1); |
---|
5692 | attrib(prim[i],"isCohenMacaulay",1); |
---|
5693 | } |
---|
5694 | else |
---|
5695 | { attrib(prim[i],"isHypersurface",0); } |
---|
5696 | |
---|
5697 | if ( sp == 1) //the case of one component: copy attribs from id |
---|
5698 | { |
---|
5699 | if(attrib(id,"isRegInCodim2")==1) |
---|
5700 | {attrib(prim[i],"isRegInCodim2",1); } |
---|
5701 | else |
---|
5702 | {attrib(prim[i],"isRegInCodim2",0); } |
---|
5703 | |
---|
5704 | if(attrib(id,"isCohenMacaulay")==1) |
---|
5705 | {attrib(prim[i],"isCohenMacaulay",1); } |
---|
5706 | else |
---|
5707 | {attrib(prim[i],"isCohenMacaulay",0); } |
---|
5708 | |
---|
5709 | if(attrib(id,"isCompleteIntersection")==1) |
---|
5710 | {attrib(prim[i],"isCompleteIntersection",1); } |
---|
5711 | else |
---|
5712 | {attrib(prim[i],"isCompleteIntersection",0); } |
---|
5713 | } |
---|
5714 | else |
---|
5715 | { |
---|
5716 | attrib(prim[i],"isRegInCodim2",0); |
---|
5717 | attrib(prim[i],"isCohenMacaulay",0); |
---|
5718 | attrib(prim[i],"isCompleteIntersection",0); |
---|
5719 | } |
---|
5720 | |
---|
5721 | //------ Now compute the normalization of each component --------- |
---|
5722 | //note: for equidimensional components the "splitting tools" can |
---|
5723 | //create further decomposition |
---|
5724 | //We now start normalizationPrimes with |
---|
5725 | //ihp = partial normalisation map = identity map = maxideal(1) |
---|
5726 | //del = partial delta invariant = 0 |
---|
5727 | //deli= intvec of partial delta invariants of components |
---|
5728 | //in normalizationPrimes all the work is done: |
---|
5729 | |
---|
5730 | keepresult = normalizationPrimes(prim[i],maxideal(1),0,0); |
---|
5731 | |
---|
5732 | for(j=1; j<=size(keepresult)-1; j++) |
---|
5733 | { |
---|
5734 | result=insert(result,keepresult[j]); |
---|
5735 | } |
---|
5736 | skr = size(keepresult); |
---|
5737 | |
---|
5738 | //compute delta: |
---|
5739 | if( del >= 0 && keepresult[skr][1] >=0 ) |
---|
5740 | { |
---|
5741 | del = del + keepresult[skr][1]; |
---|
5742 | } |
---|
5743 | else |
---|
5744 | { |
---|
5745 | del = -1; |
---|
5746 | } |
---|
5747 | deli = keepresult[skr][2],deli; |
---|
5748 | |
---|
5749 | if ( dbg>=1 ) |
---|
5750 | { |
---|
5751 | "// delta of component",i; keepresult[skr][1]; |
---|
5752 | } |
---|
5753 | } |
---|
5754 | sr = size(result); |
---|
5755 | |
---|
5756 | // -------------- Now compute intersection multiplicities ------------- |
---|
5757 | //intersection multiplicities of list prim, sp=size(prim). |
---|
5758 | if ( dbg>=1 ) |
---|
5759 | { |
---|
5760 | "// Sum of delta for all components"; del; |
---|
5761 | if ( sp>1 ) |
---|
5762 | { |
---|
5763 | "// Compute intersection multiplicities of the components"; |
---|
5764 | } |
---|
5765 | } |
---|
5766 | |
---|
5767 | if ( sp > 1 ) |
---|
5768 | { |
---|
5769 | int mul = iMult(prim); |
---|
5770 | if ( mul < 0 ) |
---|
5771 | { |
---|
5772 | del = -1; |
---|
5773 | } |
---|
5774 | else |
---|
5775 | { |
---|
5776 | del = del + mul; |
---|
5777 | } |
---|
5778 | } |
---|
5779 | deli = deli[1..size(deli)-1]; |
---|
5780 | result = result,list(deli,del); |
---|
5781 | |
---|
5782 | //--------------- Finally print comments and return ------------------ |
---|
5783 | if ( dbg >= 0) |
---|
5784 | {""; |
---|
5785 | "// 'normalC' created a list, say nor, of two lists: |
---|
5786 | // To see the result, type |
---|
5787 | nor; |
---|
5788 | |
---|
5789 | // * nor[1] is a list of",sr,"ring(s). |
---|
5790 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
5791 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
5792 | // and similair for the other rings nor[1][i]; |
---|
5793 | // Ri/norid is the affine algebra of the normalization of r/P_i (where P_i |
---|
5794 | // is an associated prime or an equidimensional part of the input ideal id) |
---|
5795 | // and normap the normalization map from the basering to Ri/norid; |
---|
5796 | |
---|
5797 | // * nor[2] shows the delta-invariant of each component and of id |
---|
5798 | // (-1 means infinite, 0 that r/P_i resp. r/id is normal, and -2 that delta |
---|
5799 | // of a component was not computed)."; |
---|
5800 | } |
---|
5801 | return(result); |
---|
5802 | } |
---|
5803 | |
---|
5804 | example |
---|
5805 | { "EXAMPLE:"; |
---|
5806 | printlevel = printlevel+1; |
---|
5807 | echo = 2; |
---|
5808 | ring s = 0,(x,y),dp; |
---|
5809 | ideal i = (x2-y3)*(x2+y2)*x; |
---|
5810 | |
---|
5811 | list nor = normalC(i); |
---|
5812 | |
---|
5813 | nor; |
---|
5814 | // 2 branches have delta = 1, and 1 branch has delta = 0 |
---|
5815 | // the total delta invariant is 13 |
---|
5816 | |
---|
5817 | def R2 = nor[1][2]; setring R2; |
---|
5818 | norid; normap; |
---|
5819 | |
---|
5820 | echo = 0; |
---|
5821 | printlevel = printlevel-1; |
---|
5822 | pause(" hit return to continue"); echo=2; |
---|
5823 | |
---|
5824 | ring r = 2,(x,y,z),dp; |
---|
5825 | ideal i = z3-xy4; |
---|
5826 | nor = normalC(i); nor; |
---|
5827 | // the delta invariant is infinite |
---|
5828 | // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module |
---|
5829 | // in its quotient field Quot(r/i) |
---|
5830 | |
---|
5831 | // the normalization as affine algebra over the ground field: |
---|
5832 | def R = nor[1][1]; setring R; |
---|
5833 | norid; normap; |
---|
5834 | |
---|
5835 | echo = 0; |
---|
5836 | pause(" hit return to continue");echo = 2; |
---|
5837 | |
---|
5838 | setring r; |
---|
5839 | nor = normalC(i, "withGens", "prim"); // a different algorithm |
---|
5840 | nor; |
---|
5841 | } |
---|
5842 | |
---|
5843 | ////////////////////////////////////////////////////////////////////////////// |
---|
5844 | //closureRingtower seems not to be used anywhere |
---|
5845 | static proc closureRingtower(list L) |
---|
5846 | "USAGE: closureRingtower(list L); L a list of rings |
---|
5847 | CREATE: rings R(1),...,R(n) such that R(i)=L[i] for all i |
---|
5848 | EXAMPLE: example closureRingtower; shows an example |
---|
5849 | " |
---|
5850 | { |
---|
5851 | int n=size(L); |
---|
5852 | for (int i=1;i<=n;i++) |
---|
5853 | { |
---|
5854 | if (defined(R(i))) |
---|
5855 | { |
---|
5856 | string s="Fixed name R("+string(i)+") leads to conflict with existing " |
---|
5857 | +"object having this name"; |
---|
5858 | ERROR(s); |
---|
5859 | } |
---|
5860 | def R(i)=L[i]; |
---|
5861 | export R(i); |
---|
5862 | } |
---|
5863 | |
---|
5864 | return(); |
---|
5865 | } |
---|
5866 | example |
---|
5867 | { |
---|
5868 | "EXAMPLE:"; echo=2; |
---|
5869 | ring R=0,(x,y),dp; |
---|
5870 | ideal I=x4,y4; |
---|
5871 | list L=primeClosure(ReesAlgebra(I)[1]); |
---|
5872 | L=delete(L,size(L)); |
---|
5873 | L; |
---|
5874 | closureRingtower(L); |
---|
5875 | R(1); |
---|
5876 | R(4); |
---|
5877 | kill R(1),R(2),R(3),R(4); |
---|
5878 | } |
---|
5879 | |
---|
5880 | // Up to here: procedures for normalC |
---|
5881 | /////////////////////////////////////////////////////////////////////////////// |
---|
5882 | |
---|
5883 | /////////////////////////////////////////////////////////////////////////////// |
---|
5884 | // From here: miscellaneous procedures |
---|
5885 | |
---|
5886 | // Used for timing and comparing the different normalization procedures. |
---|
5887 | // Option (can be entered in any order) |
---|
5888 | // "normal" -> uses the new algortihm (normal) |
---|
5889 | // "normalP" -> uses normalP |
---|
5890 | // "normalC" -> uses normalC, without "withGens" option |
---|
5891 | // "primCl" -> uses normalC, with option "withGens". |
---|
5892 | // "111" -> checks the output of normalM using norTest. |
---|
5893 | // "p" -> compares the output of norM with the output of normalP |
---|
5894 | // ("normalP" option must also be set). |
---|
5895 | // "pc" -> compares the output of norM with the output of normalC with |
---|
5896 | // option "withGens" |
---|
5897 | // ("primCl" option must also be set). |
---|
5898 | |
---|
5899 | proc timeNormal(ideal I, list #) |
---|
5900 | { |
---|
5901 | def r = basering; |
---|
5902 | |
---|
5903 | //--------------------------- define the method --------------------------- |
---|
5904 | int isPrim, useRing; |
---|
5905 | int decomp = -1; |
---|
5906 | int norM, norC, norP, primCl; |
---|
5907 | int checkP, check111, checkPC; |
---|
5908 | int i; |
---|
5909 | ideal U1, U2, W; |
---|
5910 | poly c1, c2; |
---|
5911 | int ch; |
---|
5912 | string check; |
---|
5913 | string method; //make all options one string in order to use |
---|
5914 | //all combinations of options simultaneously |
---|
5915 | for ( i=1; i <= size(#); i++ ) |
---|
5916 | { |
---|
5917 | if ( typeof(#[i]) == "string" ) |
---|
5918 | { |
---|
5919 | method = method + #[i]; |
---|
5920 | } |
---|
5921 | } |
---|
5922 | if ( find(method, "normal")) |
---|
5923 | {norM = 1;} |
---|
5924 | if ( find(method, "normalP") and (char(basering) > 0)) |
---|
5925 | {norP = 1;} |
---|
5926 | if ( find(method, "normalC")) |
---|
5927 | {norC = 1;} |
---|
5928 | if ( find(method, "primCl")) |
---|
5929 | {primCl = 1;} |
---|
5930 | if ( find(method, "isprim") or find(method,"isPrim") ) |
---|
5931 | {decomp = 0;} |
---|
5932 | if ( find(method, "p") ) |
---|
5933 | {checkP = 1;} |
---|
5934 | if ( find(method, "pc") ) |
---|
5935 | {checkPC = 1;} |
---|
5936 | if ( find(method, "111") ) |
---|
5937 | {check111 = 1;} |
---|
5938 | |
---|
5939 | int tt; |
---|
5940 | if(norM) |
---|
5941 | { |
---|
5942 | tt = timer; |
---|
5943 | if(decomp == 0) |
---|
5944 | { |
---|
5945 | "Running normal(useRing, isPrim)..."; |
---|
5946 | list a1 = normal(I, "useRing", "isPrim"); |
---|
5947 | "Time normal(useRing, isPrim): ", timer - tt; |
---|
5948 | } |
---|
5949 | else |
---|
5950 | { |
---|
5951 | "Running normal(useRing)..."; |
---|
5952 | list a1 = normal(I, "useRing"); |
---|
5953 | "Time normal(useRing): ", timer - tt; |
---|
5954 | } |
---|
5955 | ""; |
---|
5956 | } |
---|
5957 | if(norP) |
---|
5958 | { |
---|
5959 | tt = timer; |
---|
5960 | if(decomp == 0) |
---|
5961 | { |
---|
5962 | "Running normalP(isPrim)..."; |
---|
5963 | list a2 = normalP(I, "isPrim"); |
---|
5964 | "Time normalP(isPrim): ", timer - tt; |
---|
5965 | } |
---|
5966 | else |
---|
5967 | { |
---|
5968 | "Running normalP()..."; |
---|
5969 | list a2 = normalP(I); |
---|
5970 | "Time normalP(): ", timer - tt; |
---|
5971 | } |
---|
5972 | ""; |
---|
5973 | } |
---|
5974 | |
---|
5975 | if(norC) |
---|
5976 | { |
---|
5977 | tt = timer; |
---|
5978 | if(decomp == 0) |
---|
5979 | { |
---|
5980 | "Running normalC(isPrim)..."; |
---|
5981 | list a3 = normalC(I, "isPrim"); |
---|
5982 | "Time normalC(isPrim): ", timer - tt; |
---|
5983 | } |
---|
5984 | else |
---|
5985 | { |
---|
5986 | "Running normalC()..."; |
---|
5987 | list a3 = normalC(I); |
---|
5988 | "Time normalC(): ", timer - tt; |
---|
5989 | } |
---|
5990 | ""; |
---|
5991 | } |
---|
5992 | |
---|
5993 | if(primCl) |
---|
5994 | { |
---|
5995 | tt = timer; |
---|
5996 | if(decomp == 0) |
---|
5997 | { |
---|
5998 | "Running normalC(withGens, isPrim)..."; |
---|
5999 | list a4 = normalC(I, "isPrim", "withGens"); |
---|
6000 | "Time normalC(withGens, isPrim): ", timer - tt; |
---|
6001 | } |
---|
6002 | else |
---|
6003 | { |
---|
6004 | "Running normalC(withGens)..."; |
---|
6005 | list a4 = normalC(I, "withGens"); |
---|
6006 | "Time normalC(withGens): ", timer - tt; |
---|
6007 | } |
---|
6008 | ""; |
---|
6009 | } |
---|
6010 | |
---|
6011 | if(check111 and norM) |
---|
6012 | { |
---|
6013 | "Checking output with norTest..."; |
---|
6014 | "WARNING: this checking only works if the original ideal was prime."; |
---|
6015 | norTest(I, a1); |
---|
6016 | ""; |
---|
6017 | } |
---|
6018 | |
---|
6019 | if(checkP and norP and norM) |
---|
6020 | { |
---|
6021 | "Comparing with normalP output..."; |
---|
6022 | if(size(a2) > 0) |
---|
6023 | { |
---|
6024 | "WARNING: this checking only works if the original ideal was prime."; |
---|
6025 | U1 = a1[2][1]; |
---|
6026 | c1 = U1[size(U1)]; |
---|
6027 | U2 = a2[1][1]; |
---|
6028 | c2 = a2[1][1][size(a2[1][1])]; |
---|
6029 | W = changeDenominator(U1, c1, c2, groebner(I)); |
---|
6030 | qring q = groebner(I); |
---|
6031 | ideal U2 = fetch(r, U2); |
---|
6032 | ideal W = fetch(r, W); |
---|
6033 | ch = 0; |
---|
6034 | if(size(reduce(U2, groebner(W))) == 0) |
---|
6035 | { |
---|
6036 | "U2 c U1"; |
---|
6037 | ch = 1; |
---|
6038 | } |
---|
6039 | if(size(reduce(W, groebner(U2))) == 0) |
---|
6040 | { |
---|
6041 | "U1 c U2"; |
---|
6042 | ch = ch + 1; |
---|
6043 | } |
---|
6044 | if(ch == 2) |
---|
6045 | { |
---|
6046 | "Output of normalP is equal."; |
---|
6047 | } |
---|
6048 | else |
---|
6049 | { |
---|
6050 | "ERROR: Output of normalP is different."; |
---|
6051 | } |
---|
6052 | setring r; |
---|
6053 | kill q; |
---|
6054 | } |
---|
6055 | else |
---|
6056 | { |
---|
6057 | "normalP returned no output. Comparison is not possible."; |
---|
6058 | } |
---|
6059 | ""; |
---|
6060 | } |
---|
6061 | |
---|
6062 | if(checkPC and norM and primCl) |
---|
6063 | { |
---|
6064 | "Comparing with primeClosure output..."; |
---|
6065 | if(size(a4) > 0) |
---|
6066 | { |
---|
6067 | "WARNING: this checking only works if the original ideal was prime."; |
---|
6068 | // primeClosure check |
---|
6069 | U1 = a1[2][1]; |
---|
6070 | c1 = U1[size(U1)]; |
---|
6071 | U2 = a4[2][1]; |
---|
6072 | c2 = a4[2][1][size(a4[2][1])]; |
---|
6073 | W = changeDenominator(U1, c1, c2, groebner(I)); |
---|
6074 | qring q = groebner(I); |
---|
6075 | ideal U2 = fetch(r, U2); |
---|
6076 | ideal W = fetch(r, W); |
---|
6077 | ch = 0; |
---|
6078 | if(size(reduce(U2, groebner(W))) == 0) |
---|
6079 | { |
---|
6080 | "U2 c U1"; |
---|
6081 | ch = 1; |
---|
6082 | } |
---|
6083 | if(size(reduce(W, groebner(U2))) == 0) |
---|
6084 | { |
---|
6085 | "U1 c U2"; |
---|
6086 | ch = ch + 1; |
---|
6087 | } |
---|
6088 | if(ch == 2) |
---|
6089 | { |
---|
6090 | "Output of normalC(withGens) is equal."; |
---|
6091 | } |
---|
6092 | else |
---|
6093 | { |
---|
6094 | "ERROR: Output of normalC(withGens) is different."; |
---|
6095 | } |
---|
6096 | setring r; |
---|
6097 | kill q; |
---|
6098 | } |
---|
6099 | else |
---|
6100 | { |
---|
6101 | "normalC(withGens) returned no output. Comparison is not possible."; |
---|
6102 | } |
---|
6103 | ""; |
---|
6104 | } |
---|
6105 | } |
---|
6106 | |
---|
6107 | /////////////////////////////////////////////////////////////////////////// |
---|
6108 | static proc sqroot(int n); |
---|
6109 | { |
---|
6110 | int s = 1; |
---|
6111 | while(s*s < n) { s++; } |
---|
6112 | return(s); |
---|
6113 | } |
---|
6114 | |
---|
6115 | /////////////////////////////////////////////////////////////////////////// |
---|
6116 | proc norTest (ideal i, list nor, list #) |
---|
6117 | "USAGE: norTest(i,nor,[n]); i=prime ideal, nor=list, n=optional integer |
---|
6118 | ASSUME: nor is the output of normal(i) (any options) or |
---|
6119 | normalP(i,"withRing") or normalC(i) (any options). |
---|
6120 | In particular, the ring nor[1][1] contains the ideal norid |
---|
6121 | and the map normap: basering/i --> nor[1][1]/norid. |
---|
6122 | RETURN: an intvec v such that: |
---|
6123 | @format |
---|
6124 | v[1] = 1 if the normap is injective and 0 otherwise |
---|
6125 | v[2] = 1 if the normap is finite and 0 otherwise |
---|
6126 | v[3] = 1 if nor[1][1]/norid is normal and 0 otherwise |
---|
6127 | @end format |
---|
6128 | If n=1 (resp n=2) only v[1] (resp. v[2]) is computed and returned |
---|
6129 | THEORY: The procedure can be used to test whether the computation of the |
---|
6130 | normalization was correct: basering/i --> nor[1][1]/norid is the |
---|
6131 | normalization of basering/i if and only if v=1,1,0. |
---|
6132 | NOTE: For big examples it can be hard to fully test correctness; the |
---|
6133 | partial test norTest(i,nor,2) is usually fast |
---|
6134 | EXAMPLE: example norTest; shows an example |
---|
6135 | " |
---|
6136 | { |
---|
6137 | //### Sollte erweitert werden auf den reduziblen Fall: einen neuen affinen |
---|
6138 | // Ring nor[1][1]+...+nor[1][r] (direkte Summe) erzeugen, map dorthin |
---|
6139 | // definieren und dann testen. |
---|
6140 | |
---|
6141 | int prl = printlevel - voice + 2; |
---|
6142 | int a,b,d; |
---|
6143 | int n,ii; |
---|
6144 | if (size(#) > 0) { n = #[1]; } |
---|
6145 | |
---|
6146 | def BAS = basering; |
---|
6147 | |
---|
6148 | //### make a copy of nor to have a cpoy of nor[1][1] (not a reference to) |
---|
6149 | // in order not to override norid and normap. |
---|
6150 | // delete nor[2] (if it contains the module generators, which are not used) |
---|
6151 | // s.t. newnor does not belong to a ring. |
---|
6152 | |
---|
6153 | list newnor = nor; |
---|
6154 | if ( size(newnor) == 3 ) |
---|
6155 | { |
---|
6156 | newnor = delete(newnor,2); |
---|
6157 | } |
---|
6158 | def R = newnor[1][1]; |
---|
6159 | qring QAS = std(i); |
---|
6160 | |
---|
6161 | |
---|
6162 | setring R; |
---|
6163 | int nva = nvars(R); |
---|
6164 | string svars = varstr(R); |
---|
6165 | string svar; |
---|
6166 | |
---|
6167 | norid = interred(norid); |
---|
6168 | |
---|
6169 | //--------- create new ring with one dp block keeping weights ------------ |
---|
6170 | list LR = ringlist(R); |
---|
6171 | list g3 = LR[3]; |
---|
6172 | int n3 = size(g3); |
---|
6173 | list newg3; |
---|
6174 | intvec V; |
---|
6175 | |
---|
6176 | //--------- check first whether variables Z(i),...,A(i) exist ----------- |
---|
6177 | for (ii=90; ii>=65; ii--) |
---|
6178 | { |
---|
6179 | if ( find(svars,ASCII(ii)+"(") == 0 ) |
---|
6180 | { |
---|
6181 | svar = ASCII(ii); break; |
---|
6182 | } |
---|
6183 | } |
---|
6184 | if ( size(svar) != 0 ) |
---|
6185 | { |
---|
6186 | for ( ii = 1; ii <= nva; ii++ ) |
---|
6187 | { |
---|
6188 | LR[2][ii] = svar+"("+string(ii)+")"; |
---|
6189 | V[ii] = 1; |
---|
6190 | } |
---|
6191 | } |
---|
6192 | else |
---|
6193 | { |
---|
6194 | for ( ii = 1; ii <= nva; ii++ ) |
---|
6195 | { |
---|
6196 | LR[2][ii] = "Z("+string(100*nva+ii)+")"; |
---|
6197 | V[ii] = 1; |
---|
6198 | } |
---|
6199 | } |
---|
6200 | |
---|
6201 | if ( g3[n3][1]== "c" or g3[n3][1] == "C" ) |
---|
6202 | { |
---|
6203 | list gm = g3[n3]; //last blockis module ordering |
---|
6204 | newg3[1] = list("dp",V); |
---|
6205 | newg3 = insert(newg3,gm,size(newg3)); |
---|
6206 | } |
---|
6207 | else |
---|
6208 | { |
---|
6209 | list gm = g3[1]; //first block is module ordering |
---|
6210 | newg3[1] = list("dp",V); |
---|
6211 | newg3 = insert(newg3,gm); |
---|
6212 | } |
---|
6213 | LR[3] = newg3; |
---|
6214 | //LR;""; |
---|
6215 | def newR = ring(LR); |
---|
6216 | |
---|
6217 | setring newR; |
---|
6218 | ideal norid = fetch(R,norid); |
---|
6219 | ideal normap = fetch(R,normap); |
---|
6220 | if( defined(lnorid) ) { kill lnorid; } //um ** redefinig zu beheben |
---|
6221 | if( defined(snorid) ) { kill snorid; } //sollte nicht noetig sein |
---|
6222 | |
---|
6223 | //----------- go to quotient ring for checking injectivity ------------- |
---|
6224 | //"mstd"; |
---|
6225 | list lnorid = mstd(norid); |
---|
6226 | ideal snorid = lnorid[1]; |
---|
6227 | //"size mstdnorid:", size(snorid),size(lnorid[2]); |
---|
6228 | //"size string mstdnorid:", size(string(snorid)),size(string(lnorid[2])); |
---|
6229 | qring QR = snorid; |
---|
6230 | ideal qnormap = fetch(newR,normap); |
---|
6231 | //ideal qnormap = imap(newR,normap); |
---|
6232 | //ideal qnormap = imap(R,normap); |
---|
6233 | map Qnormap = QAS,qnormap; //r/id --> R/norid |
---|
6234 | |
---|
6235 | //------------------------ check injectivity --------------------------- |
---|
6236 | //"injective:"; |
---|
6237 | a = is_injective(Qnormap,QAS); //a. Test for injectivity of Qnormap |
---|
6238 | dbprint ( prl, "injective: "+string(a) ); |
---|
6239 | if ( n==1 ) { return (a); } |
---|
6240 | a; |
---|
6241 | |
---|
6242 | //------------------------ check finiteness --------------------------- |
---|
6243 | setring newR; |
---|
6244 | b = mapIsFinite(normap,BAS,lnorid[2]); //b. Test for finiteness of normap |
---|
6245 | dbprint ( prl, "finite: "+string(b) ); |
---|
6246 | if ( n==2 ) { return (intvec(a,b)); } |
---|
6247 | b; |
---|
6248 | |
---|
6249 | //------------------------ check normality --------------------------- |
---|
6250 | list testnor = normal(lnorid[2],"isPrim","noFac", "withDelta"); |
---|
6251 | //### Problem: bei mehrfachem Aufruf von norTest gibt es |
---|
6252 | // ** redefining norid & ** redefining normap |
---|
6253 | //Dies produziert Fehler, da alte norid und normap ueberschrieben werden |
---|
6254 | //norid und normap werden innnerhalb von proc computeRing ueberschrieben |
---|
6255 | //Die Kopie newR scheint das Problem zu loesen |
---|
6256 | |
---|
6257 | printlevel=prl; |
---|
6258 | |
---|
6259 | d = testnor[3][2]; //d = delta |
---|
6260 | kill testnor; //### sollte ueberfluessig sein |
---|
6261 | int d1 = (d==0); //d1=1 if delta=0 |
---|
6262 | dbprint ( prl, "delta: "+string(d) ); |
---|
6263 | return(intvec(a,b,d1)); |
---|
6264 | } |
---|
6265 | example |
---|
6266 | { "EXAMPLE:"; echo = 2; |
---|
6267 | int prl = printlevel; |
---|
6268 | printlevel = -1; |
---|
6269 | ring r = 0,(x,y),dp; |
---|
6270 | ideal i = (x-y^2)^2 - y*x^3; |
---|
6271 | list nor = normal(i); |
---|
6272 | norTest(i,nor); //1,1,1 means that normal was correct |
---|
6273 | |
---|
6274 | nor = normalC(i); |
---|
6275 | norTest(i,nor); //1,1,1 means that normal was correct |
---|
6276 | |
---|
6277 | ring s = 2,(x,y),dp; |
---|
6278 | ideal i = (x-y^2)^2 - y*x^3; |
---|
6279 | nor = normalP(i,"withRing"); |
---|
6280 | norTest(i,nor); //1,1,1 means that normalP was correct |
---|
6281 | printlevel = prl; |
---|
6282 | } |
---|
6283 | |
---|
6284 | /////////////////////////////////////////////////////////////////////////// |
---|
6285 | // |
---|
6286 | // EXAMPLES |
---|
6287 | // |
---|
6288 | /////////////////////////////////////////////////////////////////////////// |
---|
6289 | /* |
---|
6290 | //commands for computing the normalization: |
---|
6291 | // options for normal: "equidim", "prim" |
---|
6292 | // "noDeco", "isPrim", "noFac" |
---|
6293 | // (prim by default) |
---|
6294 | // options for normalP: "withRing", "isPrim" or "noFac" |
---|
6295 | // options for normalC: "equidim", "prim", "withGens", |
---|
6296 | // "noDeco", "isPrim", "noFac" |
---|
6297 | |
---|
6298 | //Commands for testing 'normal' |
---|
6299 | list nor = normal(i); nor; |
---|
6300 | list nor = normal(i,"isPrim");nor; |
---|
6301 | list nor = normal(i,"equidim");nor; |
---|
6302 | list nor = normal(i,"prim");nor; |
---|
6303 | list nor = normal(i,"equidim","noFac");nor; |
---|
6304 | list nor = normal(i,"prim","noFac");nor; |
---|
6305 | |
---|
6306 | //Commands for testing 'normalP' in positive char |
---|
6307 | list nor = normalP(i);nor; //withGens but no ringstructure |
---|
6308 | list nor = normalP(i,"withRing"); nor; //compute the ringstructure |
---|
6309 | list nor = normalP(i,"isPrim"); nor; //if i is known to be prime |
---|
6310 | |
---|
6311 | //Commands for testing 'normalC' |
---|
6312 | list nor = normal(i); nor; |
---|
6313 | list nor = normal(i,"withGens");nor; |
---|
6314 | list nor = normal(i,"isPrim");nor; |
---|
6315 | list nor = normal(i,"equidim");nor; |
---|
6316 | list nor = normal(i,"prim");nor; |
---|
6317 | list nor = normal(i,"equidim","noFac");nor; |
---|
6318 | list nor = normal(i,"prim","noFac");nor; |
---|
6319 | |
---|
6320 | //Commands for testing correctness (i must be prime): |
---|
6321 | list nor = normalP(i,"withRing","isPrim"); |
---|
6322 | list nor = normal(i,"isPrim"); |
---|
6323 | norTest(i,nor); //full test for not too big examples (1,1,1 => ok) |
---|
6324 | norTest(i,nor,2); //partial test for big examples (1,1 => ok) |
---|
6325 | factorize(i[1]); //checks for irreducibility |
---|
6326 | |
---|
6327 | ///////////////////////////////////////////////////////////////////////////// |
---|
6328 | |
---|
6329 | //----------------------Examples for normal (new algorithm)------------------ |
---|
6330 | // Timings with Computeserver Dual AMD Opteron 242 1.60GHz. |
---|
6331 | // Examples from "Normalization of Rings" paper. |
---|
6332 | |
---|
6333 | // Example 1 |
---|
6334 | // char 0 : normal = 0 secs (7 steps) - normalC = 75 secs |
---|
6335 | // char 2 : normal = 0 secs (7 steps) - normalP = 0 secs - normalC = 0 secs |
---|
6336 | // char 5 : normal = 1 secs (7 steps) - normalP = 71 - normalC = 1 secs |
---|
6337 | // char 11 : normal = 2 secs (7 steps) - normalP = 12 secs - normalC doesn't finish |
---|
6338 | // char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 1 sec |
---|
6339 | LIB"normal.lib"; |
---|
6340 | ring r = 2, (x, y), dp; |
---|
6341 | ideal i = (x-y)*x*(y+x^2)^3-y^3*(x^3+x*y-y^2); |
---|
6342 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
6343 | |
---|
6344 | // Example 2 |
---|
6345 | // char 0 : normal = 1 sec (7 steps) - normalC doesn't finish |
---|
6346 | // char 3 : normal = 1 secs (8 steps) - normalP = 0 secs - normalC = 4 secs |
---|
6347 | // char 13 : normal = 1 sec (7 steps) - normalP doesn't finish - normalC = 13 secs |
---|
6348 | // char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 10 sec |
---|
6349 | //Example is reducible in char 5 and 7 |
---|
6350 | LIB"normal.lib"; |
---|
6351 | ring r = 3, (x, y), dp; |
---|
6352 | ideal i = 55*x^8+66*y^2*x^9+837*x^2*y^6-75*y^4*x^2-70*y^6-97*y^7*x^2; |
---|
6353 | timeNormal(i, "normal", "normalC", "normalP", "p", "isPrim"); |
---|
6354 | |
---|
6355 | // Example 3 |
---|
6356 | // char 0 : normal = 3 secs (6 steps) - normalC doesn't finish |
---|
6357 | // char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
6358 | // char 5 : normal = 0 secs (6 steps) - normalP = 8 secs - normalC doesn't finish |
---|
6359 | LIB"normal.lib"; |
---|
6360 | ring r=5,(x, y),dp; |
---|
6361 | ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9; |
---|
6362 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
6363 | |
---|
6364 | // Example 4 |
---|
6365 | // char 0 : normal = 0 secs (1 step) - normalC = 0 secs |
---|
6366 | // char 5 : normal = 0 secs (1 step) - normalP = 3 secs - normalC = 0 secs |
---|
6367 | // char 11 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
6368 | // char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
6369 | LIB"normal.lib"; |
---|
6370 | ring r=5,(x,y),dp; // genus 0 4 nodes and 6 cusps im P2 |
---|
6371 | ideal i=(x2+y^2-1)^3 +27x2y2; |
---|
6372 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
6373 | |
---|
6374 | // Example 5 |
---|
6375 | // char 0 : normal = 0 secs (1 step) - normalC = 0 secs |
---|
6376 | // char 5 : normal = 1 secs (3 step) - normalP doesn't finish - normalC doesn't finish |
---|
6377 | // char 11 : normal = 0 secs (1 step) - normalP 0 secs - normalC = 0 secs |
---|
6378 | // char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
6379 | LIB"normal.lib"; |
---|
6380 | ring r=11,(x,y),dp; //24 sing, delta 24 |
---|
6381 | ideal i=-x10+x8y2-x6y4-x2y8+2y10-x8+2x6y2+x4y4-x2y6-y8+2x6-x4y2+x2y4+2x4+2x2y2-y4-x2+y2-1; |
---|
6382 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
6383 | |
---|
6384 | // Example 6 |
---|
6385 | // char 2 : normal = 5 secs (2 steps) - normalP = 25 secs - normalC = 166 secs |
---|
6386 | LIB"normal.lib"; |
---|
6387 | ring r=2,(v,u,z,y,x),dp; |
---|
6388 | ideal i = z3+zyx+y3x2+y2x3, uyx+z2,uz+z+y2x+yx2, u2+u+zy+zx, v3+vux+vz2+vzyx+vzx+uz3+uz2y+z3+z2yx2; |
---|
6389 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
6390 | |
---|
6391 | // Example 7 |
---|
6392 | // char 0 : normal = 11 secs (6 steps) - normalC = 11 secs |
---|
6393 | // char 2 : normal = 11 secs (6 steps) - normalP = 0 secs - normalC = 11 secs |
---|
6394 | // char 5 : normal = 11 secs (6 steps) - normalP = 3 secs - normalC = 11 secs |
---|
6395 | // char 11 : normal = 11 secs (6 steps) - normalP = 43 secs - normalC = 11 secs |
---|
6396 | // char 32003 : normal = 11 secs (6 steps) - normalP doesn't finish - normalC = 11 secs |
---|
6397 | LIB"normal.lib"; |
---|
6398 | ring r=11,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
6399 | ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3; |
---|
6400 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
6401 | |
---|
6402 | //////////////////////////////////////////////////////////////////////////////// |
---|
6403 | |
---|
6404 | // Other examples with new algorithm |
---|
6405 | |
---|
6406 | // Example 1 |
---|
6407 | // char 0 : normal = 1 secs (13 steps) - normalC doesn't finish |
---|
6408 | // char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
6409 | // char 5 : normal = 1 secs (13 steps) - normalP = 29 secs - normalC doesn't finish |
---|
6410 | ring r=2,(x,y),dp; //genus 35 |
---|
6411 | ideal i=y30+y13x+x4y5+x3*(x+1)^2; |
---|
6412 | timeNormal(i, "normal", "normalC", "normalP"); |
---|
6413 | |
---|
6414 | // Example 2 |
---|
6415 | // char 0 : normal = 1 secs (13 steps) - normalC doesn't finish |
---|
6416 | // char 3 : normal = 2 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
6417 | ring r=3,(x,y),dp; //genus 19, delta 21 |
---|
6418 | ideal i=y20+y13x+x4y5+x3*(x+1)^2; |
---|
6419 | timeNormal(i, "normal", "normalC", "normalP"); |
---|
6420 | |
---|
6421 | // Example 3 |
---|
6422 | // Very fast with all algorithms |
---|
6423 | ring r = 3, (x, y), dp; |
---|
6424 | ideal I = (x-y^2)^2-x*y^3; |
---|
6425 | timeNormal(I, "normal", "normalC", "normalP", "primCl", "111", "p", "pc"); |
---|
6426 | |
---|
6427 | |
---|
6428 | |
---|
6429 | //----------------------Test Example for charp ------------------- |
---|
6430 | //Zu tun: |
---|
6431 | //### nach minor nur std statt mstd verwenden |
---|
6432 | //***hat bei keinem Beisp etwas gebracht -> wieder zurueck |
---|
6433 | //### wenn interred ok, dann wieder einsetzen (am Schluss) |
---|
6434 | //### bottelnecks bei maps beheben |
---|
6435 | //### minor verbessern |
---|
6436 | //### preimage verbessern (Ist imm Kern map oder imap verwendet?) |
---|
6437 | //### Gleich in Ordnung dp wechseln, ringlist verwenden |
---|
6438 | //### interred ev nur zum Schluss |
---|
6439 | // (z.B. wenn nacher std; wenn nacher minor: testen ) |
---|
6440 | |
---|
6441 | //Zeiten mit normalV5.lib (mstd aktiv, interred inaktiv) |
---|
6442 | |
---|
6443 | //SWANSON EXAMPLES: (Macaulay2, icFracP=normalP, icFractions<->normal) |
---|
6444 | //--------------------------------------------------------------------- |
---|
6445 | //1. Series Fp[x,y,u,v]/(x2v-y2u) |
---|
6446 | //------------------------------- |
---|
6447 | //characteristic p 2 3 5 7 11 13 17 37 97 |
---|
6448 | //icFracP 0.04 0.03 0.04 0.04 0.04 0.05 0.05 0.13 0.59 Mac |
---|
6449 | //normalP 0 0 0 0 0 0 0 0 1 Sing |
---|
6450 | //icFractions 0.08 0.09 0.09 0.09 0.14 0.15 0.15 0.15 0.15 Mac |
---|
6451 | //normal 0 0 0 0 0 0 0 0 0 Sing |
---|
6452 | |
---|
6453 | 2. Series Fp[u, v, w, x, y, z]/u2x4+uvy4+v2z4 |
---|
6454 | //-------------------------------------------- |
---|
6455 | //characteristic p 2 3 5 7 11 |
---|
6456 | //icFracP 0.07 0.22 9.67 143 12543 |
---|
6457 | //normalP 0 0 5 42 1566 |
---|
6458 | //icFractions 1.16 * * * * *: > 6h |
---|
6459 | //normal 0 0 0 0 0 |
---|
6460 | |
---|
6461 | //3. Series Fp[u, v, w, x, y, z]/(u2xp+uvyp+v2zp) |
---|
6462 | //----------------------------------------------- |
---|
6463 | //characteristic p 2 3 5 7 11 13 17 19 23 |
---|
6464 | //icFracP 0.06 0.07 0.09 0.27 1.81 4.89 26 56 225 |
---|
6465 | //normalP 0 0 0 0 1 2 6 10 27 |
---|
6466 | //icFractions 0.16 1.49 75.00 4009 * * * * * |
---|
6467 | //normal 0 0 2 836 |
---|
6468 | //normal(neu) 0 0 1 2 10 155 |
---|
6469 | //### p=7 normal braucht 807 sec in: |
---|
6470 | // ideal endid = phi1(endid); //### bottelneck' |
---|
6471 | |
---|
6472 | //1. |
---|
6473 | int p = 2; ring r = p,(u,v,x,y,z),dp; ideal i = x2v-y2u; |
---|
6474 | //2. |
---|
6475 | int p = 7; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2x4+uvy4+v2z4; |
---|
6476 | //3. |
---|
6477 | int p=11; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2*x^p+uv*y^p+v2*z^p; |
---|
6478 | |
---|
6479 | //IRREDUCIBLE EXAMPLES: |
---|
6480 | //--------------------- |
---|
6481 | //timing for MacBookPro 2.2GHz Intel Core 2 Duo, 4GB Ram |
---|
6482 | //Sing. ix86Mac-darwin version 3-1-0 (3100-2008101314) Oct 13 2008 14:46:59 |
---|
6483 | //if no time is given: < 1 sec |
---|
6484 | |
---|
6485 | //Apply: |
---|
6486 | list nor = normal(i,"isPrim"); nor; |
---|
6487 | list nor = normalP(i,"withRing","isPrim"); nor; |
---|
6488 | def R=nor[1][1]; setring R; norid; normap; |
---|
6489 | setring r; |
---|
6490 | norTest(i,nor); |
---|
6491 | |
---|
6492 | int tt = timer; |
---|
6493 | list nor = normalP(i,"withRing","isPrim"); nor; |
---|
6494 | timer-tt; |
---|
6495 | int tt = timer; |
---|
6496 | list nor = normal(i,"isPrim"); |
---|
6497 | timer-tt; |
---|
6498 | |
---|
6499 | ring r=19,(x,y,u,v),dp; //delta -1 |
---|
6500 | ideal i=x2v-y2u; |
---|
6501 | //norTest 2 sec |
---|
6502 | |
---|
6503 | ring r=2,(y,x2,x1),lp; //delta -1 |
---|
6504 | ideal i=y^4+y^2*x2*x1+x2^3*x1^2+x2^2*x1^3; |
---|
6505 | //### norid hat 1 Element nach interred |
---|
6506 | |
---|
6507 | ring r = 11,(x,y,z),wp(2,1,2); //alles < 1 sec |
---|
6508 | ideal i=z3 - xy4 + x2; //not reduced, delta =0 ok |
---|
6509 | ideal i=y4+x5+y2x; //not reduced, delta -1 |
---|
6510 | //interred verkleinert norid |
---|
6511 | |
---|
6512 | ring r=3,(u,v,x,y,z),dp; //delta -1 |
---|
6513 | ideal i=u2x3+uvy3+v2z3; |
---|
6514 | |
---|
6515 | ring r=3,(u,v,x,y,z),dp; //delta -1 |
---|
6516 | ideal i=u2x4+uvy4+v2z4; |
---|
6517 | //norTest(i,nor); 0 sec, norTest(i,nor) haengt! |
---|
6518 | |
---|
6519 | ring r=5,(u,v,x,y,z),dp; //delta -1 |
---|
6520 | ideal i=u2x6+uvy6+v2z6; |
---|
6521 | //normalP 5sec, normalC 1sec |
---|
6522 | //V5: norTest(i,nor); 45 sec bei normalP, V6 12 sec |
---|
6523 | //28 sec bei normal |
---|
6524 | |
---|
6525 | ring r=5,(u,v,x,y,z),dp; //delta -1 |
---|
6526 | ideal i=u2x5+uvy5+v2z5; |
---|
6527 | //normalP 1sec, normalC 1 sec, |
---|
6528 | //norTest lange: minor(jacob(I),h,J) 193 (308)sec, haengt dann bei M = std(M); |
---|
6529 | //norTest(i,nor,2); verwenden! |
---|
6530 | //Sing 3.0-4 orig >9h! hngt bei Q = mstd(Q)[2]; |
---|
6531 | |
---|
6532 | ring r=2,(y,x),wp(12,5); //delta 3 |
---|
6533 | ideal i=y5+y2x4+y2x+yx2+x12; |
---|
6534 | //normalP 0 sec (Test 0 sec), normalC 2 sec (Test 2 sec) |
---|
6535 | //normalC withGens (ohne interred) 0sec |
---|
6536 | |
---|
6537 | ring r=2,(y,x),dp; //delta= 22 |
---|
6538 | ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9; |
---|
6539 | //normalP 1sec, interred verkleinert norid betraechtlich |
---|
6540 | //normalC haengt bei minor, ideal im loop wird zu gross ### |
---|
6541 | //interred bei normalC vergroeesert string um Faktor 4000! |
---|
6542 | //withGens haengt bei interred in loop 4 (> 10 h) oder |
---|
6543 | //(nach Ausschalten von interred) bei |
---|
6544 | //int delt=vdim(std(modulo(f,ideal(p)))); (>?h) |
---|
6545 | |
---|
6546 | //Leonard1: (1. Komponente von Leonard), delta -1 |
---|
6547 | ring r=2,(v,u,z,y,x),dp; |
---|
6548 | ideal i = z3+zyx+y3x2+y2x3, uyx+z2,uz+z+y2x+yx2, u2+u+zy+zx, |
---|
6549 | v3+vux+vz2+vzyx+vzx+uz3+uz2y+z3+z2yx2; |
---|
6550 | //normalP 5 sec (withRing 9 sec), norTest(i,nor,2); 45 sec |
---|
6551 | //normalC 102sec, 99sec |
---|
6552 | //### Zeit wird bei ideal Ann = quotient(SM[2],SL[1]); und bei |
---|
6553 | // f = quotient(p*J,J); verbraucht |
---|
6554 | //withGens (ohne interred) 131sec, norTest(i,nor,2); 2min25sec |
---|
6555 | //norTest(i,nor,2); 45 sec |
---|
6556 | |
---|
6557 | ring r=2,(y,x),wp(25,21); //Leonard2, delta 232 |
---|
6558 | ring r=2,(y,x),dp; |
---|
6559 | ideal i= |
---|
6560 | y^21+y^20*x +y^18*(x^3+x+1) +y^17*(x^3+1) +y^16*(x^4+x) |
---|
6561 | +y^15*(x^7+x^6+x^3+x+1) +y^14*x^7 +y^13*(x^8+x^7+x^6+x^4+x^3+1) |
---|
6562 | +y^12*(x^9+x^8+x^4+1) +y^11*(x^11+x^9+x^8+x^5+x^4+x^3+x^2) |
---|
6563 | +y^10*(x^12+x^9+x^8+x^7+x^5+x^3+x+1) |
---|
6564 | +y^9*(x^14+x^13+x^10+x^9+x^8+x^7+x^6+x^3+x^2+1) |
---|
6565 | +y^8*(x^13+x^9+x^8+x^6+x^4+x^3+x) +y^7*(x^16+x^15+x^13+x^12+x^11+x^7+x^3+x) |
---|
6566 | +y^6*(x^17+x^16+x^13+x^9+x^8+x) +y^5*(x^17+x^16+x^12+x^7+x^5+x^2+x+1) |
---|
6567 | +y^4*(x^19+x^16+x^15+x^12+x^6+x^5+x^3+1) |
---|
6568 | +y^3*(x^18+x^15+x^12+x^10+x^9+x^7+x^4+x) |
---|
6569 | +y^2*(x^22+x^21+x^20+x^18+x^13+x^12+x^9+x^8+x^7+x^5+x^4+x^3) |
---|
6570 | +y*(x^23+x^22+x^20+x^17+x^15+x^14+x^12+x^9) |
---|
6571 | +(x^25+x^23+x^19+x^17+x^15+x^13+x^11+x^5); |
---|
6572 | //normalP: dp 2sec withRing 8sec, |
---|
6573 | //wp 4sec, withRing:51sec Zeit in lin = subst(lin, var(ii), vip); in elimpart ), |
---|
6574 | //norTest(i,nor,2): haengt bei mstd(norid); |
---|
6575 | //### normalC: (m. interred): haengt bei endid = interred(endid); |
---|
6576 | //GEFIXTES INTERRED ABWARTEN. Dann interred aktivieren |
---|
6577 | //interred(norid) haengt u. mst(norid) zu lange |
---|
6578 | //(o.interred): haengt bei haengt bei list SM = mstd(i); |
---|
6579 | //ideal in der Mitte zu gross |
---|
6580 | //i = Ideal (size 118, 13 var) fuer die neue Normalisierung |
---|
6581 | //normal(neu) haengt bei return(std(i)) (offensichtlich in eineranderen lib) |
---|
6582 | |
---|
6583 | REDUCIBLE EXAMPLES: |
---|
6584 | ------------------ |
---|
6585 | //Apply: |
---|
6586 | int tt = timer; |
---|
6587 | list nor=normalP(i,"isPrim","withRing"); |
---|
6588 | timer-tt; |
---|
6589 | |
---|
6590 | list nor = normal(i); nor; |
---|
6591 | list nor = normalC(i); nor; |
---|
6592 | list nor = normalC(i, "withGens"); nor; |
---|
6593 | list nor = normalP(i,"withRing"); nor; |
---|
6594 | list nor = normalP(i); nor; |
---|
6595 | def R=nor[1][1]; setring R; norid; normap; |
---|
6596 | |
---|
6597 | //Leonhard 4 Komponenten, dim=2, delta: 0,0,0,-1 |
---|
6598 | ring r=2,(v,u,z,y,x),dp; //lp zu lange |
---|
6599 | ideal i=z3+zyx+y3x2+y2x3, uyx+z2, v3+vuyx+vux+vzyx+vzx+uy3x2+uy2x+zy3x+zy2x2; |
---|
6600 | //normalP: 19 sec, withRing: 22 sec |
---|
6601 | //normalC ohne (mit) interred: 112 (113)sec, equidim: 99sec |
---|
6602 | //normalC 1. mal 111 sec, (2.mal) 450sec!! 3.mal 172 sec |
---|
6603 | //(unterschiedlich lange primdec, mit Auswirkungen) |
---|
6604 | //char 19: normalC: 15sec , withGens: 14sec (o.interr.) |
---|
6605 | |
---|
6606 | //----------------------Test Example for special cases ------------------- |
---|
6607 | int tt = timer; |
---|
6608 | list nor=normalP(i,"withRing");nor; |
---|
6609 | //list nor=normalP(i,"withRing", "isPrim");nor; |
---|
6610 | timer-tt; |
---|
6611 | def R1 = nor[1][1]; setring R1; norid; normap; interred(norid); |
---|
6612 | setring r; |
---|
6613 | |
---|
6614 | int tt = timer; |
---|
6615 | list nor=normal(i,"isPrim");nor; |
---|
6616 | timer-tt; |
---|
6617 | |
---|
6618 | ring r = 29,(x,y,z),dp; |
---|
6619 | ideal i = x2y2,x2z2; //Nicht equidimensional, equidim reduziert nicht, ok |
---|
6620 | ideal i = xyz*(z3-xy4); //### interred(norid) verkuerzt |
---|
6621 | //je 0 sec |
---|
6622 | |
---|
6623 | ideal j = x,y; |
---|
6624 | ideal i = j*xy; |
---|
6625 | equidim(i); |
---|
6626 | //hat eingebettete Komponente, equidim rechnet wie in Beschreibung (ok) |
---|
6627 | |
---|
6628 | ring r = 19,(x,y),dp; |
---|
6629 | ideal i = x3-y4; //delta = 3 |
---|
6630 | ideal i = y*x*(x3-y4); //delta = 11; 0,0,3 |
---|
6631 | ideal i = (x2-y3)*(x3-y4); //delta = 13; 1,3 |
---|
6632 | ideal i = (x-y)*(x3+y2)*(x3-y4); //delta = 23; 0,1,3 |
---|
6633 | ideal i = (x-1)*(x3+y2)*(x2-y3); //delta = 16; 0,1,1 |
---|
6634 | ideal i = (x-y^2)^2 - y*x^3; //delta = 3 |
---|
6635 | //singularities at not only at 0, hier rechnet equidim falsch |
---|
6636 | |
---|
6637 | // -------------------------- General Examples ---------------------------//Huneke, irred., delta=2 (Version 3-0-4: < 1sec) |
---|
6638 | //Version 3-0-6 default: 1sec, mit gens 2sec, mit delta 5 sec |
---|
6639 | //(prim,noFac):ca 7 Min, prim:ca 10 min(wg facstd) |
---|
6640 | // |
---|
6641 | // "equidim" < 1sec irred. 5sec |
---|
6642 | // ring r=31991,(a,b,c,d,e),dp; |
---|
6643 | ring r=2,(a,b,c,d,e),dp; //delta=2 |
---|
6644 | ideal i= |
---|
6645 | 5abcde-a5-b5-c5-d5-e5, |
---|
6646 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
6647 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
6648 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
6649 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
6650 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
6651 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
6652 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
6653 | //normalC: char 2, 31991: 0 sec (isPrim); char 2, equidim: 7 sec |
---|
6654 | //norTest(i,nor,2); 1sec |
---|
6655 | //normalP char 2: 1sec (isPrim) |
---|
6656 | //size(norid); size(string(norid));21 1219 interred(norid): 21 1245 (0 sec) |
---|
6657 | |
---|
6658 | int tt = timer; |
---|
6659 | list nor=normalC(i);nor; |
---|
6660 | timer-tt; |
---|
6661 | |
---|
6662 | list nor = normalP(i,"isPrim"); |
---|
6663 | |
---|
6664 | //Vasconcelos irred., delta -1 (dauert laenger) |
---|
6665 | //auf macbook pro = 20 sec mit alter Version, |
---|
6666 | //Sing 3-0-6: |
---|
6667 | // Char 32003: "equidim" 30 sec, "noFac": 30sec |
---|
6668 | //gens: nach 9 min abgebr (haengt in Lin = ideal(T*syzf);) !!!! Hans zu tun |
---|
6669 | //Char 2: default (charp) 2 sec, normalC ca 30 sec |
---|
6670 | //ring r=32003,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
6671 | ring r=2,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
6672 | ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3; |
---|
6673 | //normalC: char 2: 22, sec (mit und ohne isPrim) |
---|
6674 | //normalP char 2: 0sec (isPrim) o. interred |
---|
6675 | //char 32003: ### haengt in ideal endid = phi1(endid); |
---|
6676 | |
---|
6677 | //------------------------------------------------------- |
---|
6678 | //kleine Beispiele: |
---|
6679 | |
---|
6680 | //Theo1, irred, delta=-1 |
---|
6681 | //normalC: 1sec, normalP: 3 sec |
---|
6682 | ring r=32003,(x,y,z),wp(2,3,6); //dim 2,dim slocus 1 |
---|
6683 | ideal i=zy2-zx3-x6; |
---|
6684 | //normalC: char 2,19,32003: 0 sec (isPrim) |
---|
6685 | //normalP (isPrim) char 2,19: 0sec, char 29: 1sec |
---|
6686 | |
---|
6687 | //Theo1a, CohenMacaulay regular in codim 2, dim slocus=1, delta=0 |
---|
6688 | //normalC: 0 sec, normalP: haegt in K=preimage(R,phi,L); |
---|
6689 | ring r=32003,(x,y,z,u),dp; |
---|
6690 | ideal i=zy2-zx3-x6+u2; |
---|
6691 | //normalC: char 2,32003: 0 sec (isPrim) |
---|
6692 | //normalP (isPrim) char 2: 0sec, char 19: haengt in K = preimage(Q,phi,L); |
---|
6693 | |
---|
6694 | //Theo2, irreduzibel, reduziert, < 1sec, delta -1 |
---|
6695 | ring r=0,(x,y,z),wp(3,4,12); |
---|
6696 | ideal i=z*(y3-x4)+x8; |
---|
6697 | //normalC: char 2,32003,0: 0 sec (isPrim) |
---|
6698 | //normalP (isPrim) char 2: 0 1sec, char 19: 1sec char 29: 7 sec |
---|
6699 | |
---|
6700 | //Theo2a, reduiziert, 2-dim, dim_slocus=1, alte Version 3 sec, |
---|
6701 | //normalP ca 30 sec, normalC ca 4sec, delta -1 |
---|
6702 | //ring r=32003,(T(1..4)),wp(3,4,12,17); |
---|
6703 | //ring r=11,(T(1..4)),dp; |
---|
6704 | ring r=11,(T(1..4)),wp(3,4,12,17); |
---|
6705 | ideal i= |
---|
6706 | T(1)^8-T(1)^4*T(3)+T(2)^3*T(3), |
---|
6707 | T(1)^4*T(2)^2-T(2)^2*T(3)+T(1)*T(4), |
---|
6708 | T(1)^7+T(1)^3*T(2)^3-T(1)^3*T(3)+T(2)*T(4), |
---|
6709 | 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; |
---|
6710 | //normalC: char 2,32003: 0 sec (isPrim) |
---|
6711 | //normalP (isPrim) char 2: 0sec, char 11 2se, char 19: 13sec |
---|
6712 | //norTest 48sec in char11 |
---|
6713 | //### interred verkuerzt |
---|
6714 | //char 29: haengt in K = preimage(Q,phi,L); |
---|
6715 | |
---|
6716 | //Theo3, irred, 2-dim, 1-dim sing, < 1sec |
---|
6717 | ring r=11,(x,y,z),wp(3,5,15); |
---|
6718 | ideal i=z*(y3-x5)+x10; |
---|
6719 | //normalC: char 2,0: 0 sec (withRing) |
---|
6720 | //normalP (withRing) char 2,11: 0sec, char 19: 13sec norTest 12sec(char 11) |
---|
6721 | |
---|
6722 | //Theo4 reducible, delta (0,0,0) -1 |
---|
6723 | ring r=29,(x,y,z),dp; |
---|
6724 | ideal i=(x-y)*(x-z)*(y-z); |
---|
6725 | //normalC: char 2,32003: 0 sec |
---|
6726 | //normalP char withRing 2, 29: 0sec, 6sec |
---|
6727 | |
---|
6728 | //Theo6 |
---|
6729 | ring r=32003,(x,y,z),dp; |
---|
6730 | ideal i=x2y2+x2z2+y2z2; |
---|
6731 | //normalC: char 2,32003: 0 sec |
---|
6732 | //normalP char withRing 2, 29: 0sec, 4sec |
---|
6733 | |
---|
6734 | //Sturmfels, CM, 15 componenten, alle glatt |
---|
6735 | ring r=0,(b,s,t,u,v,w,x,y,z),dp; |
---|
6736 | ideal i= bv+su, bw+tu, sw+tv, by+sx, bz+tx, sz+ty,uy+vx,uz+wx,vz+wy,bvz; |
---|
6737 | //normalC car 11, 0: 1sec, normalP 0 sec |
---|
6738 | |
---|
6739 | //riemenschneider, , dim 3, 5 Komp. delta (0,0,0,0,0), -1 |
---|
6740 | ring r=2,(p,q,s,t,u,v,w,x,y,z),wp(1,1,1,1,1,1,2,1,1,1); |
---|
6741 | ideal i=xz,vx,ux,su,qu,txy,stx,qtx,uv2z-uwz,uv3-uvw,puv2-puw; |
---|
6742 | //alles 0 sec in char 2 |
---|
6743 | |
---|
6744 | //4 Komponenten, alle glatt, 0sec |
---|
6745 | ring r=11,(x,y,z,t),dp; |
---|
6746 | ideal i=x2z+xzt,xyz,xy2-xyt,x2y+xyt; |
---|
6747 | |
---|
6748 | //dim 3, 2 Komponenten delta (-1,0), -1 |
---|
6749 | ring r=2,(u,v,w,x,y,z),wp(1,1,1,3,2,1); |
---|
6750 | ideal i=wx,wy,wz,vx,vy,vz,ux,uy,uz,y3-x2; |
---|
6751 | //alles 0 sec in char 2 |
---|
6752 | //--------------------------------------------------------- |
---|
6753 | int tt = timer; |
---|
6754 | list nor=normalP(i,"normalC","withRing");nor; |
---|
6755 | timer-tt; |
---|
6756 | |
---|
6757 | //St_S/Y, 3 Komponenten, 2 glatt, 1 normal |
---|
6758 | //charp haengt (in char 20) in K=preimage(R,phi,L); |
---|
6759 | //ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
6760 | ring r=11,(b,s,t,u,v,w,x,y,z),dp; |
---|
6761 | ideal i=wy-vz,vx-uy,tv-sw,su-bv,tuy-bvz; |
---|
6762 | //normalC: char 2,32003: 0 sec |
---|
6763 | //normalP char withRing 2: 1sec, char 11: 40sec |
---|
6764 | |
---|
6765 | //Horrocks: cahr 0: 17 (8 in char 11) Komponenten alle normal, delta 1 |
---|
6766 | //char 11: 8 Komponenten alle normal, delta -1 |
---|
6767 | ring r=0,(a,b,c,d,e,f),dp; |
---|
6768 | //ring r=11,(a,b,c,d,e,f),dp; //Charp bis p = 200 ca 3sec |
---|
6769 | ideal i= |
---|
6770 | adef-16000be2f+16001cef2, ad2f+8002bdef+8001cdf2, abdf-16000b2ef+16001bcf2, |
---|
6771 | a2df+8002abef+8001acf2, ad2e-8000bde2-7999cdef, acde-16000bce2+16001c2ef, |
---|
6772 | a2de-8000abe2-7999acef, acd2+8002bcde+8001c2df, abd2-8000b2de-7999bcdf, |
---|
6773 | a2d2+9603abde-10800b2e2-9601acdf+800bcef+11601c2f2, |
---|
6774 | abde-8000b2e2-acdf-16001bcef-8001c2f2, abcd-16000b2ce+16001bc2f, |
---|
6775 | a2cd+8002abce+8001ac2f, a2bd-8000ab2e-7999abcf, ab3f-3bdf3, |
---|
6776 | a2b2f-2adf3-16000bef3+16001cf4, a3bf+4aef3, ac3e-10668cde3, |
---|
6777 | a2c2e+10667ade3+16001be4+5334ce3f, a3ce+10669ae3f, bc3d+8001cd3e, |
---|
6778 | ac3d+8000bc3e+16001cd2e2+8001c4f, b2c2d+16001ad4+4000bd3e+12001cd3f, |
---|
6779 | b2c2e-10668bc3f-10667cd2ef, abc2e-cde2f, b3cd-8000bd3f, b3ce-10668b2c2f-10667bd2ef, abc2f-cdef2, a2bce-16000be3f+16001ce2f2, |
---|
6780 | ab3d-8000b4e-8001b3cf+16000bd2f2, ab2cf-bdef2, |
---|
6781 | a2bcf-16000be2f2+16001cef3, a4d-8000a3be+8001a3cf-2ae2f2; |
---|
6782 | //normalC: char 0: 1sec char 11: 0sec |
---|
6783 | //normalP: char 11: 0sec |
---|
6784 | |
---|
6785 | //2sec mit normalC, in char 2 ebenfalls (char 20 mit charp >1 min) |
---|
6786 | //4 Komp. in char 2, delta (0,0,0,0) -1, char 11:delta (-1,0,0,0) -1 |
---|
6787 | ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
6788 | ideal i= |
---|
6789 | wx2y3-vx2y2z+wx2yz2+wy3z2-vx2z3-vy2z3, |
---|
6790 | vx3y2-ux2y3+vx3z2-ux2yz2+vxy2z2-uy3z2, |
---|
6791 | tvx2y2-swx2y2+tvx2z2-swx2z2+tvy2z2-swy2z2, |
---|
6792 | sux2y2-bvx2y2+sux2z2-bvx2z2+suy2z2-bvy2z2, |
---|
6793 | tux2y3-bvx2y2z+tux2yz2+tuy3z2-bvx2z3-bvy2z3; |
---|
6794 | //normalC: char 2,32003: 1 sec |
---|
6795 | //normalP char withRing 2: 1sec, char 11: 40sec |
---|
6796 | |
---|
6797 | //--------------------------------------------------------- |
---|
6798 | //genus: |
---|
6799 | int tt = timer; |
---|
6800 | list nor=normal(i, "noFac");nor; |
---|
6801 | timer-tt; |
---|
6802 | |
---|
6803 | //Yoshihiko Sakai, irred, 0sec, delta = 8 |
---|
6804 | ring r=0,(x,y),dp; //genus 0 4 nodes and 6 cusps im P2 |
---|
6805 | //ring r=7,(x,y),dp; //charp haengt in K = preimage(Q,phi,L) |
---|
6806 | ideal i=(x2+y^2-1)^3 +27x2y2; |
---|
6807 | |
---|
6808 | ring r=0,(x,y),dp; //genus 0 |
---|
6809 | ideal i=(x-y^2)^2 - y*x^3; |
---|
6810 | |
---|
6811 | ring r=0,(x,y),dp; //genus 4 |
---|
6812 | ideal i=y3-x6+1; |
---|
6813 | |
---|
6814 | int m=9; // q=9: genus 0 |
---|
6815 | int p=2; |
---|
6816 | int q=9;//2,...,9 |
---|
6817 | ring r=0,(x,y),dp; |
---|
6818 | ideal i=y^m - x^p*(x - 1)^q; |
---|
6819 | |
---|
6820 | ring r=0,(x,y),dp; //genus 19 |
---|
6821 | ideal i=55*x^8+66*y^2*x^9+837*x^2*y^6-75*y^4*x^2-70*y^6-97*y^7*x^2; |
---|
6822 | |
---|
6823 | ring r=23,(x,y),dp; //genus 34, delta 2 |
---|
6824 | ideal i=y10+(-2494x2+474)*y8+(84366+2042158x4-660492)*y6 |
---|
6825 | +(128361096x4-47970216x2+6697080-761328152x6)*y4 |
---|
6826 | +(-12024807786x4-506101284x2+15052058268x6+202172841-3212x8)*y2 |
---|
6827 | +34263110700x4-228715574724x6+5431439286x2+201803238 |
---|
6828 | -9127158539954x10-3212722859346x8; |
---|
6829 | //normalC, normalP 0 sec |
---|
6830 | |
---|
6831 | //Rob Koelman |
---|
6832 | //ring r=0,(x,y,z),dp; //dim sing = 1 (nach ca 15 min abgebrochen) |
---|
6833 | ring r=32003,(x,y,z),dp; |
---|
6834 | ideal i= |
---|
6835 | 761328152*x^6*z^4-5431439286*x^2*y^8+2494*x^2*z^8+228715574724*x^6*y^4+ |
---|
6836 | 9127158539954*x^10-15052058268*x^6*y^2*z^2+3212722859346*x^8*y^2- |
---|
6837 | 134266087241*x^8*z^2-202172841*y^8*z^2-34263110700*x^4*y^6-6697080*y^6*z^4- |
---|
6838 | 2042158*x^4*z^6-201803238*y^10+12024807786*x^4*y^4*z^2-128361096*x^4*y^2*z^4+ |
---|
6839 | 506101284*x^2*z^2*y^6+47970216*x^2*z^4*y^4+660492*x^2*z^6*y^2- |
---|
6840 | z^10-474*z^8*y^2-84366*z^6*y^4; |
---|
6841 | //normalC char 32003: 10 sec, char 0 : |
---|
6842 | |
---|
6843 | //ring r=0,(x,y),dp;//genus 10 with 26 cusps (nach ca 4 min abgebrochen) |
---|
6844 | ring r=32003,(x,y),dp; //24 sing, delta 24 |
---|
6845 | ideal i=9127158539954x10+3212722859346x8y2+228715574724x6y4-34263110700x4y6 |
---|
6846 | -5431439286x2y8-201803238y10-134266087241x8-15052058268x6y2+12024807786x4y4 |
---|
6847 | +506101284x2y6-202172841y8+761328152x6-128361096x4y2+47970216x2y4-6697080y6 |
---|
6848 | -2042158x4+660492x2y2-84366y4+2494x2-474y2-1; |
---|
6849 | //normalC 32003: 4 sec, char 0: abgebrochen bei pr = facstd(i); ### |
---|
6850 | |
---|
6851 | ring r=0,(x,y),dp; //irred, genus 1 with 5 cusps, delta 5 |
---|
6852 | ideal i=57y5+516x4y-320x4+66y4-340x2y3+73y3+128x2-84x2y2-96x2y; |
---|
6853 | //normalC 0 sec |
---|
6854 | |
---|
6855 | ring r=2,(x,y),dp; //genus 4, 2 Zweige, delta (13,9) 89 |
---|
6856 | ideal i=((x2+y3)^2+xy6)*((x3+y2)^2+x10y); |
---|
6857 | //normalC: char 2 : 1sec, char 0: lange |
---|
6858 | //normalP char 2 withRing: 0sec |
---|
6859 | |
---|
6860 | ring r=2,(y,z,w,u),dp; //2 Komp. genus -5 |
---|
6861 | ideal i=y2+z2+w2+u2,w4-u4; |
---|
6862 | //normalC: char 2 : 0sec, char 0: 1sec |
---|
6863 | //normalP char 2 withRing: 0sec |
---|
6864 | |
---|
6865 | ring r=0,(y,z,w,u),dp; //irred. genus 9 |
---|
6866 | ideal i=y2+z2+w2+u2,z4+w4+u4; |
---|
6867 | //char 0: 0sec |
---|
6868 | |
---|
6869 | ring r=0,(x,y,t),dp; //irred, delta -1 |
---|
6870 | ideal i= 25x8+200x7y+720x6y2+1520x5y3+2064x4y4+1856x3y5+1088x2y6+384xy7+64y8-12x6t2-72x5yt2-184x4y2t2-256x3y3t2-192x2y4t2-64xy5t2-2x4t4-8x3yt4+16xy3t4+16y4t4+4x2t6+8xyt6+8y2t6+t8; |
---|
6871 | //char 0: 0sec |
---|
6872 | |
---|
6873 | ring r=0,(x,y,z,w,u),dp; |
---|
6874 | ideal i=x2+y2+z2+w2+u2,x3+y3+z3,z4+w4+u4; |
---|
6875 | //char 0: 0sec |
---|
6876 | |
---|
6877 | //--------------------------------------------------------- |
---|
6878 | //Probleme mit normalC in char 2 und char 0 |
---|
6879 | |
---|
6880 | int tt = timer; |
---|
6881 | list nor=normalC(i,"withRing");nor; |
---|
6882 | timer-tt; |
---|
6883 | |
---|
6884 | //Mark van Hoeij |
---|
6885 | ring r=3,(x,y),dp; //genus 19, delta 21 |
---|
6886 | ideal i=y20+y13x+x4y5+x3*(x+1)^2; |
---|
6887 | //normalC: char 2 > 10 min bei list SM = mstd(i);### |
---|
6888 | //normalP char 2 withRing: 0sec, char 11: haengt bei K = preimage(Q,phi,L); |
---|
6889 | |
---|
6890 | ring r=2,(x,y),dp; //genus 35 |
---|
6891 | ideal i=y30+y13x+x4y5+x3*(x+1)^2; |
---|
6892 | //char 0 abgebrochen bei list SM = mstd(i); ### |
---|
6893 | //char 2 nach ca 30 min |
---|
6894 | //normalC: char 2: abgebr. bei list SM = mstd(i); //Now the work starts' |
---|
6895 | //normalC, withGens, char 2: abgebrochen bei Q=mstd(Q)[2]; |
---|
6896 | //normalP char 2 withRing: 0sec |
---|
6897 | |
---|
6898 | ring r=0,(x,y),dp; //irred, genus 55, delta 21 |
---|
6899 | ideal i=y40+y13x+x4y5+x3*(x+1)^2; |
---|
6900 | //normalC: char 2 lange |
---|
6901 | //normalP char 2 withRing: 0sec |
---|
6902 | |
---|
6903 | ring r=29,(x,y,t),dp; //char 0: genus -5, 4 Komp, delta (-1,-1,0,0), -1 |
---|
6904 | ideal i=x8+8x7y+32x6y2+80x5y3+136x4y4+160x3y5+128x2y6+64xy7+16y8+4x6t2+24x5yt2+72x4y2t2+128x3y3t2+144x2y4t2+96xy5t2+32y6t2+14x4t4+56x3yt4+112x2y2t4+112xy3t4+40y4t4+20x2t6+40xyt6+8y2t6+9t8; |
---|
6905 | //normalC: char 29 : 0sec, char 0: 0sec //char 29 6 Komponenten |
---|
6906 | //normalP char 29 withRing: 1sec |
---|
6907 | |
---|
6908 | //-------------------------- problematic examples ------------------------ |
---|
6909 | //ring r=0,(x,y,t),dp; |
---|
6910 | ring r=32003,(x,y,t),dp; |
---|
6911 | ideal i= |
---|
6912 | 32761x8+786264x7y+8314416x6y2+50590224x5y3+193727376x4y4+478146240x3y5+742996800x2y6+664848000xy7+262440000y8+524176x7t+11007696x6yt+99772992x5y2t+505902240x4y3t+1549819008x3y4t+2868877440x2y5t+2971987200xy6t+1329696000y7t+3674308x6t2+66137544x5yt2+499561128x4y2t2+2026480896x3y3t2+4656222144x2y4t2+5746386240xy5t2+2976652800y6t2+14737840x5t3+221067600x4yt3+1335875904x3y2t3+4064449536x2y3t3+6226336512xy4t3+3842432640y5t3+36997422x4t4+443969064x3yt4+2012198112x2y2t4+4081745520xy3t4+3126751632y4t4+59524208x3t5+535717872x2yt5+1618766208xy2t5+1641991392y3t5+59938996x2t6+359633976xyt6+543382632y2t6+34539344xt7+103618032yt7+8720497t8; |
---|
6913 | //char 0: lange (es liegt an den grossen Zahlen), char 32003: 0 sec |
---|
6914 | |
---|
6915 | //dasselbe Beipiel in char 19: irred |
---|
6916 | ring r=0,(x,y,t),dp; |
---|
6917 | ideal i= |
---|
6918 | 5x8+6x7y-3x6y2+7x5y3-6x4y4-8x3y5-5x2y6-8y8+4x7t+8x6yt+2x5y2t-6x4y3t+9x3y4t+9x2y5t-xy6t-7x6t2+7x5yt2-x4y2t2+5x3y3t2+7x2y4t2+xy5t2-3y6t2-4x5t3 -3x4yt3+2x3y2t3-7x2y3t3-6xy4t3-3y5t3-5x4t4-3x3yt4-4x2y2t4-8xy3t4 +7y4t4+x3t5+9x2yt5+9xy2t5-8y3t5-2y2t6+4xt7-7yt7-9t8; |
---|
6919 | //normalP: char 2,3: 0sec, norTest 0,2 sec, char 11 haengt bei peimage |
---|
6920 | //normalC: char 3: 0 sec, char 0: 1sec |
---|
6921 | |
---|
6922 | //ring r=0,(x,y),dp; |
---|
6923 | ring r=32003,(x,y),dp; |
---|
6924 | ideal i= |
---|
6925 | x30y21+21x29y20+210x28y19+10x27y19+1330x27y18+190x26y18+5985x26y17 |
---|
6926 | +1710x25y17+20349x25y16+45x24y17+9690x24y16+54264x24y15+765x23y16 |
---|
6927 | +38760x23y15+116280x23y14+6120x22y15+116280x22y14+120x21y15 |
---|
6928 | +203490x22y13+30600x21y14+271320x21y13+1799x20y14+293930x21y12+107100x20y13 |
---|
6929 | +503880x20y12+12586x19y13+352716x20y11+278460x19y12+210x18y13+755820x19y11 |
---|
6930 | +54509x18y12+352716x19y10+556920x18y11+2723x17y12+923780x18y10+163436x17y11 |
---|
6931 | +293930x18y9+875160x17y10+16296x16y11+923780x17y9+359359x16y10+252x15y11 |
---|
6932 | +203490x17y8+1093950x16y9+59598x15y10+755820x16y8+598598x15y9+2751x14y10 |
---|
6933 | +116280x16y7+1093950x15y8+148610x14y9+503880x15y7+769197x14y8+13650x13y9 |
---|
6934 | +54264x15y6+875160x14y7+266805x13y8+210x12y9+271320x14y6+768768x13y7 |
---|
6935 | +40635x12y8+20349x14y5+556920x13y6+354816x12y7+1855x11y8+116280x13y5 |
---|
6936 | +597597x12y6+80640x11y7+5985x13y4+278460x12y5+353892x11y6+7280x10y7+38760x12y4 |
---|
6937 | +358358x11y5+112014x10y6+120x9y7+1330x12y3+107100x11y4+264726x10y5+16660x9y6 |
---|
6938 | +9690x11y3+162799x10y4+111132x9y5+805x8y6+210x11y2+30600x10y3+146685x9y4 |
---|
6939 | +24500x8y5+1710x10y2+54236x9y3+78750x8y4+2310x7y5+21x10y+6120x9y2+58520x8y3 |
---|
6940 | +24010x7y4+45x6y5+190x9y+12509x8y2+39060x7y3+3675x6y4+x9+765x8y+15918x7y2 |
---|
6941 | +15680x6y3+204x5y4+10x8+1786x7y+12915x6y2+3500x5y3+45x7+2646x6y+6580x5y2 |
---|
6942 | +366x4y3+119x6+2562x5y+1995x4y2+10x3y3+203x5+1610x4y+324x3y2+231x4+630x3y |
---|
6943 | +23x2y2+175x3+141x2y+85x2+16xy+24x+y+4; |
---|
6944 | list nor = normal(i); |
---|
6945 | //normalC: char 0: ### hngt in SB of singular locus JM = mstd(J); |
---|
6946 | //normalC: char 32003,"noFac","equidim": 0sec, "noFac": 1sec |
---|
6947 | // ev neues interred |
---|
6948 | genus(i); // haengt bei int mu=vdim(std(jacob(f))); |
---|
6949 | //### ist das noetig? |
---|
6950 | |
---|
6951 | //Singular rechnet genus richtig, auch im Fall, dass Kurve irreduzibel, |
---|
6952 | //aber nicht absolut irreduzibel ist: |
---|
6953 | ring r = 0,(x,y),dp; |
---|
6954 | ideal i = x2+y2; //irreduzibel /Q aber reduzibel /C (x-iy)*(x+iy) |
---|
6955 | factorize( x2+y2); //liefert irreduzibel |
---|
6956 | genus(i); //sollte 0+0-2+1= -1 sein |
---|
6957 | genus(i,1); //beides ist korrekt in Singular |
---|
6958 | |
---|
6959 | */ |
---|
6960 | |
---|