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 | 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); writes a poly in integral closure as element of Quot(R/p) |
---|
19 | iMult(L); intersection multiplicity of the ideals of the list L |
---|
20 | |
---|
21 | deltaLoc(f,S); sum of delta invariants at conjugated singular points |
---|
22 | locAtZero(I); checks whether the zero set of I is located at 0 |
---|
23 | norTest(I,nor); checks the output of normal, normalP, normalC |
---|
24 | getSmallest(J); computes the polynomial of smallest degree of J |
---|
25 | getOneVar(J, vari); computes a polynomial of J in the variable vari |
---|
26 | changeDenominator(U1, c1, c2, I); computes ideal U2 such that 1/c1*U1=1/c2*U2 |
---|
27 | "; |
---|
28 | |
---|
29 | LIB "general.lib"; |
---|
30 | LIB "poly.lib"; |
---|
31 | LIB "sing.lib"; |
---|
32 | LIB "primdec.lib"; |
---|
33 | LIB "elim.lib"; |
---|
34 | LIB "presolve.lib"; |
---|
35 | LIB "inout.lib"; |
---|
36 | LIB "ring.lib"; |
---|
37 | LIB "hnoether.lib"; |
---|
38 | LIB "reesclos.lib"; |
---|
39 | LIB "algebra.lib"; |
---|
40 | |
---|
41 | /////////////////////////////////////////////////////////////////////////////// |
---|
42 | |
---|
43 | proc normal(ideal id, list #) |
---|
44 | "USAGE: normal(id [,choose]); id = radical ideal, choose = list of options. @* |
---|
45 | Optional parameters in list choose (can be entered in any order):@* |
---|
46 | Decomposition:@* |
---|
47 | - \"equidim\" -> computes first an equidimensional decomposition, |
---|
48 | and then the normalization of each component (default).@* |
---|
49 | - \"prim\" -> computes first the minimal associated primes, and then |
---|
50 | the normalization of each prime. @* |
---|
51 | - \"noDeco\" -> no preliminary decomposition is done. If the ideal is |
---|
52 | not equidimensional radical, output might be wrong.@* |
---|
53 | - \"isPrim\" -> assumes that the ideal is prime. If this assumption |
---|
54 | does not hold, the output might be wrong.@* |
---|
55 | - \"noFac\" -> factorization is avoided in the computation of the |
---|
56 | minimal associated primes; |
---|
57 | Other:@* |
---|
58 | - \"useRing\" -> uses the original ring ordering.@* |
---|
59 | If this option is set and if the ring ordering is not global, normal |
---|
60 | will change to a global ordering only for computing radicals and prime |
---|
61 | or equidimensional decompositions.@* |
---|
62 | If this option is not set, normal changes to dp ordering and performs |
---|
63 | all computations with respect to this ordering.@* |
---|
64 | - \"withDelta\" (or \"wd\") -> returns also the delta invariants.@* |
---|
65 | If the optional parameter choose is not given or empty, only |
---|
66 | \"equidim\" but no other option is used.@* |
---|
67 | - list(\"inputJ\", ideal inputJ) -> takes as initial test ideal the |
---|
68 | ideal inputJ. This option is only for use in other procedures. Using |
---|
69 | this option, the result might not be the normalization.@* |
---|
70 | (Option only valid for global algorithm.)@* |
---|
71 | - list(\"inputC\", ideal inputC) -> takes as initial conductor the |
---|
72 | ideal inputC. This option is only for use in other procedures. Using |
---|
73 | this option, the result might not be the normalization.@* |
---|
74 | (Option only valid for global algorithm.)@* |
---|
75 | Options used for computing integral basis (over rings of two |
---|
76 | variables):@* |
---|
77 | - \"var1\" -> uses a polynomial in the first variable as |
---|
78 | universal denominator.@* |
---|
79 | - \"var2\" -> uses a polynomial in the second variable as universal |
---|
80 | denominator.@* |
---|
81 | If the optional parameter choose is not given or empty, only |
---|
82 | \"equidim\" but no other option is used.@* |
---|
83 | ASSUME: The ideal must be radical, for non-radical ideals the output may |
---|
84 | be wrong (id=radical(id); makes id radical). However, when using the |
---|
85 | \"prim\" option the minimal associated primes of id are computed first |
---|
86 | and hence normal computes the normalization of the radical of id.@* |
---|
87 | NOTE: \"isPrim\" should only be used if id is known to be prime. |
---|
88 | RETURN: a list, say nor, of size 2 (resp. 3 with option \"withDelta\"). |
---|
89 | @format Let R denote the basering and id the input ideal. |
---|
90 | * nor[1] is a list of r rings, where r is the number of associated |
---|
91 | primes P_i with option \"prim\" (resp. >= no of equidimenensional |
---|
92 | components P_i with option \"equidim\").@* |
---|
93 | Each ring Ri := nor[1][i], i=1..r, contains two ideals with given |
---|
94 | names @code{norid} and @code{normap} such that: @* |
---|
95 | - Ri/norid is the normalization of the i-th component, i.e. the |
---|
96 | integral closure of R/P_i in its field of fractions (as affine ring); |
---|
97 | - @code{normap} gives the normalization map from R/id to |
---|
98 | Ri/norid for each i.@* |
---|
99 | - the direct sum of the rings Ri/norid, i=1,..r, is the normalization |
---|
100 | of R/id as affine algebra; @* |
---|
101 | * nor[2] is a list of size r with information on the normalization of |
---|
102 | the i-th component as module over the basering R:@* |
---|
103 | nor[2][i] is an ideal, say U, in R such that the integral closure |
---|
104 | of basering/P_i is generated as module over R by 1/c * U, with c |
---|
105 | the last element U[size(U)] of U.@* |
---|
106 | * nor[3] (if option \"withDelta\" is set) is a list of an intvec |
---|
107 | of size r, the delta invariants of the r components, and an integer, |
---|
108 | the total delta invariant of basering/id (-1 means infinite, and 0 |
---|
109 | that R/P_i resp. R/id is normal). |
---|
110 | @end format |
---|
111 | THEORY: We use here a general algorithm described in [G.-M.Greuel, S.Laplagne, |
---|
112 | F.Seelisch: Normalization of Rings (2009)].@* |
---|
113 | The procedure computes the R-module structure, the algebra structure |
---|
114 | and the delta invariant of the normalization of R/id:@* |
---|
115 | The normalization of R/id is the integral closure of R/id in its total |
---|
116 | ring of fractions. It is a finitely generated R-module and nor[2] |
---|
117 | computes R-module generators of it. More precisely: If U:=nor[2][i] |
---|
118 | and c:=U[size(U)], then c is a non-zero divisor and U/c is an R-module |
---|
119 | in the total ring of fractions, the integral closure of R/P_i. Since |
---|
120 | U[size(U)]/c is equal to 1, R/P_i resp. R/id is contained in the |
---|
121 | integral closure.@* |
---|
122 | The normalization is also an affine algebra over the ground field |
---|
123 | and nor[1] presents it as such. For geometric considerations nor[1] is |
---|
124 | relevant since the variety of the ideal norid in Ri is the |
---|
125 | normalization of the variety of the ideal P_i in R.@* |
---|
126 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
127 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
128 | id. nor[3] returns the delta invariants of the components P_i and of |
---|
129 | id. |
---|
130 | NOTE: To use the i-th ring type e.g.: @code{def R=nor[1][i]; setring R;}. |
---|
131 | @* Increasing/decreasing printlevel displays more/less comments |
---|
132 | (default: printlevel=0). |
---|
133 | @* Implementation works also for local rings. |
---|
134 | @* Not implemented for quotient rings. |
---|
135 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
136 | be used together with the useRing-option (qhweight(id); computes |
---|
137 | weights). |
---|
138 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
139 | SEE ALSO: normalC, normalP. |
---|
140 | EXAMPLE: example normal; shows an example |
---|
141 | " |
---|
142 | { |
---|
143 | intvec opt = option(get); // Save current options |
---|
144 | |
---|
145 | int i,j; |
---|
146 | int decomp; // Preliminary decomposition: |
---|
147 | // 0 -> no decomposition (id is assumed to be prime) |
---|
148 | // 1 -> no decomposition |
---|
149 | // (id is assumed to be equidimensional radical) |
---|
150 | // 2 -> equidimensional decomposition |
---|
151 | // 3 -> minimal associated primes |
---|
152 | int noFac, useRing, withDelta; |
---|
153 | int dbg = printlevel - voice + 2; |
---|
154 | int nvar = nvars(basering); |
---|
155 | int chara = char(basering); |
---|
156 | int denomOption; // Method for choosing the conductor |
---|
157 | |
---|
158 | ideal inputJ = 0; // Test ideal given in the input (if any). |
---|
159 | ideal inputC = 0; // Conductor ideal given in the input (if any). |
---|
160 | |
---|
161 | list result, resultNew; |
---|
162 | list keepresult; |
---|
163 | list ringStruc; |
---|
164 | ideal U; |
---|
165 | poly c; |
---|
166 | int sp; // Number of components. |
---|
167 | |
---|
168 | // Default methods: |
---|
169 | noFac = 0; // Use facSTD when computing minimal associated primes |
---|
170 | decomp = 2; // Equidimensional decomposition |
---|
171 | useRing = 0; // Change first to dp ordering, and perform all |
---|
172 | // computations there. |
---|
173 | withDelta = 0; // Do not compute the delta invariant. |
---|
174 | denomOption = 0; // The default universal denominator is the smallest |
---|
175 | // degree polynomial. |
---|
176 | |
---|
177 | //--------------------------- define the method --------------------------- |
---|
178 | for ( i=1; i <= size(#); i++ ) |
---|
179 | { |
---|
180 | if ( typeof(#[i]) == "string" ) |
---|
181 | { |
---|
182 | //--------------------------- choosen methods ----------------------- |
---|
183 | if ( (#[i]=="isprim") or (#[i]=="isPrim") ) |
---|
184 | {decomp = 0;} |
---|
185 | |
---|
186 | if ( (#[i]=="nodeco") or (#[i]=="noDeco") ) |
---|
187 | {decomp = 1;} |
---|
188 | |
---|
189 | if (#[i]=="prim") |
---|
190 | {decomp = 3;} |
---|
191 | |
---|
192 | if (#[i]=="equidim") |
---|
193 | {decomp = 2;} |
---|
194 | |
---|
195 | if ( (#[i]=="nofac") or (#[i]=="noFac") ) |
---|
196 | {noFac=1;} |
---|
197 | |
---|
198 | if ( ((#[i]=="useRing") or (#[i]=="usering")) and (ordstr(basering) != "dp("+string(nvars(basering))+"),C")) |
---|
199 | {useRing = 1;} |
---|
200 | |
---|
201 | if ( (#[i]=="withDelta") or (#[i]=="wd") or (#[i]=="withdelta")) |
---|
202 | { |
---|
203 | if((decomp == 0) or (decomp == 3)) |
---|
204 | { |
---|
205 | withDelta = 1; |
---|
206 | } |
---|
207 | else |
---|
208 | { |
---|
209 | decomp = 3; |
---|
210 | withDelta = 1; |
---|
211 | //Note: the delta invariants cannot be computed with an equidimensional |
---|
212 | //decomposition, hence we compute first the minimal primes |
---|
213 | } |
---|
214 | } |
---|
215 | if (#[i]=="var1") |
---|
216 | {denomOption = 1;} |
---|
217 | if (#[i]=="var2") |
---|
218 | {denomOption = 2;} |
---|
219 | } |
---|
220 | if(typeof(#[i]) == "list"){ |
---|
221 | if(size(#[i]) == 2){ |
---|
222 | if (#[i][1]=="inputJ"){ |
---|
223 | if(typeof(#[i][2]) == "ideal"){ |
---|
224 | inputJ = #[i][2]; |
---|
225 | } |
---|
226 | } |
---|
227 | } |
---|
228 | if (#[i][1]=="inputC"){ |
---|
229 | if(size(#[i]) == 2){ |
---|
230 | if(typeof(#[i][2]) == "ideal"){ |
---|
231 | inputC = #[i][2]; |
---|
232 | } |
---|
233 | } |
---|
234 | } |
---|
235 | } |
---|
236 | } |
---|
237 | kill #; |
---|
238 | |
---|
239 | //------------------------ change ring if required ------------------------ |
---|
240 | // If the ordering is not global, we change to dp ordering for computing the |
---|
241 | // min ass primes. |
---|
242 | // If the ordering is global, but not dp, and useRing = 0, we also change to |
---|
243 | // dp ordering. |
---|
244 | |
---|
245 | int isGlobal = ord_test(basering); // Checks if the original ring has |
---|
246 | // global ordering. |
---|
247 | |
---|
248 | def origR = basering; // origR is the original ring |
---|
249 | // R is the ring where computations will be done |
---|
250 | |
---|
251 | if((useRing == 1) and (isGlobal == 1)) |
---|
252 | { |
---|
253 | def globR = basering; |
---|
254 | } |
---|
255 | else |
---|
256 | { |
---|
257 | // We change to dp ordering. |
---|
258 | list rl = ringlist(origR); |
---|
259 | list origOrd = rl[3]; |
---|
260 | list newOrd = list("dp", intvec(1:nvars(origR))), list("C", 0); |
---|
261 | rl[3] = newOrd; |
---|
262 | def globR = ring(rl); |
---|
263 | setring globR; |
---|
264 | ideal id = fetch(origR, id); |
---|
265 | } |
---|
266 | |
---|
267 | //------------------------ trivial checkings ------------------------ |
---|
268 | id = groebner(id); |
---|
269 | if((size(id) == 0) or (id[1] == 1)) |
---|
270 | { |
---|
271 | // The original ring R/I was normal. Nothing to do. |
---|
272 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
273 | setring origR; |
---|
274 | list lR = ringlist(origR); |
---|
275 | def ROut = ring(lR); |
---|
276 | setring ROut; |
---|
277 | ideal norid = fetch(origR, id); |
---|
278 | ideal normap = maxideal(1); |
---|
279 | export norid; |
---|
280 | export normap; |
---|
281 | setring origR; |
---|
282 | if(withDelta) |
---|
283 | { |
---|
284 | result = list(list(ROut), list(ideal(1)), list(intvec(0), 0)); |
---|
285 | } |
---|
286 | else |
---|
287 | { |
---|
288 | result = list(list(ROut), list(ideal(1))); |
---|
289 | } |
---|
290 | sp = 1; // number of rings in the output |
---|
291 | option(set, opt); |
---|
292 | normalOutputText(dbg, withDelta, sp); |
---|
293 | return(result); |
---|
294 | } |
---|
295 | //------------------------ preliminary decomposition----------------------- |
---|
296 | list prim; |
---|
297 | if(decomp == 2) |
---|
298 | { |
---|
299 | dbprint(dbg, "// Computing the equidimensional decomposition..."); |
---|
300 | prim = equidim(id); |
---|
301 | } |
---|
302 | if((decomp == 0) or (decomp == 1)) |
---|
303 | { |
---|
304 | prim = id; |
---|
305 | } |
---|
306 | if(decomp == 3) |
---|
307 | { |
---|
308 | dbprint(dbg, "// Computing the minimal associated primes..."); |
---|
309 | if( noFac ) |
---|
310 | { prim = minAssGTZ(id,1); } |
---|
311 | else |
---|
312 | { prim = minAssGTZ(id); } |
---|
313 | } |
---|
314 | sp = size(prim); |
---|
315 | if(dbg>=1) |
---|
316 | { |
---|
317 | prim; ""; |
---|
318 | "// number of components is", sp; |
---|
319 | ""; |
---|
320 | } |
---|
321 | |
---|
322 | |
---|
323 | //----------------- back to the original ring if required ------------------ |
---|
324 | // if ring was not global and useRing is on, we go back to the original ring |
---|
325 | if((useRing == 1) and (isGlobal != 1)) |
---|
326 | { |
---|
327 | setring origR; |
---|
328 | def R = basering; |
---|
329 | list prim = fetch(globR, prim); |
---|
330 | } |
---|
331 | else |
---|
332 | { |
---|
333 | def R = basering; |
---|
334 | ideal inputJ = fetch(origR, inputJ); |
---|
335 | ideal inputC = fetch(origR, inputC); |
---|
336 | if(useRing == 0) |
---|
337 | { |
---|
338 | ideal U; |
---|
339 | poly c; |
---|
340 | } |
---|
341 | } |
---|
342 | |
---|
343 | // ---------------- normalization of the components------------------------- |
---|
344 | // calls normalM to compute the normalization of each component. |
---|
345 | |
---|
346 | list norComp; // The normalization of each component. |
---|
347 | int delt; |
---|
348 | int deltI = 0; |
---|
349 | int totalComps = 0; |
---|
350 | |
---|
351 | setring origR; |
---|
352 | def newROrigOrd; |
---|
353 | list newRListO; |
---|
354 | setring R; |
---|
355 | def newR; |
---|
356 | list newRList; |
---|
357 | |
---|
358 | for(i=1; i<=size(prim); i++) |
---|
359 | { |
---|
360 | if(dbg>=2){pause();} |
---|
361 | if(dbg>=1) |
---|
362 | { |
---|
363 | "// start computation of component",i; |
---|
364 | " --------------------------------"; |
---|
365 | } |
---|
366 | if(groebner(prim[i])[1] != 1) |
---|
367 | { |
---|
368 | if(dbg>=2) |
---|
369 | { |
---|
370 | "We compute the normalization in the ring"; basering; |
---|
371 | } |
---|
372 | printlevel = printlevel + 1; |
---|
373 | norComp = normalM(prim[i], decomp, withDelta, denomOption, inputJ, inputC); |
---|
374 | printlevel = printlevel - 1; |
---|
375 | for(j = 1; j <= size(norComp); j++) |
---|
376 | { |
---|
377 | newR = norComp[j][3]; |
---|
378 | newRList = ringlist(newR); |
---|
379 | U = norComp[j][1]; |
---|
380 | c = norComp[j][2]; |
---|
381 | if(withDelta) |
---|
382 | { |
---|
383 | delt = norComp[j][4]; |
---|
384 | if((delt >= 0) and (deltI >= 0)) |
---|
385 | { |
---|
386 | deltI = deltI + delt; |
---|
387 | } |
---|
388 | else |
---|
389 | { |
---|
390 | deltI = -1; |
---|
391 | } |
---|
392 | } |
---|
393 | // -- incorporate result for this component to the list of results --- |
---|
394 | if(useRing == 0) |
---|
395 | { |
---|
396 | // We go back to the original ring. |
---|
397 | setring origR; |
---|
398 | U = fetch(R, U); |
---|
399 | c = fetch(R, c); |
---|
400 | newRListO = imap(R, newRList); |
---|
401 | // We change the ordering in the new ring. |
---|
402 | if(nvars(newR) > nvars(origR)) |
---|
403 | { |
---|
404 | newRListO[3]=insert(origOrd, newRListO[3][1]); |
---|
405 | } |
---|
406 | else |
---|
407 | { |
---|
408 | newRListO[3] = origOrd; |
---|
409 | } |
---|
410 | newROrigOrd = ring(newRListO); |
---|
411 | setring newROrigOrd; |
---|
412 | ideal norid = imap(newR, norid); |
---|
413 | ideal normap = imap(newR, normap); |
---|
414 | export norid; |
---|
415 | export normap; |
---|
416 | setring origR; |
---|
417 | totalComps++; |
---|
418 | result[totalComps] = list(U, c, newROrigOrd); |
---|
419 | if(withDelta) |
---|
420 | { |
---|
421 | result[totalComps] = insert(result[totalComps], delt, 3); |
---|
422 | } |
---|
423 | setring R; |
---|
424 | } |
---|
425 | else |
---|
426 | { |
---|
427 | setring R; |
---|
428 | totalComps++; |
---|
429 | result[totalComps] = norComp[j]; |
---|
430 | } |
---|
431 | } |
---|
432 | } |
---|
433 | } |
---|
434 | |
---|
435 | // -------------------------- delta computation ---------------------------- |
---|
436 | if(withDelta == 1) |
---|
437 | { |
---|
438 | // Intersection multiplicities of list prim, sp=size(prim). |
---|
439 | if ( dbg >= 1 ) |
---|
440 | { |
---|
441 | "// Sum of delta for all components: ", deltI; |
---|
442 | } |
---|
443 | if(size(prim) > 1) |
---|
444 | { |
---|
445 | dbprint(dbg, "// Computing the sum of the intersection multiplicities of the components..."); |
---|
446 | int mul = iMult(prim); |
---|
447 | if ( mul < 0 ) |
---|
448 | { |
---|
449 | deltI = -1; |
---|
450 | } |
---|
451 | else |
---|
452 | { |
---|
453 | deltI = deltI + mul; |
---|
454 | } |
---|
455 | if ( dbg >= 1 ) |
---|
456 | { |
---|
457 | "// Intersection multiplicity is : ", mul; |
---|
458 | } |
---|
459 | } |
---|
460 | } |
---|
461 | |
---|
462 | // -------------------------- prepare output ------------------------------ |
---|
463 | setring origR; |
---|
464 | |
---|
465 | list RL; // List of rings |
---|
466 | list MG; // Module generators |
---|
467 | intvec DV; // Vector of delta's of each component |
---|
468 | for(i = 1; i <= size(result); i++) |
---|
469 | { |
---|
470 | RL[i] = result[i][3]; |
---|
471 | MG[i] = lineUpLast(result[i][1], result[i][2]); |
---|
472 | if(withDelta) |
---|
473 | { |
---|
474 | DV[i] = result[i][4]; |
---|
475 | } |
---|
476 | } |
---|
477 | if(withDelta) |
---|
478 | { |
---|
479 | resultNew = list(RL, MG, list(DV, deltI)); |
---|
480 | } |
---|
481 | else |
---|
482 | { |
---|
483 | resultNew = list(RL, MG); |
---|
484 | } |
---|
485 | sp = size(RL); //RL = list of rings |
---|
486 | |
---|
487 | option(set, opt); |
---|
488 | normalOutputText(dbg, withDelta, sp); |
---|
489 | return(resultNew); |
---|
490 | } |
---|
491 | |
---|
492 | example |
---|
493 | { "EXAMPLE:"; |
---|
494 | printlevel = printlevel+1; |
---|
495 | echo = 2; |
---|
496 | ring s = 0,(x,y),dp; |
---|
497 | ideal i = (x2-y3)*(x2+y2)*x; |
---|
498 | list nor = normal(i, "withDelta", "prim"); |
---|
499 | nor; |
---|
500 | |
---|
501 | // 2 branches have delta = 1, and 1 branch has delta = 0 |
---|
502 | // the total delta invariant is 13 |
---|
503 | |
---|
504 | def R2 = nor[1][2]; setring R2; |
---|
505 | norid; normap; |
---|
506 | |
---|
507 | echo = 0; |
---|
508 | printlevel = printlevel-1; |
---|
509 | pause(" hit return to continue"); echo=2; |
---|
510 | |
---|
511 | ring r = 2,(x,y,z),dp; |
---|
512 | ideal i = z3-xy4; |
---|
513 | list nor = normal(i, "withDelta", "prim"); nor; |
---|
514 | // the delta invariant is infinite |
---|
515 | // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module |
---|
516 | // in its quotient field Quot(r/i) |
---|
517 | |
---|
518 | // the normalization as affine algebra over the ground field: |
---|
519 | def R = nor[1][1]; setring R; |
---|
520 | norid; normap; |
---|
521 | } |
---|
522 | |
---|
523 | /////////////////////////////////////////////////////////////////////////////// |
---|
524 | // Prints the output text in proc normal. |
---|
525 | // |
---|
526 | static proc normalOutputText(int dbg, int withDelta, int sp) |
---|
527 | // int dbg: printlevel |
---|
528 | // int withDelta: output contains information about the delta invariant |
---|
529 | // int sp: number of output rings. |
---|
530 | { |
---|
531 | if ( dbg >= 0 ) |
---|
532 | { |
---|
533 | ""; |
---|
534 | if(!withDelta) |
---|
535 | { |
---|
536 | "// 'normal' created a list, say nor, of two elements."; |
---|
537 | } |
---|
538 | else |
---|
539 | { |
---|
540 | "// 'normal' created a list, say nor, of three elements."; |
---|
541 | } |
---|
542 | "// To see the list type"; |
---|
543 | " nor;"; |
---|
544 | ""; |
---|
545 | "// * nor[1] is a list of", sp, "ring(s)."; |
---|
546 | "// To access the i-th ring nor[1][i], give it a name, say Ri, and type"; |
---|
547 | " def R1 = nor[1][1]; setring R1; norid; normap;"; |
---|
548 | "// For the other rings type first (if R is the name of your base ring)"; |
---|
549 | " setring R;"; |
---|
550 | "// and then continue as for R1."; |
---|
551 | "// Ri/norid is the affine algebra of the normalization of R/P_i where"; |
---|
552 | "// P_i is the i-th component of a decomposition of the input ideal id"; |
---|
553 | "// and normap the normalization map from R to Ri/norid."; |
---|
554 | ""; |
---|
555 | "// * nor[2] is a list of", sp, "ideal(s). Let ci be the last generator"; |
---|
556 | "// of the ideal nor[2][i]. Then the integral closure of R/P_i is"; |
---|
557 | "// generated as R-submodule of the total ring of fractions by"; |
---|
558 | "// 1/ci * nor[2][i]."; |
---|
559 | |
---|
560 | if(withDelta) |
---|
561 | { ""; |
---|
562 | "// * nor[3] is a list of an intvec of size", sp, "the delta invariants "; |
---|
563 | "// of the components, and an integer, the total delta invariant "; |
---|
564 | "// of R/id (-1 means infinite, and 0 that R/P_i resp. R/id is normal)."; |
---|
565 | } |
---|
566 | } |
---|
567 | } |
---|
568 | |
---|
569 | |
---|
570 | /////////////////////////////////////////////////////////////////////////////// |
---|
571 | |
---|
572 | proc HomJJ (list Li) |
---|
573 | "USAGE: HomJJ (Li); Li = list: ideal SBid, ideal id, ideal J, poly p |
---|
574 | ASSUME: R = P/id, P = basering, a polynomial ring, id an ideal of P, |
---|
575 | @* SBid = standard basis of id, |
---|
576 | @* J = ideal of P containing the polynomial p, |
---|
577 | @* p = nonzero divisor of R |
---|
578 | COMPUTE: Endomorphism ring End_R(J)=Hom_R(J,J) with its ring structure as |
---|
579 | affine ring, together with the map R --> Hom_R(J,J) of affine rings, |
---|
580 | where R is the quotient ring of P modulo the standard basis SBid. |
---|
581 | RETURN: a list l of three objects |
---|
582 | @format |
---|
583 | l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi' |
---|
584 | such that l[1]/endid = Hom_R(J,J) and |
---|
585 | endphi describes the canonical map R -> Hom_R(J,J) |
---|
586 | l[2] : an integer which is 1 if phi is an isomorphism, 0 if not |
---|
587 | l[3] : an integer, = dim_K(Hom_R(J,J)/R) (the contribution to delta) |
---|
588 | if the dimension is finite, -1 otherwise |
---|
589 | @end format |
---|
590 | NOTE: printlevel >=1: display comments (default: printlevel=0) |
---|
591 | EXAMPLE: example HomJJ; shows an example |
---|
592 | " |
---|
593 | { |
---|
594 | //---------- initialisation --------------------------------------------------- |
---|
595 | int isIso,isPr,isHy,isCo,isRe,isEq,oSAZ,ii,jj,q,y; |
---|
596 | intvec rw,rw1; |
---|
597 | list L; |
---|
598 | y = printlevel-voice+2; // y=printlevel (default: y=0) |
---|
599 | def P = basering; |
---|
600 | ideal SBid, id, J = Li[1], Li[2], Li[3]; |
---|
601 | poly p = Li[4]; |
---|
602 | int noRed = 0; |
---|
603 | if(size(Li) > 4) |
---|
604 | { |
---|
605 | if(Li[5] == 1) { noRed = 1; } |
---|
606 | } |
---|
607 | |
---|
608 | attrib(SBid,"isSB",1); |
---|
609 | int homo = homog(Li[2]); //is 1 if id is homogeneous, 0 if not |
---|
610 | |
---|
611 | //---- set attributes for special cases where algorithm can be simplified ----- |
---|
612 | if( homo==1 ) |
---|
613 | { |
---|
614 | rw = ringweights(P); |
---|
615 | } |
---|
616 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
617 | { |
---|
618 | if(attrib(id,"isPrim")==1) { isPr=1; } |
---|
619 | } |
---|
620 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
621 | { |
---|
622 | if(attrib(id,"onlySingularAtZero")==1){oSAZ=1; } |
---|
623 | } |
---|
624 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
625 | { |
---|
626 | if(attrib(id,"isIsolatedSingularity")==1) { isIso=1; } |
---|
627 | } |
---|
628 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
629 | { |
---|
630 | if(attrib(id,"isCohenMacaulay")==1) { isCo=1; } |
---|
631 | } |
---|
632 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
633 | { |
---|
634 | if(attrib(id,"isRegInCodim2")==1) { isRe=1; } |
---|
635 | } |
---|
636 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
637 | { |
---|
638 | if(attrib(id,"isEquidimensional")==1) { isEq=1; } |
---|
639 | } |
---|
640 | //-------------------------- go to quotient ring ------------------------------ |
---|
641 | qring R = SBid; |
---|
642 | ideal id = fetch(P,id); |
---|
643 | ideal J = fetch(P,J); |
---|
644 | poly p = fetch(P,p); |
---|
645 | ideal f,rf,f2; |
---|
646 | module syzf; |
---|
647 | //---------- computation of p*Hom(J,J) as R-ideal ----------------------------- |
---|
648 | if ( y>=1 ) |
---|
649 | { |
---|
650 | "// compute p*Hom(J,J) = p*J:J"; |
---|
651 | "// the ideal J:";J; |
---|
652 | } |
---|
653 | f = quotient(p*J,J); |
---|
654 | |
---|
655 | //### (neu GMG 4.10.08) divide by the greatest common divisor: |
---|
656 | poly gg = gcd( f[1],p ); |
---|
657 | for(ii=2; ii <=ncols(f); ii++) |
---|
658 | { |
---|
659 | gg=gcd(gg,f[ii]); |
---|
660 | } |
---|
661 | for(ii=1; ii<=ncols(f); ii++) |
---|
662 | { |
---|
663 | f[ii]=f[ii]/gg; |
---|
664 | } |
---|
665 | p = p/gg; |
---|
666 | |
---|
667 | if ( y>=1 ) |
---|
668 | { |
---|
669 | "// the non-zerodivisor p:"; p; |
---|
670 | "// the module p*Hom(J,J) = p*J:J :"; f; |
---|
671 | ""; |
---|
672 | } |
---|
673 | f2 = std(p); |
---|
674 | |
---|
675 | //---------- Test: Hom(J,J) == R ?, if yes, go home --------------------------- |
---|
676 | |
---|
677 | //rf = interred(reduce(f,f2)); |
---|
678 | //### interred hier weggelassen, unten zugefuegt |
---|
679 | rf = reduce(f,f2); //represents p*Hom(J,J)/p*R = Hom(J,J)/R |
---|
680 | if ( size(rf) == 0 ) |
---|
681 | { |
---|
682 | if ( homog(f) && find(ordstr(basering),"s")==0 ) |
---|
683 | { |
---|
684 | ring newR1 = char(P),(X(1..nvars(P))),(a(rw),dp); |
---|
685 | } |
---|
686 | else |
---|
687 | { |
---|
688 | ring newR1 = char(P),(X(1..nvars(P))),dp; |
---|
689 | } |
---|
690 | ideal endphi = maxideal(1); |
---|
691 | ideal endid = fetch(P,id); |
---|
692 | endid = simplify(endid,2); |
---|
693 | L = substpart(endid,endphi,homo,rw); //## hier substpart |
---|
694 | def lastRing = L[1]; |
---|
695 | setring lastRing; |
---|
696 | |
---|
697 | attrib(endid,"onlySingularAtZero",oSAZ); |
---|
698 | attrib(endid,"isCohenMacaulay",isCo); |
---|
699 | attrib(endid,"isPrim",isPr); |
---|
700 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
701 | attrib(endid,"isRegInCodim2",isRe); |
---|
702 | attrib(endid,"isEqudimensional",isEq); |
---|
703 | attrib(endid,"isHypersurface",0); |
---|
704 | attrib(endid,"isCompleteIntersection",0); |
---|
705 | attrib(endid,"isRadical",0); |
---|
706 | L=lastRing; |
---|
707 | L = insert(L,1,1); |
---|
708 | dbprint(y,"// case R = Hom(J,J)"); |
---|
709 | if(y>=1) |
---|
710 | { |
---|
711 | "// R=Hom(J,J)"; |
---|
712 | lastRing; |
---|
713 | "// the new ideal"; |
---|
714 | endid; |
---|
715 | " "; |
---|
716 | "// the old ring"; |
---|
717 | P; |
---|
718 | "// the old ideal"; |
---|
719 | setring P; |
---|
720 | id; |
---|
721 | " "; |
---|
722 | setring lastRing; |
---|
723 | "// the map to the new ring"; |
---|
724 | endphi; |
---|
725 | " "; |
---|
726 | pause(); |
---|
727 | ""; |
---|
728 | } |
---|
729 | setring P; |
---|
730 | L[3]=0; |
---|
731 | return(L); |
---|
732 | } |
---|
733 | if(y>=1) |
---|
734 | { |
---|
735 | "// R is not equal to Hom(J,J), we have to try again"; |
---|
736 | pause(); |
---|
737 | ""; |
---|
738 | } |
---|
739 | //---------- Hom(J,J) != R: create new ring and map from old ring ------------- |
---|
740 | // the ring newR1/SBid+syzf will be isomorphic to Hom(J,J) as R-module |
---|
741 | // f2=p (i.e. ideal generated by p) |
---|
742 | |
---|
743 | //f = mstd(f)[2]; //### geaendert GMG 04.10.08 |
---|
744 | //ideal ann = quotient(f2,f); //### f durch rf ersetzt |
---|
745 | rf = mstd(rf)[2]; //rf = NF(f,p), hence <p,rf> = <p,f> |
---|
746 | ideal ann = quotient(f2,rf); //p:f = p:rf |
---|
747 | |
---|
748 | //------------- compute the contribution to delta ---------- |
---|
749 | //delt=dim_K(Hom(JJ)/R (or -1 if infinite) |
---|
750 | |
---|
751 | int delt=vdim(std(modulo(f,ideal(p)))); |
---|
752 | |
---|
753 | f = p,rf; // generates pJ:J mod(p), i.e. p*Hom(J,J)/p*R as R-module |
---|
754 | q = size(f); |
---|
755 | syzf = syz(f); |
---|
756 | |
---|
757 | if ( homo==1 ) |
---|
758 | { |
---|
759 | rw1 = rw,0; |
---|
760 | for ( ii=2; ii<=q; ii++ ) |
---|
761 | { |
---|
762 | rw = rw, deg(f[ii])-deg(f[1]); |
---|
763 | rw1 = rw1, deg(f[ii])-deg(f[1]); |
---|
764 | } |
---|
765 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),(a(rw1),dp); |
---|
766 | } |
---|
767 | else |
---|
768 | { |
---|
769 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),dp; |
---|
770 | } |
---|
771 | |
---|
772 | //map psi1 = P,maxideal(1); //### psi1 durch fetch ersetzt |
---|
773 | //ideal SBid = psi1(SBid); |
---|
774 | ideal SBid = fetch(P,SBid); |
---|
775 | attrib(SBid,"isSB",1); |
---|
776 | |
---|
777 | qring newR = std(SBid); |
---|
778 | |
---|
779 | //map psi = R,ideal(X(1..nvars(R))); //### psi durch fetch ersetzt |
---|
780 | //ideal id = psi(id); |
---|
781 | //ideal f = psi(f); |
---|
782 | //module syzf = psi(syzf); |
---|
783 | ideal id = fetch(R,id); |
---|
784 | ideal f = fetch(R,f); |
---|
785 | module syzf = fetch(R,syzf); |
---|
786 | ideal pf,Lin,Quad,Q; |
---|
787 | matrix T,A; |
---|
788 | list L1; |
---|
789 | |
---|
790 | //---------- computation of Hom(J,J) as affine ring --------------------------- |
---|
791 | // determine kernel of: R[T1,...,Tq] -> J:J >-> R[1/p]=R[t]/(t*p-1), |
---|
792 | // Ti -> fi/p -> t*fi (p=f1=f[1]), to get ring structure. This is of course |
---|
793 | // the same as the kernel of R[T1,...,Tq] -> pJ:J >-> R, Ti -> fi. |
---|
794 | // It is a fact, that the kernel is generated by the linear and the quadratic |
---|
795 | // relations |
---|
796 | // f=p,rf, rf=reduce(f,p), generates pJ:J mod(p), |
---|
797 | // i.e. p*Hom(J,J)/p*R as R-module |
---|
798 | |
---|
799 | pf = f[1]*f; |
---|
800 | T = matrix(ideal(T(1..q)),1,q); |
---|
801 | Lin = ideal(T*syzf); |
---|
802 | if(y>=1) |
---|
803 | { |
---|
804 | "// the ring structure of Hom(J,J) as R-algebra"; |
---|
805 | "// the linear relations:"; |
---|
806 | Lin; |
---|
807 | } |
---|
808 | |
---|
809 | poly ff; |
---|
810 | for (ii=2; ii<=q; ii++ ) |
---|
811 | { |
---|
812 | for ( jj=2; jj<=ii; jj++ ) |
---|
813 | { |
---|
814 | ff = NF(f[ii]*f[jj],std(0)); //this makes lift much faster |
---|
815 | A = lift(pf,ff); //ff lin. comb. of elts of pf mod I |
---|
816 | Quad = Quad, ideal(T(jj)*T(ii) - T*A); //quadratic relations |
---|
817 | } |
---|
818 | } |
---|
819 | |
---|
820 | if(y>=1) |
---|
821 | { |
---|
822 | "// the quadratic relations"; |
---|
823 | Quad; |
---|
824 | pause(); |
---|
825 | newline; |
---|
826 | } |
---|
827 | Q = Lin,Quad; |
---|
828 | Q = subst(Q,T(1),1); |
---|
829 | //Q = mstd(Q)[2]; //### sehr aufwendig, daher weggelassen (GMG) |
---|
830 | //### ev das neue interred |
---|
831 | //mstd dient nur zum verkleinern, die SB-Eigenschaft geht spaeter verloren |
---|
832 | //da in neuen Ring abgebildet und mit id vereinigt |
---|
833 | |
---|
834 | //---------- reduce number of variables by substitution, if possible ---------- |
---|
835 | if (homo==1) |
---|
836 | { |
---|
837 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),(a(rw),dp); |
---|
838 | } |
---|
839 | else |
---|
840 | { |
---|
841 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),dp; |
---|
842 | } |
---|
843 | |
---|
844 | ideal endid = imap(newR,id),imap(newR,Q); |
---|
845 | //hier wird Q weiterverwendet, die SB-Eigenschaft wird nicht verwendet. |
---|
846 | endid = simplify(endid,2); |
---|
847 | ideal endphi = ideal(X(1..nvars(R))); |
---|
848 | |
---|
849 | |
---|
850 | if(noRed == 0) |
---|
851 | { |
---|
852 | L = substpart(endid,endphi,homo,rw); |
---|
853 | def lastRing=L[1]; |
---|
854 | setring lastRing; |
---|
855 | //return(lastRing); |
---|
856 | } |
---|
857 | else |
---|
858 | { |
---|
859 | list RL = ringlist(newRing); |
---|
860 | def lastRing = ring(RL); |
---|
861 | setring lastRing; |
---|
862 | ideal endid = fetch(newRing, endid); |
---|
863 | ideal endphi = fetch(newRing, endphi); |
---|
864 | export(endid); |
---|
865 | export(endphi); |
---|
866 | //def lastRing = newRing; |
---|
867 | //setring R; |
---|
868 | //return(newR); |
---|
869 | } |
---|
870 | |
---|
871 | |
---|
872 | // L = substpart(endid,endphi,homo,rw); |
---|
873 | |
---|
874 | // def lastRing=L[1]; |
---|
875 | // setring lastRing; |
---|
876 | |
---|
877 | attrib(endid,"onlySingularAtZero",0); |
---|
878 | map sigma=R,endphi; |
---|
879 | ideal an=sigma(ann); |
---|
880 | export(an); //noetig? |
---|
881 | //ideal te=an,endid; |
---|
882 | //if(isIso && (size(reduce(te,std(maxideal(1))))==0)) //#### ok??? |
---|
883 | // { |
---|
884 | // attrib(endid,"onlySingularAtZero",oSAZ); |
---|
885 | // } |
---|
886 | //kill te; |
---|
887 | attrib(endid,"isCohenMacaulay",isCo); //#### ok??? |
---|
888 | attrib(endid,"isPrim",isPr); |
---|
889 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
890 | attrib(endid,"isRegInCodim2",isRe); |
---|
891 | attrib(endid,"isEquidimensional",isEq); |
---|
892 | attrib(endid,"isHypersurface",0); |
---|
893 | attrib(endid,"isCompleteIntersection",0); |
---|
894 | attrib(endid,"isRadical",0); |
---|
895 | if(y>=1) |
---|
896 | { |
---|
897 | "// the new ring after reduction of the number of variables"; |
---|
898 | lastRing; |
---|
899 | "// the new ideal"; |
---|
900 | endid; ""; |
---|
901 | "// the old ring"; |
---|
902 | P; |
---|
903 | "// the old ideal"; |
---|
904 | setring P; |
---|
905 | id; |
---|
906 | " "; |
---|
907 | setring lastRing; |
---|
908 | "// the map to the new ring"; |
---|
909 | endphi; |
---|
910 | " "; |
---|
911 | pause(); |
---|
912 | ""; |
---|
913 | } |
---|
914 | L = lastRing; |
---|
915 | L = insert(L,0,1); |
---|
916 | L[3] = delt; |
---|
917 | return(L); |
---|
918 | } |
---|
919 | example |
---|
920 | {"EXAMPLE:"; echo = 2; |
---|
921 | ring r = 0,(x,y),wp(2,3); |
---|
922 | ideal id = y^2-x^3; |
---|
923 | ideal J = x,y; |
---|
924 | poly p = x; |
---|
925 | list Li = std(id),id,J,p; |
---|
926 | list L = HomJJ(Li); |
---|
927 | def end = L[1]; // defines ring L[1], containing ideals endid, endphi |
---|
928 | setring end; // makes end the basering |
---|
929 | end; |
---|
930 | endid; // end/endid is isomorphic to End(r/id) as ring |
---|
931 | map psi = r,endphi;// defines the canonical map r/id -> End(r/id) |
---|
932 | psi; |
---|
933 | L[3]; // contribution to delta |
---|
934 | } |
---|
935 | |
---|
936 | |
---|
937 | /////////////////////////////////////////////////////////////////////////////// |
---|
938 | //compute intersection multiplicities as needed for delta(I) in |
---|
939 | //normalizationPrimes and normalP: |
---|
940 | |
---|
941 | proc iMult (list prim) |
---|
942 | "USAGE: iMult(L); L a list of ideals |
---|
943 | RETURN: int, the intersection multiplicity of the ideals of L; |
---|
944 | if iMult(L) is infinite, -1 is returned. |
---|
945 | THEORY: If r=size(L)=2 then iMult(L) = vdim(std(L[1]+L[2])) and in general |
---|
946 | iMult(L) = sum{ iMult(L[j],Lj) | j=1..r-1 } with Lj the intersection |
---|
947 | of L[j+1],...,L[r]. If I is the intersection of all ideals in L then |
---|
948 | we have delta(I) = delta(L[1])+...+delta(L[r]) + iMult(L) where |
---|
949 | delta(I) = vdim (normalisation(R/I)/(R/I)), R the basering. |
---|
950 | EXAMPLE: example iMult; shows an example |
---|
951 | " |
---|
952 | { int i,mul,mu; |
---|
953 | int sp = size(prim); |
---|
954 | int y = printlevel-voice+2; |
---|
955 | if ( sp > 1 ) |
---|
956 | { |
---|
957 | ideal I(sp-1) = prim[sp]; |
---|
958 | mu = vdim(std(I(sp-1)+prim[sp-1])); |
---|
959 | mul = mu; |
---|
960 | if ( y>=1 ) |
---|
961 | { |
---|
962 | "// intersection multiplicity of component",sp,"with",sp-1,":"; mu; |
---|
963 | } |
---|
964 | if ( mu >= 0 ) |
---|
965 | { |
---|
966 | for (i=sp-2; i>=1 ; i--) |
---|
967 | { |
---|
968 | ideal I(i) = intersect(I(i+1),prim[i+1]); |
---|
969 | mu = vdim(std(I(i)+prim[i])); |
---|
970 | if ( mu < 0 ) |
---|
971 | { |
---|
972 | break; |
---|
973 | } |
---|
974 | mul = mul + mu; |
---|
975 | if ( y>=1 ) |
---|
976 | { |
---|
977 | "// intersection multiplicity of components",sp,"...",i+1,"with",i; mu; |
---|
978 | } |
---|
979 | } |
---|
980 | } |
---|
981 | } |
---|
982 | return(mul); |
---|
983 | } |
---|
984 | example |
---|
985 | { "EXAMPLE:"; echo = 2; |
---|
986 | ring s = 23,(x,y),dp; |
---|
987 | list L = (x-y),(x3+y2); |
---|
988 | iMult(L); |
---|
989 | L = (x-y),(x3+y2),(x3-y4); |
---|
990 | iMult(L); |
---|
991 | } |
---|
992 | /////////////////////////////////////////////////////////////////////////////// |
---|
993 | //check if I has a singularity only at zero, as needed in normalizationPrimes |
---|
994 | |
---|
995 | proc locAtZero (ideal I) |
---|
996 | "USAGE: locAtZero(I); I = ideal |
---|
997 | RETURN: int, 1 if I has only one point which is located at zero, 0 otherwise |
---|
998 | ASSUME: I is given as a standard bases in the basering |
---|
999 | NOTE: only useful in affine rings, in local rings vdim does the check |
---|
1000 | EXAMPLE: example locAtZero; shows an example |
---|
1001 | " |
---|
1002 | { |
---|
1003 | int ii,jj, caz; //caz: conzentrated at zero |
---|
1004 | int dbp = printlevel-voice+2; |
---|
1005 | int nva = nvars(basering); |
---|
1006 | int vdi = vdim(I); |
---|
1007 | if ( vdi < 0 ) |
---|
1008 | { |
---|
1009 | if (dbp >=1) |
---|
1010 | { "// non-isolated singularitiy";""; } |
---|
1011 | return(caz); |
---|
1012 | } |
---|
1013 | |
---|
1014 | //Now the ideal is 0-dim |
---|
1015 | //First an easy test |
---|
1016 | //If I is homogenous and not constant it is concentrated at 0 |
---|
1017 | if( homog(I)==1 && size(jet(I,0))==0) |
---|
1018 | { |
---|
1019 | caz=1; |
---|
1020 | if (dbp >=1) |
---|
1021 | { "// isolated singularity and homogeneous";""; } |
---|
1022 | return(caz); |
---|
1023 | } |
---|
1024 | |
---|
1025 | //Now the general case with I 0-dim. Choose an appropriate power pot, |
---|
1026 | //and check each variable x whether x^pot is in I. |
---|
1027 | int mi1 = mindeg1(lead(I)); |
---|
1028 | int pot = vdi; |
---|
1029 | if ( (mi1+(mi1==1))^2 < vdi ) |
---|
1030 | { |
---|
1031 | pot = (mi1+(mi1==1))^2; //### alternativ: pot = vdi lassen |
---|
1032 | } |
---|
1033 | |
---|
1034 | while ( 1 ) |
---|
1035 | { |
---|
1036 | caz = 1; |
---|
1037 | for ( ii=1; ii<= nva; ii++ ) |
---|
1038 | { |
---|
1039 | if ( NF(var(ii)^pot,I) != 0 ) |
---|
1040 | { |
---|
1041 | caz = 0; break; |
---|
1042 | } |
---|
1043 | } |
---|
1044 | if ( caz == 1 || pot >= vdi ) |
---|
1045 | { |
---|
1046 | if (dbp >=1) |
---|
1047 | { |
---|
1048 | "// mindeg, exponent, vdim used in 'locAtZero':", mi1,pot,vdi; ""; |
---|
1049 | } |
---|
1050 | return(caz); |
---|
1051 | } |
---|
1052 | else |
---|
1053 | { |
---|
1054 | if ( pot^2 < vdi ) |
---|
1055 | { pot = pot^2; } |
---|
1056 | else |
---|
1057 | { pot = vdi; } |
---|
1058 | } |
---|
1059 | } |
---|
1060 | } |
---|
1061 | example |
---|
1062 | { "EXAMPLE:"; echo = 2; |
---|
1063 | ring r = 0,(x,y,z),dp; |
---|
1064 | poly f = z5+y4+x3+xyz; |
---|
1065 | ideal i = jacob(f),f; |
---|
1066 | i=std(i); |
---|
1067 | locAtZero(i); |
---|
1068 | i= std(i*ideal(x-1,y,z)); |
---|
1069 | locAtZero(i); |
---|
1070 | } |
---|
1071 | |
---|
1072 | /////////////////////////////////////////////////////////////////////////////// |
---|
1073 | |
---|
1074 | //The next procedure normalizationPrimes computes the normalization of an |
---|
1075 | //irreducible or an equidimensional ideal i. |
---|
1076 | //- If i is irreducuble, then the returned list, say nor, has size 2 |
---|
1077 | //with nor[1] the normalization ring and nor[2] the delta invariant. |
---|
1078 | //- If i is equidimensional, than the "splitting tools" can create a |
---|
1079 | //decomposition of i and nor can have more than 1 ring. |
---|
1080 | |
---|
1081 | static proc normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #) |
---|
1082 | "USAGE: normalizationPrimes(i,ihp,delt[,si]); i = equidimensional ideal, |
---|
1083 | ihp = map (partial normalization), delt = partial delta-invariant, |
---|
1084 | si = ideal s.t. V(si) contains singular locus (optional) |
---|
1085 | RETURN: a list of rings, say nor, and an integer, the delta-invariant |
---|
1086 | at the end of the list. |
---|
1087 | each ring nor[j], j = 1..size(nor)-1, contains two ideals |
---|
1088 | with given names norid and normap such that |
---|
1089 | - the direct sum of the rings nor[j]/norid is |
---|
1090 | the normalization of basering/i; |
---|
1091 | - normap gives the normalization map from basering/id |
---|
1092 | to nor[j]/norid (for each j) |
---|
1093 | nor[size(nor)] = dim_K(normalisation(P/i) / (P/i)) is the |
---|
1094 | delta-invariant, where P is the basering. |
---|
1095 | EXAMPLE: example normalizationPrimes; shows an example |
---|
1096 | " |
---|
1097 | { |
---|
1098 | //Note: this procedure calls itself as long as the test for |
---|
1099 | //normality, i.e if R==Hom(J,J), is negative. |
---|
1100 | |
---|
1101 | int printlev = printlevel; //store printlevel in order to reset it later |
---|
1102 | int y = printlevel-voice+2; // y=printlevel (default: y=0) |
---|
1103 | if(y>=1) |
---|
1104 | { |
---|
1105 | ""; |
---|
1106 | "// START a normalization loop with the ideal"; |
---|
1107 | i; ""; |
---|
1108 | "// in the ring:"; |
---|
1109 | basering; ""; |
---|
1110 | pause(); |
---|
1111 | ""; |
---|
1112 | } |
---|
1113 | |
---|
1114 | def BAS=basering; |
---|
1115 | list result,keepresult1,keepresult2,JM,gnirlist; |
---|
1116 | ideal J,SB,MB; |
---|
1117 | int depth,lauf,prdim,osaz; |
---|
1118 | int ti=timer; |
---|
1119 | |
---|
1120 | gnirlist = ringlist(BAS); |
---|
1121 | |
---|
1122 | //----------- the trivial case of a zero ideal as input, RETURN ------------ |
---|
1123 | if(size(i)==0) |
---|
1124 | { |
---|
1125 | if(y>=1) |
---|
1126 | { |
---|
1127 | "// the ideal was the zero-ideal"; |
---|
1128 | } |
---|
1129 | // execute("ring newR7="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1130 | // +ordstr(basering)+");"); |
---|
1131 | def newR7 = ring(gnirlist); |
---|
1132 | setring newR7; |
---|
1133 | ideal norid=ideal(0); |
---|
1134 | ideal normap=fetch(BAS,ihp); |
---|
1135 | export norid; |
---|
1136 | export normap; |
---|
1137 | result=newR7; |
---|
1138 | result[size(result)+1]=list(delt,delti); |
---|
1139 | setring BAS; |
---|
1140 | return(result); |
---|
1141 | } |
---|
1142 | |
---|
1143 | //--------------- General NOTATION, compute SB of input ----------------- |
---|
1144 | // SM is a list, the result of mstd(i) |
---|
1145 | // SM[1] = SB of input ideal i, |
---|
1146 | // SM[2] = (minimal) generators for i. |
---|
1147 | // We work with SM and will copy the attributes from i to SM[2] |
---|
1148 | // JM will be a list, either JM[1]=maxideal(1),JM[2]=maxideal(1) |
---|
1149 | // in case i has onlySingularAtZero, or JM = mstd(si) where si = #[1], |
---|
1150 | // or JM = mstd(J) where J is the ideal of the singular locus |
---|
1151 | // JM[2] must be (made) radical |
---|
1152 | |
---|
1153 | if(y>=1) |
---|
1154 | { |
---|
1155 | "// SB-computation of the ideal"; |
---|
1156 | } |
---|
1157 | |
---|
1158 | list SM = mstd(i); //Now the work starts |
---|
1159 | int dimSM = dim(SM[1]); //dimension of variety to normalize |
---|
1160 | if(y>=1) |
---|
1161 | { |
---|
1162 | "// the dimension is:"; dimSM; |
---|
1163 | } |
---|
1164 | //----------------- the general case, set attributes ---------------- |
---|
1165 | //Note: onlySingularAtZero is NOT preserved under the ring extension |
---|
1166 | //basering --> Hom(J,J) (in contrast to isIsolatedSingularity), |
---|
1167 | //therefore we reset it: |
---|
1168 | |
---|
1169 | attrib(i,"onlySingularAtZero",0); |
---|
1170 | |
---|
1171 | if(attrib(i,"isPrim")==1) |
---|
1172 | { |
---|
1173 | attrib(SM[2],"isPrim",1); |
---|
1174 | } |
---|
1175 | else |
---|
1176 | { |
---|
1177 | attrib(SM[2],"isPrim",0); |
---|
1178 | } |
---|
1179 | if(attrib(i,"isIsolatedSingularity")==1) |
---|
1180 | { |
---|
1181 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
1182 | } |
---|
1183 | else |
---|
1184 | { |
---|
1185 | attrib(SM[2],"isIsolatedSingularity",0); |
---|
1186 | } |
---|
1187 | if(attrib(i,"isCohenMacaulay")==1) |
---|
1188 | { |
---|
1189 | attrib(SM[2],"isCohenMacaulay",1); |
---|
1190 | } |
---|
1191 | else |
---|
1192 | { |
---|
1193 | attrib(SM[2],"isCohenMacaulay",0); |
---|
1194 | } |
---|
1195 | if(attrib(i,"isRegInCodim2")==1) |
---|
1196 | { |
---|
1197 | attrib(SM[2],"isRegInCodim2",1); |
---|
1198 | } |
---|
1199 | else |
---|
1200 | { |
---|
1201 | attrib(SM[2],"isRegInCodim2",0); |
---|
1202 | } |
---|
1203 | if(attrib(i,"isEquidimensional")==1) |
---|
1204 | { |
---|
1205 | attrib(SM[2],"isEquidimensional",1); |
---|
1206 | } |
---|
1207 | else |
---|
1208 | { |
---|
1209 | attrib(SM[2],"isEquidimensional",0); |
---|
1210 | } |
---|
1211 | if(attrib(i,"isCompleteIntersection")==1) |
---|
1212 | { |
---|
1213 | attrib(SM[2],"isCompleteIntersection",1); |
---|
1214 | } |
---|
1215 | else |
---|
1216 | { |
---|
1217 | attrib(SM[2],"isCompleteIntersection",0); |
---|
1218 | } |
---|
1219 | if(attrib(i,"isHypersurface")==1) |
---|
1220 | { |
---|
1221 | attrib(SM[2],"isHypersurface",1); |
---|
1222 | } |
---|
1223 | else |
---|
1224 | { |
---|
1225 | attrib(SM[2],"isHypersurface",0); |
---|
1226 | } |
---|
1227 | |
---|
1228 | if(attrib(i,"onlySingularAtZero")==1) |
---|
1229 | { |
---|
1230 | attrib(SM[2],"onlySingularAtZero",1); |
---|
1231 | } |
---|
1232 | else |
---|
1233 | { |
---|
1234 | attrib(SM[2],"onlySingularAtZero",0); |
---|
1235 | } |
---|
1236 | |
---|
1237 | //------- an easy and cheap test for onlySingularAtZero --------- |
---|
1238 | if( (attrib(SM[2],"isIsolatedSingularity")==1) && (homog(SM[2])==1) ) |
---|
1239 | { |
---|
1240 | attrib(SM[2],"onlySingularAtZero",1); |
---|
1241 | } |
---|
1242 | |
---|
1243 | //-------------------- Trivial cases, in each case RETURN ------------------ |
---|
1244 | // input ideal is the ideal of a partial normalization |
---|
1245 | |
---|
1246 | // ------------ Trivial case: input ideal contains a unit --------------- |
---|
1247 | if( dimSM == -1) |
---|
1248 | { ""; |
---|
1249 | " // A unit ideal was found."; |
---|
1250 | " // Stop with partial result computed so far";""; |
---|
1251 | |
---|
1252 | MB=SM[2]; |
---|
1253 | intvec rw; |
---|
1254 | list LL=substpart(MB,ihp,0,rw); |
---|
1255 | def newR6=LL[1]; |
---|
1256 | setring newR6; |
---|
1257 | ideal norid=endid; |
---|
1258 | ideal normap=endphi; |
---|
1259 | kill endid,endphi; |
---|
1260 | export norid; |
---|
1261 | export normap; |
---|
1262 | result=newR6; |
---|
1263 | result[size(result)+1]=list(delt,delti); |
---|
1264 | setring BAS; |
---|
1265 | return(result); |
---|
1266 | } |
---|
1267 | |
---|
1268 | // --- Trivial case: input ideal is zero-dimensional and homog --- |
---|
1269 | if( (dim(SM[1])==0) && (homog(SM[2])==1) ) |
---|
1270 | { |
---|
1271 | if(y>=1) |
---|
1272 | { |
---|
1273 | "// the ideal was zero-dimensional and homogeneous"; |
---|
1274 | } |
---|
1275 | MB=maxideal(1); |
---|
1276 | intvec rw; |
---|
1277 | list LL=substpart(MB,ihp,0,rw); |
---|
1278 | def newR5=LL[1]; |
---|
1279 | setring newR5; |
---|
1280 | ideal norid=endid; |
---|
1281 | ideal normap=endphi; |
---|
1282 | kill endid,endphi; |
---|
1283 | export norid; |
---|
1284 | export normap; |
---|
1285 | result=newR5; |
---|
1286 | result[size(result)+1]=list(delt,delti); |
---|
1287 | setring BAS; |
---|
1288 | return(result); |
---|
1289 | } |
---|
1290 | |
---|
1291 | // --- Trivial case: input ideal defines a line --- |
---|
1292 | //the one-dimensional, homogeneous case and degree 1 case |
---|
1293 | if( (dim(SM[1])==1) && (maxdeg1(SM[2])==1) && (homog(SM[2])==1) ) |
---|
1294 | { |
---|
1295 | if(y>=1) |
---|
1296 | { |
---|
1297 | "// the ideal defines a line"; |
---|
1298 | } |
---|
1299 | MB=SM[2]; |
---|
1300 | intvec rw; |
---|
1301 | list LL=substpart(MB,ihp,0,rw); |
---|
1302 | def newR4=LL[1]; |
---|
1303 | setring newR4; |
---|
1304 | ideal norid=endid; |
---|
1305 | ideal normap=endphi; |
---|
1306 | kill endid,endphi; |
---|
1307 | export norid; |
---|
1308 | export normap; |
---|
1309 | result=newR4; |
---|
1310 | result[size(result)+1]=list(delt,delti); |
---|
1311 | setring BAS; |
---|
1312 | return(result); |
---|
1313 | } |
---|
1314 | |
---|
1315 | //---------------------- The non-trivial cases start ------------------- |
---|
1316 | //the higher dimensional case |
---|
1317 | //we test first hypersurface, CohenMacaulay and complete intersection |
---|
1318 | |
---|
1319 | if( ((size(SM[2])+dim(SM[1])) == nvars(basering)) ) |
---|
1320 | { |
---|
1321 | //the test for complete intersection |
---|
1322 | attrib(SM[2],"isCohenMacaulay",1); |
---|
1323 | attrib(SM[2],"isCompleteIntersection",1); |
---|
1324 | attrib(SM[2],"isEquidimensional",1); |
---|
1325 | if(y>=1) |
---|
1326 | { |
---|
1327 | "// the ideal is a complete intersection"; |
---|
1328 | } |
---|
1329 | } |
---|
1330 | if( size(SM[2]) == 1 ) |
---|
1331 | { |
---|
1332 | attrib(SM[2],"isHypersurface",1); |
---|
1333 | if(y>=1) |
---|
1334 | { |
---|
1335 | "// the ideal is a hypersurface"; |
---|
1336 | } |
---|
1337 | } |
---|
1338 | |
---|
1339 | //------------------- compute the singular locus ------------------- |
---|
1340 | // Computation if singular locus is critical |
---|
1341 | // Notation: J ideal of singular locus or (if given) containing it |
---|
1342 | // JM = mstd(J) or maxideal(1),maxideal(1) |
---|
1343 | // JM[1] SB of singular locus, JM[2] minbasis, dimJ = dim(JM[1]) |
---|
1344 | // SM[1] SB of the input ideal i, SM[2] minbasis |
---|
1345 | // Computation if singular locus is critical, because it determines the |
---|
1346 | // size of the ring Hom_R(J,J). We only need a test ideal contained in J. |
---|
1347 | |
---|
1348 | //----------------------- onlySingularAtZero ------------------------- |
---|
1349 | if( attrib(SM[2],"onlySingularAtZero") ) |
---|
1350 | { |
---|
1351 | JM = maxideal(1),maxideal(1); |
---|
1352 | attrib(JM[1],"isSB",1); |
---|
1353 | attrib(JM[2],"isRadical",1); |
---|
1354 | if( dim(SM[1]) >=2 ) |
---|
1355 | { |
---|
1356 | attrib(SM[2],"isRegInCodim2",1); |
---|
1357 | } |
---|
1358 | } |
---|
1359 | |
---|
1360 | //-------------------- not onlySingularAtZero ------------------------- |
---|
1361 | if( attrib(SM[2],"onlySingularAtZero") == 0 ) |
---|
1362 | { |
---|
1363 | //--- the case where an ideal #[1] is given: |
---|
1364 | if( size(#)>0 ) |
---|
1365 | { |
---|
1366 | J = #[1],SM[2]; |
---|
1367 | JM = mstd(J); |
---|
1368 | if( typeof(attrib(#[1],"isRadical"))!="int" ) |
---|
1369 | { |
---|
1370 | attrib(JM[2],"isRadical",0); |
---|
1371 | } |
---|
1372 | } |
---|
1373 | |
---|
1374 | //--- the case where an ideal #[1] is not given: |
---|
1375 | if( (size(#)==0) ) |
---|
1376 | { |
---|
1377 | if(y >=1 ) |
---|
1378 | { |
---|
1379 | "// singular locus will be computed"; |
---|
1380 | } |
---|
1381 | |
---|
1382 | J = SM[1],minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]); |
---|
1383 | if( y >=1 ) |
---|
1384 | { |
---|
1385 | "// SB of singular locus will be computed"; |
---|
1386 | } |
---|
1387 | JM = mstd(J); |
---|
1388 | } |
---|
1389 | |
---|
1390 | int dimJ = dim(JM[1]); |
---|
1391 | attrib(JM[1],"isSB",1); |
---|
1392 | if( y>=1 ) |
---|
1393 | { |
---|
1394 | "// the dimension of the singular locus is"; dimJ ; ""; |
---|
1395 | } |
---|
1396 | |
---|
1397 | if(dim(JM[1]) <= dim(SM[1])-2) |
---|
1398 | { |
---|
1399 | attrib(SM[2],"isRegInCodim2",1); |
---|
1400 | } |
---|
1401 | |
---|
1402 | //------------------ the smooth case, RETURN ------------------- |
---|
1403 | if( dimJ == -1 ) |
---|
1404 | { |
---|
1405 | if(y>=1) |
---|
1406 | { |
---|
1407 | "// the ideal is smooth"; |
---|
1408 | } |
---|
1409 | MB=SM[2]; |
---|
1410 | intvec rw; |
---|
1411 | list LL=substpart(MB,ihp,0,rw); |
---|
1412 | def newR3=LL[1]; |
---|
1413 | setring newR3; |
---|
1414 | ideal norid=endid; |
---|
1415 | ideal normap=endphi; |
---|
1416 | kill endid,endphi; |
---|
1417 | export norid; |
---|
1418 | export normap; |
---|
1419 | result=newR3; |
---|
1420 | result[size(result)+1]=list(delt,delti); |
---|
1421 | setring BAS; |
---|
1422 | return(result); |
---|
1423 | } |
---|
1424 | |
---|
1425 | //------- extra check for onlySingularAtZero, relatively cheap ---------- |
---|
1426 | //it uses the procedure 'locAtZero' from for testing |
---|
1427 | //if an ideal is concentrated at 0 |
---|
1428 | if(y>=1) |
---|
1429 | { |
---|
1430 | "// extra test for onlySingularAtZero:"; |
---|
1431 | } |
---|
1432 | if ( locAtZero(JM[1]) ) |
---|
1433 | { |
---|
1434 | attrib(SM[2],"onlySingularAtZero",1); |
---|
1435 | JM = maxideal(1),maxideal(1); |
---|
1436 | attrib(JM[1],"isSB",1); |
---|
1437 | attrib(JM[2],"isRadical",1); |
---|
1438 | } |
---|
1439 | else |
---|
1440 | { |
---|
1441 | attrib(SM[2],"onlySingularAtZero",0); |
---|
1442 | } |
---|
1443 | } |
---|
1444 | |
---|
1445 | //displaying the attributes: |
---|
1446 | if(y>=2) |
---|
1447 | { |
---|
1448 | "// the attributes of the ideal are:"; |
---|
1449 | "// isCohenMacaulay:", attrib(SM[2],"isCohenMacaulay"); |
---|
1450 | "// isCompleteIntersection:", attrib(SM[2],"isCompleteIntersection"); |
---|
1451 | "// isHypersurface:", attrib(SM[2],"isHypersurface"); |
---|
1452 | "// isEquidimensional:", attrib(SM[2],"isEquidimensional"); |
---|
1453 | "// isPrim:", attrib(SM[2],"isPrim"); |
---|
1454 | "// isRegInCodim2:", attrib(SM[2],"isRegInCodim2"); |
---|
1455 | "// isIsolatedSingularity:", attrib(SM[2],"isIsolatedSingularity"); |
---|
1456 | "// onlySingularAtZero:", attrib(SM[2],"onlySingularAtZero"); |
---|
1457 | "// isRad:", attrib(SM[2],"isRad");""; |
---|
1458 | } |
---|
1459 | |
---|
1460 | //------------- case: CohenMacaulay in codim 2, RETURN --------------- |
---|
1461 | if( (attrib(SM[2],"isRegInCodim2")==1) && |
---|
1462 | (attrib(SM[2],"isCohenMacaulay")==1) ) |
---|
1463 | { |
---|
1464 | if(y>=1) |
---|
1465 | { |
---|
1466 | "// the ideal was CohenMacaulay and regular in codim 2, hence normal"; |
---|
1467 | } |
---|
1468 | MB=SM[2]; |
---|
1469 | intvec rw; |
---|
1470 | list LL=substpart(MB,ihp,0,rw); |
---|
1471 | def newR6=LL[1]; |
---|
1472 | setring newR6; |
---|
1473 | ideal norid=endid; |
---|
1474 | ideal normap=endphi; |
---|
1475 | kill endid,endphi; |
---|
1476 | export norid; |
---|
1477 | export normap; |
---|
1478 | result=newR6; |
---|
1479 | result[size(result)+1]=list(delt,delti); |
---|
1480 | setring BAS; |
---|
1481 | return(result); |
---|
1482 | } |
---|
1483 | |
---|
1484 | //---------- case: isolated singularity only at 0, RETURN ------------ |
---|
1485 | // In this case things are easier, we can use the maximal ideal as radical |
---|
1486 | // of the singular locus; |
---|
1487 | // JM mstd of ideal of singular locus, SM mstd of input ideal |
---|
1488 | |
---|
1489 | if( attrib(SM[2],"onlySingularAtZero") ) |
---|
1490 | { |
---|
1491 | //------ check variables for being a non zero-divizor ------ |
---|
1492 | // SL = ideal of vars not contained in ideal SM[1]: |
---|
1493 | |
---|
1494 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
1495 | ideal SL = simplify(reduce(maxideal(1),SM[1]),2); |
---|
1496 | ideal Ann = quotient(SM[2],SL[1]); |
---|
1497 | ideal qAnn = simplify(reduce(Ann,SM[1]),2); |
---|
1498 | //NOTE: qAnn=0 if and only if first var (=SL[1]) not in SM is a nzd of R/SM |
---|
1499 | |
---|
1500 | //------------- We found a non-zerodivisor of R/SM ----------------------- |
---|
1501 | // here the enlarging of the ring via Hom_R(J,J) starts |
---|
1502 | |
---|
1503 | if( size(qAnn)==0 ) |
---|
1504 | { |
---|
1505 | if(y>=1) |
---|
1506 | { |
---|
1507 | ""; |
---|
1508 | "// the ideal rad(J):"; maxideal(1); |
---|
1509 | ""; |
---|
1510 | } |
---|
1511 | |
---|
1512 | // ------------- test for normality, compute Hom_R(J,J) ------------- |
---|
1513 | // Note: |
---|
1514 | // HomJJ (ideal SBid, ideal id, ideal J, poly p) with |
---|
1515 | // SBid = SB of id, J = radical ideal of basering P with: |
---|
1516 | // nonNormal(R) is in V(J), J contains the nonzero divisor p |
---|
1517 | // of R = P/id (J = test ideal) |
---|
1518 | // returns a list l of three objects |
---|
1519 | // l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi' |
---|
1520 | // s.t. l[1]/endid = Hom_R(J,J) and endphi= map R -> Hom_R(J,J) |
---|
1521 | // l[2] : an integer which is 1 if phi is an isomorphism, 0 if not |
---|
1522 | // l[3] : an integer, = dim_K(Hom_R(J,J)/R) if finite, -1 otherwise |
---|
1523 | |
---|
1524 | list RR; |
---|
1525 | RR = SM[1],SM[2],maxideal(1),SL[1]; |
---|
1526 | RR = HomJJ(RR,y); |
---|
1527 | // --------------------- non-normal case ------------------ |
---|
1528 | //RR[2]==0 means that the test for normality is negative |
---|
1529 | if( RR[2]==0 ) |
---|
1530 | { |
---|
1531 | def newR=RR[1]; |
---|
1532 | setring newR; |
---|
1533 | map psi=BAS,endphi; |
---|
1534 | list JM = psi(JM); //### |
---|
1535 | ideal J = JM[2]; |
---|
1536 | if ( delt>=0 && RR[3]>=0 ) |
---|
1537 | { |
---|
1538 | delt = delt+RR[3]; |
---|
1539 | } |
---|
1540 | else |
---|
1541 | { delt = -1; } |
---|
1542 | delti[size(delti)]=delt; |
---|
1543 | |
---|
1544 | // ---------- recursive call of normalizationPrimes ----------- |
---|
1545 | //normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #) |
---|
1546 | //ihp = (partial) normalisation map from basering |
---|
1547 | //#[1] ideal s.t. V(#[1]) contains singular locus of i (test ideal) |
---|
1548 | |
---|
1549 | if ( y>=1 ) |
---|
1550 | { |
---|
1551 | "// case: onlySingularAtZero, non-zerodivisor found"; |
---|
1552 | "// contribution of delta in ringextension R -> Hom_R(J,J):"; delt; |
---|
1553 | } |
---|
1554 | |
---|
1555 | //intvec atr=getAttrib(endid); |
---|
1556 | //"//### case: isolated singularity only at 0, recursive"; |
---|
1557 | //"size endid:", size(endid), size(string(endid)); |
---|
1558 | //"interred:"; |
---|
1559 | //endid = interred(endid); |
---|
1560 | //endid = setAttrib(endid,atr); |
---|
1561 | //"size endid:", size(endid), size(string(endid)); |
---|
1562 | |
---|
1563 | printlevel=printlevel+1; |
---|
1564 | list tluser = |
---|
1565 | normalizationPrimes(endid,psi(ihp),delt,delti); |
---|
1566 | //list tluser = |
---|
1567 | // normalizationPrimes(endid,psi(ihp),delt,delti,J); |
---|
1568 | //#### ??? improvement: give also the old ideal of sing locus??? |
---|
1569 | |
---|
1570 | printlevel = printlev; //reset printlevel |
---|
1571 | setring BAS; |
---|
1572 | return(tluser); |
---|
1573 | } |
---|
1574 | |
---|
1575 | // ------------------ the normal case, RETURN ----------------- |
---|
1576 | // Now RR[2] must be 1, hence the test for normality was positive |
---|
1577 | MB=SM[2]; |
---|
1578 | //execute("ring newR7="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1579 | // +ordstr(basering)+");"); |
---|
1580 | def newR7 = ring(gnirlist); |
---|
1581 | setring newR7; |
---|
1582 | ideal norid=fetch(BAS,MB); |
---|
1583 | ideal normap=fetch(BAS,ihp); |
---|
1584 | if ( delt>=0 && RR[3]>=0 ) |
---|
1585 | { |
---|
1586 | delt = delt+RR[3]; |
---|
1587 | } |
---|
1588 | else |
---|
1589 | { delt = -1; } |
---|
1590 | delti[size(delti)]=delt; |
---|
1591 | |
---|
1592 | intvec atr = getAttrib(norid); |
---|
1593 | |
---|
1594 | //"//### case: isolated singularity only at 0, final"; |
---|
1595 | //"size norid:", size(norid), size(string(norid)); |
---|
1596 | //"interred:"; |
---|
1597 | //norid = interred(norid); |
---|
1598 | //norid = setAttrib(norid,atr); |
---|
1599 | //"size norid:", size(norid), size(string(norid)); |
---|
1600 | |
---|
1601 | export norid; |
---|
1602 | export normap; |
---|
1603 | result=newR7; |
---|
1604 | result[size(result)+1]=list(delt,delti); |
---|
1605 | setring BAS; |
---|
1606 | return(result); |
---|
1607 | } |
---|
1608 | |
---|
1609 | //------ zerodivisor of R/SM was found, gives a splitting ------------ |
---|
1610 | //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM |
---|
1611 | //and we have found a splitting: id and id1 |
---|
1612 | //id = Ann defines components of R/SM in the complement of V(SL[1]) |
---|
1613 | //id1 defines components of R/SM in the complement of V(id) |
---|
1614 | |
---|
1615 | else |
---|
1616 | { |
---|
1617 | ideal id = Ann; |
---|
1618 | attrib(id,"isCohenMacaulay",0); |
---|
1619 | attrib(id,"isPrim",0); |
---|
1620 | attrib(id,"isIsolatedSingularity",1); |
---|
1621 | attrib(id,"isRegInCodim2",0); |
---|
1622 | attrib(id,"isHypersurface",0); |
---|
1623 | attrib(id,"isCompleteIntersection",0); |
---|
1624 | attrib(id,"isEquidimensional",0); |
---|
1625 | attrib(id,"onlySingularAtZero",1); |
---|
1626 | |
---|
1627 | ideal id1 = quotient(SM[2],Ann); |
---|
1628 | attrib(id1,"isCohenMacaulay",0); |
---|
1629 | attrib(id1,"isPrim",0); |
---|
1630 | attrib(id1,"isIsolatedSingularity",1); |
---|
1631 | attrib(id1,"isRegInCodim2",0); |
---|
1632 | attrib(id1,"isHypersurface",0); |
---|
1633 | attrib(id1,"isCompleteIntersection",0); |
---|
1634 | attrib(id1,"isEquidimensional",0); |
---|
1635 | attrib(id1,"onlySingularAtZero",1); |
---|
1636 | |
---|
1637 | // ---------- recursive call of normalizationPrimes ----------- |
---|
1638 | if ( y>=1 ) |
---|
1639 | { |
---|
1640 | "// case: onlySingularAtZero, zerodivisor found, splitting:"; |
---|
1641 | "// total delta before splitting:", delt; |
---|
1642 | "// splitting in two components:"; |
---|
1643 | } |
---|
1644 | |
---|
1645 | printlevel = printlevel+1; //to see comments in normalizationPrimes |
---|
1646 | keepresult1 = normalizationPrimes(id,ihp,0,0); //1st split factor |
---|
1647 | keepresult2 = normalizationPrimes(id1,ihp,0,0); //2nd split factor |
---|
1648 | printlevel = printlev; //reset printlevel |
---|
1649 | |
---|
1650 | int delt1 = keepresult1[size(keepresult1)][1]; |
---|
1651 | int delt2 = keepresult2[size(keepresult2)][1]; |
---|
1652 | intvec delti1 = keepresult1[size(keepresult1)][2]; |
---|
1653 | intvec delti2 = keepresult2[size(keepresult2)][2]; |
---|
1654 | |
---|
1655 | if( delt>=0 && delt1>=0 && delt2>=0 ) |
---|
1656 | { ideal idid1=id,id1; |
---|
1657 | int mul = vdim(std(idid1)); |
---|
1658 | if ( mul>=0 ) |
---|
1659 | { |
---|
1660 | delt = delt+mul+delt1+delt2; |
---|
1661 | } |
---|
1662 | else |
---|
1663 | { |
---|
1664 | delt = -1; |
---|
1665 | } |
---|
1666 | } |
---|
1667 | if ( y>=1 ) |
---|
1668 | { |
---|
1669 | "// delta of first component:", delt1; |
---|
1670 | "// delta of second componenet:", delt2; |
---|
1671 | "// intersection multiplicity of both components:", mul; |
---|
1672 | "// total delta after splitting:", delt; |
---|
1673 | } |
---|
1674 | |
---|
1675 | else |
---|
1676 | { |
---|
1677 | delt = -1; |
---|
1678 | } |
---|
1679 | for(lauf=1;lauf<=size(keepresult2)-1;lauf++) |
---|
1680 | { |
---|
1681 | keepresult1=insert(keepresult1,keepresult2[lauf]); |
---|
1682 | } |
---|
1683 | keepresult1[size(keepresult1)]=list(delt,delti); |
---|
1684 | |
---|
1685 | return(keepresult1); |
---|
1686 | } |
---|
1687 | } |
---|
1688 | // Case "onlySingularAtZero" has finished and returned result |
---|
1689 | |
---|
1690 | //-------------- General case, not onlySingularAtZero, RETURN --------------- |
---|
1691 | //test for non-normality, i.e. if Hom(I,I)<>R |
---|
1692 | //we can use Hom(I,I) to continue |
---|
1693 | |
---|
1694 | //------ check variables for being a non zero-divizor ------ |
---|
1695 | // SL = ideal of vars not contained in ideal SM[1]: |
---|
1696 | |
---|
1697 | ideal SL = simplify(reduce(JM[2],SM[1]),2); |
---|
1698 | ideal Ann = quotient(SM[2],SL[1]); |
---|
1699 | ideal qAnn = simplify(reduce(Ann,SM[1]),2); |
---|
1700 | //NOTE: qAnn=0 <==> first var (=SL[1]) not contained in SM is a nzd of R/SM |
---|
1701 | |
---|
1702 | //------------- We found a non-zerodivisor of R/SM ----------------------- |
---|
1703 | //SM = mstd of ideal of variety, JM = mstd of ideal of singular locus |
---|
1704 | |
---|
1705 | if( size(qAnn)==0 ) |
---|
1706 | { |
---|
1707 | list RR; |
---|
1708 | list RS; |
---|
1709 | // ----------------- Computation of the radical ----------------- |
---|
1710 | if(y>=1) |
---|
1711 | { |
---|
1712 | "// radical computation of singular locus"; |
---|
1713 | } |
---|
1714 | J = radical(JM[2]); //the radical of singular locus |
---|
1715 | JM = mstd(J); |
---|
1716 | |
---|
1717 | if(y>=1) |
---|
1718 | { |
---|
1719 | "// radical is equal to:";""; JM[2]; |
---|
1720 | ""; |
---|
1721 | } |
---|
1722 | // ------------ choose non-zerodivisor of smaller degree ---------- |
---|
1723 | //### evtl. fuer SL[1] anderen Nichtnullteiler aus J waehlen ? |
---|
1724 | if( deg(SL[1]) > deg(J[1]) ) |
---|
1725 | { |
---|
1726 | Ann=quotient(SM[2],J[1]); |
---|
1727 | qAnn=simplify(reduce(Ann,SM[1]),2); |
---|
1728 | if(size(qAnn)==0) |
---|
1729 | { |
---|
1730 | SL[1]=J[1]; |
---|
1731 | } |
---|
1732 | } |
---|
1733 | |
---|
1734 | // --------------- computation of Hom(rad(J),rad(J)) -------------- |
---|
1735 | RR=SM[1],SM[2],JM[2],SL[1]; |
---|
1736 | |
---|
1737 | if(y>=1) |
---|
1738 | { |
---|
1739 | "// compute Hom(rad(J),rad(J))"; |
---|
1740 | } |
---|
1741 | |
---|
1742 | RS=HomJJ(RR,y); //most important subprocedure |
---|
1743 | |
---|
1744 | // ------------------ the normal case, RETURN ----------------- |
---|
1745 | // RS[2]==1 means that the test for normality was positive |
---|
1746 | if(RS[2]==1) |
---|
1747 | { |
---|
1748 | def lastR=RS[1]; |
---|
1749 | setring lastR; |
---|
1750 | map psi1=BAS,endphi; |
---|
1751 | ideal norid=endid; |
---|
1752 | ideal normap=psi1(ihp); |
---|
1753 | kill endid,endphi; |
---|
1754 | |
---|
1755 | intvec atr=getAttrib(norid); |
---|
1756 | |
---|
1757 | //"//### general case: not isolated singularity only at 0, final"; |
---|
1758 | //"size norid:", size(norid), size(string(norid)); |
---|
1759 | //"interred:"; |
---|
1760 | //norid = interred(norid); |
---|
1761 | //norid = setAttrib(norid,atr); |
---|
1762 | //"size norid:", size(norid), size(string(norid)); |
---|
1763 | |
---|
1764 | export norid; |
---|
1765 | export normap; |
---|
1766 | result=lastR; |
---|
1767 | if ( y>=1 ) |
---|
1768 | { |
---|
1769 | "// case: not onlySingularAtZero, last ring Hom_R(J,J) computed"; |
---|
1770 | "// delta before last ring:", delt; |
---|
1771 | } |
---|
1772 | |
---|
1773 | if ( delt>=0 && RS[3]>=0 ) |
---|
1774 | { |
---|
1775 | delt = delt+RS[3]; |
---|
1776 | } |
---|
1777 | else |
---|
1778 | { delt = -1; } |
---|
1779 | |
---|
1780 | // delti = delti,delt; |
---|
1781 | delti[size(delti)]=delt; |
---|
1782 | |
---|
1783 | if ( y>=1 ) |
---|
1784 | { |
---|
1785 | "// delta of last ring:", delt; |
---|
1786 | } |
---|
1787 | |
---|
1788 | result[size(result)+1]=list(delt,delti); |
---|
1789 | setring BAS; |
---|
1790 | return(result); |
---|
1791 | } |
---|
1792 | |
---|
1793 | // ----- the non-normal case, recursive call of normalizationPrimes ------- |
---|
1794 | // RS=HomJJ(RR,y) was computed above, RS[1] contains endid and endphi |
---|
1795 | // RS[1] = new ring Hom_R(J,J), RS[2]= 0 or 1, RS[2]=contribution to delta |
---|
1796 | // now RS[2]must be 0, i.e. the test for normality was negative |
---|
1797 | |
---|
1798 | int n = nvars(basering); |
---|
1799 | ideal MJ = JM[2]; |
---|
1800 | |
---|
1801 | def newR=RS[1]; |
---|
1802 | setring newR; |
---|
1803 | map psi=BAS,endphi; |
---|
1804 | if ( y>=1 ) |
---|
1805 | { |
---|
1806 | "// case: not onlySingularAtZero, compute new ring = Hom_R(J,J)"; |
---|
1807 | "// delta of old ring:", delt; |
---|
1808 | } |
---|
1809 | if ( delt>=0 && RS[3]>=0 ) |
---|
1810 | { |
---|
1811 | delt = delt+RS[3]; |
---|
1812 | } |
---|
1813 | else |
---|
1814 | { delt = -1; } |
---|
1815 | if ( y>=1 ) |
---|
1816 | { |
---|
1817 | "// delta of new ring:", delt; |
---|
1818 | } |
---|
1819 | |
---|
1820 | delti[size(delti)]=delt; |
---|
1821 | intvec atr=getAttrib(endid); |
---|
1822 | |
---|
1823 | //"//### general case: not isolated singularity only at 0, recursive"; |
---|
1824 | //"size endid:", size(endid), size(string(endid)); |
---|
1825 | //"interred:"; |
---|
1826 | //endid = interred(endid); |
---|
1827 | //endid = setAttrib(endid,atr); |
---|
1828 | //"size endid:", size(endid), size(string(endid)); |
---|
1829 | |
---|
1830 | printlevel = printlevel+1; |
---|
1831 | list tluser= |
---|
1832 | normalizationPrimes(endid,psi(ihp),delt,delti,psi(MJ)); |
---|
1833 | printlevel = printlev; //reset printlevel |
---|
1834 | setring BAS; |
---|
1835 | return(tluser); |
---|
1836 | } |
---|
1837 | |
---|
1838 | //---- A whole singular component was found, RETURN ----- |
---|
1839 | if( Ann == 1) |
---|
1840 | { |
---|
1841 | "// Input appeared not to be a radical ideal!"; |
---|
1842 | "// A (everywhere singular) component with ideal"; |
---|
1843 | "// equal to its Jacobian ideal was found"; |
---|
1844 | "// Procedure will stop with partial result computed so far";""; |
---|
1845 | |
---|
1846 | MB=SM[2]; |
---|
1847 | intvec rw; |
---|
1848 | list LL=substpart(MB,ihp,0,rw); |
---|
1849 | def newR6=LL[1]; |
---|
1850 | setring newR6; |
---|
1851 | ideal norid=endid; |
---|
1852 | ideal normap=endphi; |
---|
1853 | kill endid,endphi; |
---|
1854 | export norid; |
---|
1855 | export normap; |
---|
1856 | result=newR6; |
---|
1857 | result[size(result)+1]=lst(delt,delti); |
---|
1858 | setring BAS; |
---|
1859 | return(result); |
---|
1860 | } |
---|
1861 | |
---|
1862 | //------ zerodivisor of R/SM was found, gives a splitting ------------ |
---|
1863 | //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM |
---|
1864 | //and we have found a splitting: new1 and new2 |
---|
1865 | //id = Ann defines components of R/SM in the complement of V(SL[1]) |
---|
1866 | //id1 defines components of R/SM in the complement of V(id) |
---|
1867 | |
---|
1868 | else |
---|
1869 | { |
---|
1870 | if(y>=1) |
---|
1871 | { |
---|
1872 | "// zero-divisor found"; |
---|
1873 | } |
---|
1874 | int equi = attrib(SM[2],"isEquidimensional"); |
---|
1875 | int oSAZ = attrib(SM[2],"onlySingularAtZero"); |
---|
1876 | int isIs = attrib(SM[2],"isIsolatedSingularity"); |
---|
1877 | |
---|
1878 | ideal new1 = Ann; |
---|
1879 | ideal new2 = quotient(SM[2],Ann); |
---|
1880 | //ideal new2=SL[1],SM[2]; |
---|
1881 | |
---|
1882 | //execute("ring newR1="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1883 | // +ordstr(basering)+");"); |
---|
1884 | def newR1 = ring(gnirlist); |
---|
1885 | setring newR1; |
---|
1886 | |
---|
1887 | ideal vid = fetch(BAS,new1); |
---|
1888 | ideal ihp = fetch(BAS,ihp); |
---|
1889 | attrib(vid,"isCohenMacaulay",0); |
---|
1890 | attrib(vid,"isPrim",0); |
---|
1891 | attrib(vid,"isIsolatedSingularity",isIs); |
---|
1892 | attrib(vid,"isRegInCodim2",0); |
---|
1893 | attrib(vid,"onlySingularAtZero",oSAZ); |
---|
1894 | attrib(vid,"isEquidimensional",equi); |
---|
1895 | attrib(vid,"isHypersurface",0); |
---|
1896 | attrib(vid,"isCompleteIntersection",0); |
---|
1897 | |
---|
1898 | // ---------- recursive call of normalizationPrimes ----------- |
---|
1899 | if ( y>=1 ) |
---|
1900 | { |
---|
1901 | "// total delta before splitting:", delt; |
---|
1902 | "// splitting in two components:"; |
---|
1903 | } |
---|
1904 | printlevel = printlevel+1; |
---|
1905 | keepresult1 = |
---|
1906 | normalizationPrimes(vid,ihp,0,0); //1st split factor |
---|
1907 | |
---|
1908 | list delta1 = keepresult1[size(keepresult1)]; |
---|
1909 | |
---|
1910 | setring BAS; |
---|
1911 | //execute("ring newR2="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
1912 | // +ordstr(basering)+");"); |
---|
1913 | def newR2 = ring(gnirlist); |
---|
1914 | setring newR2; |
---|
1915 | |
---|
1916 | ideal vid = fetch(BAS,new2); |
---|
1917 | ideal ihp = fetch(BAS,ihp); |
---|
1918 | attrib(vid,"isCohenMacaulay",0); |
---|
1919 | attrib(vid,"isPrim",0); |
---|
1920 | attrib(vid,"isIsolatedSingularity",isIs); |
---|
1921 | attrib(vid,"isRegInCodim2",0); |
---|
1922 | attrib(vid,"isEquidimensional",equi); |
---|
1923 | attrib(vid,"isHypersurface",0); |
---|
1924 | attrib(vid,"isCompleteIntersection",0); |
---|
1925 | attrib(vid,"onlySingularAtZero",oSAZ); |
---|
1926 | |
---|
1927 | keepresult2 = |
---|
1928 | normalizationPrimes(vid,ihp,0,0); |
---|
1929 | list delta2 = keepresult2[size(keepresult2)]; //2nd split factor |
---|
1930 | printlevel = printlev; //reset printlevel |
---|
1931 | |
---|
1932 | setring BAS; |
---|
1933 | |
---|
1934 | //compute intersection multiplicity of both components: |
---|
1935 | new1 = new1,new2; |
---|
1936 | int mul=vdim(std(new1)); |
---|
1937 | |
---|
1938 | // ----- normalizationPrimes finished, add up results, RETURN -------- |
---|
1939 | for(lauf=1;lauf<=size(keepresult2)-1;lauf++) |
---|
1940 | { |
---|
1941 | keepresult1 = insert(keepresult1,keepresult2[lauf]); |
---|
1942 | } |
---|
1943 | if ( delt >=0 && delta1[1] >=0 && delta2[1] >=0 && mul >=0 ) |
---|
1944 | { |
---|
1945 | delt = delt+mul+delta1[1]+delta2[1]; |
---|
1946 | } |
---|
1947 | else |
---|
1948 | { delt = -1; } |
---|
1949 | delti = -2; |
---|
1950 | |
---|
1951 | if ( y>=1 ) |
---|
1952 | { |
---|
1953 | "// zero divisor produced a splitting into two components"; |
---|
1954 | "// delta of first component:", delta1; |
---|
1955 | "// delta of second componenet:", delta2; |
---|
1956 | "// intersection multiplicity of both components:", mul; |
---|
1957 | "// total delta after splitting:", delt; |
---|
1958 | } |
---|
1959 | keepresult1[size(keepresult1)] = list(delt,delti); |
---|
1960 | return(keepresult1); |
---|
1961 | } |
---|
1962 | } |
---|
1963 | example |
---|
1964 | { "EXAMPLE:";echo = 2; |
---|
1965 | // Huneke |
---|
1966 | ring qr=31991,(a,b,c,d,e),dp; |
---|
1967 | ideal i= |
---|
1968 | 5abcde-a5-b5-c5-d5-e5, |
---|
1969 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
1970 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
1971 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
1972 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
1973 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
1974 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
1975 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
1976 | |
---|
1977 | list pr=normalizationPrimes(i); |
---|
1978 | def r1 = pr[1]; |
---|
1979 | setring r1; |
---|
1980 | norid; |
---|
1981 | normap; |
---|
1982 | } |
---|
1983 | |
---|
1984 | /////////////////////////////////////////////////////////////////////////////// |
---|
1985 | static proc substpart(ideal endid, ideal endphi, int homo, intvec rw) |
---|
1986 | |
---|
1987 | "//Repeated application of elimpart to endid, until no variables can be |
---|
1988 | //directy substituded. homo=1 if input is homogeneous, rw contains |
---|
1989 | //original weights, endphi (partial) normalization map"; |
---|
1990 | |
---|
1991 | //NOTE concerning iteration of maps: Let phi: x->f(y,z), y->g(x,z) then |
---|
1992 | //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 |
---|
1993 | //and so on: none of the x or y will be eliminated |
---|
1994 | //Now subst: first x and then y: x+y+z->f(g(x,z),z)+g(x,z)+z eliminates y |
---|
1995 | //further subst replaces x by y, makes no sense (objects more compicated). |
---|
1996 | //Subst first y and then x eliminates x |
---|
1997 | //In our situation we have triangular form: x->f(y,z), y->g(z). |
---|
1998 | //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 |
---|
1999 | //subst x,y: x+y+z->f(g(z),z)+g(z)+z, eliminates x,y |
---|
2000 | //subst y,x: x+y+z->f(y,z)+g(z)+z eliminates only x |
---|
2001 | //HENCE: substitute vars depending on most other vars first |
---|
2002 | //However, if the sytem xi-fi is reduced then xi does not appear in any of the |
---|
2003 | //fj and hence the order does'nt matter when substitutinp xi by fi |
---|
2004 | |
---|
2005 | { |
---|
2006 | def newRing = basering; |
---|
2007 | int ii,jj; |
---|
2008 | map phi = newRing,maxideal(1); //identity map |
---|
2009 | list Le = elimpart(endid); |
---|
2010 | //this proc and the next loop try to substitute as many variables as |
---|
2011 | //possible indices of substituted variables |
---|
2012 | |
---|
2013 | int q = size(Le[2]); //q vars, stored in Le[2], have been substitutet |
---|
2014 | intvec rw1 = 0; //will become indices of substituted variables |
---|
2015 | rw1[nvars(basering)] = 0; |
---|
2016 | rw1 = rw1+1; //rw1=1,..,1 (as many 1 as nvars(basering)) |
---|
2017 | |
---|
2018 | while( size(Le[2]) != 0 ) |
---|
2019 | { |
---|
2020 | endid = Le[1]; |
---|
2021 | if ( defined(ps) ) |
---|
2022 | { kill ps; } |
---|
2023 | map ps = newRing,Le[5]; |
---|
2024 | phi = ps(phi); |
---|
2025 | for(ii=1;ii<=size(Le[2]);ii++) |
---|
2026 | { |
---|
2027 | phi=phi(phi); |
---|
2028 | } |
---|
2029 | //eingefuegt wegen x2-y2z2+z3 |
---|
2030 | |
---|
2031 | for( ii=1; ii<=size(rw1); ii++ ) |
---|
2032 | { |
---|
2033 | if( Le[4][ii]==0 ) //ii = index of var which was substituted |
---|
2034 | { |
---|
2035 | rw1[ii]=0; //substituted vars have entry 0 in rw1 |
---|
2036 | } |
---|
2037 | } |
---|
2038 | Le=elimpart(endid); //repeated application of elimpart |
---|
2039 | q = q + size(Le[2]); |
---|
2040 | } |
---|
2041 | endphi = phi(endphi); |
---|
2042 | //---------- return ----------------------------------------------------------- |
---|
2043 | // first the trivial case, where all variable have been eliminated |
---|
2044 | if( nvars(newRing) == q ) |
---|
2045 | { |
---|
2046 | ring lastRing = char(basering),T(1),dp; |
---|
2047 | ideal endid = T(1); |
---|
2048 | ideal endphi = T(1); |
---|
2049 | for(ii=2; ii<=q; ii++ ) |
---|
2050 | { |
---|
2051 | endphi[ii] = 0; |
---|
2052 | } |
---|
2053 | export(endid,endphi); |
---|
2054 | list L = lastRing; |
---|
2055 | setring newRing; |
---|
2056 | return(L); |
---|
2057 | } |
---|
2058 | |
---|
2059 | // in the homogeneous case put weights for the remaining vars correctly, i.e. |
---|
2060 | // delete from rw those weights for which the corresponding entry of rw1 is 0 |
---|
2061 | |
---|
2062 | if (homo==1 && nvars(newRing)-q >1 && size(endid) >0 ) |
---|
2063 | { |
---|
2064 | jj=1; |
---|
2065 | for( ii=2; ii<size(rw1); ii++) |
---|
2066 | { |
---|
2067 | jj++; |
---|
2068 | if( rw1[ii]==0 ) |
---|
2069 | { |
---|
2070 | rw=rw[1..jj-1],rw[jj+1..size(rw)]; |
---|
2071 | jj=jj-1; |
---|
2072 | } |
---|
2073 | } |
---|
2074 | if( rw1[1]==0 ) { rw=rw[2..size(rw)]; } |
---|
2075 | if( rw1[size(rw1)]==0 ){ rw=rw[1..size(rw)-1]; } |
---|
2076 | |
---|
2077 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),(a(rw),dp); |
---|
2078 | } |
---|
2079 | else |
---|
2080 | { |
---|
2081 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),dp; |
---|
2082 | } |
---|
2083 | ideal lastmap; |
---|
2084 | jj = 1; |
---|
2085 | |
---|
2086 | for(ii=1; ii<=size(rw1); ii++ ) |
---|
2087 | { |
---|
2088 | if ( rw1[ii]==1 ) { lastmap[ii] = T(jj); jj=jj+1; } |
---|
2089 | if ( rw1[ii]==0 ) { lastmap[ii] = 0; } |
---|
2090 | } |
---|
2091 | map phi1 = newRing,lastmap; |
---|
2092 | ideal endid = phi1(endid); //### bottelneck |
---|
2093 | ideal endphi = phi1(endphi); |
---|
2094 | |
---|
2095 | /* |
---|
2096 | Versuch: subst statt phi |
---|
2097 | for(ii=1; ii<=size(rw1); ii++ ) |
---|
2098 | { |
---|
2099 | if ( rw1[ii]==1 ) { endid = subst(endid,var(ii),T(jj)); } |
---|
2100 | if ( rw1[ii]==0 ) { endid = subst(endid,var(ii),0); } |
---|
2101 | } |
---|
2102 | */ |
---|
2103 | export(endid); |
---|
2104 | export(endphi); |
---|
2105 | list L = lastRing; |
---|
2106 | setring newRing; |
---|
2107 | return(L); |
---|
2108 | } |
---|
2109 | /////////////////////////////////////////////////////////////////////////////// |
---|
2110 | static proc deltaP(ideal I) |
---|
2111 | { |
---|
2112 | def R=basering; |
---|
2113 | int c,d,i; |
---|
2114 | int n=nvars(R); |
---|
2115 | list nor; |
---|
2116 | if(size(I)>1){ERROR("no hypersurface");} |
---|
2117 | ideal J=std(slocus(I)); |
---|
2118 | if(dim(J)<=0){return(0);} |
---|
2119 | poly h; |
---|
2120 | d=1; |
---|
2121 | while((d)&&(i<n)) |
---|
2122 | { |
---|
2123 | i++; |
---|
2124 | h=var(i); |
---|
2125 | d=dim(std(J+ideal(h))); |
---|
2126 | } |
---|
2127 | i=0; |
---|
2128 | while(d) |
---|
2129 | { |
---|
2130 | i++; |
---|
2131 | if(i>10){ERROR("delta not found, please inform the authors")}; |
---|
2132 | h=randomLast(100)[n]; |
---|
2133 | d=dim(std(J+ideal(h))); |
---|
2134 | } |
---|
2135 | I=I,h-1; |
---|
2136 | if(char(R)<=19) |
---|
2137 | { |
---|
2138 | nor=normalP(I); |
---|
2139 | } |
---|
2140 | else |
---|
2141 | { |
---|
2142 | nor=normal(I); |
---|
2143 | } |
---|
2144 | return(nor[2][2]); |
---|
2145 | } |
---|
2146 | |
---|
2147 | proc genus(ideal I,list #) |
---|
2148 | "USAGE: genus(i) or genus(i,1); I a 1-dimensional ideal |
---|
2149 | RETURN: an integer, the geometric genus p_g = p_a - delta of the projective |
---|
2150 | curve defined by i, where p_a is the arithmetic genus. |
---|
2151 | NOTE: delta is the sum of all local delta-invariants of the singularities, |
---|
2152 | i.e. dim(R'/R), R' the normalization of the local ring R of the |
---|
2153 | singularity. @* |
---|
2154 | genus(i,1) uses the normalization to compute delta. Usually genus(i,1) |
---|
2155 | is slower than genus(i) but sometimes not. |
---|
2156 | EXAMPLE: example genus; shows an example |
---|
2157 | " |
---|
2158 | { |
---|
2159 | int w = printlevel-voice+2; // w=printlevel (default: w=0) |
---|
2160 | |
---|
2161 | def R0=basering; |
---|
2162 | if(char(basering)>0) |
---|
2163 | { |
---|
2164 | def R1=changeord("dp"); |
---|
2165 | setring R1; |
---|
2166 | ideal I=imap(R0,I); |
---|
2167 | I=radical(I); |
---|
2168 | I=std(I); |
---|
2169 | if(dim(I)!=1) |
---|
2170 | { |
---|
2171 | if(((homog(I))&&(dim(I)!=2))||(!homog(I))) |
---|
2172 | { |
---|
2173 | ERROR("This is not a curve"); |
---|
2174 | } |
---|
2175 | } |
---|
2176 | if(homog(I)&&(dim(I)==2)) |
---|
2177 | { |
---|
2178 | def S=R0; |
---|
2179 | setring S; |
---|
2180 | ideal J=I; |
---|
2181 | } |
---|
2182 | else |
---|
2183 | { |
---|
2184 | def S=changevar(varstr(R0)+",@t"); |
---|
2185 | setring S; |
---|
2186 | ideal J=imap(R1,I); |
---|
2187 | J=homog(J,@t); |
---|
2188 | J=std(J); |
---|
2189 | } |
---|
2190 | int pa=1-hilbPoly(J)[1]; |
---|
2191 | pa=pa-deltaP(J); |
---|
2192 | setring R0; |
---|
2193 | return(pa); |
---|
2194 | } |
---|
2195 | I=std(I); |
---|
2196 | if(dim(I)!=1) |
---|
2197 | { |
---|
2198 | if(((homog(I))&&(dim(I)!=2))||(!homog(I))) |
---|
2199 | { |
---|
2200 | // ERROR("This is not a curve"); |
---|
2201 | if(w==1){"** WARNING: Input does not define a curve **"; "";} |
---|
2202 | } |
---|
2203 | } |
---|
2204 | list L=elimpart(I); |
---|
2205 | if(size(L[2])!=0) |
---|
2206 | { |
---|
2207 | map psi=R0,L[5]; |
---|
2208 | I=std(psi(I)); |
---|
2209 | } |
---|
2210 | if(size(I)==0) |
---|
2211 | { |
---|
2212 | return(0); |
---|
2213 | } |
---|
2214 | list N=findvars(I,0); |
---|
2215 | if(size(N[1])==1) |
---|
2216 | { |
---|
2217 | |
---|
2218 | poly p=I[1]; |
---|
2219 | // if(deg(squarefree(p))<deg(p)){ERROR("Curve is not reduced");} |
---|
2220 | return(-deg(p)+1); |
---|
2221 | } |
---|
2222 | if(size(N[1]) < nvars(R0)) |
---|
2223 | { |
---|
2224 | string newvar=string(N[1]); |
---|
2225 | execute("ring R=("+charstr(R0)+"),("+newvar+"),dp;"); |
---|
2226 | ideal I =imap(R0,I); |
---|
2227 | attrib(I,"isSB",1); |
---|
2228 | } |
---|
2229 | else |
---|
2230 | { |
---|
2231 | def R=basering; |
---|
2232 | } |
---|
2233 | if(dim(I)==2) |
---|
2234 | { |
---|
2235 | def newR=basering; |
---|
2236 | } |
---|
2237 | else |
---|
2238 | { |
---|
2239 | if(dim(I)==0) |
---|
2240 | { |
---|
2241 | execute("ring Rhelp=("+charstr(R0)+"),(@s,@t),dp;"); |
---|
2242 | } |
---|
2243 | else |
---|
2244 | { |
---|
2245 | execute("ring Rhelp=("+charstr(R0)+"),(@s),dp;"); |
---|
2246 | } |
---|
2247 | def newR=R+Rhelp; |
---|
2248 | setring newR; |
---|
2249 | ideal I=imap(R,I); |
---|
2250 | I=homog(I,@s); |
---|
2251 | attrib(I,"isSB",1); |
---|
2252 | } |
---|
2253 | |
---|
2254 | if((nvars(basering)<=3)&&(size(I)>1)) |
---|
2255 | { |
---|
2256 | ERROR("This is not equidimensional"); |
---|
2257 | } |
---|
2258 | |
---|
2259 | intvec hp=hilbPoly(I); |
---|
2260 | int p_a=1-hp[1]; |
---|
2261 | int d=hp[2]; |
---|
2262 | |
---|
2263 | if(w>=1) |
---|
2264 | { |
---|
2265 | "";"The ideal of the projective curve:";"";I;""; |
---|
2266 | "The coefficients of the Hilbert polynomial";hp; |
---|
2267 | "arithmetic genus:";p_a; |
---|
2268 | "degree:";d;""; |
---|
2269 | } |
---|
2270 | |
---|
2271 | intvec v = hilb(I,1); |
---|
2272 | int i,o; |
---|
2273 | if(nvars(basering)>3) |
---|
2274 | { |
---|
2275 | map phi=newR,maxideal(1); |
---|
2276 | int de; |
---|
2277 | ideal K,L1; |
---|
2278 | matrix M; |
---|
2279 | poly m=var(4); |
---|
2280 | poly he; |
---|
2281 | for(i=5;i<=nvars(basering);i++){m=m*var(i);} |
---|
2282 | K=eliminate(I,m,v); |
---|
2283 | if(size(K)==1){de=deg(K[1]);} |
---|
2284 | m=var(1); |
---|
2285 | for(i=2;i<=nvars(basering)-3;i++){m=m*var(i);} |
---|
2286 | i=0; |
---|
2287 | while(d!=de) |
---|
2288 | { |
---|
2289 | o=1; |
---|
2290 | i++; |
---|
2291 | K=phi(I); |
---|
2292 | K=eliminate(K,m,v); |
---|
2293 | if(size(K)==1){de=deg(K[1]);} |
---|
2294 | if((i==5)&&(d!=de)) |
---|
2295 | { |
---|
2296 | K=reduce(equidimMax(I),I); |
---|
2297 | if(size(K)!=0){ERROR("This is not equidimensional");} |
---|
2298 | } |
---|
2299 | if(i==10) |
---|
2300 | { |
---|
2301 | J;K; |
---|
2302 | ERROR("genus: did not find a good projection for to |
---|
2303 | the plain"); |
---|
2304 | } |
---|
2305 | if(i<5) |
---|
2306 | { |
---|
2307 | M=sparsetriag(nvars(newR),nvars(newR),80-5*i,i); |
---|
2308 | } |
---|
2309 | else |
---|
2310 | { |
---|
2311 | if(i<8) |
---|
2312 | { |
---|
2313 | M=transpose(sparsetriag(nvars(newR),nvars(newR),80-5*i,i)); |
---|
2314 | } |
---|
2315 | else |
---|
2316 | { |
---|
2317 | he=0; |
---|
2318 | while(he==0) |
---|
2319 | { |
---|
2320 | M=randommat(nvars(newR),nvars(newR),ideal(1),20); |
---|
2321 | he=det(M); |
---|
2322 | } |
---|
2323 | } |
---|
2324 | } |
---|
2325 | L1=M*transpose(maxideal(1)); |
---|
2326 | phi=newR,L1; |
---|
2327 | } |
---|
2328 | I=K; |
---|
2329 | } |
---|
2330 | poly p=I[1]; |
---|
2331 | |
---|
2332 | execute("ring S=("+charstr(R)+"),(x,y,t),dp;"); |
---|
2333 | ideal L=maxideal(1); |
---|
2334 | execute("ring C=("+charstr(R)+"),(x,y),ds;"); |
---|
2335 | ideal I; |
---|
2336 | execute("ring A=("+charstr(R)+"),(x,t),dp;"); |
---|
2337 | map phi=S,1,x,t; |
---|
2338 | map psi=S,x,1,t; |
---|
2339 | poly g,h; |
---|
2340 | ideal I,I1; |
---|
2341 | execute("ring B=("+charstr(R)+"),(x,t),ds;"); |
---|
2342 | |
---|
2343 | setring S; |
---|
2344 | if(o) |
---|
2345 | { |
---|
2346 | for(i=1;i<=nvars(newR)-3;i++){L[i]=0;} |
---|
2347 | L=L,maxideal(1); |
---|
2348 | } |
---|
2349 | map sigma=newR,L; |
---|
2350 | poly F=sigma(p); |
---|
2351 | if(w>=1){"the projected curve:";"";F;"";} |
---|
2352 | |
---|
2353 | kill newR; |
---|
2354 | |
---|
2355 | int genus=(d-1)*(d-2)/2; |
---|
2356 | if(w>=1){"the arithmetic genus of the plane curve:";genus;pause();} |
---|
2357 | |
---|
2358 | int delt,deltaloc,deltainf,tau,tauinf,cusps,iloc,iglob,l,nsing, |
---|
2359 | tauloc,tausing,k,rat,nbranchinf,nbranch,nodes,cuspsinf,nodesinf; |
---|
2360 | list inv; |
---|
2361 | |
---|
2362 | if(w>=1) |
---|
2363 | {"";"analyse the singularities at oo";"";"singular locus at (1,x,0):";"";} |
---|
2364 | setring A; |
---|
2365 | g=phi(F); |
---|
2366 | h=psi(F); |
---|
2367 | I=g,jacob(g),var(2); |
---|
2368 | I=std(I); |
---|
2369 | if(deg(I[1])>0) |
---|
2370 | { |
---|
2371 | list qr=minAssGTZ(I); |
---|
2372 | if(w>=1){qr;"";} |
---|
2373 | |
---|
2374 | for(k=1;k<=size(qr);k++) |
---|
2375 | { |
---|
2376 | if(w>=1){ nsing=nsing+vdim(std(qr[k]));} |
---|
2377 | inv=deltaLoc(g,qr[k]); |
---|
2378 | deltainf=deltainf+inv[1]; |
---|
2379 | tauinf=tauinf+inv[2]; |
---|
2380 | l=vdim(std(qr[k])); |
---|
2381 | if(inv[2]==l){nodesinf=nodesinf+l;} |
---|
2382 | if(inv[2]==2*l){cuspsinf=cuspsinf+l;} |
---|
2383 | nbranchinf=nbranchinf+inv[3]; |
---|
2384 | } |
---|
2385 | } |
---|
2386 | else |
---|
2387 | { |
---|
2388 | if(w>=1){" the curve is smooth at (1,x,0)";"";} |
---|
2389 | } |
---|
2390 | if(w>=1){"singular locus at (0,1,0):";"";} |
---|
2391 | inv=deltaLoc(h,maxideal(1)); |
---|
2392 | if((w>=1)&&(inv[2]!=0)){ nsing++;} |
---|
2393 | deltainf=deltainf+inv[1]; |
---|
2394 | tauinf=tauinf+inv[2]; |
---|
2395 | if(inv[2]==1){nodesinf++;} |
---|
2396 | if(inv[2]==2){cuspsinf++;} |
---|
2397 | |
---|
2398 | if((w>=1)&&(inv[2]==0)){" the curve is smooth at (0,1,0)";"";} |
---|
2399 | if(inv[2]>0){nbranchinf=nbranchinf+inv[3];} |
---|
2400 | |
---|
2401 | if(w>=1) |
---|
2402 | { |
---|
2403 | if(tauinf==0) |
---|
2404 | { |
---|
2405 | " the curve is smooth at oo";""; |
---|
2406 | } |
---|
2407 | else |
---|
2408 | { |
---|
2409 | "number of singularities at oo:";nsing; |
---|
2410 | "nodes at oo:";nodesinf; |
---|
2411 | "cusps at oo:";cuspsinf; |
---|
2412 | "branches at oo:";nbranchinf; |
---|
2413 | "Tjurina number at oo:";tauinf; |
---|
2414 | "delta at oo:";deltainf; |
---|
2415 | "Milnor number at oo:";2*deltainf-nbranchinf+nsing; |
---|
2416 | pause(); |
---|
2417 | } |
---|
2418 | "singularities at (x,y,1):";""; |
---|
2419 | } |
---|
2420 | execute("ring newR=("+charstr(R)+"),(x,y),dp;"); |
---|
2421 | //the singularities at the affine part |
---|
2422 | map sigma=S,var(1),var(2),1; |
---|
2423 | ideal I=sigma(F); |
---|
2424 | |
---|
2425 | if(size(#)!=0) |
---|
2426 | { //uses the normalization to compute delta |
---|
2427 | list nor=normal(I); |
---|
2428 | delt=nor[size(nor)][2]; |
---|
2429 | genus=genus-delt-deltainf; |
---|
2430 | setring R0; |
---|
2431 | return(genus); |
---|
2432 | } |
---|
2433 | |
---|
2434 | ideal I1=jacob(I); |
---|
2435 | matrix Hess[2][2]=jacob(I1); |
---|
2436 | ideal ID=I+I1+ideal(det(Hess));//singular locus of I+I1 |
---|
2437 | |
---|
2438 | ideal radID=std(radical(ID));//the non-nodal locus |
---|
2439 | if(w>=1){"the non-nodal locus:";"";radID;pause();"";} |
---|
2440 | if(deg(radID[1])==0) |
---|
2441 | { |
---|
2442 | ideal IDsing=1; |
---|
2443 | } |
---|
2444 | else |
---|
2445 | { |
---|
2446 | ideal IDsing=minor(jacob(ID),2)+radID;//singular locus of ID |
---|
2447 | } |
---|
2448 | |
---|
2449 | iglob=vdim(std(IDsing)); |
---|
2450 | |
---|
2451 | if(iglob!=0)//computation of the radical of IDsing |
---|
2452 | { |
---|
2453 | ideal radIDsing=reduce(IDsing,radID); |
---|
2454 | if(size(radIDsing)==0) |
---|
2455 | { |
---|
2456 | radIDsing=radID; |
---|
2457 | attrib(radIDsing,"isSB",1); |
---|
2458 | } |
---|
2459 | else |
---|
2460 | { |
---|
2461 | radIDsing=std(radical(IDsing)); |
---|
2462 | } |
---|
2463 | iglob=vdim(radIDsing); |
---|
2464 | if((w>=1)&&(iglob)) |
---|
2465 | {"the non-nodal-cuspidal locus:";radIDsing;pause();"";} |
---|
2466 | } |
---|
2467 | cusps=vdim(radID)-iglob; |
---|
2468 | nsing=nsing+cusps; |
---|
2469 | |
---|
2470 | if(iglob==0) |
---|
2471 | { |
---|
2472 | if(w>=1){" there are only cusps and nodes";"";} |
---|
2473 | tau=vdim(std(I+jacob(I))); |
---|
2474 | tauinf=tauinf+tau; |
---|
2475 | nodes=tau-2*cusps; |
---|
2476 | delt=nodes+cusps; |
---|
2477 | nbranch=2*tau-3*cusps; |
---|
2478 | nsing=nsing+nodes; |
---|
2479 | } |
---|
2480 | else |
---|
2481 | { |
---|
2482 | if(w>=1){"the non-nodal-cuspidal singularities";"";} |
---|
2483 | setring C; |
---|
2484 | ideal I1=imap(newR,radIDsing); |
---|
2485 | iloc=vdim(std(I1)); |
---|
2486 | if(iglob==iloc) |
---|
2487 | { |
---|
2488 | if(w>=1){"only cusps and nodes outside (0,0,1)";} |
---|
2489 | setring newR; |
---|
2490 | tau=vdim(std(I+jacob(I))); |
---|
2491 | tauinf=tauinf+tau; |
---|
2492 | inv=deltaLoc(I[1],maxideal(1)); |
---|
2493 | delt=inv[1]; |
---|
2494 | tauloc=inv[2]; |
---|
2495 | nodes=tau-tauloc-2*cusps; |
---|
2496 | nsing=nsing+nodes; |
---|
2497 | if (inv[2]!=0) { nsing++; } |
---|
2498 | nbranch=inv[3]+ 2*nodes+cusps; |
---|
2499 | delt=delt+nodes+cusps; |
---|
2500 | if((w>=1)&&(inv[2]==0)){"smooth at (0,0,1)";} |
---|
2501 | } |
---|
2502 | else |
---|
2503 | { |
---|
2504 | setring newR; |
---|
2505 | list pr=minAssGTZ(radIDsing); |
---|
2506 | if(w>=1){pr;} |
---|
2507 | |
---|
2508 | for(k=1;k<=size(pr);k++) |
---|
2509 | { |
---|
2510 | if(w>=1){nsing=nsing+vdim(std(pr[k]));} |
---|
2511 | inv=deltaLoc(I[1],pr[k]); |
---|
2512 | delt=delt+inv[1]; |
---|
2513 | tausing=tausing+inv[2]; |
---|
2514 | nbranch=nbranch+inv[3]; |
---|
2515 | } |
---|
2516 | tau=vdim(std(I+jacob(I))); |
---|
2517 | tauinf=tauinf+tau; |
---|
2518 | nodes=tau-tausing-2*cusps; |
---|
2519 | nsing=nsing+nodes; |
---|
2520 | delt=delt+nodes+cusps; |
---|
2521 | nbranch=nbranch+2*nodes+cusps; |
---|
2522 | } |
---|
2523 | } |
---|
2524 | genus=genus-delt-deltainf; |
---|
2525 | if(w>=1) |
---|
2526 | { |
---|
2527 | "The projected plane curve has locally:";""; |
---|
2528 | "singularities:";nsing; |
---|
2529 | "branches:";nbranch+nbranchinf; |
---|
2530 | "nodes:"; nodes+nodesinf; |
---|
2531 | "cusps:";cusps+cuspsinf; |
---|
2532 | "Tjurina number:";tauinf; |
---|
2533 | "Milnor number:";2*(delt+deltainf)-nbranch-nbranchinf+nsing; |
---|
2534 | "delta of the projected curve:";delt+deltainf; |
---|
2535 | "delta of the curve:";p_a-genus; |
---|
2536 | "genus:";genus; |
---|
2537 | "===================================================="; |
---|
2538 | ""; |
---|
2539 | } |
---|
2540 | setring R0; |
---|
2541 | return(genus); |
---|
2542 | } |
---|
2543 | example |
---|
2544 | { "EXAMPLE:"; echo = 2; |
---|
2545 | ring r=0,(x,y),dp; |
---|
2546 | ideal i=y^9 - x^2*(x - 1)^9; |
---|
2547 | genus(i); |
---|
2548 | ring r7=7,(x,y),dp; |
---|
2549 | ideal i=y^9 - x^2*(x - 1)^9; |
---|
2550 | genus(i); |
---|
2551 | } |
---|
2552 | |
---|
2553 | /////////////////////////////////////////////////////////////////////////////// |
---|
2554 | proc deltaLoc(poly f,ideal singL) |
---|
2555 | "USAGE: deltaLoc(f,J); f poly, J ideal |
---|
2556 | ASSUME: f is reduced bivariate polynomial; basering has exactly two variables; |
---|
2557 | J is irreducible prime component of the singular locus of f (e.g., one |
---|
2558 | entry of the output of @code{minAssGTZ(I);}, I = <f,jacob(f)>). |
---|
2559 | RETURN: list L: |
---|
2560 | @texinfo |
---|
2561 | @table @asis |
---|
2562 | @item @code{L[1]}; int: |
---|
2563 | the sum of (local) delta invariants of f at the (conjugated) singular |
---|
2564 | points given by J. |
---|
2565 | @item @code{L[2]}; int: |
---|
2566 | the sum of (local) Tjurina numbers of f at the (conjugated) singular |
---|
2567 | points given by J. |
---|
2568 | @item @code{L[3]}; int: |
---|
2569 | the sum of (local) number of branches of f at the (conjugated) |
---|
2570 | singular points given by J. |
---|
2571 | @end table |
---|
2572 | @end texinfo |
---|
2573 | NOTE: procedure makes use of @code{execute}; increasing printlevel displays |
---|
2574 | more comments (default: printlevel=0). |
---|
2575 | SEE ALSO: delta, tjurina |
---|
2576 | KEYWORDS: delta invariant; Tjurina number |
---|
2577 | EXAMPLE: example deltaLoc; shows an example |
---|
2578 | " |
---|
2579 | { |
---|
2580 | intvec save_opt=option(get); |
---|
2581 | option(redSB); |
---|
2582 | def R=basering; |
---|
2583 | execute("ring S=("+charstr(R)+"),(x,y),lp;"); |
---|
2584 | map phi=R,x,y; |
---|
2585 | ideal singL=phi(singL); |
---|
2586 | singL=simplify(std(singL),1); |
---|
2587 | attrib(singL,"isSB",1); |
---|
2588 | int d=vdim(singL); |
---|
2589 | poly f=phi(f); |
---|
2590 | int i; |
---|
2591 | int w = printlevel-voice+2; // w=printlevel (default: w=0) |
---|
2592 | if(d==1) |
---|
2593 | { |
---|
2594 | map alpha=S,var(1)-singL[2][2],var(2)-singL[1][2]; |
---|
2595 | f=alpha(f); |
---|
2596 | execute("ring C=("+charstr(S)+"),("+varstr(S)+"),ds;"); |
---|
2597 | poly f=imap(S,f); |
---|
2598 | ideal singL=imap(S,singL); |
---|
2599 | if((w>=1)&&(ord(f)>=2)) |
---|
2600 | { |
---|
2601 | "local analysis of the singularities";""; |
---|
2602 | basering; |
---|
2603 | singL; |
---|
2604 | f; |
---|
2605 | pause(); |
---|
2606 | } |
---|
2607 | } |
---|
2608 | else |
---|
2609 | { |
---|
2610 | poly p; |
---|
2611 | poly c; |
---|
2612 | map psi; |
---|
2613 | number co; |
---|
2614 | |
---|
2615 | while((deg(lead(singL[1]))>1)&&(deg(lead(singL[2]))>1)) |
---|
2616 | { |
---|
2617 | psi=S,x,y+random(-100,100)*x; |
---|
2618 | singL=psi(singL); |
---|
2619 | singL=std(singL); |
---|
2620 | f=psi(f); |
---|
2621 | } |
---|
2622 | |
---|
2623 | if(deg(lead(singL[2]))==1) |
---|
2624 | { |
---|
2625 | p=singL[1]; |
---|
2626 | c=singL[2]-lead(singL[2]); |
---|
2627 | co=leadcoef(singL[2]); |
---|
2628 | } |
---|
2629 | if(deg(lead(singL[1]))==1) |
---|
2630 | { |
---|
2631 | psi=S,y,x; |
---|
2632 | f=psi(f); |
---|
2633 | singL=psi(singL); |
---|
2634 | p=singL[2]; |
---|
2635 | c=singL[1]-lead(singL[1]); |
---|
2636 | co=leadcoef(singL[1]); |
---|
2637 | } |
---|
2638 | |
---|
2639 | execute("ring B=("+charstr(S)+"),a,dp;"); |
---|
2640 | map beta=S,a,a; |
---|
2641 | poly p=beta(p); |
---|
2642 | |
---|
2643 | execute("ring C=("+charstr(S)+",a),("+varstr(S)+"),ds;"); |
---|
2644 | number p=number(imap(B,p)); |
---|
2645 | |
---|
2646 | minpoly=p; |
---|
2647 | map iota=S,a,a; |
---|
2648 | number c=number(iota(c)); |
---|
2649 | number co=iota(co); |
---|
2650 | |
---|
2651 | map alpha=S,x-c/co,y+a; |
---|
2652 | poly f=alpha(f); |
---|
2653 | f=cleardenom(f); |
---|
2654 | if((w>=1)&&(ord(f)>=2)) |
---|
2655 | { |
---|
2656 | "local analysis of the singularities";""; |
---|
2657 | basering; |
---|
2658 | alpha; |
---|
2659 | f; |
---|
2660 | pause(); |
---|
2661 | ""; |
---|
2662 | } |
---|
2663 | } |
---|
2664 | option(noredSB); |
---|
2665 | ideal fstd=std(ideal(f)+jacob(f)); |
---|
2666 | poly hc=highcorner(fstd); |
---|
2667 | int tau=vdim(fstd); |
---|
2668 | int o=ord(f); |
---|
2669 | int delt,nb; |
---|
2670 | |
---|
2671 | if(tau==0) //smooth case |
---|
2672 | { |
---|
2673 | setring R; |
---|
2674 | option(set,save_opt); |
---|
2675 | return(list(0,0,1)); |
---|
2676 | } |
---|
2677 | if((char(basering)>=181)||(char(basering)==0)) |
---|
2678 | { |
---|
2679 | if(o==2) //A_k-singularity |
---|
2680 | { |
---|
2681 | if(w>=1){"A_k-singularity";"";} |
---|
2682 | setring R; |
---|
2683 | delt=(tau+1)/2; |
---|
2684 | option(set,save_opt); |
---|
2685 | return(list(d*delt,d*tau,d*(2*delt-tau+1))); |
---|
2686 | } |
---|
2687 | if((lead(f)==var(1)*var(2)^2)||(lead(f)==var(1)^2*var(2))) |
---|
2688 | { |
---|
2689 | if(w>=1){"D_k- singularity";"";} |
---|
2690 | |
---|
2691 | setring R; |
---|
2692 | delt=(tau+2)/2; |
---|
2693 | option(set,save_opt); |
---|
2694 | return(list(d*delt,d*tau,d*(2*delt-tau+1))); |
---|
2695 | } |
---|
2696 | |
---|
2697 | int mu=vdim(std(jacob(f))); |
---|
2698 | poly g=f+var(1)^mu+var(2)^mu; //to obtain a convenient Newton-polygon |
---|
2699 | |
---|
2700 | list NP=newtonpoly(g); |
---|
2701 | if(w>=1){"Newton-Polygon:";NP;"";} |
---|
2702 | int s=size(NP); |
---|
2703 | |
---|
2704 | if(is_NND(f,mu,NP)) |
---|
2705 | { // the Newton-polygon is non-degenerate |
---|
2706 | // compute nb, the number of branches |
---|
2707 | for(i=1;i<=s-1;i++) |
---|
2708 | { |
---|
2709 | nb=nb+gcd(NP[i][2]-NP[i+1][2],NP[i][1]-NP[i+1][1]); |
---|
2710 | } |
---|
2711 | if(w>=1){"Newton-Polygon is non-degenerated";"";} |
---|
2712 | option(set,save_opt); |
---|
2713 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
2714 | } |
---|
2715 | |
---|
2716 | if(w>=1){"Newton-Polygon is degenerated";"";} |
---|
2717 | |
---|
2718 | // the following can certainly be made more efficient when replacing |
---|
2719 | // 'hnexpansion' (used only for computing number of branches) by |
---|
2720 | // successive blowing-up + test if Newton polygon degenerate: |
---|
2721 | if(s>2) // splitting of f |
---|
2722 | { |
---|
2723 | if(w>=1){"Newton polygon can be used for splitting";"";} |
---|
2724 | intvec v=NP[1][2]-NP[2][2],NP[2][1]; |
---|
2725 | int de=w_deg(g,v); |
---|
2726 | int st=w_deg(hc,v)+v[1]+v[2]; |
---|
2727 | poly f1=var(2)^NP[2][2]; |
---|
2728 | poly f2=jet(g,de,v)/var(2)^NP[2][2]; |
---|
2729 | poly h=g-f1*f2; |
---|
2730 | de=w_deg(h,v); |
---|
2731 | poly k; |
---|
2732 | ideal wi=var(2)^NP[2][2],f2; |
---|
2733 | matrix li; |
---|
2734 | while(de<st) |
---|
2735 | { |
---|
2736 | k=jet(h,de,v); |
---|
2737 | li=lift(wi,k); |
---|
2738 | f1=f1+li[2,1]; |
---|
2739 | f2=f2+li[1,1]; |
---|
2740 | h=g-f1*f2; |
---|
2741 | de=w_deg(h,v); |
---|
2742 | } |
---|
2743 | nb=deltaLoc(f1,maxideal(1))[3]+deltaLoc(f2,maxideal(1))[3]; |
---|
2744 | setring R; |
---|
2745 | option(set,save_opt); |
---|
2746 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
2747 | } |
---|
2748 | |
---|
2749 | f=jet(f,deg(hc)+2); |
---|
2750 | if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";} |
---|
2751 | ideal fac=factorize(f,1); |
---|
2752 | if(size(fac)>1) |
---|
2753 | { |
---|
2754 | nb=0; |
---|
2755 | for(i=1;i<=size(fac);i++) |
---|
2756 | { |
---|
2757 | nb=nb+deltaLoc(fac[i],maxideal(1))[3]; |
---|
2758 | } |
---|
2759 | setring R; |
---|
2760 | option(set,save_opt); |
---|
2761 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
2762 | } |
---|
2763 | list HNEXP=hnexpansion(f); |
---|
2764 | if (typeof(HNEXP[1])=="ring") { |
---|
2765 | def altring = basering; |
---|
2766 | def HNEring = HNEXP[1]; setring HNEring; |
---|
2767 | nb=size(hne); |
---|
2768 | setring R; |
---|
2769 | kill HNEring; |
---|
2770 | } |
---|
2771 | else |
---|
2772 | { |
---|
2773 | nb=size(HNEXP); |
---|
2774 | } |
---|
2775 | option(set,save_opt); |
---|
2776 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
2777 | } |
---|
2778 | else //the case of small characteristic |
---|
2779 | { |
---|
2780 | f=jet(f,deg(hc)+2); |
---|
2781 | if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";} |
---|
2782 | delt=delta(f); |
---|
2783 | option(set,save_opt); |
---|
2784 | return(list(d*delt,d*tau,d)); |
---|
2785 | } |
---|
2786 | option(set,save_opt); |
---|
2787 | } |
---|
2788 | example |
---|
2789 | { "EXAMPLE:"; echo = 2; |
---|
2790 | ring r=0,(x,y),dp; |
---|
2791 | poly f=(x2+y^2-1)^3 +27x2y2; |
---|
2792 | ideal I=f,jacob(f); |
---|
2793 | I=std(I); |
---|
2794 | list qr=minAssGTZ(I); |
---|
2795 | size(qr); |
---|
2796 | // each component of the singular locus either describes a cusp or a pair |
---|
2797 | // of conjugated nodes: |
---|
2798 | deltaLoc(f,qr[1]); |
---|
2799 | deltaLoc(f,qr[2]); |
---|
2800 | deltaLoc(f,qr[3]); |
---|
2801 | deltaLoc(f,qr[4]); |
---|
2802 | deltaLoc(f,qr[5]); |
---|
2803 | deltaLoc(f,qr[6]); |
---|
2804 | } |
---|
2805 | /////////////////////////////////////////////////////////////////////////////// |
---|
2806 | // compute the weighted degree of p; |
---|
2807 | // this code is an exact copy of the proc in paraplanecurves.lib |
---|
2808 | // (since we do not want to make it non-static) |
---|
2809 | static proc w_deg(poly p, intvec v) |
---|
2810 | { |
---|
2811 | if(p==0){return(-1);} |
---|
2812 | int d=0; |
---|
2813 | while(jet(p,d,v)==0){d++;} |
---|
2814 | d=(transpose(leadexp(jet(p,d,v)))*v)[1]; |
---|
2815 | return(d); |
---|
2816 | } |
---|
2817 | |
---|
2818 | //proc hilbPoly(ideal J) |
---|
2819 | //{ |
---|
2820 | // poly hp; |
---|
2821 | // int i; |
---|
2822 | // if(!attrib(J,"isSB")){J=std(J);} |
---|
2823 | // intvec v = hilb(J,2); |
---|
2824 | // for(i=1; i<=size(v); i++){ hp=hp+v[i]*(var(1)-i+2);} |
---|
2825 | // return(hp); |
---|
2826 | //} |
---|
2827 | |
---|
2828 | |
---|
2829 | ////////////////////////////////////////////////////////////////////////////// |
---|
2830 | |
---|
2831 | proc primeClosure (list L, list #) |
---|
2832 | "USAGE: primeClosure(L [,c]); L a list of a ring containing a prime ideal |
---|
2833 | ker, c an optional integer |
---|
2834 | RETURN: a list L (of size n+1) consisting of rings L[1],...,L[n] such that |
---|
2835 | - L[1] is a copy of (not a reference to!) the input ring L[1] |
---|
2836 | - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi |
---|
2837 | such that |
---|
2838 | L[1]/ker --> ... --> L[n]/ker |
---|
2839 | are injections given by the corresponding ideals phi, and L[n]/ker |
---|
2840 | is the integral closure of L[1]/ker in its quotient field. |
---|
2841 | - all rings L[i] contain a polynomial nzd such that elements of |
---|
2842 | L[i]/ker are quotients of elements of L[i-1]/ker with denominator |
---|
2843 | nzd via the injection phi. |
---|
2844 | L[n+1] is the delta invariant |
---|
2845 | NOTE: - L is constructed by recursive calls of primeClosure itself. |
---|
2846 | - c determines the choice of nzd: |
---|
2847 | - c not given or equal to 0: first generator of the ideal SL, |
---|
2848 | the singular locus of Spec(L[i]/ker) |
---|
2849 | - c<>0: the generator of SL with least number of monomials. |
---|
2850 | EXAMPLE: example primeClosure; shows an example |
---|
2851 | " |
---|
2852 | { |
---|
2853 | //---- Start with a consistency check: |
---|
2854 | |
---|
2855 | if (!(typeof(L[1])=="ring")) |
---|
2856 | { |
---|
2857 | "// Parameter must be a ring or a list containing a ring!"; |
---|
2858 | return(-1); |
---|
2859 | } |
---|
2860 | |
---|
2861 | int dblvl = printlevel-voice+2; |
---|
2862 | list gnirlist = ringlist(basering); |
---|
2863 | |
---|
2864 | //---- Some auxiliary variables: |
---|
2865 | int delt; //finally the delta invariant |
---|
2866 | if ( size(L) == 1 ) |
---|
2867 | { |
---|
2868 | L[2] = delt; //set delta to 0 |
---|
2869 | } |
---|
2870 | int n = size(L)-1; //L without delta invariant |
---|
2871 | |
---|
2872 | //---- How to choose the non-zerodivisor later on? |
---|
2873 | |
---|
2874 | int nzdoption=0; |
---|
2875 | if (size(#)>0) |
---|
2876 | { |
---|
2877 | nzdoption=#[1]; |
---|
2878 | } |
---|
2879 | |
---|
2880 | // R0 below is the ring to work with, if we are in step one, make a copy of the |
---|
2881 | // input ring, so that all objects are created in the copy, not in the original |
---|
2882 | // ring (therefore a copy, not a reference is defined). |
---|
2883 | |
---|
2884 | if (n==1) |
---|
2885 | { |
---|
2886 | def R = L[1]; |
---|
2887 | list Rlist = ringlist(R); |
---|
2888 | def BAS = basering; |
---|
2889 | setring R; |
---|
2890 | if (!(typeof(ker)=="ideal")) |
---|
2891 | { |
---|
2892 | "// No ideal ker in the input ring!"; |
---|
2893 | return (-1); |
---|
2894 | } |
---|
2895 | ker=simplify(interred(ker),15); |
---|
2896 | //execute ("ring R0="+charstr(R)+",("+varstr(R)+"),("+ordstr(R)+");"); |
---|
2897 | // Rlist may be not defined in this new ring, so we define it again. |
---|
2898 | list Rlist2 = ringlist(R); |
---|
2899 | def R0 = ring(Rlist2); |
---|
2900 | setring R0; |
---|
2901 | ideal ker=fetch(R,ker); |
---|
2902 | // check whether we compute the normalization of the blow up of |
---|
2903 | // an isolated singularity at the origin (checked in normalI) |
---|
2904 | |
---|
2905 | if (typeof(attrib(L[1],"iso_sing_Rees"))=="int") |
---|
2906 | { |
---|
2907 | attrib(R0,"iso_sing_Rees",attrib(L[1],"iso_sing_Rees")); |
---|
2908 | } |
---|
2909 | L[1]=R0; |
---|
2910 | } |
---|
2911 | else |
---|
2912 | { |
---|
2913 | def R0 = L[n]; |
---|
2914 | setring R0; |
---|
2915 | } |
---|
2916 | |
---|
2917 | // In order to apply HomJJ from normal.lib, we need the radical of the singular |
---|
2918 | // locus of ker, J:=rad(ker): |
---|
2919 | |
---|
2920 | list SM=mstd(ker); |
---|
2921 | |
---|
2922 | // In the first iteration, we have to compute the singular locus "from |
---|
2923 | // scratch". |
---|
2924 | // In further iterations, we can fetch it from the previous one but |
---|
2925 | // have to compute its radical |
---|
2926 | // the next rings R1 contain already the (fetched) ideal |
---|
2927 | |
---|
2928 | if (n==1) //we are in R0=L[1] |
---|
2929 | { |
---|
2930 | if (typeof(attrib(R0,"iso_sing_Rees"))=="int") |
---|
2931 | { |
---|
2932 | ideal J; |
---|
2933 | for (int s=1;s<=attrib(R0,"iso_sing_Rees");s++) |
---|
2934 | { |
---|
2935 | J=J,var(s); |
---|
2936 | } |
---|
2937 | J = J,SM[2]; |
---|
2938 | list JM = mstd(J); |
---|
2939 | } |
---|
2940 | else |
---|
2941 | { |
---|
2942 | if ( dblvl >= 1 ) |
---|
2943 | {""; |
---|
2944 | "// compute the singular locus"; |
---|
2945 | } |
---|
2946 | //### Berechnung des singulaeren Orts geaendert (ist so schneller) |
---|
2947 | ideal J = minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]); |
---|
2948 | J = J,SM[2]; |
---|
2949 | list JM = mstd(J); |
---|
2950 | } |
---|
2951 | |
---|
2952 | if ( dblvl >= 1 ) |
---|
2953 | {""; |
---|
2954 | "// dimension of singular locus is", dim(JM[1]); |
---|
2955 | if ( dblvl >= 2 ) |
---|
2956 | {""; |
---|
2957 | "// the singular locus is:"; JM[2]; |
---|
2958 | } |
---|
2959 | } |
---|
2960 | |
---|
2961 | if ( dblvl >= 1 ) |
---|
2962 | {""; |
---|
2963 | "// compute radical of singular locus"; |
---|
2964 | } |
---|
2965 | |
---|
2966 | J = simplify(radical(JM[2]),2); |
---|
2967 | if ( dblvl >= 1 ) |
---|
2968 | {""; |
---|
2969 | "// radical of singular locus is:"; J; |
---|
2970 | pause(); |
---|
2971 | } |
---|
2972 | } |
---|
2973 | else |
---|
2974 | { |
---|
2975 | if ( dblvl >= 1 ) |
---|
2976 | {""; |
---|
2977 | "// compute radical of test ideal in ideal of singular locus"; |
---|
2978 | } |
---|
2979 | J = simplify(radical(J),2); |
---|
2980 | if ( dblvl >= 1 ) |
---|
2981 | {""; |
---|
2982 | "// radical of test ideal is:"; J; |
---|
2983 | pause(); |
---|
2984 | } |
---|
2985 | } |
---|
2986 | |
---|
2987 | // having computed the radical J of/in the ideal of the singular locus, |
---|
2988 | // we now need to pick an element nzd of J; |
---|
2989 | // NOTE: nzd must be a non-zero divisor mod ker, i.e. not contained in ker |
---|
2990 | |
---|
2991 | poly nzd = J[1]; |
---|
2992 | poly nzd1 = NF(nzd,SM[1]); |
---|
2993 | if (nzd1 != 0) |
---|
2994 | { |
---|
2995 | if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) ) |
---|
2996 | { |
---|
2997 | nzd = nzd1; |
---|
2998 | } |
---|
2999 | } |
---|
3000 | |
---|
3001 | if (nzdoption || nzd1==0) |
---|
3002 | { |
---|
3003 | for (int ii=2;ii<=ncols(J);ii++) |
---|
3004 | { |
---|
3005 | nzd1 = NF(J[ii],SM[1]); |
---|
3006 | if ( nzd1 != 0 ) |
---|
3007 | { |
---|
3008 | if ( (deg(nzd)>=deg(J[ii])) && (size(nzd)>size(J[ii])) ) |
---|
3009 | { |
---|
3010 | nzd=J[ii]; |
---|
3011 | } |
---|
3012 | if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) ) |
---|
3013 | { |
---|
3014 | nzd = nzd1; |
---|
3015 | } |
---|
3016 | } |
---|
3017 | } |
---|
3018 | } |
---|
3019 | |
---|
3020 | export nzd; |
---|
3021 | // In this case we do not eliminate variables, so that the maps |
---|
3022 | // are well defined. |
---|
3023 | list RR = SM[1],SM[2],J,nzd,1; |
---|
3024 | |
---|
3025 | if ( dblvl >= 1 ) |
---|
3026 | {""; |
---|
3027 | "// compute the first ring extension:"; |
---|
3028 | "RR: "; |
---|
3029 | RR; |
---|
3030 | } |
---|
3031 | |
---|
3032 | list RS = HomJJ(RR); |
---|
3033 | //NOTE: HomJJ creates new ring with variables X(i) and T(j) |
---|
3034 | //------------------------------------------------------------------------- |
---|
3035 | // If we've reached the integral closure (as determined by the result of |
---|
3036 | // HomJJ), then we are done, otherwise we have to prepare the next iteration. |
---|
3037 | |
---|
3038 | if (RS[2]==1) // we've reached the integral closure, we are still in R0 |
---|
3039 | { |
---|
3040 | kill J; |
---|
3041 | if ( n== 1) |
---|
3042 | { |
---|
3043 | def R1 = RS[1]; |
---|
3044 | setring R1; |
---|
3045 | ideal norid, normap = endid, endphi; |
---|
3046 | kill endid, endphi; |
---|
3047 | |
---|
3048 | //"//### case: primeClosure, final"; |
---|
3049 | //"size norid:", size(norid), size(string(norid)); |
---|
3050 | //"interred:"; |
---|
3051 | //norid = interred(norid); |
---|
3052 | //"size norid:", size(norid), size(string(norid)); |
---|
3053 | |
---|
3054 | export (norid, normap); |
---|
3055 | L[1] = R1; |
---|
3056 | } |
---|
3057 | return(L); |
---|
3058 | } |
---|
3059 | else // prepare the next iteration |
---|
3060 | { |
---|
3061 | if (n==1) // In the first iteration: keep only the data |
---|
3062 | { // needed later on. |
---|
3063 | kill RR,SM; |
---|
3064 | export(ker); |
---|
3065 | } |
---|
3066 | if ( dblvl >= 1 ) |
---|
3067 | {""; |
---|
3068 | "// computing the next ring extension, we are in loop"; n+1; |
---|
3069 | } |
---|
3070 | |
---|
3071 | def R1 = RS[1]; // The data of the next ring R1: |
---|
3072 | delt = RS[3]; // the delta invariant of the ring extension |
---|
3073 | setring R1; // keep only what is necessary and kill |
---|
3074 | ideal ker=endid; // everything else. |
---|
3075 | export(ker); |
---|
3076 | ideal norid=endid; |
---|
3077 | |
---|
3078 | //"//### case: primeClosure, loop", n+1; |
---|
3079 | //"size norid:", size(norid), size(string(norid)); |
---|
3080 | //"interred:"; |
---|
3081 | //norid = interred(norid); //???? |
---|
3082 | //"size norid:", size(norid), size(string(norid)); |
---|
3083 | |
---|
3084 | export(norid); |
---|
3085 | kill endid; |
---|
3086 | |
---|
3087 | map phi = R0,endphi; // fetch the singular locus |
---|
3088 | ideal J = mstd(simplify(phi(J)+ker,4))[2]; // ideal J in R1 |
---|
3089 | export(J); |
---|
3090 | if(n>1) |
---|
3091 | { |
---|
3092 | ideal normap=phi(normap); |
---|
3093 | } |
---|
3094 | else |
---|
3095 | { |
---|
3096 | ideal normap=endphi; |
---|
3097 | } |
---|
3098 | export(normap); |
---|
3099 | kill phi; // we save phi as ideal, not as map, so that |
---|
3100 | ideal phi=endphi; // we have more flexibility in the ring names |
---|
3101 | kill endphi; // later on. |
---|
3102 | export(phi); |
---|
3103 | L=insert(L,R1,n); // Add the new ring R1 and go on with the |
---|
3104 | // next iteration |
---|
3105 | if ( L[size(L)] >= 0 && delt >= 0 ) |
---|
3106 | { |
---|
3107 | delt = L[size(L)] + delt; |
---|
3108 | } |
---|
3109 | else |
---|
3110 | { |
---|
3111 | delt = -1; |
---|
3112 | } |
---|
3113 | L[size(L)] = delt; |
---|
3114 | |
---|
3115 | if (size(#)>0) |
---|
3116 | { |
---|
3117 | return (primeClosure(L,#)); |
---|
3118 | } |
---|
3119 | else |
---|
3120 | { |
---|
3121 | return(primeClosure(L)); // next iteration. |
---|
3122 | } |
---|
3123 | } |
---|
3124 | } |
---|
3125 | example |
---|
3126 | { |
---|
3127 | "EXAMPLE:"; echo=2; |
---|
3128 | ring R=0,(x,y),dp; |
---|
3129 | ideal I=x4,y4; |
---|
3130 | def K=ReesAlgebra(I)[1]; // K contains ker such that K/ker=R[It] |
---|
3131 | list L=primeClosure(K); |
---|
3132 | def R(1)=L[1]; // L[4] contains ker, L[4]/ker is the |
---|
3133 | def R(4)=L[4]; // integral closure of L[1]/ker |
---|
3134 | setring R(1); |
---|
3135 | R(1); |
---|
3136 | ker; |
---|
3137 | setring R(4); |
---|
3138 | R(4); |
---|
3139 | ker; |
---|
3140 | } |
---|
3141 | |
---|
3142 | /////////////////////////////////////////////////////////////////////////////// |
---|
3143 | |
---|
3144 | proc closureFrac(list L) |
---|
3145 | "USAGE: closureFrac (L); L a list of size n+1 as in the result of |
---|
3146 | primeClosure, L[n] contains an additional polynomial f |
---|
3147 | CREATE: a list fraction of two elements of L[1], such that |
---|
3148 | f=fraction[1]/fraction[2] via the injections phi L[i]-->L[i+1]. |
---|
3149 | EXAMPLE: example closureFrac; shows an example |
---|
3150 | " |
---|
3151 | { |
---|
3152 | // Define some auxiliary variables: |
---|
3153 | |
---|
3154 | int n=size(L)-1; |
---|
3155 | int i,j,k,l,n2,n3; |
---|
3156 | intvec V; |
---|
3157 | string mapstr; |
---|
3158 | for (i=1; i<=n; i++) { def R(i) = L[i]; } |
---|
3159 | |
---|
3160 | // The quotient representing f is computed as in 'closureGenerators' with |
---|
3161 | // the differences that |
---|
3162 | // - the loop is done twice: for the numerator and for the denominator; |
---|
3163 | // - the result is stored in the list fraction and |
---|
3164 | // - we have to make sure that no more objects of the rings R(i) survive. |
---|
3165 | |
---|
3166 | for (j=1; j<=2; j++) |
---|
3167 | { |
---|
3168 | setring R(n); |
---|
3169 | if (j==1) |
---|
3170 | { |
---|
3171 | poly p=f; |
---|
3172 | } |
---|
3173 | else |
---|
3174 | { |
---|
3175 | p=1; |
---|
3176 | } |
---|
3177 | |
---|
3178 | for (k=n; k>1; k--) |
---|
3179 | { |
---|
3180 | if (j==1) |
---|
3181 | { |
---|
3182 | map phimap=R(k-1),phi; |
---|
3183 | } |
---|
3184 | |
---|
3185 | p=p*phimap(nzd); |
---|
3186 | |
---|
3187 | if (j==2) |
---|
3188 | { |
---|
3189 | kill phimap; |
---|
3190 | } |
---|
3191 | |
---|
3192 | if (j==1) |
---|
3193 | { |
---|
3194 | //### noch abfragen ob Z(i) definiert ist |
---|
3195 | list gnirlist = ringlist(R(k)); |
---|
3196 | n2 = size(gnirlist[2]); |
---|
3197 | n3 = size(gnirlist[3]); |
---|
3198 | for( i=1; i<=ncols(phi); i++) |
---|
3199 | { |
---|
3200 | gnirlist[2][n2+i] = "Z("+string(i)+")"; |
---|
3201 | } |
---|
3202 | V=0; |
---|
3203 | V[ncols(phi)]=0; V=V+1; |
---|
3204 | gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1); |
---|
3205 | def S(k) = ring(gnirlist); |
---|
3206 | setring S(k); |
---|
3207 | |
---|
3208 | //execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+", |
---|
3209 | // Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k))) |
---|
3210 | // +"),dp("+string(ncols(phi))+"));"); |
---|
3211 | |
---|
3212 | ideal phi = imap(R(k),phi); |
---|
3213 | ideal J = imap (R(k),ker); |
---|
3214 | for (l=1;l<=ncols(phi);l++) |
---|
3215 | { |
---|
3216 | J=J+(Z(l)-phi[l]); |
---|
3217 | } |
---|
3218 | J=groebner(J); |
---|
3219 | poly h=NF(imap(R(k),p),J); |
---|
3220 | } |
---|
3221 | else |
---|
3222 | { |
---|
3223 | setring S(k); |
---|
3224 | h=NF(imap(R(k),p),J); |
---|
3225 | setring R(k); |
---|
3226 | kill p; |
---|
3227 | } |
---|
3228 | |
---|
3229 | setring R(k-1); |
---|
3230 | |
---|
3231 | if (j==1) |
---|
3232 | { |
---|
3233 | ideal maxi; |
---|
3234 | maxi[nvars(R(k))] = 0; |
---|
3235 | maxi = maxi,maxideal(1); |
---|
3236 | map backmap = S(k),maxi; |
---|
3237 | |
---|
3238 | //mapstr=" map backmap = S(k),"; |
---|
3239 | //for (l=1;l<=nvars(R(k));l++) |
---|
3240 | //{ |
---|
3241 | // mapstr=mapstr+"0,"; |
---|
3242 | //} |
---|
3243 | //execute (mapstr+"maxideal(1);"); |
---|
3244 | poly p; |
---|
3245 | } |
---|
3246 | p=NF(backmap(h),std(ker)); |
---|
3247 | if (j==2) |
---|
3248 | { |
---|
3249 | kill backmap; |
---|
3250 | } |
---|
3251 | } |
---|
3252 | |
---|
3253 | if (j==1) |
---|
3254 | { |
---|
3255 | if (defined(fraction)) |
---|
3256 | { |
---|
3257 | kill fraction; |
---|
3258 | list fraction=p; |
---|
3259 | } |
---|
3260 | else |
---|
3261 | { |
---|
3262 | list fraction=p; |
---|
3263 | } |
---|
3264 | } |
---|
3265 | else |
---|
3266 | { |
---|
3267 | fraction=insert(fraction,p,1); |
---|
3268 | } |
---|
3269 | } |
---|
3270 | export(fraction); |
---|
3271 | return (); |
---|
3272 | } |
---|
3273 | example |
---|
3274 | { |
---|
3275 | "EXAMPLE:"; echo=2; |
---|
3276 | ring R=0,(x,y),dp; |
---|
3277 | ideal ker=x2+y2; |
---|
3278 | export ker; |
---|
3279 | list L=primeClosure(R); // We normalize R/ker |
---|
3280 | for (int i=1;i<=size(L);i++) { def R(i)=L[i]; } |
---|
3281 | setring R(2); |
---|
3282 | kill R; |
---|
3283 | phi; // The map R(1)-->R(2) |
---|
3284 | poly f=T(2); // We will get a representation of f |
---|
3285 | export f; |
---|
3286 | L[2]=R(2); |
---|
3287 | closureFrac(L); |
---|
3288 | setring R(1); |
---|
3289 | kill R(2); |
---|
3290 | fraction; // f=fraction[1]/fraction[2] via phi |
---|
3291 | kill R(1); |
---|
3292 | } |
---|
3293 | |
---|
3294 | /////////////////////////////////////////////////////////////////////////////// |
---|
3295 | // closureGenerators is called inside proc normal (option "withGens" ) |
---|
3296 | // |
---|
3297 | |
---|
3298 | // INPUT is the output of proc primeClosure (except for the last element, the |
---|
3299 | // delta invariant) : hence input is a list L consisting of rings |
---|
3300 | // L[1],...,L[n] (denoted R(1)...R(n) below) such that |
---|
3301 | // - L[1] is a copy of (not a reference to!) the input ring L[1] |
---|
3302 | // - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi |
---|
3303 | // such that |
---|
3304 | // L[1]/ker --> ... --> L[n]/ker |
---|
3305 | // are injections given by the corresponding ideals phi, and L[n]/ker |
---|
3306 | // is the integral closure of L[1]/ker in its quotient field. |
---|
3307 | // - all rings L[i] contain a polynomial nzd such that elements of |
---|
3308 | // L[i]/ker are quotients of elements of L[i-1]/ker with denominator |
---|
3309 | // nzd via the injection phi. |
---|
3310 | |
---|
3311 | // COMPUTE: In the list L of rings R(1),...,R(n), compute representations of |
---|
3312 | // the ring variables of the last ring R(n) as fractions of elements of R(1): |
---|
3313 | // The proc returns an ideal preim s.t. preim[i]/preim[size(preim)] expresses |
---|
3314 | // the ith variable of R(n) as fraction of elements of the basering R(1) |
---|
3315 | // preim[size(preim)] is a non-zero divisor of basering/i. |
---|
3316 | |
---|
3317 | proc closureGenerators(list L); |
---|
3318 | { |
---|
3319 | def Rees=basering; // when called inside normalI (in reesclos.lib) |
---|
3320 | // the Rees Algebra is the current basering |
---|
3321 | |
---|
3322 | // ------- First of all we need some variable declarations ----------- |
---|
3323 | int n = size(L); // the number of rings R(1)-->...-->R(n) |
---|
3324 | int length = nvars(L[n]); // the number of variables of the last ring |
---|
3325 | int j,k,l,n2,n3; |
---|
3326 | intvec V; |
---|
3327 | string mapstr; |
---|
3328 | list preimages; |
---|
3329 | //Note: the empty list belongs to no ring, hence preimages can be used |
---|
3330 | //later in R(1) |
---|
3331 | //this is not possible for ideals (belong always to some ring) |
---|
3332 | |
---|
3333 | for (int i=1; i<=n; i++) |
---|
3334 | { |
---|
3335 | def R(i)=L[i]; //give the rings from L a name |
---|
3336 | } |
---|
3337 | |
---|
3338 | // For each variable (counter j) and for each intermediate ring (counter k): |
---|
3339 | // Find a preimage of var_j*phi(nzd(k-1)) in R(k-1). |
---|
3340 | // Finally, do the same for nzd. |
---|
3341 | |
---|
3342 | for (j=1; j <= length+1; j++ ) |
---|
3343 | { |
---|
3344 | setring R(n); |
---|
3345 | if (j==1) |
---|
3346 | { |
---|
3347 | poly p; |
---|
3348 | } |
---|
3349 | if (j <= length ) |
---|
3350 | { |
---|
3351 | p=var(j); |
---|
3352 | } |
---|
3353 | else |
---|
3354 | { |
---|
3355 | p=1; |
---|
3356 | } |
---|
3357 | //i.e. p=j-th var of R(n) for j<=length and p=1 for j=length+1 |
---|
3358 | |
---|
3359 | for (k=n; k>1; k--) |
---|
3360 | { |
---|
3361 | |
---|
3362 | if (j==1) |
---|
3363 | { |
---|
3364 | map phimap=R(k-1),phi; //phimap:R(k-1)-->R(n), k=2..n, is the map |
---|
3365 | //belonging to phi in R(n) |
---|
3366 | } |
---|
3367 | |
---|
3368 | p = p*phimap(nzd); |
---|
3369 | |
---|
3370 | // Compute the preimage of [p mod ker(k)] under phi in R(k-1): |
---|
3371 | // As p is an element of Image(phi), there is a polynomial h such |
---|
3372 | // that h is mapped to [p mod ker(k)], and h can be computed as the |
---|
3373 | // normal form of p w.r.t. a Groebner basis of |
---|
3374 | // J(k) := <ker(k),Z(l)-phi(k)(l)> in R(k)[Z]=:S(k) |
---|
3375 | |
---|
3376 | if (j==1) // In the first iteration: Create S(k), fetch phi and |
---|
3377 | // ker(k) and construct the ideal J(k). |
---|
3378 | { |
---|
3379 | //### noch abfragen ob Z(i) definiert ist |
---|
3380 | list gnirlist = ringlist(R(k)); |
---|
3381 | n2 = size(gnirlist[2]); |
---|
3382 | n3 = size(gnirlist[3]); |
---|
3383 | for( i=1; i<=ncols(phi); i++) |
---|
3384 | { |
---|
3385 | gnirlist[2][n2+i] = "Z("+string(i)+")"; |
---|
3386 | } |
---|
3387 | V=0; |
---|
3388 | V[ncols(phi)]=0; |
---|
3389 | V=V+1; |
---|
3390 | gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1); |
---|
3391 | def S(k) = ring(gnirlist); |
---|
3392 | setring S(k); |
---|
3393 | |
---|
3394 | // execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+", |
---|
3395 | // Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k))) |
---|
3396 | // +"),dp("+string(ncols(phi))+"));"); |
---|
3397 | |
---|
3398 | ideal phi = imap(R(k),phi); |
---|
3399 | ideal J = imap (R(k),ker); |
---|
3400 | for ( l=1; l<=ncols(phi); l++ ) |
---|
3401 | { |
---|
3402 | J=J+(Z(l)-phi[l]); |
---|
3403 | } |
---|
3404 | J = groebner(J); |
---|
3405 | poly h = NF(imap(R(k),p),J); |
---|
3406 | } |
---|
3407 | else |
---|
3408 | { |
---|
3409 | setring S(k); |
---|
3410 | h = NF(imap(R(k),p),J); |
---|
3411 | } |
---|
3412 | |
---|
3413 | setring R(k-1); |
---|
3414 | |
---|
3415 | if (j==1) // In the first iteration: Compute backmap:S(k)-->R(k-1) |
---|
3416 | { |
---|
3417 | ideal maxi; |
---|
3418 | maxi[nvars(R(k))] = 0; |
---|
3419 | maxi = maxi,maxideal(1); |
---|
3420 | map backmap = S(k),maxi; |
---|
3421 | |
---|
3422 | //mapstr=" map backmap = S(k),"; |
---|
3423 | //for (l=1;l<=nvars(R(k));l++) |
---|
3424 | //{ |
---|
3425 | // mapstr=mapstr+"0,"; |
---|
3426 | //} |
---|
3427 | //execute (mapstr+"maxideal(1);"); |
---|
3428 | |
---|
3429 | poly p; |
---|
3430 | } |
---|
3431 | p = NF(backmap(h),std(ker)); |
---|
3432 | } |
---|
3433 | // Whe are down to R(1), store here the result in the list preimages |
---|
3434 | preimages = insert(preimages,p,j-1); |
---|
3435 | } |
---|
3436 | ideal preim; //make the list preimages to an ideal preim |
---|
3437 | for ( i=1; i<=size(preimages); i++ ) |
---|
3438 | { |
---|
3439 | preim[i] = preimages[i]; |
---|
3440 | } |
---|
3441 | // R(1) was a copy of Rees, so we have to get back to the basering Rees from |
---|
3442 | // the beginning and fetch the result (the ideal preim) to this ring. |
---|
3443 | setring Rees; |
---|
3444 | return (fetch(R(1),preim)); |
---|
3445 | } |
---|
3446 | |
---|
3447 | /////////////////////////////////////////////////////////////////////////////// |
---|
3448 | // From here: procedures for char p with Frobenius |
---|
3449 | /////////////////////////////////////////////////////////////////////////////// |
---|
3450 | |
---|
3451 | proc normalP(ideal id,list #) |
---|
3452 | "USAGE: normalP(id [,choose]); id = radical ideal, choose = optional list of |
---|
3453 | strings. |
---|
3454 | Optional parameters in list choose (can be entered in any order):@* |
---|
3455 | \"withRing\", \"isPrim\", \"noFac\", \"noRed\", where@* |
---|
3456 | - \"noFac\" -> factorization is avoided during the computation |
---|
3457 | of the minimal associated primes.@* |
---|
3458 | - \"isPrim\" -> assumes that the ideal is prime. If the assumption |
---|
3459 | does not hold, output might be wrong.@* |
---|
3460 | - \"withRing\" -> the ring structure of the normalization is |
---|
3461 | computed. The number of variables in the new ring is reduced as much |
---|
3462 | as possible.@* |
---|
3463 | - \"noRed\" -> when computing the ring structure, no reduction on the |
---|
3464 | number of variables is done, it creates one new variable for every |
---|
3465 | new module generator of the integral closure in the quotient field.@* |
---|
3466 | ASSUME: The characteristic of the ground field must be positive. If the |
---|
3467 | option \"isPrim\" is not set, the minimal associated primes of id |
---|
3468 | are computed first and hence normalP computes the normalization of |
---|
3469 | the radical of id. If option \"isPrim\" is set, the ideal must be |
---|
3470 | a prime ideal otherwise the result may be wrong. |
---|
3471 | RETURN: a list, say 'nor' of size 2 (resp. 3 if \"withRing\" is set).@* |
---|
3472 | ** If option \"withRing\" is not set: @* |
---|
3473 | Only the module structure is computed: @* |
---|
3474 | * nor[1] is a list of ideals Ii, i=1..r, in the basering R where r |
---|
3475 | is the number of minimal associated prime ideals P_i of the input |
---|
3476 | ideal id, describing the module structure:@* |
---|
3477 | If Ii is given by polynomials g_1,...,g_k in R, then c:=g_k is |
---|
3478 | non-zero in the ring R/P_i and g_1/c,...,g_k/c generate the integral |
---|
3479 | closure of R/P_i as R-module in the quotient field of R/P_i.@* |
---|
3480 | * nor[2] shows the delta invariants: it is a list of an intvec |
---|
3481 | of size r, the delta invariants of the r components, and an integer, |
---|
3482 | the total delta invariant of R/id |
---|
3483 | (-1 means infinite, and 0 that R/P_i resp. R/id is normal). @* |
---|
3484 | ** If option \"withRing\" is set: @* |
---|
3485 | The ring structure is also computed, and in this case:@* |
---|
3486 | * nor[1] is a list of r rings.@* |
---|
3487 | Each ring Ri = nor[1][i], i=1..r, contains two ideals with given |
---|
3488 | names @code{norid} and @code{normap} such that @* |
---|
3489 | - Ri/norid is the normalization of R/P_i, i.e. isomorphic as |
---|
3490 | K-algebra (K the ground field) to the integral closure of R/P_i in |
---|
3491 | the field of fractions of R/P_i; @* |
---|
3492 | - the direct sum of the rings Ri/norid is the normalization |
---|
3493 | of R/id; @* |
---|
3494 | - @code{normap} gives the normalization map from R to Ri/norid.@* |
---|
3495 | * nor[2] gives the module generators of the normalization of R/P_i, |
---|
3496 | it is the same as nor[1] if \"withRing\" is not set.@* |
---|
3497 | * nor[3] shows the delta invariants, it is the same as nor[2] if |
---|
3498 | \"withRing\" is not set. |
---|
3499 | THEORY: normalP uses the Leonard-Pellikaan-Singh-Swanson algorithm (using the |
---|
3500 | Frobenius) cf. [A. K. Singh, I. Swanson: An algorithm for computing |
---|
3501 | the integral closure, arXiv:0901.0871]. |
---|
3502 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
3503 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
3504 | id. The procedure returns the delta invariants of the components P_i |
---|
3505 | and of id. |
---|
3506 | NOTE: To use the i-th ring type: @code{def R=nor[1][i]; setring R;}. |
---|
3507 | @* Increasing/decreasing printlevel displays more/less comments |
---|
3508 | (default: printlevel = 0). |
---|
3509 | @* Not implemented for local or mixed orderings or quotient rings. |
---|
3510 | For local or mixed orderings use proc 'normal'. |
---|
3511 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
3512 | be used (qhweight(id); computes weights). |
---|
3513 | @* Works only in characteristic p > 0; use proc normal in char 0. |
---|
3514 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
3515 | SEE ALSO: normal, normalC |
---|
3516 | EXAMPLE: example normalP; shows an example |
---|
3517 | " |
---|
3518 | { |
---|
3519 | int i,j,y, sr, del, co; |
---|
3520 | intvec deli; |
---|
3521 | list resu, Resu, prim, Gens, mstdid; |
---|
3522 | ideal gens; |
---|
3523 | |
---|
3524 | // Default options |
---|
3525 | int wring = 0; // The ring structure is not computed. |
---|
3526 | int noRed = 0; // No reduction is done in the ring structure |
---|
3527 | int isPrim = 0; // Ideal is not assumed to be prime |
---|
3528 | int noFac = 0; // Use facstd when computing the decomposition |
---|
3529 | |
---|
3530 | |
---|
3531 | y = printlevel-voice+2; |
---|
3532 | |
---|
3533 | if ( ord_test(basering) != 1) |
---|
3534 | { |
---|
3535 | ""; |
---|
3536 | "// Not implemented for this ordering,"; |
---|
3537 | "// please change to global ordering!"; |
---|
3538 | return(resu); |
---|
3539 | } |
---|
3540 | if ( char(basering) <= 0) |
---|
3541 | { |
---|
3542 | ""; |
---|
3543 | "// Algorithm works only in positive characteristic,"; |
---|
3544 | "// use procedure 'normal' if the characteristic is 0"; |
---|
3545 | return(resu); |
---|
3546 | } |
---|
3547 | |
---|
3548 | //--------------------------- define the method --------------------------- |
---|
3549 | string method; //make all options one string in order to use |
---|
3550 | //all combinations of options simultaneously |
---|
3551 | for ( i=1; i<= size(#); i++ ) |
---|
3552 | { |
---|
3553 | if ( typeof(#[i]) == "string" ) |
---|
3554 | { |
---|
3555 | method = method + #[i]; |
---|
3556 | } |
---|
3557 | } |
---|
3558 | |
---|
3559 | if ( find(method,"withring") or find(method,"withRing") ) |
---|
3560 | { |
---|
3561 | wring=1; |
---|
3562 | } |
---|
3563 | if ( find(method,"noRed") or find(method,"nored") ) |
---|
3564 | { |
---|
3565 | noRed=1; |
---|
3566 | } |
---|
3567 | if ( find(method,"isPrim") or find(method,"isprim") ) |
---|
3568 | { |
---|
3569 | isPrim=1; |
---|
3570 | } |
---|
3571 | if ( find(method,"noFac") or find(method,"nofac")) |
---|
3572 | { |
---|
3573 | noFac=1; |
---|
3574 | } |
---|
3575 | |
---|
3576 | kill #; |
---|
3577 | list #; |
---|
3578 | //--------------------------- start computation --------------------------- |
---|
3579 | ideal II,K1,K2; |
---|
3580 | |
---|
3581 | //----------- check first (or ignore) if input id is prime ------------- |
---|
3582 | |
---|
3583 | if ( isPrim ) |
---|
3584 | { |
---|
3585 | prim[1] = id; |
---|
3586 | if( y >= 0 ) |
---|
3587 | { ""; |
---|
3588 | "// ** WARNING: result is correct if ideal is prime (not checked) **"; |
---|
3589 | "// disable option \"isPrim\" to decompose ideal into prime components";""; |
---|
3590 | } |
---|
3591 | } |
---|
3592 | else |
---|
3593 | { |
---|
3594 | if(y>=1) |
---|
3595 | { "// compute minimal associated primes"; } |
---|
3596 | |
---|
3597 | if( noFac ) |
---|
3598 | { prim = minAssGTZ(id,1); } |
---|
3599 | else |
---|
3600 | { prim = minAssGTZ(id); } |
---|
3601 | |
---|
3602 | if(y>=1) |
---|
3603 | { |
---|
3604 | prim;""; |
---|
3605 | "// number of irreducible components is", size(prim); |
---|
3606 | } |
---|
3607 | } |
---|
3608 | |
---|
3609 | //----------- compute integral closure for every component ------------- |
---|
3610 | |
---|
3611 | for(i=1; i<=size(prim); i++) |
---|
3612 | { |
---|
3613 | if(y>=1) |
---|
3614 | { |
---|
3615 | ""; pause(); ""; |
---|
3616 | "// start computation of component",i; |
---|
3617 | " --------------------------------"; |
---|
3618 | } |
---|
3619 | if(y>=1) |
---|
3620 | { "// compute SB of ideal"; |
---|
3621 | } |
---|
3622 | mstdid = mstd(prim[i]); |
---|
3623 | if(y>=1) |
---|
3624 | { "// dimension of component is", dim(mstdid[1]);"";} |
---|
3625 | |
---|
3626 | //------- 1-st main subprocedure: compute module generators ---------- |
---|
3627 | printlevel = printlevel+1; |
---|
3628 | II = normalityTest(mstdid); |
---|
3629 | |
---|
3630 | //------ compute also the ringstructure if "withRing" is given ------- |
---|
3631 | if ( wring ) |
---|
3632 | { |
---|
3633 | //------ 2-nd main subprocedure: compute ring structure ----------- |
---|
3634 | if(noRed == 0){ |
---|
3635 | resu = list(computeRing(II,prim[i])) + resu; |
---|
3636 | } |
---|
3637 | else |
---|
3638 | { |
---|
3639 | resu = list(computeRing(II,prim[i], "noRed")) + resu; |
---|
3640 | } |
---|
3641 | } |
---|
3642 | printlevel = printlevel-1; |
---|
3643 | |
---|
3644 | //----- rearrange module generators s.t. denominator comes last ------ |
---|
3645 | gens=0; |
---|
3646 | for( j=2; j<=size(II); j++ ) |
---|
3647 | { |
---|
3648 | gens[j-1]=II[j]; |
---|
3649 | } |
---|
3650 | gens[size(gens)+1]=II[1]; |
---|
3651 | Gens = list(gens) + Gens; |
---|
3652 | //------------------------------ compute delta ----------------------- |
---|
3653 | K1 = mstdid[1]+II; |
---|
3654 | K1 = std(K1); |
---|
3655 | K2 = mstdid[1]+II[1]; |
---|
3656 | K2 = std(K2); |
---|
3657 | // K1 = std(mstdid[1],II); //### besser |
---|
3658 | // K2 = std(mstdid[1],II[1]); //### besser: Hannes, fixen! |
---|
3659 | co = codim(K1,K2); |
---|
3660 | deli = co,deli; |
---|
3661 | if ( co >= 0 && del >= 0 ) |
---|
3662 | { |
---|
3663 | del = del + co; |
---|
3664 | } |
---|
3665 | else |
---|
3666 | { del = -1; } |
---|
3667 | } |
---|
3668 | |
---|
3669 | if ( del >= 0 ) |
---|
3670 | { |
---|
3671 | int mul = iMult(prim); |
---|
3672 | del = del + mul; |
---|
3673 | } |
---|
3674 | else |
---|
3675 | { del = -1; } |
---|
3676 | |
---|
3677 | deli = deli[1..size(deli)-1]; |
---|
3678 | if ( wring ) |
---|
3679 | { Resu = resu,Gens,list(deli,del); } |
---|
3680 | else |
---|
3681 | { Resu = Gens,list(deli,del); } |
---|
3682 | |
---|
3683 | sr = size(prim); |
---|
3684 | |
---|
3685 | //-------------------- Finally print comments and return -------------------- |
---|
3686 | if(y >= 0) |
---|
3687 | {""; |
---|
3688 | if ( wring ) |
---|
3689 | { |
---|
3690 | "// 'normalP' created a list, say nor, of three lists: |
---|
3691 | // To see the result, type |
---|
3692 | nor; |
---|
3693 | |
---|
3694 | // * nor[1] is a list of",sr,"ring(s): |
---|
3695 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
3696 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
3697 | // for the other rings type first setring R; (if R is the name of your |
---|
3698 | // original basering) and then continue as for R1; |
---|
3699 | // Ri/norid is the affine algebra of the normalization of the i-th |
---|
3700 | // component R/P_i (where P_i is a min. associated prime of the input ideal) |
---|
3701 | // and normap the normalization map from R to Ri/norid; |
---|
3702 | |
---|
3703 | // * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of |
---|
3704 | // elements g1..gk of r such that the gj/gk generate the integral |
---|
3705 | // closure of R/P_i as R-module in the quotient field of R/P_i. |
---|
3706 | |
---|
3707 | // * nor[3] shows the delta-invariant of each component and of the input |
---|
3708 | // ideal (-1 means infinite, and 0 that r/P_i is normal)."; |
---|
3709 | } |
---|
3710 | else |
---|
3711 | { |
---|
3712 | "// 'normalP' computed a list, say nor, of two lists: |
---|
3713 | // To see the result, type |
---|
3714 | nor; |
---|
3715 | |
---|
3716 | // * nor[1] is a list of",sr,"ideal(s), where each ideal nor[1][i] consists |
---|
3717 | // of elements g1..gk of the basering R such that gj/gk generate the integral |
---|
3718 | // closure of R/P_i (where P_i is a min. associated prime of the input ideal) |
---|
3719 | // as R-module in the quotient field of R/P_i; |
---|
3720 | |
---|
3721 | // * nor[2] shows the delta-invariant of each component and of the input ideal |
---|
3722 | // (-1 means infinite, and 0 that R/P_i is normal)."; |
---|
3723 | } |
---|
3724 | } |
---|
3725 | |
---|
3726 | return(Resu); |
---|
3727 | } |
---|
3728 | example |
---|
3729 | { "EXAMPLE:"; echo = 2; |
---|
3730 | ring r = 11,(x,y,z),wp(2,1,2); |
---|
3731 | ideal i = x*(z3 - xy4 + x2); |
---|
3732 | list nor= normalP(i); nor; |
---|
3733 | //the result says that both components of i are normal, but i itself |
---|
3734 | //has infinite delta |
---|
3735 | pause("hit return to continue"); |
---|
3736 | |
---|
3737 | ring s = 2,(x,y),dp; |
---|
3738 | ideal i = y*((x-y^2)^2 - x^3); |
---|
3739 | list nor = normalP(i,"withRing"); nor; |
---|
3740 | |
---|
3741 | def R2 = nor[1][2]; setring R2; |
---|
3742 | norid; normap; |
---|
3743 | } |
---|
3744 | |
---|
3745 | /////////////////////////////////////////////////////////////////////////////// |
---|
3746 | // Assume: mstdid is the result of mstd(prim[i]), prim[i] a prime component of |
---|
3747 | // the input ideal id of normalP. |
---|
3748 | // Output is an ideal U s.t. U[i]/U[1] are module generators. |
---|
3749 | |
---|
3750 | static proc normalityTest(list mstdid) |
---|
3751 | { |
---|
3752 | int y = printlevel-voice+2; |
---|
3753 | intvec op = option(get); |
---|
3754 | option(redSB); |
---|
3755 | def R = basering; |
---|
3756 | int n, p = nvars(R), char(R); |
---|
3757 | int ii; |
---|
3758 | |
---|
3759 | ideal J = mstdid[1]; //J is the SB of I |
---|
3760 | ideal I = mstdid[2]; |
---|
3761 | int h = n-dim(J); //codimension of V(I), I is a prime ideal |
---|
3762 | |
---|
3763 | //-------------------------- compute singular locus ---------------------- |
---|
3764 | qring Q = J; //pass to quotient ring |
---|
3765 | ideal I = imap(R,I); |
---|
3766 | ideal J = imap(R,J); |
---|
3767 | attrib(J,"isSB",1); |
---|
3768 | if ( y >= 1) |
---|
3769 | { "start normality test"; "compute singular locus";} |
---|
3770 | |
---|
3771 | ideal M = minor(jacob(I),h,J); //use the command minor modulo J (hence J=0) |
---|
3772 | M = std(M); //this makes M much smaller |
---|
3773 | //keep only minors which are not 0 mod I (!) this is important since we |
---|
3774 | //need a nzd mod I |
---|
3775 | |
---|
3776 | //---------------- choose nzd from ideal of singular locus -------------- |
---|
3777 | ideal D = M[1]; |
---|
3778 | for( ii=2; ii<=size(M); ii++ ) //look for the shortest one |
---|
3779 | { |
---|
3780 | if( size(M[ii]) < size(D[1]) ) |
---|
3781 | { |
---|
3782 | D = M[ii]; |
---|
3783 | } |
---|
3784 | } |
---|
3785 | |
---|
3786 | //--------------- start p-th power algorithm and return ---------------- |
---|
3787 | ideal F = var(1)^p; |
---|
3788 | for(ii=2; ii<=n; ii++) |
---|
3789 | { |
---|
3790 | F=F,var(ii)^p; |
---|
3791 | } |
---|
3792 | |
---|
3793 | ideal Dp=D^(p-1); |
---|
3794 | ideal U=1; |
---|
3795 | ideal K,L; |
---|
3796 | map phi=Q,F; |
---|
3797 | if ( y >= 1) |
---|
3798 | { "compute module generators of integral closure"; |
---|
3799 | "denominator D is:"; D; |
---|
3800 | pause(); |
---|
3801 | } |
---|
3802 | |
---|
3803 | ii=0; |
---|
3804 | list LK; |
---|
3805 | while(1) |
---|
3806 | { |
---|
3807 | ii=ii+1; |
---|
3808 | if ( y >= 1) |
---|
3809 | { "iteration", ii; } |
---|
3810 | L = U*Dp + I; |
---|
3811 | //### L=interred(L) oder mstd(L)[2]? |
---|
3812 | //Wird dadurch kleiner aber string(L) wird groesser |
---|
3813 | K = preimage(Q,phi,L); //### Improvement by block ordering? |
---|
3814 | option(returnSB); |
---|
3815 | K = intersect(U,K); //K is the new U, it is a SB |
---|
3816 | LK = mstd(K); |
---|
3817 | K = LK[2]; |
---|
3818 | |
---|
3819 | //---------------------------- simplify output -------------------------- |
---|
3820 | if(size(reduce(U,LK[1]))==0) //previous U coincides with new U |
---|
3821 | { //i.e. we reached the integral closure |
---|
3822 | U=simplify(reduce(U,groebner(D)),2); |
---|
3823 | U = D,U; |
---|
3824 | poly gg = gcd(U[1],U[size(U)]); |
---|
3825 | for(ii=2; ii<=size(U)-1 ;ii++) |
---|
3826 | { |
---|
3827 | gg = gcd(gg,U[ii]); |
---|
3828 | } |
---|
3829 | for(ii=1; ii<=size(U); ii++) |
---|
3830 | { |
---|
3831 | U[ii]=U[ii]/gg; |
---|
3832 | } |
---|
3833 | U = simplify(U,6); |
---|
3834 | //if ( y >= 1) |
---|
3835 | //{ "module generators are U[i]/U[1], with U:"; U; |
---|
3836 | // ""; pause(); } |
---|
3837 | option(set,op); |
---|
3838 | setring R; |
---|
3839 | ideal U = imap(Q,U); |
---|
3840 | return(U); |
---|
3841 | } |
---|
3842 | U=K; |
---|
3843 | } |
---|
3844 | } |
---|
3845 | |
---|
3846 | /////////////////////////////////////////////////////////////////////////////// |
---|
3847 | |
---|
3848 | static proc substpartSpecial(ideal endid, ideal endphi) |
---|
3849 | { |
---|
3850 | //Note: newRing is of the form (R the original basering): |
---|
3851 | //char(R),(T(1..N),X(1..nvars(R))),(dp(N),...); |
---|
3852 | |
---|
3853 | int ii,jj,kk; |
---|
3854 | def BAS = basering; |
---|
3855 | int n = nvars(basering); |
---|
3856 | |
---|
3857 | list Le = elimpart(endid); |
---|
3858 | int q = size(Le[2]); //q variables have been substituted |
---|
3859 | //Le;""; |
---|
3860 | if ( q == 0 ) |
---|
3861 | { |
---|
3862 | ideal normap = endphi; |
---|
3863 | ideal norid = endid; |
---|
3864 | export(norid); |
---|
3865 | export(normap); |
---|
3866 | list L = BAS; |
---|
3867 | return(L); |
---|
3868 | } |
---|
3869 | |
---|
3870 | list gnirlist = ringlist(basering); |
---|
3871 | endid = Le[1]; |
---|
3872 | //endphi;""; |
---|
3873 | for( ii=1; ii<=n; ii++) |
---|
3874 | { |
---|
3875 | if( Le[4][ii] == 0 ) //ii=index of substituted var |
---|
3876 | { |
---|
3877 | endphi = subst(endphi,var(ii),Le[5][ii]); |
---|
3878 | } |
---|
3879 | } |
---|
3880 | //endphi;""; |
---|
3881 | list g2 = gnirlist[2]; //the varlist |
---|
3882 | list g3 = gnirlist[3]; //contains blocks of orderings |
---|
3883 | int n3 = size(g3); |
---|
3884 | |
---|
3885 | //----------------- first identify module ordering ------------------ |
---|
3886 | if ( g3[n3][1]== "c" or g3[n3][1] == "C" ) |
---|
3887 | { |
---|
3888 | list gm = g3[n3]; //last blockis module ordering |
---|
3889 | g3 = delete(g3,n3); |
---|
3890 | int m = 0; |
---|
3891 | } |
---|
3892 | else |
---|
3893 | { |
---|
3894 | list gm = g3[1]; //first block is module ordering |
---|
3895 | g3 = delete(g3,1); |
---|
3896 | int m = 1; |
---|
3897 | } |
---|
3898 | //---- delete variables which were substituted and weights -------- |
---|
3899 | intvec V; |
---|
3900 | int n(0); |
---|
3901 | list newg2; |
---|
3902 | list newg3; |
---|
3903 | for ( ii=1; ii<=n3-1; ii++ ) |
---|
3904 | { |
---|
3905 | // If order is a matrix ordering, it is replaced by dp ordering. |
---|
3906 | // TODO: replace it only when some of the original |
---|
3907 | // variables are eliminated. |
---|
3908 | if(g3[ii][1] == "M"){ |
---|
3909 | g3[ii][1] = "dp"; |
---|
3910 | g3[ii][2] = (1..sqroot(size(g3[ii][2])))*0+1; |
---|
3911 | } |
---|
3912 | V = V,g3[ii][2]; //copy weights for ordering in each block |
---|
3913 | if ( ii==1 ) //into one intvector |
---|
3914 | { |
---|
3915 | V = V[2..size(V)]; |
---|
3916 | } |
---|
3917 | // int n(ii) = size(g3[ii][2]); |
---|
3918 | int n(ii) = size(V); |
---|
3919 | intvec V(ii); |
---|
3920 | |
---|
3921 | for ( jj = n(ii-1)+1; jj<=n(ii); jj++) |
---|
3922 | { |
---|
3923 | if( Le[4][jj] !=0 ) //jj=index of var which was not substituted |
---|
3924 | { |
---|
3925 | kk=kk+1; |
---|
3926 | newg2[kk] = g2[jj]; //not substituted var from varlist |
---|
3927 | V(ii)=V(ii),V[jj]; //weight of not substituted variable |
---|
3928 | } |
---|
3929 | } |
---|
3930 | if ( size(V(ii)) >= 2 ) |
---|
3931 | { |
---|
3932 | V(ii) = V(ii)[2..size(V(ii))]; |
---|
3933 | list g3(ii)=g3[ii][1],V(ii); |
---|
3934 | newg3 = insert(newg3,g3(ii),size(newg3)); |
---|
3935 | //"newg3"; newg3; |
---|
3936 | } |
---|
3937 | } |
---|
3938 | //"newg3"; newg3; |
---|
3939 | //newg3 = delete(newg3,1); //delete empty list |
---|
3940 | |
---|
3941 | /* |
---|
3942 | //### neue Ordnung, 1 Block fuer alle vars, aber Gewichte erhalten; |
---|
3943 | //vorerst nicht realisiert, da bei leonhard1 alte Version (neue Variable T(i) |
---|
3944 | //ein neuer Block) ein kuerzeres Ergebnis liefert |
---|
3945 | kill g3; |
---|
3946 | list g3; |
---|
3947 | V=0; |
---|
3948 | for ( ii= 1; ii<=n3-1; ii++ ) |
---|
3949 | { |
---|
3950 | V=V,V(ii); |
---|
3951 | } |
---|
3952 | V = V[2..size(V)]; |
---|
3953 | |
---|
3954 | if ( V==1 ) |
---|
3955 | { |
---|
3956 | g3[1] = list("dp",V); |
---|
3957 | } |
---|
3958 | else |
---|
3959 | { |
---|
3960 | g3[1] = lis("wp",V); |
---|
3961 | } |
---|
3962 | newg3 = g3; |
---|
3963 | |
---|
3964 | //"newg3";newg3;""; |
---|
3965 | //### Ende neue Ordnung |
---|
3966 | */ |
---|
3967 | |
---|
3968 | if ( m == 0 ) |
---|
3969 | { |
---|
3970 | newg3 = insert(newg3,gm,size(newg3)); |
---|
3971 | } |
---|
3972 | else |
---|
3973 | { |
---|
3974 | newg3 = insert(newg3,gm); |
---|
3975 | } |
---|
3976 | gnirlist[2] = newg2; |
---|
3977 | gnirlist[3] = newg3; |
---|
3978 | |
---|
3979 | //gnirlist; |
---|
3980 | def newBAS = ring(gnirlist); //change of ring to less vars |
---|
3981 | setring newBAS; |
---|
3982 | ideal normap = imap(BAS,endphi); |
---|
3983 | //normap = simplify(normap,2); |
---|
3984 | ideal norid = imap(BAS,endid); |
---|
3985 | export(norid); |
---|
3986 | export(normap); |
---|
3987 | list L = newBAS; |
---|
3988 | return(L); |
---|
3989 | |
---|
3990 | //Hier scheint interred gut zu sein, da es Ergebnis relativ schnell |
---|
3991 | //verkleinert. Hier wird z.B. bei leonard1 size(norid) verkleinert aber |
---|
3992 | //size(string(norid)) stark vergroessert, aber es hat keine Auswirkungen |
---|
3993 | //da keine map mehr folgt. |
---|
3994 | //### Bei Leonard2 haengt interred (BUG) |
---|
3995 | //mstd[2] verkleinert norid nocheinmal um die Haelfte, dauert aber 3.71 sec |
---|
3996 | //### Ev. Hinweis auf mstd in der Hilfe? |
---|
3997 | |
---|
3998 | } |
---|
3999 | |
---|
4000 | /////////////////////////////////////////////////////////////////////////////// |
---|
4001 | // Computes the ring structure of a ring given by module generators. |
---|
4002 | // Assume: J[i]/J[1] are the module generators in the quotient field |
---|
4003 | // with J[1] as universal denominator. |
---|
4004 | // If option "noRed" is not given, a reduction in the number of variables is |
---|
4005 | // attempted. |
---|
4006 | static proc computeRing(ideal J, ideal I, list #) |
---|
4007 | { |
---|
4008 | int i, ii,jj; |
---|
4009 | intvec V; // to be used for variable weights |
---|
4010 | int y = printlevel-voice+2; |
---|
4011 | def R = basering; |
---|
4012 | poly c = J[1]; // the denominator |
---|
4013 | list gnirlist = ringlist(basering); |
---|
4014 | string svars = varstr(basering); |
---|
4015 | int nva = nvars(basering); |
---|
4016 | string svar; |
---|
4017 | ideal maxid = maxideal(1); |
---|
4018 | |
---|
4019 | int noRed = 0; // By default, we try to reduce the number of generators. |
---|
4020 | if(size(#) > 0){ |
---|
4021 | if ( typeof(#[1]) == "string" ) |
---|
4022 | { |
---|
4023 | if (#[1] == "noRed"){noRed = 1;} |
---|
4024 | } |
---|
4025 | } |
---|
4026 | |
---|
4027 | if ( y >= 1){"// computing the ring structure...";} |
---|
4028 | |
---|
4029 | if(c==1) |
---|
4030 | { |
---|
4031 | /* if( defined(norid) ) { kill norid; } |
---|
4032 | if( defined(normap) ) { kill normap; } |
---|
4033 | ideal norid = I; |
---|
4034 | ideal normap = maxid; */ |
---|
4035 | |
---|
4036 | list gnirlist = ringlist(R); |
---|
4037 | def R1 = ring(gnirlist); |
---|
4038 | setring R1; |
---|
4039 | ideal norid = imap(R, I); |
---|
4040 | ideal normap = imap(R, maxid); |
---|
4041 | export norid; |
---|
4042 | export normap; |
---|
4043 | |
---|
4044 | if(noRed == 1){ |
---|
4045 | setring R; |
---|
4046 | return(R1); |
---|
4047 | } |
---|
4048 | else |
---|
4049 | { |
---|
4050 | list L = substpartSpecial(norid,normap); |
---|
4051 | def lastRing = L[1]; |
---|
4052 | setring R; |
---|
4053 | return(lastRing); |
---|
4054 | } |
---|
4055 | } |
---|
4056 | |
---|
4057 | |
---|
4058 | //-------------- Enlarge ring by creating new variables ------------------ |
---|
4059 | //check first whether variables T(i) and then whether Z(i),...,A(i) exist |
---|
4060 | //old variable names are not touched |
---|
4061 | |
---|
4062 | if ( find(svars,"T(") == 0 ) |
---|
4063 | { |
---|
4064 | svar = "T"; |
---|
4065 | } |
---|
4066 | else |
---|
4067 | { |
---|
4068 | for (ii=90; ii>=65; ii--) |
---|
4069 | { |
---|
4070 | if ( find(svars,ASCII(ii)+"(") == 0 ) |
---|
4071 | { |
---|
4072 | svar = ASCII(ii); break; |
---|
4073 | } |
---|
4074 | } |
---|
4075 | } |
---|
4076 | |
---|
4077 | int q = size(J)-1; |
---|
4078 | if ( size(svar) != 0 ) |
---|
4079 | { |
---|
4080 | for ( ii=q; ii>=1; ii-- ) |
---|
4081 | { |
---|
4082 | gnirlist[2] = insert(gnirlist[2],svar+"("+string(ii)+")"); |
---|
4083 | } |
---|
4084 | } |
---|
4085 | else |
---|
4086 | { |
---|
4087 | for ( ii=q; ii>=1; ii-- ) |
---|
4088 | { |
---|
4089 | gnirlist[2] = insert(gnirlist[2],"T("+string(100*nva+ii)+")"); |
---|
4090 | } |
---|
4091 | } |
---|
4092 | |
---|
4093 | V[q]=0; //create intvec of variable weights |
---|
4094 | V=V+1; |
---|
4095 | gnirlist[3] = insert(gnirlist[3],list("dp",V)); |
---|
4096 | |
---|
4097 | //this is a block ordering with one dp-block (1st block) for new vars |
---|
4098 | //the remaining weights and blocks for old vars are kept |
---|
4099 | //### perhaps better to make only one block, keeping weights ? |
---|
4100 | //this might effect syz below |
---|
4101 | //alt: ring newR = char(R),(X(1..nvars(R)),T(1..q)),dp; |
---|
4102 | //Reihenfolge geaendert:neue Variablen kommen zuerst, Namen ev. nicht T(i) |
---|
4103 | |
---|
4104 | def newR = ring(gnirlist); |
---|
4105 | setring newR; //new extended ring |
---|
4106 | ideal I = imap(R,I); |
---|
4107 | |
---|
4108 | //------------- Compute linear and quadratic relations --------------- |
---|
4109 | if(y>=1) |
---|
4110 | { |
---|
4111 | "// compute linear relations:"; |
---|
4112 | } |
---|
4113 | qring newQ = std(I); |
---|
4114 | |
---|
4115 | ideal f = imap(R,J); |
---|
4116 | module syzf = syz(f); |
---|
4117 | ideal pf = f[1]*f; |
---|
4118 | //f[1] is the denominator D from normalityTest, a non zero divisor of R/I |
---|
4119 | |
---|
4120 | ideal newT = maxideal(1); |
---|
4121 | newT = 1,newT[1..q]; |
---|
4122 | //matrix T = matrix(ideal(1,T(1..q)),1,q+1); //alt |
---|
4123 | matrix T = matrix(newT,1,q+1); |
---|
4124 | ideal Lin = ideal(T*syzf); |
---|
4125 | //Lin=interred(Lin); |
---|
4126 | //### interred reduziert ev size aber size(string(LIN)) wird groesser |
---|
4127 | |
---|
4128 | if(y>=1) |
---|
4129 | { |
---|
4130 | if(y>=3) |
---|
4131 | { |
---|
4132 | "// the linear relations:"; Lin; pause();""; |
---|
4133 | } |
---|
4134 | "// the ring structure of the normalization as affine algebra"; |
---|
4135 | "// number of linear relations:", size(Lin); |
---|
4136 | } |
---|
4137 | |
---|
4138 | if(y>=1) |
---|
4139 | { |
---|
4140 | "// compute quadratic relations:"; |
---|
4141 | } |
---|
4142 | matrix A; |
---|
4143 | ideal Quad; |
---|
4144 | poly ff; |
---|
4145 | newT = newT[2..size(newT)]; |
---|
4146 | matrix u; // The units for non-global orderings. |
---|
4147 | |
---|
4148 | // Quadratic relations |
---|
4149 | for (ii=2; ii<=q+1; ii++ ) |
---|
4150 | { |
---|
4151 | for ( jj=2; jj<=ii; jj++ ) |
---|
4152 | { |
---|
4153 | ff = NF(f[ii]*f[jj],std(0)); // this makes lift much faster |
---|
4154 | // For non-global orderings, we have to take care of the units. |
---|
4155 | if(ord_test(basering) != 1){ |
---|
4156 | A = lift(pf, ff, u); |
---|
4157 | Quad = Quad,ideal(newT[jj-1]*newT[ii-1] * u[1, 1]- T*A); |
---|
4158 | } |
---|
4159 | else |
---|
4160 | { |
---|
4161 | A = lift(pf,ff); // ff lin. comb. of elts of pf mod I |
---|
4162 | Quad = Quad,ideal(newT[jj-1]*newT[ii-1] - T*A); |
---|
4163 | } |
---|
4164 | //A = lift(pf, f[ii]*f[jj]); |
---|
4165 | //Quad = Quad, ideal(T(jj-1)*T(ii-1) - T*A); |
---|
4166 | } |
---|
4167 | } |
---|
4168 | Quad = Quad[2..ncols(Quad)]; |
---|
4169 | |
---|
4170 | if(y>=1) |
---|
4171 | { |
---|
4172 | if(y>=3) |
---|
4173 | { |
---|
4174 | "// the quadratic relations"; Quad; pause();""; |
---|
4175 | } |
---|
4176 | "// number of quadratic relations:", size(Quad); |
---|
4177 | } |
---|
4178 | ideal Q1 = Lin,Quad; //elements of Q1 are in NF w.r.t. I |
---|
4179 | |
---|
4180 | //Q1 = mstd(Q1)[2]; |
---|
4181 | //### weglassen, ist sehr zeitaufwendig. |
---|
4182 | //Ebenso interred, z.B. bei Leonard1 (1. Komponente von Leonard): |
---|
4183 | //"size Q1:", size(Q1), size(string(Q1)); //75 60083 |
---|
4184 | //Q1 = interred(Q1); |
---|
4185 | //"size Q1:", size(Q1), size(string(Q1)); //73 231956 (!) |
---|
4186 | //### Speicherueberlauf bei substpartSpecial bei 'ideal norid = phi1(endid)' |
---|
4187 | //Beispiel fuer Hans um map zu testen! |
---|
4188 | |
---|
4189 | setring newR; |
---|
4190 | ideal endid = imap(newQ,Q1),I; |
---|
4191 | ideal endphi = imap(R,maxid); |
---|
4192 | |
---|
4193 | if(noRed == 0){ |
---|
4194 | list L=substpartSpecial(endid,endphi); |
---|
4195 | def lastRing=L[1]; |
---|
4196 | if(y>=1) |
---|
4197 | { |
---|
4198 | "// number of substituted variables:", nvars(newR)-nvars(lastRing); |
---|
4199 | pause();""; |
---|
4200 | } |
---|
4201 | return(lastRing); |
---|
4202 | } |
---|
4203 | else |
---|
4204 | { |
---|
4205 | ideal norid = endid; |
---|
4206 | ideal normap = endphi; |
---|
4207 | export(norid); |
---|
4208 | export(normap); |
---|
4209 | setring R; |
---|
4210 | return(newR); |
---|
4211 | } |
---|
4212 | } |
---|
4213 | |
---|
4214 | // Up to here: procedures for char p with Frobenius |
---|
4215 | /////////////////////////////////////////////////////////////////////////////// |
---|
4216 | |
---|
4217 | /////////////////////////////////////////////////////////////////////////////// |
---|
4218 | // From here: subprocedures for normal |
---|
4219 | |
---|
4220 | // inputJ is used in parametrization of rational curves algorithms, to specify |
---|
4221 | // a different test ideal. |
---|
4222 | |
---|
4223 | static proc normalM(ideal I, int decomp, int withDelta, int denomOption, ideal inputJ, ideal inputC){ |
---|
4224 | // Computes the normalization of a ring R / I using the module structure as far |
---|
4225 | // as possible. |
---|
4226 | // The ring R is the basering. |
---|
4227 | // Input: ideal I |
---|
4228 | // Output: a list of 3 elements (resp 4 if withDelta = 1), say nor. |
---|
4229 | // - nor[1] = U, an ideal of R. |
---|
4230 | // - nor[2] = c, an element of R. |
---|
4231 | // U and c satisfy that 1/c * U is the normalization of R / I in the |
---|
4232 | // quotient field Q(R/I). |
---|
4233 | // - nor[3] = ring say T, containing two ideals norid and normap such that |
---|
4234 | // normap gives the normalization map from R / I to T / norid. |
---|
4235 | // - nor[4] = the delta invariant, if withDelta = 1. |
---|
4236 | |
---|
4237 | // Details: |
---|
4238 | // -------- |
---|
4239 | // Computes the ideal of the minors in the first step and then reuses it in all |
---|
4240 | // steps. |
---|
4241 | // In step s, the denominator is D^s, where D is a nzd of the original quotient |
---|
4242 | // ring, contained in the radical of the singular locus. |
---|
4243 | // This denominator is used except when the degree of D^i is greater than the |
---|
4244 | // degree of a universal denominator. |
---|
4245 | // The nzd is taken as the smallest degree polynomial in the radical of the |
---|
4246 | // singular locus. |
---|
4247 | |
---|
4248 | // It assumes that the ideal I is equidimensional radical. This is not checked |
---|
4249 | // in the procedure! |
---|
4250 | // If decomp = 0 or decomp = 3 it assumes further that I is prime. Therefore |
---|
4251 | // any non-zero element in the jacobian ideal is assumed to be a |
---|
4252 | // non-zerodivisor. |
---|
4253 | |
---|
4254 | // It works over the given basering. |
---|
4255 | // If it has a non-global ordering, it changes it to dp global only for |
---|
4256 | // computing radical. |
---|
4257 | |
---|
4258 | // The delta invariant is only computed if withDelta = 1, and decomp = 0 or |
---|
4259 | // decomp = 3 (meaning that the ideal is prime). |
---|
4260 | |
---|
4261 | // denomOption = 0 -> Uses the smallest degree polynomial |
---|
4262 | // denomOption = i > 0 -> Uses a polynomial in the i-th variable |
---|
4263 | |
---|
4264 | intvec save_opt=option(get); |
---|
4265 | option(redSB); |
---|
4266 | option(returnSB); |
---|
4267 | int step = 0; // Number of steps. (for debugging) |
---|
4268 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4269 | int i; // counter |
---|
4270 | int isGlobal = ord_test(basering); |
---|
4271 | |
---|
4272 | poly c; // The common denominator. |
---|
4273 | |
---|
4274 | def R = basering; |
---|
4275 | |
---|
4276 | //------------------------ Groebner bases and dimension of I----------------- |
---|
4277 | if(isGlobal == 1) |
---|
4278 | { |
---|
4279 | list IM = mstd(I); |
---|
4280 | I = IM[1]; |
---|
4281 | ideal IMin = IM[2]; // A minimal set of generators in the groebner basis. |
---|
4282 | } |
---|
4283 | else |
---|
4284 | { |
---|
4285 | // The minimal set of generators is not computed by mstd for |
---|
4286 | // non-global orderings. |
---|
4287 | I = groebner(I); |
---|
4288 | ideal IMin = I; |
---|
4289 | } |
---|
4290 | int d = dim(I); |
---|
4291 | |
---|
4292 | // ---------------- computation of the singular locus --------------------- |
---|
4293 | // We compute the radical of the ideal of minors modulo the original ideal. |
---|
4294 | // This is done only in the first step. |
---|
4295 | qring Q = I; // We work in the quotient by the groebner base of the ideal I |
---|
4296 | option(redSB); |
---|
4297 | option(returnSB); |
---|
4298 | |
---|
4299 | // If a conductor ideal was given as input, we use it instead of the |
---|
4300 | // singular locus. If a test ideal was given as input, we do not compute the |
---|
4301 | // singular locus. |
---|
4302 | ideal inputC = fetch(R, inputC); |
---|
4303 | ideal inputJ = fetch(R, inputJ); |
---|
4304 | if((inputC == 0) && (inputJ == 0)) |
---|
4305 | { |
---|
4306 | // We compute the radical of the ideal of minors modulo the original ideal. |
---|
4307 | // This is done only in the first step. |
---|
4308 | ideal I = fetch(R, I); |
---|
4309 | attrib(I, "isSB", 1); |
---|
4310 | ideal IMin = fetch(R, IMin); |
---|
4311 | |
---|
4312 | dbprint(dbg, "Computing the jacobian ideal..."); |
---|
4313 | |
---|
4314 | // If a given conductor ideal is given, we use it. |
---|
4315 | // If a given test ideal is given, we don't need to compute the jacobian |
---|
4316 | ideal J = minor(jacob(IMin), nvars(basering) - d, I); |
---|
4317 | J = groebner(J); |
---|
4318 | } |
---|
4319 | else |
---|
4320 | { |
---|
4321 | ideal J = fetch(R, inputC); |
---|
4322 | J = groebner(J); |
---|
4323 | } |
---|
4324 | |
---|
4325 | //------------------ We check if the singular locus is empty ------------- |
---|
4326 | if(J[1] == 1) |
---|
4327 | { |
---|
4328 | // The original ring R/I was normal. Nothing to do. |
---|
4329 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
4330 | setring R; |
---|
4331 | list lR = ringlist(R); |
---|
4332 | def ROut = ring(lR); |
---|
4333 | setring ROut; |
---|
4334 | ideal norid = fetch(R, I); |
---|
4335 | ideal normap = maxideal(1); |
---|
4336 | export norid; |
---|
4337 | export normap; |
---|
4338 | setring R; |
---|
4339 | if(withDelta) |
---|
4340 | { |
---|
4341 | list output = ideal(1), poly(1), ROut, 0; |
---|
4342 | } |
---|
4343 | else |
---|
4344 | { |
---|
4345 | list output = ideal(1), poly(1), ROut; |
---|
4346 | } |
---|
4347 | option(set,save_opt); |
---|
4348 | return(list(output)); |
---|
4349 | } |
---|
4350 | |
---|
4351 | |
---|
4352 | // -------------------- election of the universal denominator---------------- |
---|
4353 | // We first check if a conductor ideal was computed. If not, we don't |
---|
4354 | // compute a universal denominator. |
---|
4355 | ideal Id1; |
---|
4356 | if(J != 0) |
---|
4357 | { |
---|
4358 | if(denomOption == 0) |
---|
4359 | { |
---|
4360 | poly condu = getSmallest(J); // Choses the polynomial of smallest degree |
---|
4361 | // of J as universal denominator. |
---|
4362 | } |
---|
4363 | else |
---|
4364 | { |
---|
4365 | poly condu = getOneVar(J, denomOption); |
---|
4366 | } |
---|
4367 | if(dbg >= 1) |
---|
4368 | { |
---|
4369 | ""; |
---|
4370 | "The universal denominator is ", condu; |
---|
4371 | } |
---|
4372 | |
---|
4373 | // ----- splitting the ideal by the universal denominator (if possible) ----- |
---|
4374 | // If the ideal is equidimensional, but not necessarily prime, we check if |
---|
4375 | // the universal denominator is a non-zerodivisor of R/I. |
---|
4376 | // If not, we split I. |
---|
4377 | if((decomp == 1) or (decomp == 2)) |
---|
4378 | { |
---|
4379 | Id1 = quotient(0, condu); |
---|
4380 | if(size(Id1) > 0) |
---|
4381 | { |
---|
4382 | // We have to split. |
---|
4383 | if(dbg >= 1) |
---|
4384 | { |
---|
4385 | "A zerodivisor was found. We split the ideal. The zerodivisor is ", condu; |
---|
4386 | } |
---|
4387 | setring R; |
---|
4388 | ideal Id1 = fetch(Q, Id1), I; |
---|
4389 | Id1 = groebner(Id1); |
---|
4390 | ideal Id2 = quotient(I, Id1); |
---|
4391 | // I = I1 \cap I2 |
---|
4392 | printlevel = printlevel + 1; |
---|
4393 | ideal JDefault = 0; // Now it uses the default J; |
---|
4394 | list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault)[1]; |
---|
4395 | list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault)[1]; |
---|
4396 | printlevel = printlevel - 1; |
---|
4397 | option(set,save_opt); |
---|
4398 | return(list(nor1, nor2)); |
---|
4399 | } |
---|
4400 | } |
---|
4401 | } |
---|
4402 | else |
---|
4403 | { |
---|
4404 | poly condu = 0; |
---|
4405 | } |
---|
4406 | |
---|
4407 | // --------------- computation of the first test ideal --------------------- |
---|
4408 | // To compute the radical we go back to the original ring. |
---|
4409 | // If we are using a non-global ordering, we must change to the global |
---|
4410 | // ordering. |
---|
4411 | setring R; |
---|
4412 | // If a test ideal is given at the input, we use it. |
---|
4413 | if(inputJ == 0) |
---|
4414 | { |
---|
4415 | if(isGlobal == 1) |
---|
4416 | { |
---|
4417 | ideal J = fetch(Q, J); |
---|
4418 | J = J, I; |
---|
4419 | if(dbg >= 1) |
---|
4420 | { |
---|
4421 | "The original singular locus is"; |
---|
4422 | groebner(J); |
---|
4423 | if(dbg >= 2){pause();} |
---|
4424 | ""; |
---|
4425 | } |
---|
4426 | // We check if the only singular point is the origin. |
---|
4427 | // If so, the radical is the maximal ideal at the origin. |
---|
4428 | J = groebner(J); |
---|
4429 | if(locAtZero(J)) |
---|
4430 | { |
---|
4431 | J = maxideal(1); |
---|
4432 | } |
---|
4433 | else |
---|
4434 | { |
---|
4435 | J = radical(J); |
---|
4436 | } |
---|
4437 | } |
---|
4438 | else |
---|
4439 | { |
---|
4440 | // We change to global dp ordering. |
---|
4441 | list rl = ringlist(R); |
---|
4442 | list origOrd = rl[3]; |
---|
4443 | list newOrd = list("dp", intvec(1:nvars(R))), list("C", 0); |
---|
4444 | rl[3] = newOrd; |
---|
4445 | def globR = ring(rl); |
---|
4446 | setring globR; |
---|
4447 | ideal J = fetch(Q, J); |
---|
4448 | ideal I = fetch(R, I); |
---|
4449 | J = J, I; |
---|
4450 | if(dbg >= 1) |
---|
4451 | { |
---|
4452 | "The original singular locus is"; |
---|
4453 | groebner(J); |
---|
4454 | if(dbg>=2){pause();} |
---|
4455 | ""; |
---|
4456 | } |
---|
4457 | J = radical(J); |
---|
4458 | setring R; |
---|
4459 | ideal J = fetch(globR, J); |
---|
4460 | } |
---|
4461 | } |
---|
4462 | else |
---|
4463 | { |
---|
4464 | ideal J = inputJ; |
---|
4465 | } |
---|
4466 | |
---|
4467 | if(dbg >= 1) |
---|
4468 | { |
---|
4469 | "The radical of the original singular locus is"; |
---|
4470 | J; |
---|
4471 | if(dbg>=2){pause();} |
---|
4472 | } |
---|
4473 | |
---|
4474 | // ---------------- election of the non zero divisor --------------------- |
---|
4475 | setring Q; |
---|
4476 | J = fetch(R, J); |
---|
4477 | J = interred(J); |
---|
4478 | if(denomOption == 0) |
---|
4479 | { |
---|
4480 | poly D = getSmallest(J); // Chooses the polynomial of smallest degree as |
---|
4481 | // non-zerodivisor. |
---|
4482 | } |
---|
4483 | else |
---|
4484 | { |
---|
4485 | poly D = getOneVar(J, denomOption); |
---|
4486 | } |
---|
4487 | if(dbg >= 1) |
---|
4488 | { |
---|
4489 | "The non zero divisor is ", D; |
---|
4490 | ""; |
---|
4491 | } |
---|
4492 | |
---|
4493 | // ------- splitting the ideal by the non-zerodivisor (if possible) -------- |
---|
4494 | // If the ideal is equidimensional, but not necessarily prime, we check if D |
---|
4495 | // is actually a non-zerodivisor of R/I. |
---|
4496 | // If not, we split I. |
---|
4497 | if((decomp == 1) or (decomp == 2)) |
---|
4498 | { |
---|
4499 | // We check if D is actually a non-zerodivisor of R/I. |
---|
4500 | // If not, we split I. |
---|
4501 | Id1 = quotient(0, D); |
---|
4502 | if(size(Id1) > 0) |
---|
4503 | { |
---|
4504 | // We have to split. |
---|
4505 | if(dbg >= 1) |
---|
4506 | { |
---|
4507 | "A zerodivisor was found. We split the ideal. The zerodivisor is ", D; |
---|
4508 | } |
---|
4509 | setring R; |
---|
4510 | ideal Id1 = fetch(Q, Id1), I; |
---|
4511 | Id1 = groebner(Id1); |
---|
4512 | ideal Id2 = quotient(I, Id1); |
---|
4513 | // I = Id1 \cap Id2 |
---|
4514 | printlevel = printlevel + 1; |
---|
4515 | |
---|
4516 | ideal JDefault = 0; // Now it uses the default J; |
---|
4517 | list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault)[1]; |
---|
4518 | list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault)[1]; |
---|
4519 | printlevel = printlevel - 1; |
---|
4520 | option(set,save_opt); |
---|
4521 | return(list(nor1, nor2)); |
---|
4522 | } |
---|
4523 | } |
---|
4524 | |
---|
4525 | // --------------------- normalization ------------------------------------ |
---|
4526 | // We call normalMEqui to compute the normalization. |
---|
4527 | setring R; |
---|
4528 | poly D = fetch(Q, D); |
---|
4529 | poly condu = fetch(Q, condu); |
---|
4530 | J = fetch(Q, J); |
---|
4531 | printlevel = printlevel + 1; |
---|
4532 | list result = normalMEqui(I, J, condu, D, withDelta, denomOption); |
---|
4533 | printlevel = printlevel - 1; |
---|
4534 | option(set,save_opt); |
---|
4535 | return(list(result)); |
---|
4536 | } |
---|
4537 | |
---|
4538 | /////////////////////////////////////////////////////////////////////////////// |
---|
4539 | |
---|
4540 | static proc normalMEqui(ideal I, ideal origJ, poly condu, poly D, int withDelta) |
---|
4541 | // Here is where the normalization is actually computed. |
---|
4542 | |
---|
4543 | // Computes the normalization of R/I. (basering is R) |
---|
4544 | // I is assumed to be radical and equidimensional. |
---|
4545 | // origJ is the first test ideal. |
---|
4546 | // D is a non-zerodivisor of R/I. |
---|
4547 | // condu is a non-zerodivisor in the conductor or 0 if it was not computed. |
---|
4548 | // If withDelta = 1, computes the delta invariant. |
---|
4549 | { |
---|
4550 | int step = 0; // Number of steps. (for debugging) |
---|
4551 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4552 | int i; // counter |
---|
4553 | int isNormal = 0; // check for exiting the loop |
---|
4554 | int isGlobal = ord_test(basering); |
---|
4555 | int delt; |
---|
4556 | |
---|
4557 | def R = basering; |
---|
4558 | poly c = D; |
---|
4559 | ideal U; |
---|
4560 | ideal cJ; |
---|
4561 | list testOut; // Output of proc testIdeal |
---|
4562 | // (the test ideal and the ring structure) |
---|
4563 | |
---|
4564 | qring Q = groebner(I); |
---|
4565 | intvec save_opt=option(get); |
---|
4566 | option(redSB); |
---|
4567 | option(returnSB); |
---|
4568 | ideal J = imap(R, origJ); |
---|
4569 | poly c = imap(R, c); |
---|
4570 | poly D = imap(R, D); |
---|
4571 | poly condu = imap(R, condu); |
---|
4572 | ideal cJ; |
---|
4573 | ideal cJMod; |
---|
4574 | |
---|
4575 | dbprint(dbg, "Preliminar step begins."); |
---|
4576 | |
---|
4577 | // --------------------- computation of A1 ------------------------------- |
---|
4578 | dbprint(dbg, "Computing the quotient (DJ : J)..."); |
---|
4579 | ideal U = groebner(quotient(D*J, J)); |
---|
4580 | ideal oldU = 1; |
---|
4581 | |
---|
4582 | if(dbg >= 2) { "The quotient is"; U; } |
---|
4583 | |
---|
4584 | // ----------------- Grauer-Remmert criterion check ----------------------- |
---|
4585 | // We check if the equality in Grauert - Remmert criterion is satisfied. |
---|
4586 | isNormal = checkInclusions(D*oldU, U); |
---|
4587 | if(isNormal == 0) |
---|
4588 | { |
---|
4589 | if(dbg >= 1) |
---|
4590 | { |
---|
4591 | "In this step, we have the ring 1/c * U, with c =", c; |
---|
4592 | "and U = "; U; |
---|
4593 | } |
---|
4594 | } |
---|
4595 | else |
---|
4596 | { |
---|
4597 | // The original ring R/I was normal. Nothing to do. |
---|
4598 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
4599 | setring R; |
---|
4600 | list lR = ringlist(R); |
---|
4601 | def ROut = ring(lR); |
---|
4602 | setring ROut; |
---|
4603 | ideal norid = fetch(R, I); |
---|
4604 | ideal normap = maxideal(1); |
---|
4605 | export norid; |
---|
4606 | export normap; |
---|
4607 | setring R; |
---|
4608 | if(withDelta) |
---|
4609 | { |
---|
4610 | list output = ideal(1), poly(1), ROut, 0; |
---|
4611 | } |
---|
4612 | else |
---|
4613 | { |
---|
4614 | list output = ideal(1), poly(1), ROut; |
---|
4615 | } |
---|
4616 | option(set,save_opt); |
---|
4617 | return(output); |
---|
4618 | } |
---|
4619 | |
---|
4620 | // ----- computation of the chain of ideals A1 c A2 c ... c An ------------ |
---|
4621 | while(isNormal == 0) |
---|
4622 | { |
---|
4623 | step++; |
---|
4624 | if(dbg >= 1) { ""; "Step ", step, " begins."; } |
---|
4625 | dbprint(dbg, "Computing the test ideal..."); |
---|
4626 | |
---|
4627 | // --------------- computation of the test ideal ------------------------ |
---|
4628 | // Computes a test ideal for the new ring. |
---|
4629 | // The test ideal will be the radical in the new ring of the original |
---|
4630 | // test ideal. |
---|
4631 | setring R; |
---|
4632 | U = imap(Q, U); |
---|
4633 | c = imap(Q, c); |
---|
4634 | testOut = testIdeal(I, U, origJ, c, D); |
---|
4635 | cJ = testOut[1]; |
---|
4636 | |
---|
4637 | setring Q; |
---|
4638 | cJ = imap(R, cJ); |
---|
4639 | cJ = groebner(cJ); |
---|
4640 | |
---|
4641 | // cJ / c is now the ideal mapped back. |
---|
4642 | // We have the generators as an ideal in the new ring, |
---|
4643 | // but we want the generators as an ideal in the original ring. |
---|
4644 | cJMod = getGenerators(cJ, U, c); |
---|
4645 | |
---|
4646 | if(dbg >= 2) { "The test ideal in this step is "; cJMod; } |
---|
4647 | |
---|
4648 | cJ = cJMod; |
---|
4649 | |
---|
4650 | // ------------- computation of the quotient (DJ : J)-------------------- |
---|
4651 | oldU = U; |
---|
4652 | dbprint(dbg, "Computing the quotient (c*D*cJ : cJ)..."); |
---|
4653 | U = quotient(c*D*cJ, cJ); |
---|
4654 | if(dbg >= 2){"The quotient is "; U;} |
---|
4655 | |
---|
4656 | // ------------- Grauert - Remmert criterion check ---------------------- |
---|
4657 | // We check if the equality in Grauert - Remmert criterion is satisfied. |
---|
4658 | isNormal = checkInclusions(D*oldU, U); |
---|
4659 | |
---|
4660 | if(isNormal == 1) |
---|
4661 | { |
---|
4662 | // We go one step back. In the last step we didnt get antyhing new, |
---|
4663 | // we just verified that the ring was already normal. |
---|
4664 | dbprint(dbg, "The ring in the previous step was already normal."); |
---|
4665 | dbprint(dbg, ""); |
---|
4666 | U = oldU; |
---|
4667 | } |
---|
4668 | else |
---|
4669 | { |
---|
4670 | // ------------- preparation for next iteration ---------------------- |
---|
4671 | // We have to go on. |
---|
4672 | // The new denominator is chosen. |
---|
4673 | c = D * c; |
---|
4674 | |
---|
4675 | // If we have a universal denominator of smaller degree than c, |
---|
4676 | // we replace c by it. |
---|
4677 | if(condu != 0) |
---|
4678 | { |
---|
4679 | if(deg(c) > deg(condu)) |
---|
4680 | { |
---|
4681 | U = changeDenominatorQ(U, c, condu); |
---|
4682 | c = condu; |
---|
4683 | } |
---|
4684 | } |
---|
4685 | if(dbg >= 1) |
---|
4686 | { |
---|
4687 | "In this step, we have the ring 1/c * U, with c =", c; |
---|
4688 | "and U = "; |
---|
4689 | U; |
---|
4690 | if(dbg>=2){pause();} |
---|
4691 | } |
---|
4692 | } |
---|
4693 | } |
---|
4694 | |
---|
4695 | // ------------------------- delta computation ---------------------------- |
---|
4696 | if(withDelta) |
---|
4697 | { |
---|
4698 | ideal UD = groebner(U); |
---|
4699 | delt = vdim(std(modulo(UD, c))); |
---|
4700 | } |
---|
4701 | |
---|
4702 | // -------------------------- prepare output ----------------------------- |
---|
4703 | setring R; |
---|
4704 | U = fetch(Q, U); |
---|
4705 | c = fetch(Q, c); |
---|
4706 | |
---|
4707 | // Ring structure of the new ring |
---|
4708 | def ere = testOut[2]; |
---|
4709 | if(withDelta) |
---|
4710 | { |
---|
4711 | list output = U, c, ere, delt; |
---|
4712 | } |
---|
4713 | else |
---|
4714 | { |
---|
4715 | list output = U, c, ere; |
---|
4716 | } |
---|
4717 | option(set,save_opt); |
---|
4718 | return(output); |
---|
4719 | } |
---|
4720 | |
---|
4721 | /////////////////////////////////////////////////////////////////////////////// |
---|
4722 | |
---|
4723 | static proc lineUpLast(ideal U, poly c) |
---|
4724 | // Sets c as the last generator of U. |
---|
4725 | { |
---|
4726 | int i; |
---|
4727 | ideal newU; |
---|
4728 | for (i = 1; i <= ncols(U); i++) |
---|
4729 | { |
---|
4730 | if(U[i] != c) |
---|
4731 | { |
---|
4732 | if(size(newU) == 0) |
---|
4733 | { newU = U[i]; } |
---|
4734 | else |
---|
4735 | { newU = newU, U[i]; } |
---|
4736 | } |
---|
4737 | } |
---|
4738 | if(size(newU) == 0) |
---|
4739 | { newU = c; } |
---|
4740 | else |
---|
4741 | { newU = newU, c; } |
---|
4742 | return(newU); |
---|
4743 | } |
---|
4744 | |
---|
4745 | /////////////////////////////////////////////////////////////////////////////// |
---|
4746 | |
---|
4747 | static proc lineUp(ideal U, poly c) |
---|
4748 | // Sets c as the first generator of U. |
---|
4749 | { |
---|
4750 | int i; |
---|
4751 | ideal newU = c; |
---|
4752 | for (i = 1; i <= ncols(U); i++) |
---|
4753 | { |
---|
4754 | if(U[i] != c) |
---|
4755 | { |
---|
4756 | newU = newU, U[i]; |
---|
4757 | } |
---|
4758 | } |
---|
4759 | return(newU); |
---|
4760 | } |
---|
4761 | |
---|
4762 | /////////////////////////////////////////////////////////////////////////////// |
---|
4763 | |
---|
4764 | //WARNING - elim is not working here!! Check!! |
---|
4765 | //It is now replaced by computing an eliminating groebner basis. |
---|
4766 | proc getOneVar(ideal J, int vari) |
---|
4767 | "USAGE: getOneVar(J, vari); J is a 0-dimensional ideal, vari is an integer. |
---|
4768 | RETURN: a polynomial of J in the variable indicated by vari of smallest |
---|
4769 | degree.@* |
---|
4770 | NOTE: Works only over rings of two variables.@* |
---|
4771 | It is intended mainly as an auxiliary procedure for computing |
---|
4772 | integral bases. @* |
---|
4773 | EXAMPLE: example getOneVar; shows an example |
---|
4774 | " |
---|
4775 | { |
---|
4776 | def R = basering; |
---|
4777 | list RL = ringlist(R); |
---|
4778 | // We keep everything from R but we change the ordering to lp, and we |
---|
4779 | // order the variables as needed. |
---|
4780 | RL[3] = list(list("lp", 1:2), list("C", 0:1)); |
---|
4781 | RL[2] = list(var(3-vari), var(vari)); |
---|
4782 | RL[4]=ideal(0); // does not work with qrings: Ex.7 of paraplanecurves |
---|
4783 | def RR = ring(RL); |
---|
4784 | setring RR; |
---|
4785 | ideal J = imap(R, J); |
---|
4786 | J = groebner(J); |
---|
4787 | poly g = J[1]; |
---|
4788 | setring R; |
---|
4789 | poly g = imap(RR, g); |
---|
4790 | return(g); |
---|
4791 | } |
---|
4792 | example |
---|
4793 | { "EXAMPLE:"; |
---|
4794 | printlevel = printlevel+1; |
---|
4795 | echo = 2; |
---|
4796 | ring s = 0,(x,y),dp; |
---|
4797 | ideal J = x3-y, y3; |
---|
4798 | getOneVar(J, 1); |
---|
4799 | |
---|
4800 | echo = 0; |
---|
4801 | printlevel = printlevel-1; |
---|
4802 | } |
---|
4803 | /////////////////////////////////////////////////////////////////////////////// |
---|
4804 | |
---|
4805 | proc getSmallest(ideal J) |
---|
4806 | "USAGE: getSmallest(J); J is an ideal. |
---|
4807 | RETURN: the generator of J of smallest degree. If there are more than one, it |
---|
4808 | chooses the one with smallest number of monomials.@* |
---|
4809 | NOTE: It looks only at the generator of J, not at all the polynomials in |
---|
4810 | the ideal.@* |
---|
4811 | It is intended maninly to compute a good universal denominator in the |
---|
4812 | normalization algorithms.@* |
---|
4813 | EXAMPLE: example getSmallest; shows an example |
---|
4814 | " |
---|
4815 | { |
---|
4816 | // Computes the polynomial of smallest degree of J. |
---|
4817 | // |
---|
4818 | int i; |
---|
4819 | poly p = J[1]; |
---|
4820 | int d = deg(p); |
---|
4821 | int di; |
---|
4822 | for(i = 2; i <= ncols(J); i++) |
---|
4823 | { |
---|
4824 | if(J[i] != 0) |
---|
4825 | { |
---|
4826 | di = deg(J[i]); |
---|
4827 | if(di < d) |
---|
4828 | { |
---|
4829 | p = J[i]; |
---|
4830 | d = di; |
---|
4831 | } |
---|
4832 | else |
---|
4833 | { |
---|
4834 | if(di == d) |
---|
4835 | { |
---|
4836 | if(size(J[i]) < size(p)) |
---|
4837 | { |
---|
4838 | p = J[i]; |
---|
4839 | } |
---|
4840 | } |
---|
4841 | } |
---|
4842 | } |
---|
4843 | } |
---|
4844 | return(p); |
---|
4845 | } |
---|
4846 | example |
---|
4847 | { "EXAMPLE:"; |
---|
4848 | printlevel = printlevel+1; |
---|
4849 | echo = 2; |
---|
4850 | ring s = 0,(x,y),dp; |
---|
4851 | ideal J = x3-y, y5, x2-y2+1; |
---|
4852 | getSmallest(J); |
---|
4853 | |
---|
4854 | echo = 0; |
---|
4855 | printlevel = printlevel-1; |
---|
4856 | } |
---|
4857 | |
---|
4858 | /////////////////////////////////////////////////////////////////////////////// |
---|
4859 | |
---|
4860 | static proc getGenerators(ideal J, ideal U, poly c) |
---|
4861 | { |
---|
4862 | // Computes the generators of J as an ideal in the original ring, |
---|
4863 | // where J is given by generators in the new ring. |
---|
4864 | |
---|
4865 | // The new ring is given by 1/c * U in the total ring of fractions. |
---|
4866 | |
---|
4867 | int i, j; // counters; |
---|
4868 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4869 | poly p; // The lifted polynomial |
---|
4870 | ideal JGr = groebner(J); // Groebner base of J |
---|
4871 | |
---|
4872 | if(dbg>1){"Checking for new generators...";} |
---|
4873 | for(i = 1; i <= ncols(J); i++) |
---|
4874 | { |
---|
4875 | for(j = 1; j <= ncols(U); j++) |
---|
4876 | { |
---|
4877 | p = lift(c, J[i]*U[j])[1,1]; |
---|
4878 | p = reduce(p, JGr); |
---|
4879 | if(p != 0) |
---|
4880 | { |
---|
4881 | if(dbg>1) |
---|
4882 | { |
---|
4883 | "New polynoial added:", p; |
---|
4884 | if(dbg>4) {pause();} |
---|
4885 | } |
---|
4886 | JGr = JGr, p; |
---|
4887 | JGr = groebner(JGr); |
---|
4888 | J = J, p; |
---|
4889 | } |
---|
4890 | } |
---|
4891 | } |
---|
4892 | return(J); |
---|
4893 | } |
---|
4894 | |
---|
4895 | /////////////////////////////////////////////////////////////////////////////// |
---|
4896 | |
---|
4897 | static proc testIdeal(ideal I, ideal U, ideal origJ, poly c, poly D) |
---|
4898 | { |
---|
4899 | // Internal procedure, used in normalM. |
---|
4900 | // Computes the test ideal in the new ring. |
---|
4901 | // It takes the original test ideal and computes the radical of it in the |
---|
4902 | // new ring. |
---|
4903 | |
---|
4904 | // The new ring is 1/c * U. |
---|
4905 | // The original test ideal is origJ. |
---|
4906 | // The original ring is R / I, where R is the basering. |
---|
4907 | int i; // counter |
---|
4908 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4909 | def R = basering; // We dont work in the quo |
---|
4910 | ideal J = origJ; |
---|
4911 | |
---|
4912 | // ---------- computation of the ring structure of 1/c * U ---------------- |
---|
4913 | U = lineUp(U, c); |
---|
4914 | |
---|
4915 | if(dbg > 1){"Computing the new ring structure...";} |
---|
4916 | list ele = computeRing(U, I, "noRed"); |
---|
4917 | |
---|
4918 | def origEre = ele[1]; |
---|
4919 | setring origEre; |
---|
4920 | if(dbg > 1){"The relations are"; norid;} |
---|
4921 | |
---|
4922 | // ---------------- setting the ring to work in -------------------------- |
---|
4923 | int isGlobal = ord_test(origEre); // Checks if the original ring has |
---|
4924 | // global ordering. |
---|
4925 | if(isGlobal != 1) |
---|
4926 | { |
---|
4927 | list rl = ringlist(origEre); |
---|
4928 | list origOrd = rl[3]; |
---|
4929 | list newOrd = list("dp", intvec(1:nvars(origEre))), list("C", 0); |
---|
4930 | rl[3] = newOrd; |
---|
4931 | def ere = ring(rl); // globR is the original ring but |
---|
4932 | // with a global ordering. |
---|
4933 | setring ere; |
---|
4934 | ideal norid = imap(origEre, norid); |
---|
4935 | } |
---|
4936 | else |
---|
4937 | { |
---|
4938 | def ere = origEre; |
---|
4939 | } |
---|
4940 | |
---|
4941 | ideal I = imap(R, I); |
---|
4942 | ideal J = imap(R, J); |
---|
4943 | J = J, norid, I; |
---|
4944 | |
---|
4945 | |
---|
4946 | // ----- computation of the test ideal using the ring structure of Ai ----- |
---|
4947 | intvec save_opt=option(get); |
---|
4948 | option(redSB); |
---|
4949 | option(returnSB); |
---|
4950 | |
---|
4951 | if(dbg > 1){"Computing the radical of J...";} |
---|
4952 | J = radical(J); |
---|
4953 | if(dbg > 1){"Computing the interreduction of the radical...";} |
---|
4954 | J = groebner(J); |
---|
4955 | //J = interred(J); |
---|
4956 | if(dbg > 1) |
---|
4957 | { |
---|
4958 | "The radical in the generated ring is"; |
---|
4959 | J; |
---|
4960 | if(dbg>4){pause();} |
---|
4961 | } |
---|
4962 | |
---|
4963 | setring ere; |
---|
4964 | |
---|
4965 | // -------------- map from Ai to the total ring of fractions --------------- |
---|
4966 | // Now we must map back this ideal J to U_i / c in the total ring of |
---|
4967 | // fractions. |
---|
4968 | // The map sends T_j -> u_j / c. |
---|
4969 | // The map is built by the following steps: |
---|
4970 | // 1) We compute the degree of the generators of J with respect to the |
---|
4971 | // new variables T_j. |
---|
4972 | // 2) For each generator, we multiply each term by a power of c, as if |
---|
4973 | // taking c^n as a common denominator (considering the new variables as |
---|
4974 | // a polynomial in the old variables divided by c). |
---|
4975 | // 3) We replace the new variables T_j by the corresponding numerator u_j. |
---|
4976 | // 4) We lift the resulting polynomial to change the denominator |
---|
4977 | // from c^n to c. |
---|
4978 | int nNewVars = nvars(ere) - nvars(R); // Number of new variables |
---|
4979 | poly c = imap(R, c); |
---|
4980 | intvec @v = 1..nNewVars; // Vector of the new variables. |
---|
4981 | // They must be the first ones. |
---|
4982 | if(dbg > 1){"The indices of the new variables are", @v;} |
---|
4983 | |
---|
4984 | // ---------------------- step 1 of the mapping --------------------------- |
---|
4985 | intvec degs; |
---|
4986 | for(i = 1; i<=ncols(J); i++) |
---|
4987 | { |
---|
4988 | degs[i] = degSubring(J[i], @v); |
---|
4989 | } |
---|
4990 | if(dbg > 1) |
---|
4991 | { |
---|
4992 | "The degrees with respect to the new variables are"; |
---|
4993 | degs; |
---|
4994 | } |
---|
4995 | |
---|
4996 | // ---------------------- step 2 of the mapping --------------------------- |
---|
4997 | ideal mapJ = mapBackIdeal(J, c, @v); |
---|
4998 | |
---|
4999 | setring R; |
---|
5000 | |
---|
5001 | // ---------------------- step 3 of the mapping --------------------------- |
---|
5002 | ideal z; // The variables of the original ring in order. |
---|
5003 | for(i = 1; i<=nvars(R); i++) |
---|
5004 | { |
---|
5005 | z[i] = var(i); |
---|
5006 | } |
---|
5007 | |
---|
5008 | map f = ere, U[2..ncols(U)], z[1..ncols(z)]; // The map to the original ring. |
---|
5009 | if(dbg > 1) |
---|
5010 | { |
---|
5011 | "The map is "; |
---|
5012 | f; |
---|
5013 | if(dbg>4){pause();} |
---|
5014 | } |
---|
5015 | |
---|
5016 | if(dbg > 1){ "Computing the map..."; } |
---|
5017 | |
---|
5018 | J = f(mapJ); |
---|
5019 | if(dbg > 1) |
---|
5020 | { |
---|
5021 | "The ideal J mapped back (before lifting) is"; |
---|
5022 | J; |
---|
5023 | if(dbg>4){pause();} |
---|
5024 | } |
---|
5025 | |
---|
5026 | // ---------------------- step 4 of the mapping --------------------------- |
---|
5027 | qring Q = groebner(I); |
---|
5028 | ideal J = imap(R, J); |
---|
5029 | poly c = imap(R, c); |
---|
5030 | for(i = 1; i<=ncols(J); i++) |
---|
5031 | { |
---|
5032 | if(degs[i]>1) |
---|
5033 | { |
---|
5034 | J[i] = lift(c^(degs[i]-1), J[i])[1,1]; |
---|
5035 | } |
---|
5036 | else |
---|
5037 | { |
---|
5038 | if(degs[i]==0) { J[i] = c*J[i]; } |
---|
5039 | } |
---|
5040 | } |
---|
5041 | |
---|
5042 | if(dbg > 1) |
---|
5043 | { |
---|
5044 | "The ideal J lifted is"; |
---|
5045 | J; |
---|
5046 | if(dbg>4){pause();} |
---|
5047 | } |
---|
5048 | |
---|
5049 | // --------------------------- prepare output ---------------------------- |
---|
5050 | J = groebner(J); |
---|
5051 | |
---|
5052 | setring R; |
---|
5053 | J = imap(Q, J); |
---|
5054 | |
---|
5055 | option(set,save_opt); |
---|
5056 | return(list(J, ele[1])); |
---|
5057 | } |
---|
5058 | |
---|
5059 | /////////////////////////////////////////////////////////////////////////////// |
---|
5060 | |
---|
5061 | proc changeDenominator(ideal U1, poly c1, poly c2, ideal I) |
---|
5062 | "USAGE: changeDenominator(U1, c1, c2, I); U1 and I ideals, c1 and c2 |
---|
5063 | polynomials.@* |
---|
5064 | RETURN: an ideal U2 such that the A-modules 1/c1 * U1 and 1/c2 * U2 are equal, |
---|
5065 | where A = R/I and R is the basering.@* |
---|
5066 | NOTE: It assumes that such U2 exists. It is intended maninly as an auxiliary |
---|
5067 | procedure in the normalization algorithms.@* |
---|
5068 | EXAMPLE: example changeDenominator; shows an example |
---|
5069 | " |
---|
5070 | { |
---|
5071 | // Let A = R / I. Given an A-module in the form 1/c1 * U1 (U1 ideal of A), it |
---|
5072 | // computes a new ideal U2 such that the the A-module is 1/c2 * U2. |
---|
5073 | // The base ring is R, but the computations are to be done in R / I. |
---|
5074 | int a; // counter |
---|
5075 | def R = basering; |
---|
5076 | qring Q = I; |
---|
5077 | ideal U1 = fetch(R, U1); |
---|
5078 | poly c1 = fetch(R, c1); |
---|
5079 | poly c2 = fetch(R, c2); |
---|
5080 | ideal U2 = changeDenominatorQ(U1, c1, c2); |
---|
5081 | setring R; |
---|
5082 | ideal U2 = fetch(Q, U2); |
---|
5083 | return(U2); |
---|
5084 | } |
---|
5085 | example |
---|
5086 | { |
---|
5087 | "EXAMPLE:"; |
---|
5088 | echo = 2; |
---|
5089 | ring s = 0,(x,y),dp; |
---|
5090 | ideal I = y5-y4x+4y2x2-x4; |
---|
5091 | ideal U1 = normal(I)[2][1]; |
---|
5092 | poly c1 = U1[4]; |
---|
5093 | U1;c1; |
---|
5094 | // 1/c1 * U1 is the normalization of I. |
---|
5095 | ideal U2 = changeDenominator(U1, c1, x3, I); |
---|
5096 | U2; |
---|
5097 | // 1/x3 * U2 is also the normalization of I, but with a different denominator. |
---|
5098 | echo = 0; |
---|
5099 | } |
---|
5100 | |
---|
5101 | /////////////////////////////////////////////////////////////////////////////// |
---|
5102 | |
---|
5103 | static proc changeDenominatorQ(ideal U1, poly c1, poly c2) |
---|
5104 | { |
---|
5105 | // Given a ring in the form 1/c1 * U, it computes a new U2 st the ring |
---|
5106 | // is 1/c2 * U2. |
---|
5107 | // The base ring is already a quotient ring R / I. |
---|
5108 | int a; // counter |
---|
5109 | ideal U2; |
---|
5110 | poly p; |
---|
5111 | for(a = 1; a <= ncols(U1); a++) |
---|
5112 | { |
---|
5113 | p = lift(c1, c2*U1[a])[1,1]; |
---|
5114 | U2[a] = p; |
---|
5115 | } |
---|
5116 | return(U2); |
---|
5117 | } |
---|
5118 | |
---|
5119 | /////////////////////////////////////////////////////////////////////////////// |
---|
5120 | |
---|
5121 | static proc checkInclusions(ideal U1, ideal U2) |
---|
5122 | { |
---|
5123 | // Checks if the identity A = Hom(J, J) of Grauert-Remmert criterion is |
---|
5124 | // satisfied. |
---|
5125 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
5126 | list reduction1; |
---|
5127 | list reduction2; |
---|
5128 | |
---|
5129 | // ---------------------- inclusion Hom(J, J) c A ------------------------- |
---|
5130 | if(dbg > 1){"Checking the inclusion Hom(J, J) c A:";} |
---|
5131 | // This interred is used only because a bug in groebner! |
---|
5132 | U1 = groebner(U1); |
---|
5133 | reduction1 = reduce(U2, U1); |
---|
5134 | if(dbg > 1){reduction1[1];} |
---|
5135 | |
---|
5136 | // ---------------------- inclusion A c Hom(J, J) ------------------------- |
---|
5137 | // The following check should always be satisfied. |
---|
5138 | // This is only used for debugging. |
---|
5139 | if(dbg > 1) |
---|
5140 | { |
---|
5141 | "and the inclusion A c Hom(J, J): (this should always be satisfied)"; |
---|
5142 | // This interred is used only because a bug in groebner! |
---|
5143 | U2 = groebner(U2); |
---|
5144 | reduction2 = reduce(U1, groebner(U2)); |
---|
5145 | reduction2[1]; |
---|
5146 | if(size(reduction2[1]) > 0) |
---|
5147 | { |
---|
5148 | "Something went wrong... (this inclusion should always be satisfied)"; |
---|
5149 | ~; |
---|
5150 | } |
---|
5151 | else |
---|
5152 | { |
---|
5153 | if(dbg>4){pause();} |
---|
5154 | } |
---|
5155 | } |
---|
5156 | |
---|
5157 | if(size(reduction1[1]) == 0) |
---|
5158 | { |
---|
5159 | // We are done! The ring computed in the last step was normal. |
---|
5160 | return(1); |
---|
5161 | } |
---|
5162 | else |
---|
5163 | { |
---|
5164 | return(0); |
---|
5165 | } |
---|
5166 | } |
---|
5167 | |
---|
5168 | /////////////////////////////////////////////////////////////////////////////// |
---|
5169 | |
---|
5170 | static proc degSubring(poly p, intvec @v) |
---|
5171 | { |
---|
5172 | // Computes the degree of a polynomial taking only some variables as variables |
---|
5173 | // and the others as parameters. |
---|
5174 | |
---|
5175 | // The degree is taken w.r.t. the variables indicated in v. |
---|
5176 | int i; // Counter |
---|
5177 | int d = 0; // The degree |
---|
5178 | int e; // Degree (auxiliar variable) |
---|
5179 | for(i = 1; i <= size(p); i++) |
---|
5180 | { |
---|
5181 | e = sum(leadexp(p[i]), @v); |
---|
5182 | if(e > d){d = e;} |
---|
5183 | } |
---|
5184 | return(d); |
---|
5185 | } |
---|
5186 | |
---|
5187 | /////////////////////////////////////////////////////////////////////////////// |
---|
5188 | |
---|
5189 | static proc mapBackIdeal(ideal I, poly c, intvec @v) |
---|
5190 | { |
---|
5191 | // Modifies all polynomials in I so that a map x(i) -> y(i)/c can be |
---|
5192 | // carried out. |
---|
5193 | |
---|
5194 | // v indicates wicih variables x(i) of the ring will be mapped to y(i)/c. |
---|
5195 | |
---|
5196 | int i; // counter |
---|
5197 | for(i = 1; i <= ncols(I); i++) |
---|
5198 | { |
---|
5199 | I[i] = mapBackPoly(I[i], c, @v); |
---|
5200 | } |
---|
5201 | return(I); |
---|
5202 | } |
---|
5203 | |
---|
5204 | /////////////////////////////////////////////////////////////////////////////// |
---|
5205 | |
---|
5206 | static proc mapBackPoly(poly p, poly c, intvec @v) |
---|
5207 | { |
---|
5208 | // Multiplies each monomial of p by a power of c so that a map x(i) -> y(i)/c |
---|
5209 | // can be carried out. |
---|
5210 | |
---|
5211 | // v indicates wicih variables x(i) of the ring will be mapped to y(i)/c. |
---|
5212 | int i; // counter |
---|
5213 | int e; // exponent |
---|
5214 | int d = degSubring(p, @v); |
---|
5215 | poly g = 0; |
---|
5216 | int size_p=size(p); |
---|
5217 | for(i = 1; i <= size_p; i++) |
---|
5218 | { |
---|
5219 | e = sum(leadexp(p[i]), @v); |
---|
5220 | g = g + p[i] * c^(d-e); |
---|
5221 | } |
---|
5222 | return(g); |
---|
5223 | } |
---|
5224 | |
---|
5225 | // End procedures for normal |
---|
5226 | /////////////////////////////////////////////////////////////////////////////// |
---|
5227 | |
---|
5228 | |
---|
5229 | /////////////////////////////////////////////////////////////////////////////// |
---|
5230 | // Begin procedures for normalC |
---|
5231 | |
---|
5232 | // We first define resp. copy some attributes to be used in proc normal and |
---|
5233 | // static proc normalizationPrimes, and ..., to speed up computation in |
---|
5234 | // special cases |
---|
5235 | //NOTE: We use the following attributes: |
---|
5236 | // 1 attrib(id,"isCohenMacaulay"); //--- Cohen Macaulay |
---|
5237 | // 2 attrib(id,"isCompleteIntersection"); //--- complete intersection |
---|
5238 | // 3 attrib(id,"isHypersurface"); //--- hypersurface |
---|
5239 | // 4 attrib(id,"isEquidimensional"); //--- equidimensional ideal |
---|
5240 | // 5 attrib(id,"isPrim"); //--- prime ideal |
---|
5241 | // 6 attrib(id,"isRegInCodim2"); //--- regular in codimension 2 |
---|
5242 | // 7 attrib(id,"isIsolatedSingularity"); //--- isolated singularities |
---|
5243 | // 8 attrib(id,"onlySingularAtZero"); //--- only singular at 0 |
---|
5244 | // 9 attrib(id,"isRadical"); //--- radical ideal |
---|
5245 | //Recall: (attrib(id,"xy"),1) sets attrib xy to TRUE and |
---|
5246 | // (attrib(id,"xy"),0) to FALSE |
---|
5247 | |
---|
5248 | static proc getAttrib (ideal id) |
---|
5249 | "USAGE: getAttrib(id); id=ideal |
---|
5250 | COMPUTE: check attributes for id. If the attributes above are defined, |
---|
5251 | take its value, otherwise define it and set it to 0 |
---|
5252 | RETURN: intvec of size 9, with entries 0 or 1, values of attributes defined |
---|
5253 | above (in this order) |
---|
5254 | EXAMPLE: no example |
---|
5255 | " |
---|
5256 | { |
---|
5257 | int isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad; |
---|
5258 | |
---|
5259 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
5260 | { |
---|
5261 | if( attrib(id,"isCohenMacaulay")==1 ) |
---|
5262 | { isCoM=1; isEq=1; } |
---|
5263 | } |
---|
5264 | |
---|
5265 | if( typeof(attrib(id,"isCompleteIntersection"))=="int" ) |
---|
5266 | { |
---|
5267 | if(attrib(id,"isCompleteIntersection")==1) |
---|
5268 | { isCoI=1; isCoM=1; isEq=1; } |
---|
5269 | } |
---|
5270 | |
---|
5271 | if( typeof(attrib(id,"isHypersurface"))=="int" ) |
---|
5272 | { |
---|
5273 | if(attrib(id,"isHypersurface")==1) |
---|
5274 | { isHy=1; isCoI=1; isCoM=1; isEq=1; } |
---|
5275 | } |
---|
5276 | |
---|
5277 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
5278 | { |
---|
5279 | if(attrib(id,"isEquidimensional")==1) |
---|
5280 | { isEq=1; } |
---|
5281 | } |
---|
5282 | |
---|
5283 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
5284 | { |
---|
5285 | if(attrib(id,"isPrim")==1) |
---|
5286 | { isPr=1; } |
---|
5287 | } |
---|
5288 | |
---|
5289 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
5290 | { |
---|
5291 | if(attrib(id,"isRegInCodim2")==1) |
---|
5292 | { isReg=1; } |
---|
5293 | } |
---|
5294 | |
---|
5295 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
5296 | { |
---|
5297 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
5298 | { isIso=1; } |
---|
5299 | } |
---|
5300 | |
---|
5301 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
5302 | { |
---|
5303 | if(attrib(id,"onlySingularAtZero")==1) |
---|
5304 | { oSAZ=1; } |
---|
5305 | } |
---|
5306 | |
---|
5307 | if( typeof(attrib(id,"isRad"))=="int" ) |
---|
5308 | { |
---|
5309 | if(attrib(id,"isRad")==1) |
---|
5310 | { isRad=1; } |
---|
5311 | } |
---|
5312 | |
---|
5313 | intvec atr = isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad; |
---|
5314 | return(atr); |
---|
5315 | } |
---|
5316 | |
---|
5317 | /////////////////////////////////////////////////////////////////////////////// |
---|
5318 | |
---|
5319 | static proc setAttrib (ideal id, intvec atr) |
---|
5320 | "USAGE: setAttrib(id,atr); id ideal, atr intvec |
---|
5321 | COMPUTE: set attributes to id specified by atr |
---|
5322 | RETURN: id, with assigned attributes from atr |
---|
5323 | EXAMPLE: no example |
---|
5324 | " |
---|
5325 | { |
---|
5326 | attrib(id,"isCohenMacaulay",atr[1]); //--- Cohen Macaulay |
---|
5327 | attrib(id,"isCompleteIntersection",atr[2]); //--- complete intersection |
---|
5328 | attrib(id,"isHypersurface",atr[3]); //--- hypersurface |
---|
5329 | attrib(id,"isEquidimensional",atr[4]); //--- equidimensional ideal |
---|
5330 | attrib(id,"isPrim",atr[5]); //--- prime ideal |
---|
5331 | attrib(id,"isRegInCodim2",atr[6]); //--- regular in codimension 2 |
---|
5332 | attrib(id,"isIsolatedSingularity",atr[7]); //--- isolated singularities |
---|
5333 | attrib(id,"onlySingularAtZero",atr[8]); //--- only singular at 0 |
---|
5334 | attrib(id,"isRadical",atr[9]); //--- radical ideal |
---|
5335 | |
---|
5336 | return(id); |
---|
5337 | } |
---|
5338 | |
---|
5339 | /////////////////////////////////////////////////////////////////////////////// |
---|
5340 | // copyAttribs is not used anywhere so far |
---|
5341 | |
---|
5342 | static proc copyAttribs (ideal id1, ideal id) |
---|
5343 | "USAGE: copyAttribs(id1,id); id1, id ideals |
---|
5344 | COMPUTE: copy attributes from id1 to id |
---|
5345 | RETURN: id, with assigned attributes from id1 |
---|
5346 | EXAMPLE: no example |
---|
5347 | " |
---|
5348 | { |
---|
5349 | if( typeof(attrib(id1,"isCohenMacaulay"))=="int" ) |
---|
5350 | { |
---|
5351 | if( attrib(id1,"isCohenMacaulay")==1 ) |
---|
5352 | { |
---|
5353 | attrib(id,"isEquidimensional",1); |
---|
5354 | } |
---|
5355 | } |
---|
5356 | else |
---|
5357 | { |
---|
5358 | attrib(id,"isCohenMacaulay",0); |
---|
5359 | } |
---|
5360 | |
---|
5361 | if( typeof(attrib(id1,"isCompleteIntersection"))=="int" ) |
---|
5362 | { |
---|
5363 | if(attrib(id1,"isCompleteIntersection")==1) |
---|
5364 | { |
---|
5365 | attrib(id,"isCohenMacaulay",1); |
---|
5366 | attrib(id,"isEquidimensional",1); |
---|
5367 | } |
---|
5368 | } |
---|
5369 | else |
---|
5370 | { |
---|
5371 | attrib(id,"isCompleteIntersection",0); |
---|
5372 | } |
---|
5373 | |
---|
5374 | if( typeof(attrib(id1,"isHypersurface"))=="int" ) |
---|
5375 | { |
---|
5376 | if(attrib(id1,"isHypersurface")==1) |
---|
5377 | { |
---|
5378 | attrib(id,"isCompleteIntersection",1); |
---|
5379 | attrib(id,"isCohenMacaulay",1); |
---|
5380 | attrib(id,"isEquidimensional",1); |
---|
5381 | } |
---|
5382 | } |
---|
5383 | else |
---|
5384 | { |
---|
5385 | attrib(id,"isHypersurface",0); |
---|
5386 | } |
---|
5387 | |
---|
5388 | if( (typeof(attrib(id1,"isEquidimensional"))=="int") ) |
---|
5389 | { |
---|
5390 | if(attrib(id1,"isEquidimensional")==1) |
---|
5391 | { |
---|
5392 | attrib(id,"isEquidimensional",1); |
---|
5393 | } |
---|
5394 | } |
---|
5395 | else |
---|
5396 | { |
---|
5397 | attrib(id,"isEquidimensional",0); |
---|
5398 | } |
---|
5399 | |
---|
5400 | if( typeof(attrib(id1,"isPrim"))=="int" ) |
---|
5401 | { |
---|
5402 | if(attrib(id1,"isPrim")==1) |
---|
5403 | { |
---|
5404 | attrib(id,"isEquidimensional",1); |
---|
5405 | } |
---|
5406 | } |
---|
5407 | else |
---|
5408 | { |
---|
5409 | attrib(id,"isPrim",0); |
---|
5410 | } |
---|
5411 | |
---|
5412 | if( (typeof(attrib(id1,"isRegInCodim2"))=="int") ) |
---|
5413 | { |
---|
5414 | if(attrib(id1,"isRegInCodim2")==1) |
---|
5415 | { |
---|
5416 | attrib(id,"isRegInCodim2",1); |
---|
5417 | } |
---|
5418 | } |
---|
5419 | else |
---|
5420 | { |
---|
5421 | attrib(id,"isRegInCodim2",0); |
---|
5422 | } |
---|
5423 | |
---|
5424 | if( (typeof(attrib(id1,"isIsolatedSingularity"))=="int") ) |
---|
5425 | { |
---|
5426 | if(attrib(id1,"isIsolatedSingularity")==1) |
---|
5427 | { |
---|
5428 | attrib(id,"isIsolatedSingularity",1); |
---|
5429 | } |
---|
5430 | } |
---|
5431 | else |
---|
5432 | { |
---|
5433 | attrib(id,"isIsolatedSingularity",0); |
---|
5434 | } |
---|
5435 | |
---|
5436 | if( typeof(attrib(id1,"onlySingularAtZero"))=="int" ) |
---|
5437 | { |
---|
5438 | if(attrib(id1,"onlySingularAtZero")==1) |
---|
5439 | { |
---|
5440 | attrib(id,"isIsolatedSingularity",1); |
---|
5441 | } |
---|
5442 | } |
---|
5443 | else |
---|
5444 | { |
---|
5445 | attrib(id,"onlySingularAtZero",0); |
---|
5446 | } |
---|
5447 | |
---|
5448 | if( typeof(attrib(id1,"isRad"))=="int" ) |
---|
5449 | { |
---|
5450 | if(attrib(id1,"isRad")==1) |
---|
5451 | { |
---|
5452 | attrib(id,"isRad",1); |
---|
5453 | } |
---|
5454 | } |
---|
5455 | else |
---|
5456 | { |
---|
5457 | attrib(id,"isRad",0); |
---|
5458 | } |
---|
5459 | return(id); |
---|
5460 | } |
---|
5461 | /////////////////////////////////////////////////////////////////////////////// |
---|
5462 | |
---|
5463 | proc normalC(ideal id, list #) |
---|
5464 | "USAGE: normalC(id [,choose]); id = radical ideal, choose = optional list |
---|
5465 | of string. |
---|
5466 | Optional parameters in list choose (can be entered in any order):@* |
---|
5467 | Decomposition:@* |
---|
5468 | - \"equidim\" -> computes first an equidimensional decomposition, |
---|
5469 | and then the normalization of each component (default).@* |
---|
5470 | - \"prim\" -> computes first the minimal associated primes, and then |
---|
5471 | the normalization of each prime. @* |
---|
5472 | - \"noDeco\" -> no preliminary decomposition is done. If the ideal is |
---|
5473 | not equidimensional radical, output might be wrong.@* |
---|
5474 | - \"isPrim\" -> assumes that the ideal is prime. If the assumption does |
---|
5475 | not hold, output might be wrong.@* |
---|
5476 | - \"noFac\" -> factorization is avoided in the computation of the |
---|
5477 | minimal associated primes; |
---|
5478 | Other:@* |
---|
5479 | - \"withGens\" -> the minimal associated primes P_i of id are |
---|
5480 | computed and for each P_i, algebra generators of the integral closure |
---|
5481 | of basering/P_i are computed as elements of its quotient field;@* |
---|
5482 | If choose is not given or empty, the default options are used.@* |
---|
5483 | ASSUME: The ideal must be radical, for non-radical ideals the output may |
---|
5484 | be wrong (id=radical(id); makes id radical). However, if option |
---|
5485 | \"prim\" is set the minimal associated primes are computed first |
---|
5486 | and hence normalC computes the normalization of the radical of id. |
---|
5487 | \"isPrim\" should only be used if id is known to be irreducible. |
---|
5488 | RETURN: a list, say nor, of size 2 (resp. 3 if option \"withGens\" is set).@* |
---|
5489 | * nor[1] is always a of r rings, where r is the number of associated |
---|
5490 | primes with option \"prim\" (resp. >= no of equidimenensional |
---|
5491 | components with option \"equidim\").@* |
---|
5492 | Each ring Ri=nor[1][i], i=1..r, contains two ideals with given |
---|
5493 | names @code{norid} and @code{normap} such that @* |
---|
5494 | - Ri/norid is the normalization of the i-th component, i.e. the |
---|
5495 | integral closure in its field of fractions as affine ring, i.e. Ri is |
---|
5496 | given in the form K[X(1..p),T(1..q)], where K is the ground field; |
---|
5497 | - normap gives the normalization map from basering/id to |
---|
5498 | Ri/norid for each i (the j-th element of normap is mapped to the |
---|
5499 | j-th variable of R).@* |
---|
5500 | - the direct sum of the rings Ri/norid is the normalization |
---|
5501 | of basering/id; @* |
---|
5502 | ** If option \"withGens\" is not set: @* |
---|
5503 | * nor[2] shows the delta invariants: nor[2] is a list of an intvec of |
---|
5504 | size r, the delta invariants of the r components, and an integer, the |
---|
5505 | delta invariant of basering/id. (-1 means infinite, 0 that basering/P_i |
---|
5506 | resp. basering/input is normal, -2 means that delta resp. delta of one |
---|
5507 | of the components is not computed (which may happen if \"equidim\" is |
---|
5508 | given). @* |
---|
5509 | ** If option \"withGens\" is set: |
---|
5510 | * nor[2] is a list of ideals Ii=nor[2][i], i=1..r, in the basering, |
---|
5511 | generating the integral closure of basering/P_i in its quotient field |
---|
5512 | as K-algebra (K the ground field):@* |
---|
5513 | If Ii is given by polynomials g_1,...,g_k, then c:=g_k is a non-zero |
---|
5514 | divisor and the j-th variables of the ring Ri satisfies var(j)=g_j/c, |
---|
5515 | j=1..k-1, as element in the quotient field of basering/P_i. The |
---|
5516 | g_j/g_k+1 are K-algebra generators of the integral closure of |
---|
5517 | basering/P_i.@* |
---|
5518 | * nor[3] shows the delta invariant as above. |
---|
5519 | THEORY: We use the Grauert-Remmert-de Jong algorithm [c.f. G.-M. Greuel, |
---|
5520 | G. Pfister: A SINGULAR Introduction to Commutative Algebra, 2nd Edition. |
---|
5521 | Springer Verlag (2007)]. |
---|
5522 | The procedure computes the algebra structure and the delta invariant of |
---|
5523 | the normalization of R/id:@* |
---|
5524 | The normalization is an affine algebra over the ground field K |
---|
5525 | and nor[1] presents it as such: Ri = K[X(1..p),T(1..q)] and Ri/norid |
---|
5526 | is the integral closure of R/P_i; if option \"withGens\" is set the |
---|
5527 | X(j) and T(j) are expressed as quotients in the total ring of |
---|
5528 | fractions. Note that the X(j) and T(j) generate the integral closure |
---|
5529 | as K-algebra, but not necessarily as R-module (since relations of the |
---|
5530 | form X(1)=T(1)*T(2) may have been eliminated). Geometrically the |
---|
5531 | algebra structure is relevant since the variety of the ideal norid in |
---|
5532 | Ri is the normalization of the variety of the ideal P_i in R.@* |
---|
5533 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
5534 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
5535 | id. nor[3] returns the delta invariants of the components P_i and of |
---|
5536 | id. |
---|
5537 | NOTE: To use the i-th ring type: @code{def R=nor[1][i]; setring R;}. |
---|
5538 | @* Increasing/decreasing printlevel displays more/less comments |
---|
5539 | (default: printlevel=0). |
---|
5540 | @* Not implemented for local or mixed orderings or quotient rings. |
---|
5541 | For local or mixed orderings use proc 'normal'. |
---|
5542 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
5543 | be used (qhweight(id); computes weights). |
---|
5544 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
5545 | SEE ALSO: normal, normalP. |
---|
5546 | EXAMPLE: example normalC; shows an example |
---|
5547 | " |
---|
5548 | { |
---|
5549 | int i,j; |
---|
5550 | int withGens, withEqui, withPrim, isPrim, noFac; |
---|
5551 | int dbg = printlevel-voice+2; |
---|
5552 | int nvar = nvars(basering); |
---|
5553 | int chara = char(basering); |
---|
5554 | list result, prim, keepresult; |
---|
5555 | |
---|
5556 | int decomp; // Preliminar decomposition: |
---|
5557 | // 0 -> no decomposition (id is assumed to be prime) |
---|
5558 | // 1 -> no decomposition |
---|
5559 | // (id is assumed to be equidimensional radical) |
---|
5560 | // 2 -> equidimensional decomposition |
---|
5561 | // 3 -> minimal associated primes |
---|
5562 | |
---|
5563 | // Default methods: |
---|
5564 | noFac = 0; // Use facstd when computing minimal associated primes |
---|
5565 | decomp = 2; // Equidimensional decomposition for nvar > 2 |
---|
5566 | if (nvar <= 2) |
---|
5567 | { decomp = 3; } // Compute minimal associated primes if nvar <= 2 |
---|
5568 | |
---|
5569 | if ( ord_test(basering) != 1 ) |
---|
5570 | { |
---|
5571 | ""; |
---|
5572 | "// Not implemented for this ordering,"; |
---|
5573 | "// please change to global ordering or use proc normal"; |
---|
5574 | return(result); |
---|
5575 | } |
---|
5576 | |
---|
5577 | //--------------------------- define the method --------------------------- |
---|
5578 | string method; //make all options one string in order to use |
---|
5579 | //all combinations of options simultaneously |
---|
5580 | for ( i=1; i <= size(#); i++ ) |
---|
5581 | { |
---|
5582 | if ( typeof(#[i]) == "string" ) |
---|
5583 | { |
---|
5584 | method = method + #[i]; |
---|
5585 | } |
---|
5586 | } |
---|
5587 | |
---|
5588 | //--------------------------- choosen methods ----------------------- |
---|
5589 | // "withGens": computes algebra generators for each irreducible component |
---|
5590 | // ### the extra code for withGens should be incorporated in the general case |
---|
5591 | |
---|
5592 | if ( find(method,"withgens") or find(method,"withGens")) |
---|
5593 | { |
---|
5594 | withGens = 1; |
---|
5595 | } |
---|
5596 | |
---|
5597 | // the general case: either equidim or minAssGTZ or no decomposition |
---|
5598 | |
---|
5599 | if ( find(method,"isprim") or find(method,"isPrim") ) |
---|
5600 | {decomp = 0; isPrim=1;} |
---|
5601 | |
---|
5602 | if ( find(method,"nodeco") or find(method,"noDeco") ) |
---|
5603 | {decomp = 1;} |
---|
5604 | |
---|
5605 | if ( find(method,"equidim") ) |
---|
5606 | { decomp = 2; } |
---|
5607 | |
---|
5608 | if ( find(method,"prim") ) |
---|
5609 | { decomp = 3; } |
---|
5610 | |
---|
5611 | if ( find(method,"nofac") or find(method,"noFac") ) |
---|
5612 | { noFac = 1; } |
---|
5613 | |
---|
5614 | kill #; |
---|
5615 | list #; |
---|
5616 | |
---|
5617 | //------- Special algorithm with computation of the generators, RETURN ------- |
---|
5618 | //--------------------- method "withGens" ---------------------------------- |
---|
5619 | //the integral closure is computed in proc primeClosure. In the general case |
---|
5620 | //it is computed in normalizationPrimes. The main difference is that in |
---|
5621 | //primeClosure the singular locus is only computed in the first iteration, |
---|
5622 | //that no attributes are used, and that the generators are computed. |
---|
5623 | //In primeClosure the (algebra) generators for each irreducible component |
---|
5624 | //are computed in the static proc closureGenerators |
---|
5625 | |
---|
5626 | if( withGens ) |
---|
5627 | { |
---|
5628 | if( dbg >= 1 ) |
---|
5629 | { ""; |
---|
5630 | "// We use method 'withGens'"; |
---|
5631 | } |
---|
5632 | if ( decomp == 0 or decomp == 1 ) |
---|
5633 | { |
---|
5634 | prim[1] = id; |
---|
5635 | if( dbg >= 0 ) |
---|
5636 | { |
---|
5637 | ""; |
---|
5638 | "// ** WARNING: result is correct if ideal is prime (not checked) **"; |
---|
5639 | "// if procedure is called with string \"prim\", primality is checked"; |
---|
5640 | } |
---|
5641 | } |
---|
5642 | else |
---|
5643 | { |
---|
5644 | if(dbg >= 1) |
---|
5645 | { "// Computing minimal associated primes..."; } |
---|
5646 | |
---|
5647 | if( noFac ) |
---|
5648 | { prim = minAssGTZ(id,1); } |
---|
5649 | else |
---|
5650 | { prim = minAssGTZ(id); } |
---|
5651 | |
---|
5652 | if(dbg >= 2) |
---|
5653 | { prim;""; } |
---|
5654 | if(dbg >= 1) |
---|
5655 | { |
---|
5656 | "// number of irreducible components is", size(prim); |
---|
5657 | } |
---|
5658 | } |
---|
5659 | //----------- compute integral closure for every component ------------- |
---|
5660 | int del; |
---|
5661 | intvec deli; |
---|
5662 | list Gens,l,resu,Resu; |
---|
5663 | ideal gens; |
---|
5664 | def R = basering; |
---|
5665 | poly gg; |
---|
5666 | |
---|
5667 | for(i=1; i<=size(prim); i++) |
---|
5668 | { |
---|
5669 | if(dbg>=1) |
---|
5670 | { |
---|
5671 | ""; pause(); ""; |
---|
5672 | "// Computing normalization of component",i; |
---|
5673 | " ---------------------------------------"; |
---|
5674 | } |
---|
5675 | |
---|
5676 | if( defined(ker) ) { kill ker; } |
---|
5677 | ideal ker = prim[i]; |
---|
5678 | export(ker); |
---|
5679 | l = R; |
---|
5680 | l = primeClosure(l,1); //here the work is done |
---|
5681 | // primeClosure is called with list l consisting of the basering |
---|
5682 | //### ausprobieren ob primeClosure(l,1) schneller als primeClosure(l) |
---|
5683 | // 1 bedeutet: kuerzester nzd |
---|
5684 | // l[size(l)] is the delta invariant |
---|
5685 | |
---|
5686 | if ( l[size(l)] >= 0 && del >= 0 ) |
---|
5687 | { |
---|
5688 | del = del + l[size(l)]; |
---|
5689 | } |
---|
5690 | else |
---|
5691 | { del = -1; } |
---|
5692 | deli = l[size(l)],deli; |
---|
5693 | |
---|
5694 | l = l[1..size(l)-1]; |
---|
5695 | resu = list(l[size(l)]) + resu; |
---|
5696 | gens = closureGenerators(l); //computes algebra(!) generators |
---|
5697 | |
---|
5698 | //NOTE: gens[i]/gens[size(gens)] expresses the ith variable of resu[1] |
---|
5699 | //(the normalization) as fraction of elements of the basering; |
---|
5700 | //the variables of resu[1] are algebra generators. |
---|
5701 | //gens[size(gens)] is a non-zero divisor of basering/i |
---|
5702 | |
---|
5703 | //divide by the greatest common divisor: |
---|
5704 | gg = gcd( gens[1],gens[size(gens)] ); |
---|
5705 | for(j=2; j<=size(gens)-1; j++) |
---|
5706 | { |
---|
5707 | gg=gcd(gg,gens[j]); |
---|
5708 | } |
---|
5709 | for(j=1; j<=size(gens); j++) |
---|
5710 | { |
---|
5711 | gens[j]=gens[j]/gg; |
---|
5712 | } |
---|
5713 | Gens = list(gens) + Gens; |
---|
5714 | |
---|
5715 | /* ### Da die gens Algebra-Erzeuger sind, ist reduce nach Bestimmung |
---|
5716 | der Algebra-Variablen T(i) nicht zulaessig! |
---|
5717 | for(i=1;i<=size(gens)-1;i++) |
---|
5718 | { |
---|
5719 | gens[i]= reduce(gens[i],std(gens[size(gens)])); |
---|
5720 | } |
---|
5721 | for(i=size(gens)-1; i>=1; i--) |
---|
5722 | { |
---|
5723 | if(gens[i]==0) |
---|
5724 | { gens = delete(gens,i); } |
---|
5725 | } |
---|
5726 | */ |
---|
5727 | if( defined(ker) ) { kill ker; } |
---|
5728 | } |
---|
5729 | |
---|
5730 | if ( del >= 0 ) |
---|
5731 | { |
---|
5732 | int mul = iMult(prim); |
---|
5733 | del = del + mul; |
---|
5734 | } |
---|
5735 | else |
---|
5736 | { del = -1; } |
---|
5737 | deli = deli[1..size(deli)-1]; |
---|
5738 | Resu = resu,Gens,list(deli,del); |
---|
5739 | int sr = size(resu); |
---|
5740 | |
---|
5741 | if ( dbg >= 0 ) |
---|
5742 | {""; |
---|
5743 | "// 'normalC' created a list, say nor, of three lists: |
---|
5744 | // To see the list type |
---|
5745 | nor; |
---|
5746 | |
---|
5747 | // * nor[1] is a list of",sr,"ring(s) |
---|
5748 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
5749 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
5750 | // For the other rings type first (if R is the name of your original basering) |
---|
5751 | setring R; |
---|
5752 | // and then continue as for R1. |
---|
5753 | // Ri/norid is the affine algebra of the normalization of the i-th |
---|
5754 | // component R/P_i (where P_i is an associated prime of the input ideal id) |
---|
5755 | // and normap the normalization map from R to Ri/norid. |
---|
5756 | |
---|
5757 | // * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of |
---|
5758 | // elements g1..gk of R such that the gj/gk generate the integral |
---|
5759 | // closure of R/P_i as sub-algebra in the quotient field of R/P_i, with |
---|
5760 | // gj/gk being mapped by normap to the j-th variable of Ri; |
---|
5761 | |
---|
5762 | // * nor[3] shows the delta-invariant of each component and of id |
---|
5763 | // (-1 means infinite, and 0 that R/P_i resp. R/id is normal)."; |
---|
5764 | } |
---|
5765 | return(Resu); |
---|
5766 | } |
---|
5767 | //----------------- end method "withGens" -------------------------------- |
---|
5768 | |
---|
5769 | //-------- The general case without computation of the generators ----------- |
---|
5770 | // (attrib(id,"xy"),1) sets attrib xy to TRUE and (attrib(id,"xy"),0) to FALSE |
---|
5771 | // We use the following attributes: |
---|
5772 | // attrib(id,"isCohenMacaulay"); //--- Cohen Macaulay |
---|
5773 | // attrib(id,"isCompleteIntersection"); //--- complete intersection |
---|
5774 | // attrib(id,"isHypersurface"); //--- hypersurface |
---|
5775 | // attrib(id,"isEquidimensional",-1); //--- equidimensional ideal |
---|
5776 | // attrib(id,"isPrim"); //--- prime ideal |
---|
5777 | // attrib(id,"isRegInCodim2"); //--- regular in codimension 2 |
---|
5778 | // attrib(id,"isIsolatedSingularity"; //--- isolated singularities |
---|
5779 | // attrib(id,"onlySingularAtZero"); //--- only singular at 0 |
---|
5780 | |
---|
5781 | //------------------- first set the attributes ---------------------- |
---|
5782 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
5783 | { |
---|
5784 | if( attrib(id,"isCohenMacaulay")==1 ) |
---|
5785 | { |
---|
5786 | attrib(id,"isEquidimensional",1); |
---|
5787 | } |
---|
5788 | } |
---|
5789 | else |
---|
5790 | { |
---|
5791 | attrib(id,"isCohenMacaulay",0); |
---|
5792 | } |
---|
5793 | |
---|
5794 | if( typeof(attrib(id,"isCompleteIntersection"))=="int" ) |
---|
5795 | { |
---|
5796 | if(attrib(id,"isCompleteIntersection")==1) |
---|
5797 | { |
---|
5798 | attrib(id,"isCohenMacaulay",1); |
---|
5799 | attrib(id,"isEquidimensional",1); |
---|
5800 | } |
---|
5801 | } |
---|
5802 | else |
---|
5803 | { |
---|
5804 | attrib(id,"isCompleteIntersection",0); |
---|
5805 | } |
---|
5806 | |
---|
5807 | if( typeof(attrib(id,"isHypersurface"))=="int" ) |
---|
5808 | { |
---|
5809 | if(attrib(id,"isHypersurface")==1) |
---|
5810 | { |
---|
5811 | attrib(id,"isCompleteIntersection",1); |
---|
5812 | attrib(id,"isCohenMacaulay",1); |
---|
5813 | attrib(id,"isEquidimensional",1); |
---|
5814 | } |
---|
5815 | } |
---|
5816 | else |
---|
5817 | { |
---|
5818 | attrib(id,"isHypersurface",0); |
---|
5819 | } |
---|
5820 | |
---|
5821 | if( ! (typeof(attrib(id,"isEquidimensional"))=="int") ) |
---|
5822 | { |
---|
5823 | attrib(id,"isEquidimensional",0); |
---|
5824 | } |
---|
5825 | |
---|
5826 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
5827 | { |
---|
5828 | if(attrib(id,"isPrim")==1) |
---|
5829 | { |
---|
5830 | attrib(id,"isEquidimensional",1); |
---|
5831 | } |
---|
5832 | } |
---|
5833 | else |
---|
5834 | { |
---|
5835 | attrib(id,"isPrim",0); |
---|
5836 | } |
---|
5837 | |
---|
5838 | if( ! (typeof(attrib(id,"isRegInCodim2"))=="int") ) |
---|
5839 | { |
---|
5840 | attrib(id,"isRegInCodim2",0); |
---|
5841 | } |
---|
5842 | |
---|
5843 | if( ! (typeof(attrib(id,"isIsolatedSingularity"))=="int") ) |
---|
5844 | { |
---|
5845 | attrib(id,"isIsolatedSingularity",0); |
---|
5846 | } |
---|
5847 | |
---|
5848 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
5849 | { |
---|
5850 | if(attrib(id,"onlySingularAtZero")==1) |
---|
5851 | { |
---|
5852 | attrib(id,"isIsolatedSingularity",1); |
---|
5853 | } |
---|
5854 | } |
---|
5855 | else |
---|
5856 | { |
---|
5857 | attrib(id,"onlySingularAtZero",0); |
---|
5858 | } |
---|
5859 | |
---|
5860 | //-------------- compute equidimensional decomposition -------------------- |
---|
5861 | //If the method "equidim" is given, compute the equidim decomposition |
---|
5862 | //and goto the next step (no normalization |
---|
5863 | //ACHTUNG: equidim berechnet bei nicht reduzierten id die eingebetteten |
---|
5864 | //Komponenten als niederdim Komponenten, waehrend diese bei primdecGTZ |
---|
5865 | //nicht auftauchen: ideal(x,y)*xy |
---|
5866 | //this is default for nvars > 2 |
---|
5867 | |
---|
5868 | if( decomp == 2 ) |
---|
5869 | { |
---|
5870 | withPrim = 0; //this is used to check later that prim |
---|
5871 | //contains equidim but not prime components |
---|
5872 | if( dbg >= 1 ) |
---|
5873 | { |
---|
5874 | "// We use method 'equidim'"; |
---|
5875 | } |
---|
5876 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
5877 | { |
---|
5878 | if(attrib(id,"isEquidimensional")==1) |
---|
5879 | { |
---|
5880 | prim[1] = id; |
---|
5881 | } |
---|
5882 | else |
---|
5883 | { |
---|
5884 | prim = equidim(id); |
---|
5885 | } |
---|
5886 | } |
---|
5887 | else |
---|
5888 | { |
---|
5889 | prim = equidim(id); |
---|
5890 | } |
---|
5891 | if(dbg>=1) |
---|
5892 | { ""; |
---|
5893 | "// number of equidimensional components:", size(prim); |
---|
5894 | } |
---|
5895 | if ( !noFac ) |
---|
5896 | { |
---|
5897 | intvec opt = option(get); |
---|
5898 | option(redSB); |
---|
5899 | for(j=1; j<=size(prim); j++) |
---|
5900 | { |
---|
5901 | keepresult = keepresult+facstd(prim[j]); |
---|
5902 | } |
---|
5903 | prim = keepresult; |
---|
5904 | if ( size(prim) == 0 ) |
---|
5905 | { |
---|
5906 | prim=ideal(0); //Bug in facstd, liefert leere Liste bei 0-Ideal |
---|
5907 | } |
---|
5908 | |
---|
5909 | if(dbg>=1) |
---|
5910 | { ""; |
---|
5911 | "// number of components after application of facstd:", size(prim); |
---|
5912 | } |
---|
5913 | option(set,opt); |
---|
5914 | } |
---|
5915 | } |
---|
5916 | |
---|
5917 | //------------------- compute associated primes ------------------------- |
---|
5918 | //the case where withEqui = 0, here the min. ass. primes are computed |
---|
5919 | //start with the computation of the minimal associated primes: |
---|
5920 | |
---|
5921 | else |
---|
5922 | { |
---|
5923 | if( isPrim ) |
---|
5924 | { |
---|
5925 | if( dbg >= 0 ) |
---|
5926 | { |
---|
5927 | "// ** WARNING: result is correct if ideal is prime"; |
---|
5928 | "// or equidimensional (not checked) **"; |
---|
5929 | "// disable option \"isPrim\" to decompose ideal into prime"; |
---|
5930 | "// or equidimensional components";""; |
---|
5931 | } |
---|
5932 | if( dbg >= 1 ) |
---|
5933 | { |
---|
5934 | "// We use method 'isPrim'";""; |
---|
5935 | } |
---|
5936 | prim[1]=id; |
---|
5937 | } |
---|
5938 | else |
---|
5939 | { |
---|
5940 | withPrim = 1; //this is used to check later that prim |
---|
5941 | //contains prime but not equidim components |
---|
5942 | if( dbg >= 1 ) |
---|
5943 | { |
---|
5944 | "// We use method 'prim'"; |
---|
5945 | } |
---|
5946 | |
---|
5947 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
5948 | { |
---|
5949 | if(attrib(id,"isPrim")==1) |
---|
5950 | { |
---|
5951 | prim[1]=id; |
---|
5952 | } |
---|
5953 | else |
---|
5954 | { |
---|
5955 | if( noFac ) |
---|
5956 | { prim=minAssGTZ(id,1); } //does not use factorizing groebner |
---|
5957 | else |
---|
5958 | { prim=minAssGTZ(id); } //uses factorizing groebner |
---|
5959 | } |
---|
5960 | } |
---|
5961 | else |
---|
5962 | { |
---|
5963 | if( noFac ) |
---|
5964 | { prim=minAssGTZ(id,1); } |
---|
5965 | else |
---|
5966 | { prim=minAssGTZ(id); } |
---|
5967 | } |
---|
5968 | if(dbg>=1) |
---|
5969 | { ""; |
---|
5970 | "// number of irreducible components:", size(prim); |
---|
5971 | } |
---|
5972 | } |
---|
5973 | } |
---|
5974 | |
---|
5975 | //----- for each component (equidim or irred) compute normalization ----- |
---|
5976 | int sr, skr, del; |
---|
5977 | intvec deli; |
---|
5978 | int sp = size(prim); //size of list prim (# irred or equidim comp) |
---|
5979 | |
---|
5980 | for(i=1; i<=sp; i++) |
---|
5981 | { |
---|
5982 | if(dbg>=1) |
---|
5983 | { ""; |
---|
5984 | "// computing the normalization of component",i; |
---|
5985 | " ----------------------------------------"; |
---|
5986 | } |
---|
5987 | //-------------- first set attributes for components ------------------ |
---|
5988 | attrib(prim[i],"isEquidimensional",1); |
---|
5989 | if( withPrim ) |
---|
5990 | { |
---|
5991 | attrib(prim[i],"isPrim",1); |
---|
5992 | } |
---|
5993 | else |
---|
5994 | { attrib(prim[i],"isPrim",0); } |
---|
5995 | |
---|
5996 | if(attrib(id,"onlySingularAtZero")==1) |
---|
5997 | { attrib(prim[i],"onlySingularAtZero",1); } |
---|
5998 | else |
---|
5999 | { attrib(prim[i],"onlySingularAtZero",0); } |
---|
6000 | |
---|
6001 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
6002 | { attrib(prim[i],"isIsolatedSingularity",1); } |
---|
6003 | else |
---|
6004 | { attrib(prim[i],"isIsolatedSingularity",0); } |
---|
6005 | |
---|
6006 | if( attrib(id,"isHypersurface")==1 ) |
---|
6007 | { |
---|
6008 | attrib(prim[i],"isHypersurface",1); |
---|
6009 | attrib(prim[i],"isCompleteIntersection",1); |
---|
6010 | attrib(prim[i],"isCohenMacaulay",1); |
---|
6011 | } |
---|
6012 | else |
---|
6013 | { attrib(prim[i],"isHypersurface",0); } |
---|
6014 | |
---|
6015 | if ( sp == 1) //the case of one component: copy attribs from id |
---|
6016 | { |
---|
6017 | if(attrib(id,"isRegInCodim2")==1) |
---|
6018 | {attrib(prim[i],"isRegInCodim2",1); } |
---|
6019 | else |
---|
6020 | {attrib(prim[i],"isRegInCodim2",0); } |
---|
6021 | |
---|
6022 | if(attrib(id,"isCohenMacaulay")==1) |
---|
6023 | {attrib(prim[i],"isCohenMacaulay",1); } |
---|
6024 | else |
---|
6025 | {attrib(prim[i],"isCohenMacaulay",0); } |
---|
6026 | |
---|
6027 | if(attrib(id,"isCompleteIntersection")==1) |
---|
6028 | {attrib(prim[i],"isCompleteIntersection",1); } |
---|
6029 | else |
---|
6030 | {attrib(prim[i],"isCompleteIntersection",0); } |
---|
6031 | } |
---|
6032 | else |
---|
6033 | { |
---|
6034 | attrib(prim[i],"isRegInCodim2",0); |
---|
6035 | attrib(prim[i],"isCohenMacaulay",0); |
---|
6036 | attrib(prim[i],"isCompleteIntersection",0); |
---|
6037 | } |
---|
6038 | |
---|
6039 | //------ Now compute the normalization of each component --------- |
---|
6040 | //note: for equidimensional components the "splitting tools" can |
---|
6041 | //create further decomposition |
---|
6042 | //We now start normalizationPrimes with |
---|
6043 | //ihp = partial normalisation map = identity map = maxideal(1) |
---|
6044 | //del = partial delta invariant = 0 |
---|
6045 | //deli= intvec of partial delta invariants of components |
---|
6046 | //in normalizationPrimes all the work is done: |
---|
6047 | |
---|
6048 | keepresult = normalizationPrimes(prim[i],maxideal(1),0,0); |
---|
6049 | |
---|
6050 | for(j=1; j<=size(keepresult)-1; j++) |
---|
6051 | { |
---|
6052 | result=insert(result,keepresult[j]); |
---|
6053 | } |
---|
6054 | skr = size(keepresult); |
---|
6055 | |
---|
6056 | //compute delta: |
---|
6057 | if( del >= 0 && keepresult[skr][1] >=0 ) |
---|
6058 | { |
---|
6059 | del = del + keepresult[skr][1]; |
---|
6060 | } |
---|
6061 | else |
---|
6062 | { |
---|
6063 | del = -1; |
---|
6064 | } |
---|
6065 | deli = keepresult[skr][2],deli; |
---|
6066 | |
---|
6067 | if ( dbg>=1 ) |
---|
6068 | { |
---|
6069 | "// delta of component",i; keepresult[skr][1]; |
---|
6070 | } |
---|
6071 | } |
---|
6072 | sr = size(result); |
---|
6073 | |
---|
6074 | // -------------- Now compute intersection multiplicities ------------- |
---|
6075 | //intersection multiplicities of list prim, sp=size(prim). |
---|
6076 | if ( dbg>=1 ) |
---|
6077 | { |
---|
6078 | "// Sum of delta for all components"; del; |
---|
6079 | if ( sp>1 ) |
---|
6080 | { |
---|
6081 | "// Compute intersection multiplicities of the components"; |
---|
6082 | } |
---|
6083 | } |
---|
6084 | |
---|
6085 | if ( sp > 1 ) |
---|
6086 | { |
---|
6087 | int mul = iMult(prim); |
---|
6088 | if ( mul < 0 ) |
---|
6089 | { |
---|
6090 | del = -1; |
---|
6091 | } |
---|
6092 | else |
---|
6093 | { |
---|
6094 | del = del + mul; |
---|
6095 | } |
---|
6096 | } |
---|
6097 | deli = deli[1..size(deli)-1]; |
---|
6098 | result = result,list(deli,del); |
---|
6099 | |
---|
6100 | //--------------- Finally print comments and return ------------------ |
---|
6101 | if ( dbg >= 0) |
---|
6102 | {""; |
---|
6103 | "// 'normalC' created a list, say nor, of two lists: |
---|
6104 | // To see the result, type |
---|
6105 | nor; |
---|
6106 | |
---|
6107 | // * nor[1] is a list of",sr,"ring(s). |
---|
6108 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
6109 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
6110 | // and similair for the other rings nor[1][i]; |
---|
6111 | // Ri/norid is the affine algebra of the normalization of r/P_i (where P_i |
---|
6112 | // is an associated prime or an equidimensional part of the input ideal id) |
---|
6113 | // and normap the normalization map from the basering to Ri/norid; |
---|
6114 | |
---|
6115 | // * nor[2] shows the delta-invariant of each component and of id |
---|
6116 | // (-1 means infinite, 0 that r/P_i resp. r/id is normal, and -2 that delta |
---|
6117 | // of a component was not computed)."; |
---|
6118 | } |
---|
6119 | return(result); |
---|
6120 | } |
---|
6121 | |
---|
6122 | example |
---|
6123 | { "EXAMPLE:"; |
---|
6124 | printlevel = printlevel+1; |
---|
6125 | echo = 2; |
---|
6126 | ring s = 0,(x,y),dp; |
---|
6127 | ideal i = (x2-y3)*(x2+y2)*x; |
---|
6128 | |
---|
6129 | list nor = normalC(i); |
---|
6130 | |
---|
6131 | nor; |
---|
6132 | // 2 branches have delta = 1, and 1 branch has delta = 0 |
---|
6133 | // the total delta invariant is 13 |
---|
6134 | |
---|
6135 | def R2 = nor[1][2]; setring R2; |
---|
6136 | norid; normap; |
---|
6137 | |
---|
6138 | echo = 0; |
---|
6139 | printlevel = printlevel-1; |
---|
6140 | pause(" hit return to continue"); echo=2; |
---|
6141 | |
---|
6142 | ring r = 2,(x,y,z),dp; |
---|
6143 | ideal i = z3-xy4; |
---|
6144 | nor = normalC(i); nor; |
---|
6145 | // the delta invariant is infinite |
---|
6146 | // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module |
---|
6147 | // in its quotient field Quot(r/i) |
---|
6148 | |
---|
6149 | // the normalization as affine algebra over the ground field: |
---|
6150 | def R = nor[1][1]; setring R; |
---|
6151 | norid; normap; |
---|
6152 | |
---|
6153 | echo = 0; |
---|
6154 | pause(" hit return to continue");echo = 2; |
---|
6155 | |
---|
6156 | setring r; |
---|
6157 | nor = normalC(i, "withGens", "prim"); // a different algorithm |
---|
6158 | nor; |
---|
6159 | } |
---|
6160 | |
---|
6161 | ////////////////////////////////////////////////////////////////////////////// |
---|
6162 | //closureRingtower seems not to be used anywhere |
---|
6163 | static proc closureRingtower(list L) |
---|
6164 | "USAGE: closureRingtower(list L); L a list of rings |
---|
6165 | CREATE: rings R(1),...,R(n) such that R(i)=L[i] for all i |
---|
6166 | EXAMPLE: example closureRingtower; shows an example |
---|
6167 | " |
---|
6168 | { |
---|
6169 | int n=size(L); |
---|
6170 | for (int i=1;i<=n;i++) |
---|
6171 | { |
---|
6172 | if (defined(R(i))) |
---|
6173 | { |
---|
6174 | string s="Fixed name R("+string(i)+") leads to conflict with existing " |
---|
6175 | +"object having this name"; |
---|
6176 | ERROR(s); |
---|
6177 | } |
---|
6178 | def R(i)=L[i]; |
---|
6179 | export R(i); |
---|
6180 | } |
---|
6181 | |
---|
6182 | return(); |
---|
6183 | } |
---|
6184 | example |
---|
6185 | { |
---|
6186 | "EXAMPLE:"; echo=2; |
---|
6187 | ring R=0,(x,y),dp; |
---|
6188 | ideal I=x4,y4; |
---|
6189 | list L=primeClosure(ReesAlgebra(I)[1]); |
---|
6190 | L=delete(L,size(L)); |
---|
6191 | L; |
---|
6192 | closureRingtower(L); |
---|
6193 | R(1); |
---|
6194 | R(4); |
---|
6195 | kill R(1),R(2),R(3),R(4); |
---|
6196 | } |
---|
6197 | |
---|
6198 | // Up to here: procedures for normalC |
---|
6199 | /////////////////////////////////////////////////////////////////////////////// |
---|
6200 | |
---|
6201 | /////////////////////////////////////////////////////////////////////////////// |
---|
6202 | // From here: miscellaneous procedures |
---|
6203 | |
---|
6204 | // Used for timing and comparing the different normalization procedures. |
---|
6205 | // Option (can be entered in any order) |
---|
6206 | // "normal" -> uses the new algortihm (normal) |
---|
6207 | // "normalP" -> uses normalP |
---|
6208 | // "normalC" -> uses normalC, without "withGens" option |
---|
6209 | // "primCl" -> uses normalC, with option "withGens". |
---|
6210 | // "111" -> checks the output of normalM using norTest. |
---|
6211 | // "p" -> compares the output of norM with the output of normalP |
---|
6212 | // ("normalP" option must also be set). |
---|
6213 | // "pc" -> compares the output of norM with the output of normalC with |
---|
6214 | // option "withGens" |
---|
6215 | // ("primCl" option must also be set). |
---|
6216 | |
---|
6217 | proc timeNormal(ideal I, list #) |
---|
6218 | { |
---|
6219 | def r = basering; |
---|
6220 | |
---|
6221 | //--------------------------- define the method --------------------------- |
---|
6222 | int isPrim, useRing; |
---|
6223 | int decomp = -1; |
---|
6224 | int norM, norC, norP, primCl; |
---|
6225 | int checkP, check111, checkPC; |
---|
6226 | int i; |
---|
6227 | ideal U1, U2, W; |
---|
6228 | poly c1, c2; |
---|
6229 | int ch; |
---|
6230 | string check; |
---|
6231 | string method; //make all options one string in order to use |
---|
6232 | //all combinations of options simultaneously |
---|
6233 | for ( i=1; i <= size(#); i++ ) |
---|
6234 | { |
---|
6235 | if ( typeof(#[i]) == "string" ) |
---|
6236 | { |
---|
6237 | method = method + #[i]; |
---|
6238 | } |
---|
6239 | } |
---|
6240 | if ( find(method, "normal")) |
---|
6241 | {norM = 1;} |
---|
6242 | if ( find(method, "normalP") and (char(basering) > 0)) |
---|
6243 | {norP = 1;} |
---|
6244 | if ( find(method, "normalC")) |
---|
6245 | {norC = 1;} |
---|
6246 | if ( find(method, "primCl")) |
---|
6247 | {primCl = 1;} |
---|
6248 | if ( find(method, "isprim") or find(method,"isPrim") ) |
---|
6249 | {decomp = 0;} |
---|
6250 | if ( find(method, "p") ) |
---|
6251 | {checkP = 1;} |
---|
6252 | if ( find(method, "pc") ) |
---|
6253 | {checkPC = 1;} |
---|
6254 | if ( find(method, "111") ) |
---|
6255 | {check111 = 1;} |
---|
6256 | |
---|
6257 | int tt; |
---|
6258 | if(norM) |
---|
6259 | { |
---|
6260 | tt = timer; |
---|
6261 | if(decomp == 0) |
---|
6262 | { |
---|
6263 | "Running normal(useRing, isPrim)..."; |
---|
6264 | list a1 = normal(I, "useRing", "isPrim"); |
---|
6265 | "Time normal(useRing, isPrim): ", timer - tt; |
---|
6266 | } |
---|
6267 | else |
---|
6268 | { |
---|
6269 | "Running normal(useRing)..."; |
---|
6270 | list a1 = normal(I, "useRing"); |
---|
6271 | "Time normal(useRing): ", timer - tt; |
---|
6272 | } |
---|
6273 | ""; |
---|
6274 | } |
---|
6275 | if(norP) |
---|
6276 | { |
---|
6277 | tt = timer; |
---|
6278 | if(decomp == 0) |
---|
6279 | { |
---|
6280 | "Running normalP(isPrim)..."; |
---|
6281 | list a2 = normalP(I, "isPrim"); |
---|
6282 | "Time normalP(isPrim): ", timer - tt; |
---|
6283 | } |
---|
6284 | else |
---|
6285 | { |
---|
6286 | "Running normalP()..."; |
---|
6287 | list a2 = normalP(I); |
---|
6288 | "Time normalP(): ", timer - tt; |
---|
6289 | } |
---|
6290 | ""; |
---|
6291 | } |
---|
6292 | |
---|
6293 | if(norC) |
---|
6294 | { |
---|
6295 | tt = timer; |
---|
6296 | if(decomp == 0) |
---|
6297 | { |
---|
6298 | "Running normalC(isPrim)..."; |
---|
6299 | list a3 = normalC(I, "isPrim"); |
---|
6300 | "Time normalC(isPrim): ", timer - tt; |
---|
6301 | } |
---|
6302 | else |
---|
6303 | { |
---|
6304 | "Running normalC()..."; |
---|
6305 | list a3 = normalC(I); |
---|
6306 | "Time normalC(): ", timer - tt; |
---|
6307 | } |
---|
6308 | ""; |
---|
6309 | } |
---|
6310 | |
---|
6311 | if(primCl) |
---|
6312 | { |
---|
6313 | tt = timer; |
---|
6314 | if(decomp == 0) |
---|
6315 | { |
---|
6316 | "Running normalC(withGens, isPrim)..."; |
---|
6317 | list a4 = normalC(I, "isPrim", "withGens"); |
---|
6318 | "Time normalC(withGens, isPrim): ", timer - tt; |
---|
6319 | } |
---|
6320 | else |
---|
6321 | { |
---|
6322 | "Running normalC(withGens)..."; |
---|
6323 | list a4 = normalC(I, "withGens"); |
---|
6324 | "Time normalC(withGens): ", timer - tt; |
---|
6325 | } |
---|
6326 | ""; |
---|
6327 | } |
---|
6328 | |
---|
6329 | if(check111 and norM) |
---|
6330 | { |
---|
6331 | "Checking output with norTest..."; |
---|
6332 | "WARNING: this checking only works if the original ideal was prime."; |
---|
6333 | norTest(I, a1); |
---|
6334 | ""; |
---|
6335 | } |
---|
6336 | |
---|
6337 | if(checkP and norP and norM) |
---|
6338 | { |
---|
6339 | "Comparing with normalP output..."; |
---|
6340 | if(size(a2) > 0) |
---|
6341 | { |
---|
6342 | "WARNING: this checking only works if the original ideal was prime."; |
---|
6343 | U1 = a1[2][1]; |
---|
6344 | c1 = U1[size(U1)]; |
---|
6345 | U2 = a2[1][1]; |
---|
6346 | c2 = a2[1][1][size(a2[1][1])]; |
---|
6347 | W = changeDenominator(U1, c1, c2, groebner(I)); |
---|
6348 | qring q = groebner(I); |
---|
6349 | ideal U2 = fetch(r, U2); |
---|
6350 | ideal W = fetch(r, W); |
---|
6351 | ch = 0; |
---|
6352 | if(size(reduce(U2, groebner(W))) == 0) |
---|
6353 | { |
---|
6354 | "U2 c U1"; |
---|
6355 | ch = 1; |
---|
6356 | } |
---|
6357 | if(size(reduce(W, groebner(U2))) == 0) |
---|
6358 | { |
---|
6359 | "U1 c U2"; |
---|
6360 | ch = ch + 1; |
---|
6361 | } |
---|
6362 | if(ch == 2) |
---|
6363 | { |
---|
6364 | "Output of normalP is equal."; |
---|
6365 | } |
---|
6366 | else |
---|
6367 | { |
---|
6368 | "ERROR: Output of normalP is different."; |
---|
6369 | } |
---|
6370 | setring r; |
---|
6371 | kill q; |
---|
6372 | } |
---|
6373 | else |
---|
6374 | { |
---|
6375 | "normalP returned no output. Comparison is not possible."; |
---|
6376 | } |
---|
6377 | ""; |
---|
6378 | } |
---|
6379 | |
---|
6380 | if(checkPC and norM and primCl) |
---|
6381 | { |
---|
6382 | "Comparing with primeClosure output..."; |
---|
6383 | if(size(a4) > 0) |
---|
6384 | { |
---|
6385 | "WARNING: this checking only works if the original ideal was prime."; |
---|
6386 | // primeClosure check |
---|
6387 | U1 = a1[2][1]; |
---|
6388 | c1 = U1[size(U1)]; |
---|
6389 | U2 = a4[2][1]; |
---|
6390 | c2 = a4[2][1][size(a4[2][1])]; |
---|
6391 | W = changeDenominator(U1, c1, c2, groebner(I)); |
---|
6392 | qring q = groebner(I); |
---|
6393 | ideal U2 = fetch(r, U2); |
---|
6394 | ideal W = fetch(r, W); |
---|
6395 | ch = 0; |
---|
6396 | if(size(reduce(U2, groebner(W))) == 0) |
---|
6397 | { |
---|
6398 | "U2 c U1"; |
---|
6399 | ch = 1; |
---|
6400 | } |
---|
6401 | if(size(reduce(W, groebner(U2))) == 0) |
---|
6402 | { |
---|
6403 | "U1 c U2"; |
---|
6404 | ch = ch + 1; |
---|
6405 | } |
---|
6406 | if(ch == 2) |
---|
6407 | { |
---|
6408 | "Output of normalC(withGens) is equal."; |
---|
6409 | } |
---|
6410 | else |
---|
6411 | { |
---|
6412 | "ERROR: Output of normalC(withGens) is different."; |
---|
6413 | } |
---|
6414 | setring r; |
---|
6415 | kill q; |
---|
6416 | } |
---|
6417 | else |
---|
6418 | { |
---|
6419 | "normalC(withGens) returned no output. Comparison is not possible."; |
---|
6420 | } |
---|
6421 | ""; |
---|
6422 | } |
---|
6423 | } |
---|
6424 | |
---|
6425 | /////////////////////////////////////////////////////////////////////////// |
---|
6426 | static proc sqroot(int n); |
---|
6427 | { |
---|
6428 | int s = 1; |
---|
6429 | while(s*s < n) { s++; } |
---|
6430 | return(s); |
---|
6431 | } |
---|
6432 | |
---|
6433 | /////////////////////////////////////////////////////////////////////////// |
---|
6434 | proc norTest (ideal i, list nor, list #) |
---|
6435 | "USAGE: norTest(i,nor,[n]); i=prime ideal, nor=list, n=optional integer |
---|
6436 | ASSUME: nor is the output of normal(i) (any options) or |
---|
6437 | normalP(i,"withRing") or normalC(i) (any options). |
---|
6438 | In particular, the ring nor[1][1] contains the ideal norid |
---|
6439 | and the map normap: basering/i --> nor[1][1]/norid. |
---|
6440 | RETURN: an intvec v such that: |
---|
6441 | @format |
---|
6442 | v[1] = 1 if the normap is injective and 0 otherwise |
---|
6443 | v[2] = 1 if the normap is finite and 0 otherwise |
---|
6444 | v[3] = 1 if nor[1][1]/norid is normal and 0 otherwise |
---|
6445 | @end format |
---|
6446 | If n=1 (resp n=2) only v[1] (resp. v[2]) is computed and returned |
---|
6447 | THEORY: The procedure can be used to test whether the computation of the |
---|
6448 | normalization was correct: basering/i --> nor[1][1]/norid is the |
---|
6449 | normalization of basering/i if and only if v=1,1,0. |
---|
6450 | NOTE: For big examples it can be hard to fully test correctness; the |
---|
6451 | partial test norTest(i,nor,2) is usually fast |
---|
6452 | EXAMPLE: example norTest; shows an example |
---|
6453 | " |
---|
6454 | { |
---|
6455 | //### Sollte erweitert werden auf den reduziblen Fall: einen neuen affinen |
---|
6456 | // Ring nor[1][1]+...+nor[1][r] (direkte Summe) erzeugen, map dorthin |
---|
6457 | // definieren und dann testen. |
---|
6458 | |
---|
6459 | int prl = printlevel - voice + 2; |
---|
6460 | int a,b,d; |
---|
6461 | int n,ii; |
---|
6462 | if (size(#) > 0) { n = #[1]; } |
---|
6463 | |
---|
6464 | def BAS = basering; |
---|
6465 | |
---|
6466 | //### make a copy of nor to have a cpoy of nor[1][1] (not a reference to) |
---|
6467 | // in order not to override norid and normap. |
---|
6468 | // delete nor[2] (if it contains the module generators, which are not used) |
---|
6469 | // s.t. newnor does not belong to a ring. |
---|
6470 | |
---|
6471 | list newnor = nor; |
---|
6472 | if ( size(newnor) == 3 ) |
---|
6473 | { |
---|
6474 | newnor = delete(newnor,2); |
---|
6475 | } |
---|
6476 | def R = newnor[1][1]; |
---|
6477 | qring QAS = std(i); |
---|
6478 | |
---|
6479 | |
---|
6480 | setring R; |
---|
6481 | int nva = nvars(R); |
---|
6482 | string svars = varstr(R); |
---|
6483 | string svar; |
---|
6484 | |
---|
6485 | norid = interred(norid); |
---|
6486 | |
---|
6487 | //--------- create new ring with one dp block keeping weights ------------ |
---|
6488 | list LR = ringlist(R); |
---|
6489 | list g3 = LR[3]; |
---|
6490 | int n3 = size(g3); |
---|
6491 | list newg3; |
---|
6492 | intvec V; |
---|
6493 | |
---|
6494 | //--------- check first whether variables Z(i),...,A(i) exist ----------- |
---|
6495 | for (ii=90; ii>=65; ii--) |
---|
6496 | { |
---|
6497 | if ( find(svars,ASCII(ii)+"(") == 0 ) |
---|
6498 | { |
---|
6499 | svar = ASCII(ii); break; |
---|
6500 | } |
---|
6501 | } |
---|
6502 | if ( size(svar) != 0 ) |
---|
6503 | { |
---|
6504 | for ( ii = 1; ii <= nva; ii++ ) |
---|
6505 | { |
---|
6506 | LR[2][ii] = svar+"("+string(ii)+")"; |
---|
6507 | V[ii] = 1; |
---|
6508 | } |
---|
6509 | } |
---|
6510 | else |
---|
6511 | { |
---|
6512 | for ( ii = 1; ii <= nva; ii++ ) |
---|
6513 | { |
---|
6514 | LR[2][ii] = "Z("+string(100*nva+ii)+")"; |
---|
6515 | V[ii] = 1; |
---|
6516 | } |
---|
6517 | } |
---|
6518 | |
---|
6519 | if ( g3[n3][1]== "c" or g3[n3][1] == "C" ) |
---|
6520 | { |
---|
6521 | list gm = g3[n3]; //last blockis module ordering |
---|
6522 | newg3[1] = list("dp",V); |
---|
6523 | newg3 = insert(newg3,gm,size(newg3)); |
---|
6524 | } |
---|
6525 | else |
---|
6526 | { |
---|
6527 | list gm = g3[1]; //first block is module ordering |
---|
6528 | newg3[1] = list("dp",V); |
---|
6529 | newg3 = insert(newg3,gm); |
---|
6530 | } |
---|
6531 | LR[3] = newg3; |
---|
6532 | //LR;""; |
---|
6533 | def newR = ring(LR); |
---|
6534 | |
---|
6535 | setring newR; |
---|
6536 | ideal norid = fetch(R,norid); |
---|
6537 | ideal normap = fetch(R,normap); |
---|
6538 | if( defined(lnorid) ) { kill lnorid; } //um ** redefinig zu beheben |
---|
6539 | if( defined(snorid) ) { kill snorid; } //sollte nicht noetig sein |
---|
6540 | |
---|
6541 | //----------- go to quotient ring for checking injectivity ------------- |
---|
6542 | //"mstd"; |
---|
6543 | list lnorid = mstd(norid); |
---|
6544 | ideal snorid = lnorid[1]; |
---|
6545 | //"size mstdnorid:", size(snorid),size(lnorid[2]); |
---|
6546 | //"size string mstdnorid:", size(string(snorid)),size(string(lnorid[2])); |
---|
6547 | qring QR = snorid; |
---|
6548 | ideal qnormap = fetch(newR,normap); |
---|
6549 | //ideal qnormap = imap(newR,normap); |
---|
6550 | //ideal qnormap = imap(R,normap); |
---|
6551 | map Qnormap = QAS,qnormap; //r/id --> R/norid |
---|
6552 | |
---|
6553 | //------------------------ check injectivity --------------------------- |
---|
6554 | //"injective:"; |
---|
6555 | a = is_injective(Qnormap,QAS); //a. Test for injectivity of Qnormap |
---|
6556 | dbprint ( prl, "injective: "+string(a) ); |
---|
6557 | if ( n==1 ) { return (a); } |
---|
6558 | a; |
---|
6559 | |
---|
6560 | //------------------------ check finiteness --------------------------- |
---|
6561 | setring newR; |
---|
6562 | b = mapIsFinite(normap,BAS,lnorid[2]); //b. Test for finiteness of normap |
---|
6563 | dbprint ( prl, "finite: "+string(b) ); |
---|
6564 | if ( n==2 ) { return (intvec(a,b)); } |
---|
6565 | b; |
---|
6566 | |
---|
6567 | //------------------------ check normality --------------------------- |
---|
6568 | list testnor = normal(lnorid[2],"isPrim","noFac", "withDelta"); |
---|
6569 | //### Problem: bei mehrfachem Aufruf von norTest gibt es |
---|
6570 | // ** redefining norid & ** redefining normap |
---|
6571 | //Dies produziert Fehler, da alte norid und normap ueberschrieben werden |
---|
6572 | //norid und normap werden innnerhalb von proc computeRing ueberschrieben |
---|
6573 | //Die Kopie newR scheint das Problem zu loesen |
---|
6574 | |
---|
6575 | printlevel=prl; |
---|
6576 | |
---|
6577 | d = testnor[3][2]; //d = delta |
---|
6578 | kill testnor; //### sollte ueberfluessig sein |
---|
6579 | int d1 = (d==0); //d1=1 if delta=0 |
---|
6580 | dbprint ( prl, "delta: "+string(d) ); |
---|
6581 | return(intvec(a,b,d1)); |
---|
6582 | } |
---|
6583 | example |
---|
6584 | { "EXAMPLE:"; echo = 2; |
---|
6585 | int prl = printlevel; |
---|
6586 | printlevel = -1; |
---|
6587 | ring r = 0,(x,y),dp; |
---|
6588 | ideal i = (x-y^2)^2 - y*x^3; |
---|
6589 | list nor = normal(i); |
---|
6590 | norTest(i,nor); //1,1,1 means that normal was correct |
---|
6591 | |
---|
6592 | nor = normalC(i); |
---|
6593 | norTest(i,nor); //1,1,1 means that normal was correct |
---|
6594 | |
---|
6595 | ring s = 2,(x,y),dp; |
---|
6596 | ideal i = (x-y^2)^2 - y*x^3; |
---|
6597 | nor = normalP(i,"withRing"); |
---|
6598 | norTest(i,nor); //1,1,1 means that normalP was correct |
---|
6599 | printlevel = prl; |
---|
6600 | } |
---|
6601 | |
---|
6602 | /////////////////////////////////////////////////////////////////////////// |
---|
6603 | // |
---|
6604 | // EXAMPLES |
---|
6605 | // |
---|
6606 | /////////////////////////////////////////////////////////////////////////// |
---|
6607 | /* |
---|
6608 | //commands for computing the normalization: |
---|
6609 | // options for normal: "equidim", "prim" |
---|
6610 | // "noDeco", "isPrim", "noFac" |
---|
6611 | // (prim by default) |
---|
6612 | // options for normalP: "withRing", "isPrim" or "noFac" |
---|
6613 | // options for normalC: "equidim", "prim", "withGens", |
---|
6614 | // "noDeco", "isPrim", "noFac" |
---|
6615 | |
---|
6616 | //Commands for testing 'normal' |
---|
6617 | list nor = normal(i); nor; |
---|
6618 | list nor = normal(i,"isPrim");nor; |
---|
6619 | list nor = normal(i,"equidim");nor; |
---|
6620 | list nor = normal(i,"prim");nor; |
---|
6621 | list nor = normal(i,"equidim","noFac");nor; |
---|
6622 | list nor = normal(i,"prim","noFac");nor; |
---|
6623 | |
---|
6624 | //Commands for testing 'normalP' in positive char |
---|
6625 | list nor = normalP(i);nor; //withGens but no ringstructure |
---|
6626 | list nor = normalP(i,"withRing"); nor; //compute the ringstructure |
---|
6627 | list nor = normalP(i,"isPrim"); nor; //if i is known to be prime |
---|
6628 | |
---|
6629 | //Commands for testing 'normalC' |
---|
6630 | list nor = normal(i); nor; |
---|
6631 | list nor = normal(i,"withGens");nor; |
---|
6632 | list nor = normal(i,"isPrim");nor; |
---|
6633 | list nor = normal(i,"equidim");nor; |
---|
6634 | list nor = normal(i,"prim");nor; |
---|
6635 | list nor = normal(i,"equidim","noFac");nor; |
---|
6636 | list nor = normal(i,"prim","noFac");nor; |
---|
6637 | |
---|
6638 | //Commands for testing correctness (i must be prime): |
---|
6639 | list nor = normalP(i,"withRing","isPrim"); |
---|
6640 | list nor = normal(i,"isPrim"); |
---|
6641 | norTest(i,nor); //full test for not too big examples (1,1,1 => ok) |
---|
6642 | norTest(i,nor,2); //partial test for big examples (1,1 => ok) |
---|
6643 | factorize(i[1]); //checks for irreducibility |
---|
6644 | |
---|
6645 | ///////////////////////////////////////////////////////////////////////////// |
---|
6646 | |
---|
6647 | //----------------------Examples for normal (new algorithm)------------------ |
---|
6648 | // Timings with Computeserver Dual AMD Opteron 242 1.60GHz. |
---|
6649 | // Examples from "Normalization of Rings" paper. |
---|
6650 | |
---|
6651 | // Example 1 |
---|
6652 | // char 0 : normal = 0 secs (7 steps) - normalC = 75 secs |
---|
6653 | // char 2 : normal = 0 secs (7 steps) - normalP = 0 secs - normalC = 0 secs |
---|
6654 | // char 5 : normal = 1 secs (7 steps) - normalP = 71 - normalC = 1 secs |
---|
6655 | // char 11 : normal = 2 secs (7 steps) - normalP = 12 secs - normalC doesn't finish |
---|
6656 | // char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 1 sec |
---|
6657 | LIB"normal.lib"; |
---|
6658 | ring r = 2, (x, y), dp; |
---|
6659 | ideal i = (x-y)*x*(y+x^2)^3-y^3*(x^3+x*y-y^2); |
---|
6660 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
6661 | |
---|
6662 | // Example 2 |
---|
6663 | // char 0 : normal = 1 sec (7 steps) - normalC doesn't finish |
---|
6664 | // char 3 : normal = 1 secs (8 steps) - normalP = 0 secs - normalC = 4 secs |
---|
6665 | // char 13 : normal = 1 sec (7 steps) - normalP doesn't finish - normalC = 13 secs |
---|
6666 | // char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 10 sec |
---|
6667 | //Example is reducible in char 5 and 7 |
---|
6668 | LIB"normal.lib"; |
---|
6669 | ring r = 3, (x, y), dp; |
---|
6670 | 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; |
---|
6671 | timeNormal(i, "normal", "normalC", "normalP", "p", "isPrim"); |
---|
6672 | |
---|
6673 | // Example 3 |
---|
6674 | // char 0 : normal = 3 secs (6 steps) - normalC doesn't finish |
---|
6675 | // char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
6676 | // char 5 : normal = 0 secs (6 steps) - normalP = 8 secs - normalC doesn't finish |
---|
6677 | LIB"normal.lib"; |
---|
6678 | ring r=5,(x, y),dp; |
---|
6679 | ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9; |
---|
6680 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
6681 | |
---|
6682 | // Example 4 |
---|
6683 | // char 0 : normal = 0 secs (1 step) - normalC = 0 secs |
---|
6684 | // char 5 : normal = 0 secs (1 step) - normalP = 3 secs - normalC = 0 secs |
---|
6685 | // char 11 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
6686 | // char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
6687 | LIB"normal.lib"; |
---|
6688 | ring r=5,(x,y),dp; // genus 0 4 nodes and 6 cusps im P2 |
---|
6689 | ideal i=(x2+y^2-1)^3 +27x2y2; |
---|
6690 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
6691 | |
---|
6692 | // Example 5 |
---|
6693 | // char 0 : normal = 0 secs (1 step) - normalC = 0 secs |
---|
6694 | // char 5 : normal = 1 secs (3 step) - normalP doesn't finish - normalC doesn't finish |
---|
6695 | // char 11 : normal = 0 secs (1 step) - normalP 0 secs - normalC = 0 secs |
---|
6696 | // char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
6697 | LIB"normal.lib"; |
---|
6698 | ring r=11,(x,y),dp; //24 sing, delta 24 |
---|
6699 | ideal i=-x10+x8y2-x6y4-x2y8+2y10-x8+2x6y2+x4y4-x2y6-y8+2x6-x4y2+x2y4+2x4+2x2y2-y4-x2+y2-1; |
---|
6700 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
6701 | |
---|
6702 | // Example 6 |
---|
6703 | // char 2 : normal = 5 secs (2 steps) - normalP = 25 secs - normalC = 166 secs |
---|
6704 | LIB"normal.lib"; |
---|
6705 | ring r=2,(v,u,z,y,x),dp; |
---|
6706 | 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; |
---|
6707 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
6708 | |
---|
6709 | // Example 7 |
---|
6710 | // char 0 : normal = 11 secs (6 steps) - normalC = 11 secs |
---|
6711 | // char 2 : normal = 11 secs (6 steps) - normalP = 0 secs - normalC = 11 secs |
---|
6712 | // char 5 : normal = 11 secs (6 steps) - normalP = 3 secs - normalC = 11 secs |
---|
6713 | // char 11 : normal = 11 secs (6 steps) - normalP = 43 secs - normalC = 11 secs |
---|
6714 | // char 32003 : normal = 11 secs (6 steps) - normalP doesn't finish - normalC = 11 secs |
---|
6715 | LIB"normal.lib"; |
---|
6716 | ring r=11,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
6717 | ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3; |
---|
6718 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
6719 | |
---|
6720 | //////////////////////////////////////////////////////////////////////////////// |
---|
6721 | |
---|
6722 | // Other examples with new algorithm |
---|
6723 | |
---|
6724 | // Example 1 |
---|
6725 | // char 0 : normal = 1 secs (13 steps) - normalC doesn't finish |
---|
6726 | // char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
6727 | // char 5 : normal = 1 secs (13 steps) - normalP = 29 secs - normalC doesn't finish |
---|
6728 | ring r=2,(x,y),dp; //genus 35 |
---|
6729 | ideal i=y30+y13x+x4y5+x3*(x+1)^2; |
---|
6730 | timeNormal(i, "normal", "normalC", "normalP"); |
---|
6731 | |
---|
6732 | // Example 2 |
---|
6733 | // char 0 : normal = 1 secs (13 steps) - normalC doesn't finish |
---|
6734 | // char 3 : normal = 2 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
6735 | ring r=3,(x,y),dp; //genus 19, delta 21 |
---|
6736 | ideal i=y20+y13x+x4y5+x3*(x+1)^2; |
---|
6737 | timeNormal(i, "normal", "normalC", "normalP"); |
---|
6738 | |
---|
6739 | // Example 3 |
---|
6740 | // Very fast with all algorithms |
---|
6741 | ring r = 3, (x, y), dp; |
---|
6742 | ideal I = (x-y^2)^2-x*y^3; |
---|
6743 | timeNormal(I, "normal", "normalC", "normalP", "primCl", "111", "p", "pc"); |
---|
6744 | |
---|
6745 | |
---|
6746 | |
---|
6747 | //----------------------Test Example for charp ------------------- |
---|
6748 | //Zu tun: |
---|
6749 | //### nach minor nur std statt mstd verwenden |
---|
6750 | //***hat bei keinem Beisp etwas gebracht -> wieder zurueck |
---|
6751 | //### wenn interred ok, dann wieder einsetzen (am Schluss) |
---|
6752 | //### bottelnecks bei maps beheben |
---|
6753 | //### minor verbessern |
---|
6754 | //### preimage verbessern (Ist imm Kern map oder imap verwendet?) |
---|
6755 | //### Gleich in Ordnung dp wechseln, ringlist verwenden |
---|
6756 | //### interred ev nur zum Schluss |
---|
6757 | // (z.B. wenn nacher std; wenn nacher minor: testen ) |
---|
6758 | |
---|
6759 | //Zeiten mit normalV5.lib (mstd aktiv, interred inaktiv) |
---|
6760 | |
---|
6761 | //SWANSON EXAMPLES: (Macaulay2, icFracP=normalP, icFractions<->normal) |
---|
6762 | //--------------------------------------------------------------------- |
---|
6763 | //1. Series Fp[x,y,u,v]/(x2v-y2u) |
---|
6764 | //------------------------------- |
---|
6765 | //characteristic p 2 3 5 7 11 13 17 37 97 |
---|
6766 | //icFracP 0.04 0.03 0.04 0.04 0.04 0.05 0.05 0.13 0.59 Mac |
---|
6767 | //normalP 0 0 0 0 0 0 0 0 1 Sing |
---|
6768 | //icFractions 0.08 0.09 0.09 0.09 0.14 0.15 0.15 0.15 0.15 Mac |
---|
6769 | //normal 0 0 0 0 0 0 0 0 0 Sing |
---|
6770 | |
---|
6771 | 2. Series Fp[u, v, w, x, y, z]/u2x4+uvy4+v2z4 |
---|
6772 | //-------------------------------------------- |
---|
6773 | //characteristic p 2 3 5 7 11 |
---|
6774 | //icFracP 0.07 0.22 9.67 143 12543 |
---|
6775 | //normalP 0 0 5 42 1566 |
---|
6776 | //icFractions 1.16 * * * * *: > 6h |
---|
6777 | //normal 0 0 0 0 0 |
---|
6778 | |
---|
6779 | //3. Series Fp[u, v, w, x, y, z]/(u2xp+uvyp+v2zp) |
---|
6780 | //----------------------------------------------- |
---|
6781 | //characteristic p 2 3 5 7 11 13 17 19 23 |
---|
6782 | //icFracP 0.06 0.07 0.09 0.27 1.81 4.89 26 56 225 |
---|
6783 | //normalP 0 0 0 0 1 2 6 10 27 |
---|
6784 | //icFractions 0.16 1.49 75.00 4009 * * * * * |
---|
6785 | //normal 0 0 2 836 |
---|
6786 | //normal(neu) 0 0 1 2 10 155 |
---|
6787 | //### p=7 normal braucht 807 sec in: |
---|
6788 | // ideal endid = phi1(endid); //### bottelneck' |
---|
6789 | |
---|
6790 | //1. |
---|
6791 | int p = 2; ring r = p,(u,v,x,y,z),dp; ideal i = x2v-y2u; |
---|
6792 | //2. |
---|
6793 | int p = 7; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2x4+uvy4+v2z4; |
---|
6794 | //3. |
---|
6795 | int p=11; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2*x^p+uv*y^p+v2*z^p; |
---|
6796 | |
---|
6797 | //IRREDUCIBLE EXAMPLES: |
---|
6798 | //--------------------- |
---|
6799 | //timing for MacBookPro 2.2GHz Intel Core 2 Duo, 4GB Ram |
---|
6800 | //Sing. ix86Mac-darwin version 3-1-0 (3100-2008101314) Oct 13 2008 14:46:59 |
---|
6801 | //if no time is given: < 1 sec |
---|
6802 | |
---|
6803 | //Apply: |
---|
6804 | list nor = normal(i,"isPrim"); nor; |
---|
6805 | list nor = normalP(i,"withRing","isPrim"); nor; |
---|
6806 | def R=nor[1][1]; setring R; norid; normap; |
---|
6807 | setring r; |
---|
6808 | norTest(i,nor); |
---|
6809 | |
---|
6810 | int tt = timer; |
---|
6811 | list nor = normalP(i,"withRing","isPrim"); nor; |
---|
6812 | timer-tt; |
---|
6813 | int tt = timer; |
---|
6814 | list nor = normal(i,"isPrim"); |
---|
6815 | timer-tt; |
---|
6816 | |
---|
6817 | ring r=19,(x,y,u,v),dp; //delta -1 |
---|
6818 | ideal i=x2v-y2u; |
---|
6819 | //norTest 2 sec |
---|
6820 | |
---|
6821 | ring r=2,(y,x2,x1),lp; //delta -1 |
---|
6822 | ideal i=y^4+y^2*x2*x1+x2^3*x1^2+x2^2*x1^3; |
---|
6823 | //### norid hat 1 Element nach interred |
---|
6824 | |
---|
6825 | ring r = 11,(x,y,z),wp(2,1,2); //alles < 1 sec |
---|
6826 | ideal i=z3 - xy4 + x2; //not reduced, delta =0 ok |
---|
6827 | ideal i=y4+x5+y2x; //not reduced, delta -1 |
---|
6828 | //interred verkleinert norid |
---|
6829 | |
---|
6830 | ring r=3,(u,v,x,y,z),dp; //delta -1 |
---|
6831 | ideal i=u2x3+uvy3+v2z3; |
---|
6832 | |
---|
6833 | ring r=3,(u,v,x,y,z),dp; //delta -1 |
---|
6834 | ideal i=u2x4+uvy4+v2z4; |
---|
6835 | //norTest(i,nor); 0 sec, norTest(i,nor) haengt! |
---|
6836 | |
---|
6837 | ring r=5,(u,v,x,y,z),dp; //delta -1 |
---|
6838 | ideal i=u2x6+uvy6+v2z6; |
---|
6839 | //normalP 5sec, normalC 1sec |
---|
6840 | //V5: norTest(i,nor); 45 sec bei normalP, V6 12 sec |
---|
6841 | //28 sec bei normal |
---|
6842 | |
---|
6843 | ring r=5,(u,v,x,y,z),dp; //delta -1 |
---|
6844 | ideal i=u2x5+uvy5+v2z5; |
---|
6845 | //normalP 1sec, normalC 1 sec, |
---|
6846 | //norTest lange: minor(jacob(I),h,J) 193 (308)sec, haengt dann bei M = std(M); |
---|
6847 | //norTest(i,nor,2); verwenden! |
---|
6848 | //Sing 3.0-4 orig >9h! haengt bei Q = mstd(Q)[2]; |
---|
6849 | |
---|
6850 | ring r=2,(y,x),wp(12,5); //delta 3 |
---|
6851 | ideal i=y5+y2x4+y2x+yx2+x12; |
---|
6852 | //normalP 0 sec (Test 0 sec), normalC 2 sec (Test 2 sec) |
---|
6853 | //normalC withGens (ohne interred) 0sec |
---|
6854 | |
---|
6855 | ring r=2,(y,x),dp; //delta= 22 |
---|
6856 | ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9; |
---|
6857 | //normalP 1sec, interred verkleinert norid betraechtlich |
---|
6858 | //normalC haengt bei minor, ideal im loop wird zu gross ### |
---|
6859 | //interred bei normalC vergroeesert string um Faktor 4000! |
---|
6860 | //withGens haengt bei interred in loop 4 (> 10 h) oder |
---|
6861 | //(nach Ausschalten von interred) bei |
---|
6862 | //int delt=vdim(std(modulo(f,ideal(p)))); (>?h) |
---|
6863 | |
---|
6864 | //Leonard1: (1. Komponente von Leonard), delta -1 |
---|
6865 | ring r=2,(v,u,z,y,x),dp; |
---|
6866 | ideal i = z3+zyx+y3x2+y2x3, uyx+z2,uz+z+y2x+yx2, u2+u+zy+zx, |
---|
6867 | v3+vux+vz2+vzyx+vzx+uz3+uz2y+z3+z2yx2; |
---|
6868 | //normalP 5 sec (withRing 9 sec), norTest(i,nor,2); 45 sec |
---|
6869 | //normalC 102sec, 99sec |
---|
6870 | //### Zeit wird bei ideal Ann = quotient(SM[2],SL[1]); und bei |
---|
6871 | // f = quotient(p*J,J); verbraucht |
---|
6872 | //withGens (ohne interred) 131sec, norTest(i,nor,2); 2min25sec |
---|
6873 | //norTest(i,nor,2); 45 sec |
---|
6874 | |
---|
6875 | ring r=2,(y,x),wp(25,21); //Leonard2, delta 232 |
---|
6876 | ring r=2,(y,x),dp; |
---|
6877 | ideal i= |
---|
6878 | y^21+y^20*x +y^18*(x^3+x+1) +y^17*(x^3+1) +y^16*(x^4+x) |
---|
6879 | +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) |
---|
6880 | +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) |
---|
6881 | +y^10*(x^12+x^9+x^8+x^7+x^5+x^3+x+1) |
---|
6882 | +y^9*(x^14+x^13+x^10+x^9+x^8+x^7+x^6+x^3+x^2+1) |
---|
6883 | +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) |
---|
6884 | +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) |
---|
6885 | +y^4*(x^19+x^16+x^15+x^12+x^6+x^5+x^3+1) |
---|
6886 | +y^3*(x^18+x^15+x^12+x^10+x^9+x^7+x^4+x) |
---|
6887 | +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) |
---|
6888 | +y*(x^23+x^22+x^20+x^17+x^15+x^14+x^12+x^9) |
---|
6889 | +(x^25+x^23+x^19+x^17+x^15+x^13+x^11+x^5); |
---|
6890 | //normalP: dp 2sec withRing 8sec, |
---|
6891 | //wp 4sec, withRing:51sec Zeit in lin = subst(lin, var(ii), vip); in elimpart ), |
---|
6892 | //norTest(i,nor,2): haengt bei mstd(norid); |
---|
6893 | //### normalC: (m. interred): haengt bei endid = interred(endid); |
---|
6894 | //GEFIXTES INTERRED ABWARTEN. Dann interred aktivieren |
---|
6895 | //interred(norid) haengt u. mst(norid) zu lange |
---|
6896 | //(o.interred): haengt bei haengt bei list SM = mstd(i); |
---|
6897 | //ideal in der Mitte zu gross |
---|
6898 | //i = Ideal (size 118, 13 var) fuer die neue Normalisierung |
---|
6899 | //normal(neu) haengt bei return(std(i)) (offensichtlich in eineranderen lib) |
---|
6900 | |
---|
6901 | REDUCIBLE EXAMPLES: |
---|
6902 | ------------------ |
---|
6903 | //Apply: |
---|
6904 | int tt = timer; |
---|
6905 | list nor=normalP(i,"isPrim","withRing"); |
---|
6906 | timer-tt; |
---|
6907 | |
---|
6908 | list nor = normal(i); nor; |
---|
6909 | list nor = normalC(i); nor; |
---|
6910 | list nor = normalC(i, "withGens"); nor; |
---|
6911 | list nor = normalP(i,"withRing"); nor; |
---|
6912 | list nor = normalP(i); nor; |
---|
6913 | def R=nor[1][1]; setring R; norid; normap; |
---|
6914 | |
---|
6915 | //Leonhard 4 Komponenten, dim=2, delta: 0,0,0,-1 |
---|
6916 | ring r=2,(v,u,z,y,x),dp; //lp zu lange |
---|
6917 | ideal i=z3+zyx+y3x2+y2x3, uyx+z2, v3+vuyx+vux+vzyx+vzx+uy3x2+uy2x+zy3x+zy2x2; |
---|
6918 | //normalP: 19 sec, withRing: 22 sec |
---|
6919 | //normalC ohne (mit) interred: 112 (113)sec, equidim: 99sec |
---|
6920 | //normalC 1. mal 111 sec, (2.mal) 450sec!! 3.mal 172 sec |
---|
6921 | //(unterschiedlich lange primdec, mit Auswirkungen) |
---|
6922 | //char 19: normalC: 15sec , withGens: 14sec (o.interr.) |
---|
6923 | |
---|
6924 | //----------------------Test Example for special cases ------------------- |
---|
6925 | int tt = timer; |
---|
6926 | list nor=normalP(i,"withRing");nor; |
---|
6927 | //list nor=normalP(i,"withRing", "isPrim");nor; |
---|
6928 | timer-tt; |
---|
6929 | def R1 = nor[1][1]; setring R1; norid; normap; interred(norid); |
---|
6930 | setring r; |
---|
6931 | |
---|
6932 | int tt = timer; |
---|
6933 | list nor=normal(i,"isPrim");nor; |
---|
6934 | timer-tt; |
---|
6935 | |
---|
6936 | ring r = 29,(x,y,z),dp; |
---|
6937 | ideal i = x2y2,x2z2; //Nicht equidimensional, equidim reduziert nicht, ok |
---|
6938 | ideal i = xyz*(z3-xy4); //### interred(norid) verkuerzt |
---|
6939 | //je 0 sec |
---|
6940 | |
---|
6941 | ideal j = x,y; |
---|
6942 | ideal i = j*xy; |
---|
6943 | equidim(i); |
---|
6944 | //hat eingebettete Komponente, equidim rechnet wie in Beschreibung (ok) |
---|
6945 | |
---|
6946 | ring r = 19,(x,y),dp; |
---|
6947 | ideal i = x3-y4; //delta = 3 |
---|
6948 | ideal i = y*x*(x3-y4); //delta = 11; 0,0,3 |
---|
6949 | ideal i = (x2-y3)*(x3-y4); //delta = 13; 1,3 |
---|
6950 | ideal i = (x-y)*(x3+y2)*(x3-y4); //delta = 23; 0,1,3 |
---|
6951 | ideal i = (x-1)*(x3+y2)*(x2-y3); //delta = 16; 0,1,1 |
---|
6952 | ideal i = (x-y^2)^2 - y*x^3; //delta = 3 |
---|
6953 | //singularities at not only at 0, hier rechnet equidim falsch |
---|
6954 | |
---|
6955 | // -------------------------- General Examples ---------------------------//Huneke, irred., delta=2 (Version 3-0-4: < 1sec) |
---|
6956 | //Version 3-0-6 default: 1sec, mit gens 2sec, mit delta 5 sec |
---|
6957 | //(prim,noFac):ca 7 Min, prim:ca 10 min(wg facstd) |
---|
6958 | // |
---|
6959 | // "equidim" < 1sec irred. 5sec |
---|
6960 | // ring r=31991,(a,b,c,d,e),dp; |
---|
6961 | ring r=2,(a,b,c,d,e),dp; //delta=2 |
---|
6962 | ideal i= |
---|
6963 | 5abcde-a5-b5-c5-d5-e5, |
---|
6964 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
6965 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
6966 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
6967 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
6968 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
6969 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
6970 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
6971 | //normalC: char 2, 31991: 0 sec (isPrim); char 2, equidim: 7 sec |
---|
6972 | //norTest(i,nor,2); 1sec |
---|
6973 | //normalP char 2: 1sec (isPrim) |
---|
6974 | //size(norid); size(string(norid));21 1219 interred(norid): 21 1245 (0 sec) |
---|
6975 | |
---|
6976 | int tt = timer; |
---|
6977 | list nor=normalC(i);nor; |
---|
6978 | timer-tt; |
---|
6979 | |
---|
6980 | list nor = normalP(i,"isPrim"); |
---|
6981 | |
---|
6982 | //Vasconcelos irred., delta -1 (dauert laenger) |
---|
6983 | //auf macbook pro = 20 sec mit alter Version, |
---|
6984 | //Sing 3-0-6: |
---|
6985 | // Char 32003: "equidim" 30 sec, "noFac": 30sec |
---|
6986 | //gens: nach 9 min abgebr (haengt in Lin = ideal(T*syzf);) !!!! Hans zu tun |
---|
6987 | //Char 2: default (charp) 2 sec, normalC ca 30 sec |
---|
6988 | //ring r=32003,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
6989 | ring r=2,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
6990 | ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3; |
---|
6991 | //normalC: char 2: 22, sec (mit und ohne isPrim) |
---|
6992 | //normalP char 2: 0sec (isPrim) o. interred |
---|
6993 | //char 32003: ### haengt in ideal endid = phi1(endid); |
---|
6994 | |
---|
6995 | //------------------------------------------------------- |
---|
6996 | //kleine Beispiele: |
---|
6997 | |
---|
6998 | //Theo1, irred, delta=-1 |
---|
6999 | //normalC: 1sec, normalP: 3 sec |
---|
7000 | ring r=32003,(x,y,z),wp(2,3,6); //dim 2,dim slocus 1 |
---|
7001 | ideal i=zy2-zx3-x6; |
---|
7002 | //normalC: char 2,19,32003: 0 sec (isPrim) |
---|
7003 | //normalP (isPrim) char 2,19: 0sec, char 29: 1sec |
---|
7004 | |
---|
7005 | //Theo1a, CohenMacaulay regular in codim 2, dim slocus=1, delta=0 |
---|
7006 | //normalC: 0 sec, normalP: haegt in K=preimage(R,phi,L); |
---|
7007 | ring r=32003,(x,y,z,u),dp; |
---|
7008 | ideal i=zy2-zx3-x6+u2; |
---|
7009 | //normalC: char 2,32003: 0 sec (isPrim) |
---|
7010 | //normalP (isPrim) char 2: 0sec, char 19: haengt in K = preimage(Q,phi,L); |
---|
7011 | |
---|
7012 | //Theo2, irreduzibel, reduziert, < 1sec, delta -1 |
---|
7013 | ring r=0,(x,y,z),wp(3,4,12); |
---|
7014 | ideal i=z*(y3-x4)+x8; |
---|
7015 | //normalC: char 2,32003,0: 0 sec (isPrim) |
---|
7016 | //normalP (isPrim) char 2: 0 1sec, char 19: 1sec char 29: 7 sec |
---|
7017 | |
---|
7018 | //Theo2a, reduiziert, 2-dim, dim_slocus=1, alte Version 3 sec, |
---|
7019 | //normalP ca 30 sec, normalC ca 4sec, delta -1 |
---|
7020 | //ring r=32003,(T(1..4)),wp(3,4,12,17); |
---|
7021 | //ring r=11,(T(1..4)),dp; |
---|
7022 | ring r=11,(T(1..4)),wp(3,4,12,17); |
---|
7023 | ideal i= |
---|
7024 | T(1)^8-T(1)^4*T(3)+T(2)^3*T(3), |
---|
7025 | T(1)^4*T(2)^2-T(2)^2*T(3)+T(1)*T(4), |
---|
7026 | T(1)^7+T(1)^3*T(2)^3-T(1)^3*T(3)+T(2)*T(4), |
---|
7027 | 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; |
---|
7028 | //normalC: char 2,32003: 0 sec (isPrim) |
---|
7029 | //normalP (isPrim) char 2: 0sec, char 11 2se, char 19: 13sec |
---|
7030 | //norTest 48sec in char11 |
---|
7031 | //### interred verkuerzt |
---|
7032 | //char 29: haengt in K = preimage(Q,phi,L); |
---|
7033 | |
---|
7034 | //Theo3, irred, 2-dim, 1-dim sing, < 1sec |
---|
7035 | ring r=11,(x,y,z),wp(3,5,15); |
---|
7036 | ideal i=z*(y3-x5)+x10; |
---|
7037 | //normalC: char 2,0: 0 sec (withRing) |
---|
7038 | //normalP (withRing) char 2,11: 0sec, char 19: 13sec norTest 12sec(char 11) |
---|
7039 | |
---|
7040 | //Theo4 reducible, delta (0,0,0) -1 |
---|
7041 | ring r=29,(x,y,z),dp; |
---|
7042 | ideal i=(x-y)*(x-z)*(y-z); |
---|
7043 | //normalC: char 2,32003: 0 sec |
---|
7044 | //normalP char withRing 2, 29: 0sec, 6sec |
---|
7045 | |
---|
7046 | //Theo6 |
---|
7047 | ring r=32003,(x,y,z),dp; |
---|
7048 | ideal i=x2y2+x2z2+y2z2; |
---|
7049 | //normalC: char 2,32003: 0 sec |
---|
7050 | //normalP char withRing 2, 29: 0sec, 4sec |
---|
7051 | |
---|
7052 | //Sturmfels, CM, 15 componenten, alle glatt |
---|
7053 | ring r=0,(b,s,t,u,v,w,x,y,z),dp; |
---|
7054 | ideal i= bv+su, bw+tu, sw+tv, by+sx, bz+tx, sz+ty,uy+vx,uz+wx,vz+wy,bvz; |
---|
7055 | //normalC car 11, 0: 1sec, normalP 0 sec |
---|
7056 | |
---|
7057 | //riemenschneider, , dim 3, 5 Komp. delta (0,0,0,0,0), -1 |
---|
7058 | ring r=2,(p,q,s,t,u,v,w,x,y,z),wp(1,1,1,1,1,1,2,1,1,1); |
---|
7059 | ideal i=xz,vx,ux,su,qu,txy,stx,qtx,uv2z-uwz,uv3-uvw,puv2-puw; |
---|
7060 | //alles 0 sec in char 2 |
---|
7061 | |
---|
7062 | //4 Komponenten, alle glatt, 0sec |
---|
7063 | ring r=11,(x,y,z,t),dp; |
---|
7064 | ideal i=x2z+xzt,xyz,xy2-xyt,x2y+xyt; |
---|
7065 | |
---|
7066 | //dim 3, 2 Komponenten delta (-1,0), -1 |
---|
7067 | ring r=2,(u,v,w,x,y,z),wp(1,1,1,3,2,1); |
---|
7068 | ideal i=wx,wy,wz,vx,vy,vz,ux,uy,uz,y3-x2; |
---|
7069 | //alles 0 sec in char 2 |
---|
7070 | //--------------------------------------------------------- |
---|
7071 | int tt = timer; |
---|
7072 | list nor=normalP(i,"normalC","withRing");nor; |
---|
7073 | timer-tt; |
---|
7074 | |
---|
7075 | //St_S/Y, 3 Komponenten, 2 glatt, 1 normal |
---|
7076 | //charp haengt (in char 20) in K=preimage(R,phi,L); |
---|
7077 | //ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
7078 | ring r=11,(b,s,t,u,v,w,x,y,z),dp; |
---|
7079 | ideal i=wy-vz,vx-uy,tv-sw,su-bv,tuy-bvz; |
---|
7080 | //normalC: char 2,32003: 0 sec |
---|
7081 | //normalP char withRing 2: 1sec, char 11: 40sec |
---|
7082 | |
---|
7083 | //Horrocks: cahr 0: 17 (8 in char 11) Komponenten alle normal, delta 1 |
---|
7084 | //char 11: 8 Komponenten alle normal, delta -1 |
---|
7085 | ring r=0,(a,b,c,d,e,f),dp; |
---|
7086 | //ring r=11,(a,b,c,d,e,f),dp; //Charp bis p = 200 ca 3sec |
---|
7087 | ideal i= |
---|
7088 | adef-16000be2f+16001cef2, ad2f+8002bdef+8001cdf2, abdf-16000b2ef+16001bcf2, |
---|
7089 | a2df+8002abef+8001acf2, ad2e-8000bde2-7999cdef, acde-16000bce2+16001c2ef, |
---|
7090 | a2de-8000abe2-7999acef, acd2+8002bcde+8001c2df, abd2-8000b2de-7999bcdf, |
---|
7091 | a2d2+9603abde-10800b2e2-9601acdf+800bcef+11601c2f2, |
---|
7092 | abde-8000b2e2-acdf-16001bcef-8001c2f2, abcd-16000b2ce+16001bc2f, |
---|
7093 | a2cd+8002abce+8001ac2f, a2bd-8000ab2e-7999abcf, ab3f-3bdf3, |
---|
7094 | a2b2f-2adf3-16000bef3+16001cf4, a3bf+4aef3, ac3e-10668cde3, |
---|
7095 | a2c2e+10667ade3+16001be4+5334ce3f, a3ce+10669ae3f, bc3d+8001cd3e, |
---|
7096 | ac3d+8000bc3e+16001cd2e2+8001c4f, b2c2d+16001ad4+4000bd3e+12001cd3f, |
---|
7097 | b2c2e-10668bc3f-10667cd2ef, abc2e-cde2f, b3cd-8000bd3f, b3ce-10668b2c2f-10667bd2ef, abc2f-cdef2, a2bce-16000be3f+16001ce2f2, |
---|
7098 | ab3d-8000b4e-8001b3cf+16000bd2f2, ab2cf-bdef2, |
---|
7099 | a2bcf-16000be2f2+16001cef3, a4d-8000a3be+8001a3cf-2ae2f2; |
---|
7100 | //normalC: char 0: 1sec char 11: 0sec |
---|
7101 | //normalP: char 11: 0sec |
---|
7102 | |
---|
7103 | //2sec mit normalC, in char 2 ebenfalls (char 20 mit charp >1 min) |
---|
7104 | //4 Komp. in char 2, delta (0,0,0,0) -1, char 11:delta (-1,0,0,0) -1 |
---|
7105 | ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
7106 | ideal i= |
---|
7107 | wx2y3-vx2y2z+wx2yz2+wy3z2-vx2z3-vy2z3, |
---|
7108 | vx3y2-ux2y3+vx3z2-ux2yz2+vxy2z2-uy3z2, |
---|
7109 | tvx2y2-swx2y2+tvx2z2-swx2z2+tvy2z2-swy2z2, |
---|
7110 | sux2y2-bvx2y2+sux2z2-bvx2z2+suy2z2-bvy2z2, |
---|
7111 | tux2y3-bvx2y2z+tux2yz2+tuy3z2-bvx2z3-bvy2z3; |
---|
7112 | //normalC: char 2,32003: 1 sec |
---|
7113 | //normalP char withRing 2: 1sec, char 11: 40sec |
---|
7114 | |
---|
7115 | //--------------------------------------------------------- |
---|
7116 | //genus: |
---|
7117 | int tt = timer; |
---|
7118 | list nor=normal(i, "noFac");nor; |
---|
7119 | timer-tt; |
---|
7120 | |
---|
7121 | //Yoshihiko Sakai, irred, 0sec, delta = 8 |
---|
7122 | ring r=0,(x,y),dp; //genus 0 4 nodes and 6 cusps im P2 |
---|
7123 | //ring r=7,(x,y),dp; //charp haengt in K = preimage(Q,phi,L) |
---|
7124 | ideal i=(x2+y^2-1)^3 +27x2y2; |
---|
7125 | |
---|
7126 | ring r=0,(x,y),dp; //genus 0 |
---|
7127 | ideal i=(x-y^2)^2 - y*x^3; |
---|
7128 | |
---|
7129 | ring r=0,(x,y),dp; //genus 4 |
---|
7130 | ideal i=y3-x6+1; |
---|
7131 | |
---|
7132 | int m=9; // q=9: genus 0 |
---|
7133 | int p=2; |
---|
7134 | int q=9;//2,...,9 |
---|
7135 | ring r=0,(x,y),dp; |
---|
7136 | ideal i=y^m - x^p*(x - 1)^q; |
---|
7137 | |
---|
7138 | ring r=0,(x,y),dp; //genus 19 |
---|
7139 | 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; |
---|
7140 | |
---|
7141 | ring r=23,(x,y),dp; //genus 34, delta 2 |
---|
7142 | ideal i=y10+(-2494x2+474)*y8+(84366+2042158x4-660492)*y6 |
---|
7143 | +(128361096x4-47970216x2+6697080-761328152x6)*y4 |
---|
7144 | +(-12024807786x4-506101284x2+15052058268x6+202172841-3212x8)*y2 |
---|
7145 | +34263110700x4-228715574724x6+5431439286x2+201803238 |
---|
7146 | -9127158539954x10-3212722859346x8; |
---|
7147 | //normalC, normalP 0 sec |
---|
7148 | |
---|
7149 | //Rob Koelman |
---|
7150 | //ring r=0,(x,y,z),dp; //dim sing = 1 (nach ca 15 min abgebrochen) |
---|
7151 | ring r=32003,(x,y,z),dp; |
---|
7152 | ideal i= |
---|
7153 | 761328152*x^6*z^4-5431439286*x^2*y^8+2494*x^2*z^8+228715574724*x^6*y^4+ |
---|
7154 | 9127158539954*x^10-15052058268*x^6*y^2*z^2+3212722859346*x^8*y^2- |
---|
7155 | 134266087241*x^8*z^2-202172841*y^8*z^2-34263110700*x^4*y^6-6697080*y^6*z^4- |
---|
7156 | 2042158*x^4*z^6-201803238*y^10+12024807786*x^4*y^4*z^2-128361096*x^4*y^2*z^4+ |
---|
7157 | 506101284*x^2*z^2*y^6+47970216*x^2*z^4*y^4+660492*x^2*z^6*y^2- |
---|
7158 | z^10-474*z^8*y^2-84366*z^6*y^4; |
---|
7159 | //normalC char 32003: 10 sec, char 0 : |
---|
7160 | |
---|
7161 | //ring r=0,(x,y),dp;//genus 10 with 26 cusps (nach ca 4 min abgebrochen) |
---|
7162 | ring r=32003,(x,y),dp; //24 sing, delta 24 |
---|
7163 | ideal i=9127158539954x10+3212722859346x8y2+228715574724x6y4-34263110700x4y6 |
---|
7164 | -5431439286x2y8-201803238y10-134266087241x8-15052058268x6y2+12024807786x4y4 |
---|
7165 | +506101284x2y6-202172841y8+761328152x6-128361096x4y2+47970216x2y4-6697080y6 |
---|
7166 | -2042158x4+660492x2y2-84366y4+2494x2-474y2-1; |
---|
7167 | //normalC 32003: 4 sec, char 0: abgebrochen bei pr = facstd(i); ### |
---|
7168 | |
---|
7169 | ring r=0,(x,y),dp; //irred, genus 1 with 5 cusps, delta 5 |
---|
7170 | ideal i=57y5+516x4y-320x4+66y4-340x2y3+73y3+128x2-84x2y2-96x2y; |
---|
7171 | //normalC 0 sec |
---|
7172 | |
---|
7173 | ring r=2,(x,y),dp; //genus 4, 2 Zweige, delta (13,9) 89 |
---|
7174 | ideal i=((x2+y3)^2+xy6)*((x3+y2)^2+x10y); |
---|
7175 | //normalC: char 2 : 1sec, char 0: lange |
---|
7176 | //normalP char 2 withRing: 0sec |
---|
7177 | |
---|
7178 | ring r=2,(y,z,w,u),dp; //2 Komp. genus -5 |
---|
7179 | ideal i=y2+z2+w2+u2,w4-u4; |
---|
7180 | //normalC: char 2 : 0sec, char 0: 1sec |
---|
7181 | //normalP char 2 withRing: 0sec |
---|
7182 | |
---|
7183 | ring r=0,(y,z,w,u),dp; //irred. genus 9 |
---|
7184 | ideal i=y2+z2+w2+u2,z4+w4+u4; |
---|
7185 | //char 0: 0sec |
---|
7186 | |
---|
7187 | ring r=0,(x,y,t),dp; //irred, delta -1 |
---|
7188 | 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; |
---|
7189 | //char 0: 0sec |
---|
7190 | |
---|
7191 | ring r=0,(x,y,z,w,u),dp; |
---|
7192 | ideal i=x2+y2+z2+w2+u2,x3+y3+z3,z4+w4+u4; |
---|
7193 | //char 0: 0sec |
---|
7194 | |
---|
7195 | //--------------------------------------------------------- |
---|
7196 | //Probleme mit normalC in char 2 und char 0 |
---|
7197 | |
---|
7198 | int tt = timer; |
---|
7199 | list nor=normalC(i,"withRing");nor; |
---|
7200 | timer-tt; |
---|
7201 | |
---|
7202 | //Mark van Hoeij |
---|
7203 | ring r=3,(x,y),dp; //genus 19, delta 21 |
---|
7204 | ideal i=y20+y13x+x4y5+x3*(x+1)^2; |
---|
7205 | //normalC: char 2 > 10 min bei list SM = mstd(i);### |
---|
7206 | //normalP char 2 withRing: 0sec, char 11: haengt bei K = preimage(Q,phi,L); |
---|
7207 | |
---|
7208 | ring r=2,(x,y),dp; //genus 35 |
---|
7209 | ideal i=y30+y13x+x4y5+x3*(x+1)^2; |
---|
7210 | //char 0 abgebrochen bei list SM = mstd(i); ### |
---|
7211 | //char 2 nach ca 30 min |
---|
7212 | //normalC: char 2: abgebr. bei list SM = mstd(i); //Now the work starts' |
---|
7213 | //normalC, withGens, char 2: abgebrochen bei Q=mstd(Q)[2]; |
---|
7214 | //normalP char 2 withRing: 0sec |
---|
7215 | |
---|
7216 | ring r=0,(x,y),dp; //irred, genus 55, delta 21 |
---|
7217 | ideal i=y40+y13x+x4y5+x3*(x+1)^2; |
---|
7218 | //normalC: char 2 lange |
---|
7219 | //normalP char 2 withRing: 0sec |
---|
7220 | |
---|
7221 | ring r=29,(x,y,t),dp; //char 0: genus -5, 4 Komp, delta (-1,-1,0,0), -1 |
---|
7222 | 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; |
---|
7223 | //normalC: char 29 : 0sec, char 0: 0sec //char 29 6 Komponenten |
---|
7224 | //normalP char 29 withRing: 1sec |
---|
7225 | |
---|
7226 | //-------------------------- problematic examples ------------------------ |
---|
7227 | //ring r=0,(x,y,t),dp; |
---|
7228 | ring r=32003,(x,y,t),dp; |
---|
7229 | ideal i= |
---|
7230 | 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; |
---|
7231 | //char 0: lange (es liegt an den grossen Zahlen), char 32003: 0 sec |
---|
7232 | |
---|
7233 | //dasselbe Beipiel in char 19: irred |
---|
7234 | ring r=0,(x,y,t),dp; |
---|
7235 | ideal i= |
---|
7236 | 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; |
---|
7237 | //normalP: char 2,3: 0sec, norTest 0,2 sec, char 11 haengt bei peimage |
---|
7238 | //normalC: char 3: 0 sec, char 0: 1sec |
---|
7239 | |
---|
7240 | //ring r=0,(x,y),dp; |
---|
7241 | ring r=32003,(x,y),dp; |
---|
7242 | ideal i= |
---|
7243 | x30y21+21x29y20+210x28y19+10x27y19+1330x27y18+190x26y18+5985x26y17 |
---|
7244 | +1710x25y17+20349x25y16+45x24y17+9690x24y16+54264x24y15+765x23y16 |
---|
7245 | +38760x23y15+116280x23y14+6120x22y15+116280x22y14+120x21y15 |
---|
7246 | +203490x22y13+30600x21y14+271320x21y13+1799x20y14+293930x21y12+107100x20y13 |
---|
7247 | +503880x20y12+12586x19y13+352716x20y11+278460x19y12+210x18y13+755820x19y11 |
---|
7248 | +54509x18y12+352716x19y10+556920x18y11+2723x17y12+923780x18y10+163436x17y11 |
---|
7249 | +293930x18y9+875160x17y10+16296x16y11+923780x17y9+359359x16y10+252x15y11 |
---|
7250 | +203490x17y8+1093950x16y9+59598x15y10+755820x16y8+598598x15y9+2751x14y10 |
---|
7251 | +116280x16y7+1093950x15y8+148610x14y9+503880x15y7+769197x14y8+13650x13y9 |
---|
7252 | +54264x15y6+875160x14y7+266805x13y8+210x12y9+271320x14y6+768768x13y7 |
---|
7253 | +40635x12y8+20349x14y5+556920x13y6+354816x12y7+1855x11y8+116280x13y5 |
---|
7254 | +597597x12y6+80640x11y7+5985x13y4+278460x12y5+353892x11y6+7280x10y7+38760x12y4 |
---|
7255 | +358358x11y5+112014x10y6+120x9y7+1330x12y3+107100x11y4+264726x10y5+16660x9y6 |
---|
7256 | +9690x11y3+162799x10y4+111132x9y5+805x8y6+210x11y2+30600x10y3+146685x9y4 |
---|
7257 | +24500x8y5+1710x10y2+54236x9y3+78750x8y4+2310x7y5+21x10y+6120x9y2+58520x8y3 |
---|
7258 | +24010x7y4+45x6y5+190x9y+12509x8y2+39060x7y3+3675x6y4+x9+765x8y+15918x7y2 |
---|
7259 | +15680x6y3+204x5y4+10x8+1786x7y+12915x6y2+3500x5y3+45x7+2646x6y+6580x5y2 |
---|
7260 | +366x4y3+119x6+2562x5y+1995x4y2+10x3y3+203x5+1610x4y+324x3y2+231x4+630x3y |
---|
7261 | +23x2y2+175x3+141x2y+85x2+16xy+24x+y+4; |
---|
7262 | list nor = normal(i); |
---|
7263 | //normalC: char 0: ### haengt in SB of singular locus JM = mstd(J); |
---|
7264 | //normalC: char 32003,"noFac","equidim": 0sec, "noFac": 1sec |
---|
7265 | // ev neues interred |
---|
7266 | genus(i); // haengt bei int mu=vdim(std(jacob(f))); |
---|
7267 | //### ist das noetig? |
---|
7268 | |
---|
7269 | //Singular rechnet genus richtig, auch im Fall, dass Kurve irreduzibel, |
---|
7270 | //aber nicht absolut irreduzibel ist: |
---|
7271 | ring r = 0,(x,y),dp; |
---|
7272 | ideal i = x2+y2; //irreduzibel /Q aber reduzibel /C (x-iy)*(x+iy) |
---|
7273 | factorize( x2+y2); //liefert irreduzibel |
---|
7274 | genus(i); //sollte 0+0-2+1= -1 sein |
---|
7275 | genus(i,1); //beides ist korrekt in Singular |
---|
7276 | |
---|
7277 | */ |
---|
7278 | |
---|