1 | ////////////////////////////////////////////////////////////////////////////// |
---|
2 | version="version normal.lib 4.0.1.1 Dec_2014 "; // $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 | SEE ALSO: locnormal_lib;modnormal_lib |
---|
29 | "; |
---|
30 | |
---|
31 | LIB "general.lib"; |
---|
32 | LIB "poly.lib"; |
---|
33 | LIB "sing.lib"; |
---|
34 | LIB "primdec.lib"; |
---|
35 | LIB "elim.lib"; |
---|
36 | LIB "presolve.lib"; |
---|
37 | LIB "inout.lib"; |
---|
38 | LIB "ring.lib"; |
---|
39 | LIB "hnoether.lib"; |
---|
40 | LIB "reesclos.lib"; |
---|
41 | LIB "algebra.lib"; |
---|
42 | |
---|
43 | /////////////////////////////////////////////////////////////////////////////// |
---|
44 | |
---|
45 | proc normal(ideal id, list #) |
---|
46 | "USAGE: normal(id [,choose]); id = radical ideal, choose = list of options. @* |
---|
47 | Optional parameters in list choose (can be entered in any order):@* |
---|
48 | Decomposition:@* |
---|
49 | - \"equidim\" -> computes first an equidimensional decomposition of the |
---|
50 | input ideal, and then the normalization of each component (default).@* |
---|
51 | - \"prim\" -> computes first the minimal associated primes of the input |
---|
52 | ideal, and then the normalization of each prime. (When the input ideal |
---|
53 | is not prime and the minimal associated primes are easy to compute, |
---|
54 | this method is usually faster than \"equidim\".)@* |
---|
55 | - \"noDeco\" -> no preliminary decomposition is done. If the ideal is |
---|
56 | not equidimensional radical, output might be wrong.@* |
---|
57 | - \"isPrim\" -> assumes that the ideal is prime. If this assumption |
---|
58 | does not hold, the output might be wrong.@* |
---|
59 | - \"noFac\" -> factorization is avoided in the computation of the |
---|
60 | minimal associated primes; |
---|
61 | Other:@* |
---|
62 | - \"useRing\" -> uses the original ring ordering.@* |
---|
63 | If this option is set and if the ring ordering is not global, normal |
---|
64 | will change to a global ordering only for computing radicals and prime |
---|
65 | or equidimensional decompositions.@* |
---|
66 | If this option is not set, normal changes to dp ordering and performs |
---|
67 | all computations with respect to this ordering.@* |
---|
68 | - \"withDelta\" (or \"wd\") -> returns also the delta invariants.@* |
---|
69 | If the optional parameter choose is not given or empty, only |
---|
70 | \"equidim\" but no other option is used.@* |
---|
71 | - list(\"inputJ\", ideal inputJ) -> takes as initial test ideal the |
---|
72 | ideal inputJ. 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 | - list(\"inputC\", ideal inputC) -> takes as initial conductor the |
---|
76 | ideal inputC. This option is only for use in other procedures. Using |
---|
77 | this option, the result might not be the normalization.@* |
---|
78 | (Option only valid for global algorithm.)@* |
---|
79 | Options used for computing integral basis (over rings of two |
---|
80 | variables):@* |
---|
81 | - \"var1\" -> uses a polynomial in the first variable as |
---|
82 | universal denominator.@* |
---|
83 | - \"var2\" -> uses a polynomial in the second variable as universal |
---|
84 | denominator.@* |
---|
85 | If the optional parameter choose is not given or empty, only |
---|
86 | \"equidim\" but no other option is used.@* |
---|
87 | ASSUME: The ideal must be radical, for non-radical ideals the output may |
---|
88 | be wrong (id=radical(id); makes id radical). However, when using the |
---|
89 | \"prim\" option the minimal associated primes of id are computed first |
---|
90 | and hence normal computes the normalization of the radical of id.@* |
---|
91 | NOTE: \"isPrim\" should only be used if id is known to be prime. |
---|
92 | RETURN: a list, say nor, of size 2 (resp. 3 with option \"withDelta\"). |
---|
93 | @format Let R denote the basering and id the input ideal. |
---|
94 | * nor[1] is a list of r rings, where r is the number of associated |
---|
95 | primes P_i with option \"prim\" (resp. >= no of equidimenensional |
---|
96 | components P_i with option \"equidim\").@* |
---|
97 | Each ring Ri := nor[1][i], i=1..r, contains two ideals with given |
---|
98 | names @code{norid} and @code{normap} such that: @* |
---|
99 | - Ri/norid is the normalization of the i-th component, i.e. the |
---|
100 | integral closure of R/P_i in its field of fractions (as affine ring); |
---|
101 | - @code{normap} gives the normalization map from R/id to |
---|
102 | Ri/norid for each i.@* |
---|
103 | - the direct sum of the rings Ri/norid, i=1,..r, is the normalization |
---|
104 | of R/id as affine algebra; @* |
---|
105 | * nor[2] is a list of size r with information on the normalization of |
---|
106 | the i-th component as module over the basering R:@* |
---|
107 | nor[2][i] is an ideal, say U, in R such that the integral closure |
---|
108 | of basering/P_i is generated as module over R by 1/c * U, with c |
---|
109 | the last element U[size(U)] of U.@* |
---|
110 | * nor[3] (if option \"withDelta\" is set) is a list of an intvec |
---|
111 | of size r, the delta invariants of the r components, and an integer, |
---|
112 | the total delta invariant of basering/id (-1 means infinite, and 0 |
---|
113 | that R/P_i resp. R/id is normal). |
---|
114 | @end format |
---|
115 | THEORY: We use here a general algorithm described in [G.-M.Greuel, S.Laplagne, |
---|
116 | F.Seelisch: Normalization of Rings (2009)].@* |
---|
117 | The procedure computes the R-module structure, the algebra structure |
---|
118 | and the delta invariant of the normalization of R/id:@* |
---|
119 | The normalization of R/id is the integral closure of R/id in its total |
---|
120 | ring of fractions. It is a finitely generated R-module and nor[2] |
---|
121 | computes R-module generators of it. More precisely: If U:=nor[2][i] |
---|
122 | and c:=U[size(U)], then c is a non-zero divisor and U/c is an R-module |
---|
123 | in the total ring of fractions, the integral closure of R/P_i. Since |
---|
124 | U[size(U)]/c is equal to 1, R/P_i resp. R/id is contained in the |
---|
125 | integral closure.@* |
---|
126 | The normalization is also an affine algebra over the ground field |
---|
127 | and nor[1] presents it as such. For geometric considerations nor[1] is |
---|
128 | relevant since the variety of the ideal norid in Ri is the |
---|
129 | normalization of the variety of the ideal P_i in R.@* |
---|
130 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
131 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
132 | id. nor[3] returns the delta invariants of the components P_i and of |
---|
133 | id. |
---|
134 | NOTE: To use the i-th ring type e.g.: @code{def R=nor[1][i]; setring R;}. |
---|
135 | @* Increasing/decreasing printlevel displays more/less comments |
---|
136 | (default: printlevel=0). |
---|
137 | @* Implementation works also for local rings. |
---|
138 | @* Not implemented for quotient rings. |
---|
139 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
140 | be used together with the useRing-option (qhweight(id); computes |
---|
141 | weights). |
---|
142 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
143 | SEE ALSO: normalC, normalP. |
---|
144 | EXAMPLE: example normal; shows an example |
---|
145 | " |
---|
146 | { |
---|
147 | ASSUME(0, not isQuotientRing(basering) ); |
---|
148 | |
---|
149 | intvec opt = option(get); // Save current options |
---|
150 | |
---|
151 | int i,j; |
---|
152 | int decomp; // Preliminary decomposition: |
---|
153 | // 0 -> no decomposition (id is assumed to be prime) |
---|
154 | // 1 -> no decomposition |
---|
155 | // (id is assumed to be equidimensional radical) |
---|
156 | // 2 -> equidimensional decomposition |
---|
157 | // 3 -> minimal associated primes |
---|
158 | int noFac, useRing, withDelta; |
---|
159 | int dbg = printlevel - voice + 2; |
---|
160 | int nvar = nvars(basering); |
---|
161 | int chara = char(basering); |
---|
162 | int denomOption; // Method for choosing the conductor |
---|
163 | |
---|
164 | ideal inputJ = 0; // Test ideal given in the input (if any). |
---|
165 | ideal inputC = 0; // Conductor ideal given in the input (if any). |
---|
166 | |
---|
167 | list result, resultNew; |
---|
168 | list keepresult; |
---|
169 | list ringStruc; |
---|
170 | ideal U; |
---|
171 | poly c; |
---|
172 | int sp; // Number of components. |
---|
173 | |
---|
174 | // Default methods: |
---|
175 | noFac = 0; // Use facSTD when computing minimal associated primes |
---|
176 | decomp = 2; // Equidimensional decomposition |
---|
177 | useRing = 0; // Change first to dp ordering, and perform all |
---|
178 | // computations there. |
---|
179 | withDelta = 0; // Do not compute the delta invariant. |
---|
180 | denomOption = 0; // The default universal denominator is the smallest |
---|
181 | // degree polynomial. |
---|
182 | |
---|
183 | //--------------------------- define the method --------------------------- |
---|
184 | for ( i=1; i <= size(#); i++ ) |
---|
185 | { |
---|
186 | if ( typeof(#[i]) == "string" ) |
---|
187 | { |
---|
188 | //--------------------------- choosen methods ----------------------- |
---|
189 | if ( (#[i]=="isprim") or (#[i]=="isPrim") ) |
---|
190 | {decomp = 0;} |
---|
191 | |
---|
192 | if ( (#[i]=="nodeco") or (#[i]=="noDeco") ) |
---|
193 | {decomp = 1;} |
---|
194 | |
---|
195 | if (#[i]=="prim") |
---|
196 | {decomp = 3;} |
---|
197 | |
---|
198 | if (#[i]=="equidim") |
---|
199 | {decomp = 2;} |
---|
200 | |
---|
201 | if ( (#[i]=="nofac") or (#[i]=="noFac") ) |
---|
202 | {noFac=1;} |
---|
203 | |
---|
204 | if ( ((#[i]=="useRing") or (#[i]=="usering")) and (ordstr(basering) != "dp("+string(nvars(basering))+"),C")) |
---|
205 | {useRing = 1;} |
---|
206 | |
---|
207 | if ( (#[i]=="withDelta") or (#[i]=="wd") or (#[i]=="withdelta")) |
---|
208 | { |
---|
209 | if((decomp == 0) or (decomp == 3)) |
---|
210 | { |
---|
211 | withDelta = 1; |
---|
212 | } |
---|
213 | else |
---|
214 | { |
---|
215 | decomp = 3; |
---|
216 | withDelta = 1; |
---|
217 | //Note: the delta invariants cannot be computed with an equidimensional |
---|
218 | //decomposition, hence we compute first the minimal primes |
---|
219 | } |
---|
220 | } |
---|
221 | if (#[i]=="var1") |
---|
222 | {denomOption = 1;} |
---|
223 | if (#[i]=="var2") |
---|
224 | {denomOption = 2;} |
---|
225 | } |
---|
226 | if(typeof(#[i]) == "list"){ |
---|
227 | if(size(#[i]) == 2){ |
---|
228 | if (#[i][1]=="inputJ"){ |
---|
229 | if(typeof(#[i][2]) == "ideal"){ |
---|
230 | inputJ = #[i][2]; |
---|
231 | } |
---|
232 | } |
---|
233 | } |
---|
234 | if (#[i][1]=="inputC"){ |
---|
235 | if(size(#[i]) == 2){ |
---|
236 | if(typeof(#[i][2]) == "ideal"){ |
---|
237 | inputC = #[i][2]; |
---|
238 | } |
---|
239 | } |
---|
240 | } |
---|
241 | } |
---|
242 | } |
---|
243 | kill #; |
---|
244 | |
---|
245 | //------------------------ change ring if required ------------------------ |
---|
246 | // If the ordering is not global, we change to dp ordering for computing the |
---|
247 | // min ass primes. |
---|
248 | // If the ordering is global, but not dp, and useRing = 0, we also change to |
---|
249 | // dp ordering. |
---|
250 | |
---|
251 | int isGlobal = attrib(basering,"global");// Checks if the original ring has |
---|
252 | // global ordering. |
---|
253 | |
---|
254 | def origR = basering; // origR is the original ring |
---|
255 | // R is the ring where computations will be done |
---|
256 | |
---|
257 | if((useRing == 1) and (isGlobal == 1)) |
---|
258 | { |
---|
259 | def globR = basering; |
---|
260 | } |
---|
261 | else |
---|
262 | { |
---|
263 | // We change to dp ordering. |
---|
264 | list rl = ringlist(origR); |
---|
265 | list origOrd = rl[3]; |
---|
266 | list newOrd = list("dp", intvec(1:nvars(origR))), list("C", 0); |
---|
267 | rl[3] = newOrd; |
---|
268 | def globR = ring(rl); |
---|
269 | setring globR; |
---|
270 | ideal id = fetch(origR, id); |
---|
271 | } |
---|
272 | |
---|
273 | //------------------------ trivial checkings ------------------------ |
---|
274 | id = groebner(id); |
---|
275 | if((size(id) == 0) or (id[1] == 1)) |
---|
276 | { |
---|
277 | // The original ring R/I was normal. Nothing to do. |
---|
278 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
279 | setring origR; |
---|
280 | list lR = ringlist(origR); |
---|
281 | def ROut = ring(lR); |
---|
282 | setring ROut; |
---|
283 | ideal norid = fetch(origR, id); |
---|
284 | ideal normap = maxideal(1); |
---|
285 | export norid; |
---|
286 | export normap; |
---|
287 | setring origR; |
---|
288 | if(withDelta) |
---|
289 | { |
---|
290 | result = list(list(ROut), list(ideal(1)), list(intvec(0), 0)); |
---|
291 | } |
---|
292 | else |
---|
293 | { |
---|
294 | result = list(list(ROut), list(ideal(1))); |
---|
295 | } |
---|
296 | sp = 1; // number of rings in the output |
---|
297 | option(set, opt); |
---|
298 | normalOutputText(dbg, withDelta, sp); |
---|
299 | return(result); |
---|
300 | } |
---|
301 | //------------------------ preliminary decomposition----------------------- |
---|
302 | list prim; |
---|
303 | if(decomp == 2) |
---|
304 | { |
---|
305 | dbprint(dbg, "// Computing the equidimensional decomposition..."); |
---|
306 | prim = equidim(id); |
---|
307 | } |
---|
308 | if((decomp == 0) or (decomp == 1)) |
---|
309 | { |
---|
310 | prim = id; |
---|
311 | } |
---|
312 | if(decomp == 3) |
---|
313 | { |
---|
314 | dbprint(dbg, "// Computing the minimal associated primes..."); |
---|
315 | if( noFac ) |
---|
316 | { prim = minAssGTZ(id,1); } |
---|
317 | else |
---|
318 | { prim = minAssGTZ(id); } |
---|
319 | } |
---|
320 | sp = size(prim); |
---|
321 | if(dbg>=1) |
---|
322 | { |
---|
323 | prim; ""; |
---|
324 | "// number of components is", sp; |
---|
325 | ""; |
---|
326 | } |
---|
327 | |
---|
328 | |
---|
329 | //----------------- back to the original ring if required ------------------ |
---|
330 | // if ring was not global and useRing is on, we go back to the original ring |
---|
331 | if((useRing == 1) and (isGlobal != 1)) |
---|
332 | { |
---|
333 | setring origR; |
---|
334 | def R = basering; |
---|
335 | list prim = fetch(globR, prim); |
---|
336 | } |
---|
337 | else |
---|
338 | { |
---|
339 | def R = basering; |
---|
340 | ideal inputJ = fetch(origR, inputJ); |
---|
341 | ideal inputC = fetch(origR, inputC); |
---|
342 | if(useRing == 0) |
---|
343 | { |
---|
344 | ideal U; |
---|
345 | poly c; |
---|
346 | } |
---|
347 | } |
---|
348 | |
---|
349 | // ---------------- normalization of the components------------------------- |
---|
350 | // calls normalM to compute the normalization of each component. |
---|
351 | |
---|
352 | list norComp; // The normalization of each component. |
---|
353 | int delt; |
---|
354 | int deltI = 0; |
---|
355 | int totalComps = 0; |
---|
356 | |
---|
357 | setring origR; |
---|
358 | def newROrigOrd; |
---|
359 | list newRListO; |
---|
360 | setring R; |
---|
361 | def newR; |
---|
362 | list newRList; |
---|
363 | |
---|
364 | for(i=1; i<=size(prim); i++) |
---|
365 | { |
---|
366 | if(dbg>=2){pause();} |
---|
367 | if(dbg>=1) |
---|
368 | { |
---|
369 | "// start computation of component",i; |
---|
370 | " --------------------------------"; |
---|
371 | } |
---|
372 | if(groebner(prim[i])[1] != 1) |
---|
373 | { |
---|
374 | if(dbg>=2) |
---|
375 | { |
---|
376 | "We compute the normalization in the ring"; basering; |
---|
377 | } |
---|
378 | printlevel = printlevel + 1; |
---|
379 | norComp = normalM(prim[i], decomp, withDelta, denomOption, inputJ, inputC); |
---|
380 | printlevel = printlevel - 1; |
---|
381 | for(j = 1; j <= size(norComp); j++) |
---|
382 | { |
---|
383 | newR = norComp[j][3]; |
---|
384 | if(!defined(savebasering)) { def savebasering;} |
---|
385 | savebasering=basering; |
---|
386 | setring newR; // must be in a compatible ring to newR |
---|
387 | // as ringlist may produce ring-dep. stuff |
---|
388 | if(!defined(newRList)) { list newRList;} |
---|
389 | newRList = ringlist(newR); |
---|
390 | setring savebasering; |
---|
391 | U = norComp[j][1]; |
---|
392 | c = norComp[j][2]; |
---|
393 | if(withDelta) |
---|
394 | { |
---|
395 | delt = norComp[j][4]; |
---|
396 | if((delt >= 0) and (deltI >= 0)) |
---|
397 | { |
---|
398 | deltI = deltI + delt; |
---|
399 | } |
---|
400 | else |
---|
401 | { |
---|
402 | deltI = -1; |
---|
403 | } |
---|
404 | } |
---|
405 | // -- incorporate result for this component to the list of results --- |
---|
406 | if(useRing == 0) |
---|
407 | { |
---|
408 | // We go back to the original ring. |
---|
409 | setring origR; |
---|
410 | U = fetch(R, U); |
---|
411 | c = fetch(R, c); |
---|
412 | newRListO = imap(newR, newRList); |
---|
413 | // We change the ordering in the new ring. |
---|
414 | if(nvars(newR) > nvars(origR)) |
---|
415 | { |
---|
416 | newRListO[3]=insert(origOrd, newRListO[3][1]); |
---|
417 | } |
---|
418 | else |
---|
419 | { |
---|
420 | newRListO[3] = origOrd; |
---|
421 | } |
---|
422 | newROrigOrd = ring(newRListO); |
---|
423 | setring newROrigOrd; |
---|
424 | ideal norid = imap(newR, norid); |
---|
425 | ideal normap = imap(newR, normap); |
---|
426 | export norid; |
---|
427 | export normap; |
---|
428 | setring origR; |
---|
429 | totalComps++; |
---|
430 | result[totalComps] = list(U, c, newROrigOrd); |
---|
431 | if(withDelta) |
---|
432 | { |
---|
433 | result[totalComps] = insert(result[totalComps], delt, 3); |
---|
434 | } |
---|
435 | setring R; |
---|
436 | } |
---|
437 | else |
---|
438 | { |
---|
439 | setring R; |
---|
440 | totalComps++; |
---|
441 | result[totalComps] = norComp[j]; |
---|
442 | } |
---|
443 | } |
---|
444 | } |
---|
445 | } |
---|
446 | |
---|
447 | // -------------------------- delta computation ---------------------------- |
---|
448 | if(withDelta == 1) |
---|
449 | { |
---|
450 | // Intersection multiplicities of list prim, sp=size(prim). |
---|
451 | if ( dbg >= 1 ) |
---|
452 | { |
---|
453 | "// Sum of delta for all components: ", deltI; |
---|
454 | } |
---|
455 | if(size(prim) > 1) |
---|
456 | { |
---|
457 | dbprint(dbg, "// Computing the sum of the intersection multiplicities of the components..."); |
---|
458 | int mul = iMult(prim); |
---|
459 | if ( mul < 0 ) |
---|
460 | { |
---|
461 | deltI = -1; |
---|
462 | } |
---|
463 | else |
---|
464 | { |
---|
465 | deltI = deltI + mul; |
---|
466 | } |
---|
467 | if ( dbg >= 1 ) |
---|
468 | { |
---|
469 | "// Intersection multiplicity is : ", mul; |
---|
470 | } |
---|
471 | } |
---|
472 | } |
---|
473 | |
---|
474 | // -------------------------- prepare output ------------------------------ |
---|
475 | setring origR; |
---|
476 | |
---|
477 | list RL; // List of rings |
---|
478 | list MG; // Module generators |
---|
479 | intvec DV; // Vector of delta's of each component |
---|
480 | for(i = 1; i <= size(result); i++) |
---|
481 | { |
---|
482 | RL[i] = result[i][3]; |
---|
483 | MG[i] = lineUpLast(result[i][1], result[i][2]); |
---|
484 | if(withDelta) |
---|
485 | { |
---|
486 | DV[i] = result[i][4]; |
---|
487 | } |
---|
488 | } |
---|
489 | if(withDelta) |
---|
490 | { |
---|
491 | resultNew = list(RL, MG, list(DV, deltI)); |
---|
492 | } |
---|
493 | else |
---|
494 | { |
---|
495 | resultNew = list(RL, MG); |
---|
496 | } |
---|
497 | sp = size(RL); //RL = list of rings |
---|
498 | |
---|
499 | option(set, opt); |
---|
500 | normalOutputText(dbg, withDelta, sp); |
---|
501 | return(resultNew); |
---|
502 | } |
---|
503 | |
---|
504 | example |
---|
505 | { "EXAMPLE:"; |
---|
506 | printlevel = printlevel+1; |
---|
507 | echo = 2; |
---|
508 | ring s = 0,(x,y),dp; |
---|
509 | ideal i = (x2-y3)*(x2+y2)*x; |
---|
510 | list nor = normal(i, "withDelta", "prim"); |
---|
511 | nor; |
---|
512 | |
---|
513 | // 2 branches have delta = 1, and 1 branch has delta = 0 |
---|
514 | // the total delta invariant is 13 |
---|
515 | |
---|
516 | def R2 = nor[1][2]; setring R2; |
---|
517 | norid; normap; |
---|
518 | |
---|
519 | echo = 0; |
---|
520 | printlevel = printlevel-1; |
---|
521 | pause(" hit return to continue"); echo=2; |
---|
522 | |
---|
523 | ring r = 2,(x,y,z),dp; |
---|
524 | ideal i = z3-xy4; |
---|
525 | list nor = normal(i, "withDelta", "prim"); nor; |
---|
526 | // the delta invariant is infinite |
---|
527 | // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module |
---|
528 | // in its quotient field Quot(r/i) |
---|
529 | |
---|
530 | // the normalization as affine algebra over the ground field: |
---|
531 | def R = nor[1][1]; setring R; |
---|
532 | norid; normap; |
---|
533 | } |
---|
534 | |
---|
535 | /////////////////////////////////////////////////////////////////////////////// |
---|
536 | // Prints the output text in proc normal. |
---|
537 | // |
---|
538 | static proc normalOutputText(int dbg, int withDelta, int sp) |
---|
539 | // int dbg: printlevel |
---|
540 | // int withDelta: output contains information about the delta invariant |
---|
541 | // int sp: number of output rings. |
---|
542 | { |
---|
543 | if ( dbg >= 0 ) |
---|
544 | { |
---|
545 | ""; |
---|
546 | if(!withDelta) |
---|
547 | { |
---|
548 | "// 'normal' created a list, say nor, of two elements."; |
---|
549 | } |
---|
550 | else |
---|
551 | { |
---|
552 | "// 'normal' created a list, say nor, of three elements."; |
---|
553 | } |
---|
554 | "// To see the list type"; |
---|
555 | " nor;"; |
---|
556 | ""; |
---|
557 | "// * nor[1] is a list of", sp, "ring(s)."; |
---|
558 | "// To access the i-th ring nor[1][i], give it a name, say Ri, and type"; |
---|
559 | " def R1 = nor[1][1]; setring R1; norid; normap;"; |
---|
560 | "// For the other rings type first (if R is the name of your base ring)"; |
---|
561 | " setring R;"; |
---|
562 | "// and then continue as for R1."; |
---|
563 | "// Ri/norid is the affine algebra of the normalization of R/P_i where"; |
---|
564 | "// P_i is the i-th component of a decomposition of the input ideal id"; |
---|
565 | "// and normap the normalization map from R to Ri/norid."; |
---|
566 | ""; |
---|
567 | "// * nor[2] is a list of", sp, "ideal(s). Let ci be the last generator"; |
---|
568 | "// of the ideal nor[2][i]. Then the integral closure of R/P_i is"; |
---|
569 | "// generated as R-submodule of the total ring of fractions by"; |
---|
570 | "// 1/ci * nor[2][i]."; |
---|
571 | |
---|
572 | if(withDelta) |
---|
573 | { ""; |
---|
574 | "// * nor[3] is a list of an intvec of size", sp, "the delta invariants "; |
---|
575 | "// of the components, and an integer, the total delta invariant "; |
---|
576 | "// of R/id (-1 means infinite, and 0 that R/P_i resp. R/id is normal)."; |
---|
577 | } |
---|
578 | } |
---|
579 | } |
---|
580 | |
---|
581 | |
---|
582 | /////////////////////////////////////////////////////////////////////////////// |
---|
583 | |
---|
584 | proc HomJJ (list Li) |
---|
585 | "USAGE: HomJJ (Li); Li = list: ideal SBid, ideal id, ideal J, poly p |
---|
586 | ASSUME: R = P/id, P = basering, a polynomial ring, id an ideal of P, |
---|
587 | @* SBid = standard basis of id, |
---|
588 | @* J = ideal of P containing the polynomial p, |
---|
589 | @* p = nonzero divisor of R |
---|
590 | COMPUTE: Endomorphism ring End_R(J)=Hom_R(J,J) with its ring structure as |
---|
591 | affine ring, together with the map R --> Hom_R(J,J) of affine rings, |
---|
592 | where R is the quotient ring of P modulo the standard basis SBid. |
---|
593 | RETURN: a list l of three objects |
---|
594 | @format |
---|
595 | l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi' |
---|
596 | such that l[1]/endid = Hom_R(J,J) and |
---|
597 | endphi describes the canonical map R -> Hom_R(J,J) |
---|
598 | l[2] : an integer which is 1 if phi is an isomorphism, 0 if not |
---|
599 | l[3] : an integer, = dim_K(Hom_R(J,J)/R) (the contribution to delta) |
---|
600 | if the dimension is finite, -1 otherwise |
---|
601 | @end format |
---|
602 | NOTE: printlevel >=1: display comments (default: printlevel=0) |
---|
603 | EXAMPLE: example HomJJ; shows an example |
---|
604 | " |
---|
605 | { |
---|
606 | ASSUME(0, not isQuotientRing(basering) ); |
---|
607 | |
---|
608 | //---------- initialisation --------------------------------------------------- |
---|
609 | int isIso,isPr,isHy,isCo,isRe,isEq,oSAZ,ii,jj,q,y; |
---|
610 | intvec rw,rw1; |
---|
611 | list L; |
---|
612 | y = printlevel-voice+2; // y=printlevel (default: y=0) |
---|
613 | def P = basering; |
---|
614 | ideal SBid, id, J = Li[1], Li[2], Li[3]; |
---|
615 | poly p = Li[4]; |
---|
616 | int noRed = 0; |
---|
617 | if(size(Li) > 4) |
---|
618 | { |
---|
619 | if(Li[5] == 1) { noRed = 1; } |
---|
620 | } |
---|
621 | |
---|
622 | attrib(SBid,"isSB",1); |
---|
623 | int homo = homog(Li[2]); //is 1 if id is homogeneous, 0 if not |
---|
624 | |
---|
625 | //---- set attributes for special cases where algorithm can be simplified ----- |
---|
626 | if( homo==1 ) |
---|
627 | { |
---|
628 | rw = ringweights(P); |
---|
629 | } |
---|
630 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
631 | { |
---|
632 | if(attrib(id,"isPrim")==1) { isPr=1; } |
---|
633 | } |
---|
634 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
635 | { |
---|
636 | if(attrib(id,"onlySingularAtZero")==1){oSAZ=1; } |
---|
637 | } |
---|
638 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
639 | { |
---|
640 | if(attrib(id,"isIsolatedSingularity")==1) { isIso=1; } |
---|
641 | } |
---|
642 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
643 | { |
---|
644 | if(attrib(id,"isCohenMacaulay")==1) { isCo=1; } |
---|
645 | } |
---|
646 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
647 | { |
---|
648 | if(attrib(id,"isRegInCodim2")==1) { isRe=1; } |
---|
649 | } |
---|
650 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
651 | { |
---|
652 | if(attrib(id,"isEquidimensional")==1) { isEq=1; } |
---|
653 | } |
---|
654 | //-------------------------- go to quotient ring ------------------------------ |
---|
655 | qring R = SBid; |
---|
656 | ideal id = fetch(P,id); |
---|
657 | ideal J = fetch(P,J); |
---|
658 | poly p = fetch(P,p); |
---|
659 | ideal f,rf,f2; |
---|
660 | module syzf; |
---|
661 | //---------- computation of p*Hom(J,J) as R-ideal ----------------------------- |
---|
662 | if ( y>=1 ) |
---|
663 | { |
---|
664 | "// compute p*Hom(J,J) = p*J:J"; |
---|
665 | "// the ideal J:";J; |
---|
666 | } |
---|
667 | f = quotient(p*J,J); |
---|
668 | |
---|
669 | //### (neu GMG 4.10.08) divide by the greatest common divisor: |
---|
670 | poly gg = gcd( f[1],p ); |
---|
671 | for(ii=2; ii <=ncols(f); ii++) |
---|
672 | { |
---|
673 | gg=gcd(gg,f[ii]); |
---|
674 | } |
---|
675 | for(ii=1; ii<=ncols(f); ii++) |
---|
676 | { |
---|
677 | f[ii]=f[ii]/gg; |
---|
678 | } |
---|
679 | p = p/gg; |
---|
680 | |
---|
681 | if ( y>=1 ) |
---|
682 | { |
---|
683 | "// the non-zerodivisor p:"; p; |
---|
684 | "// the module p*Hom(J,J) = p*J:J :"; f; |
---|
685 | ""; |
---|
686 | } |
---|
687 | f2 = std(p); |
---|
688 | |
---|
689 | //---------- Test: Hom(J,J) == R ?, if yes, go home --------------------------- |
---|
690 | |
---|
691 | //rf = interred(reduce(f,f2)); |
---|
692 | //### interred hier weggelassen, unten zugefuegt |
---|
693 | rf = reduce(f,f2); //represents p*Hom(J,J)/p*R = Hom(J,J)/R |
---|
694 | if ( size(rf) == 0 ) |
---|
695 | { |
---|
696 | if ( homog(f) && find(ordstr(basering),"s")==0 ) |
---|
697 | { |
---|
698 | ring newR1 = char(P),(X(1..nvars(P))),(a(rw),dp); |
---|
699 | } |
---|
700 | else |
---|
701 | { |
---|
702 | ring newR1 = char(P),(X(1..nvars(P))),dp; |
---|
703 | } |
---|
704 | ideal endphi = maxideal(1); |
---|
705 | ideal endid = fetch(P,id); |
---|
706 | endid = simplify(endid,2); |
---|
707 | L = substpart(endid,endphi,homo,rw); //## hier substpart |
---|
708 | def lastRing = L[1]; |
---|
709 | setring lastRing; |
---|
710 | |
---|
711 | attrib(endid,"onlySingularAtZero",oSAZ); |
---|
712 | attrib(endid,"isCohenMacaulay",isCo); |
---|
713 | attrib(endid,"isPrim",isPr); |
---|
714 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
715 | attrib(endid,"isRegInCodim2",isRe); |
---|
716 | attrib(endid,"isEqudimensional",isEq); |
---|
717 | attrib(endid,"isHypersurface",0); |
---|
718 | attrib(endid,"isCompleteIntersection",0); |
---|
719 | attrib(endid,"isRadical",0); |
---|
720 | L=lastRing; |
---|
721 | L = insert(L,1,1); |
---|
722 | dbprint(y,"// case R = Hom(J,J)"); |
---|
723 | if(y>=1) |
---|
724 | { |
---|
725 | "// R=Hom(J,J)"; |
---|
726 | lastRing; |
---|
727 | "// the new ideal"; |
---|
728 | endid; |
---|
729 | " "; |
---|
730 | "// the old ring"; |
---|
731 | P; |
---|
732 | "// the old ideal"; |
---|
733 | setring P; |
---|
734 | id; |
---|
735 | " "; |
---|
736 | setring lastRing; |
---|
737 | "// the map to the new ring"; |
---|
738 | endphi; |
---|
739 | " "; |
---|
740 | pause(); |
---|
741 | ""; |
---|
742 | } |
---|
743 | setring P; |
---|
744 | L[3]=0; |
---|
745 | return(L); |
---|
746 | } |
---|
747 | if(y>=1) |
---|
748 | { |
---|
749 | "// R is not equal to Hom(J,J), we have to try again"; |
---|
750 | pause(); |
---|
751 | ""; |
---|
752 | } |
---|
753 | //---------- Hom(J,J) != R: create new ring and map from old ring ------------- |
---|
754 | // the ring newR1/SBid+syzf will be isomorphic to Hom(J,J) as R-module |
---|
755 | // f2=p (i.e. ideal generated by p) |
---|
756 | |
---|
757 | //f = mstd(f)[2]; //### geaendert GMG 04.10.08 |
---|
758 | //ideal ann = quotient(f2,f); //### f durch rf ersetzt |
---|
759 | rf = mstd(rf)[2]; //rf = NF(f,p), hence <p,rf> = <p,f> |
---|
760 | ideal ann = quotient(f2,rf); //p:f = p:rf |
---|
761 | |
---|
762 | //------------- compute the contribution to delta ---------- |
---|
763 | //delt=dim_K(Hom(JJ)/R (or -1 if infinite) |
---|
764 | |
---|
765 | int delt=vdim(std(modulo(f,ideal(p)))); |
---|
766 | |
---|
767 | f = p,rf; // generates pJ:J mod(p), i.e. p*Hom(J,J)/p*R as R-module |
---|
768 | q = size(f); |
---|
769 | syzf = syz(f); |
---|
770 | |
---|
771 | if ( homo==1 ) |
---|
772 | { |
---|
773 | rw1 = rw,0; |
---|
774 | for ( ii=2; ii<=q; ii++ ) |
---|
775 | { |
---|
776 | rw = rw, deg(f[ii])-deg(f[1]); |
---|
777 | rw1 = rw1, deg(f[ii])-deg(f[1]); |
---|
778 | } |
---|
779 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),(a(rw1),dp); |
---|
780 | } |
---|
781 | else |
---|
782 | { |
---|
783 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),dp; |
---|
784 | } |
---|
785 | |
---|
786 | //map psi1 = P,maxideal(1); //### psi1 durch fetch ersetzt |
---|
787 | //ideal SBid = psi1(SBid); |
---|
788 | ideal SBid = fetch(P,SBid); |
---|
789 | attrib(SBid,"isSB",1); |
---|
790 | |
---|
791 | qring newR = std(SBid); |
---|
792 | |
---|
793 | //map psi = R,ideal(X(1..nvars(R))); //### psi durch fetch ersetzt |
---|
794 | //ideal id = psi(id); |
---|
795 | //ideal f = psi(f); |
---|
796 | //module syzf = psi(syzf); |
---|
797 | ideal id = fetch(R,id); |
---|
798 | ideal f = fetch(R,f); |
---|
799 | module syzf = fetch(R,syzf); |
---|
800 | ideal pf,Lin,Quad,Q; |
---|
801 | matrix T,A; |
---|
802 | list L1; |
---|
803 | |
---|
804 | //---------- computation of Hom(J,J) as affine ring --------------------------- |
---|
805 | // determine kernel of: R[T1,...,Tq] -> J:J >-> R[1/p]=R[t]/(t*p-1), |
---|
806 | // Ti -> fi/p -> t*fi (p=f1=f[1]), to get ring structure. This is of course |
---|
807 | // the same as the kernel of R[T1,...,Tq] -> pJ:J >-> R, Ti -> fi. |
---|
808 | // It is a fact, that the kernel is generated by the linear and the quadratic |
---|
809 | // relations |
---|
810 | // f=p,rf, rf=reduce(f,p), generates pJ:J mod(p), |
---|
811 | // i.e. p*Hom(J,J)/p*R as R-module |
---|
812 | |
---|
813 | pf = f[1]*f; |
---|
814 | T = matrix(ideal(T(1..q)),1,q); |
---|
815 | Lin = ideal(T*syzf); |
---|
816 | if(y>=1) |
---|
817 | { |
---|
818 | "// the ring structure of Hom(J,J) as R-algebra"; |
---|
819 | "// the linear relations:"; |
---|
820 | Lin; |
---|
821 | } |
---|
822 | |
---|
823 | poly ff; |
---|
824 | for (ii=2; ii<=q; ii++ ) |
---|
825 | { |
---|
826 | for ( jj=2; jj<=ii; jj++ ) |
---|
827 | { |
---|
828 | ff = NF(f[ii]*f[jj],std(0)); //this makes lift much faster |
---|
829 | A = lift(pf,ff); //ff lin. comb. of elts of pf mod I |
---|
830 | Quad = Quad, ideal(T(jj)*T(ii) - T*A); //quadratic relations |
---|
831 | } |
---|
832 | } |
---|
833 | |
---|
834 | if(y>=1) |
---|
835 | { |
---|
836 | "// the quadratic relations"; |
---|
837 | Quad; |
---|
838 | pause(); |
---|
839 | newline; |
---|
840 | } |
---|
841 | Q = Lin,Quad; |
---|
842 | Q = subst(Q,T(1),1); |
---|
843 | //Q = mstd(Q)[2]; //### sehr aufwendig, daher weggelassen (GMG) |
---|
844 | //### ev das neue interred |
---|
845 | //mstd dient nur zum verkleinern, die SB-Eigenschaft geht spaeter verloren |
---|
846 | //da in neuen Ring abgebildet und mit id vereinigt |
---|
847 | |
---|
848 | //---------- reduce number of variables by substitution, if possible ---------- |
---|
849 | if (homo==1) |
---|
850 | { |
---|
851 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),(a(rw),dp); |
---|
852 | } |
---|
853 | else |
---|
854 | { |
---|
855 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),dp; |
---|
856 | } |
---|
857 | |
---|
858 | ideal endid = imap(newR,id),imap(newR,Q); |
---|
859 | //hier wird Q weiterverwendet, die SB-Eigenschaft wird nicht verwendet. |
---|
860 | endid = simplify(endid,2); |
---|
861 | ideal endphi = ideal(X(1..nvars(R))); |
---|
862 | |
---|
863 | |
---|
864 | if(noRed == 0) |
---|
865 | { |
---|
866 | L = substpart(endid,endphi,homo,rw); |
---|
867 | def lastRing=L[1]; |
---|
868 | setring lastRing; |
---|
869 | //return(lastRing); |
---|
870 | } |
---|
871 | else |
---|
872 | { |
---|
873 | list RL = ringlist(newRing); |
---|
874 | def lastRing = ring(RL); |
---|
875 | setring lastRing; |
---|
876 | ideal endid = fetch(newRing, endid); |
---|
877 | ideal endphi = fetch(newRing, endphi); |
---|
878 | export(endid); |
---|
879 | export(endphi); |
---|
880 | //def lastRing = newRing; |
---|
881 | //setring R; |
---|
882 | //return(newR); |
---|
883 | } |
---|
884 | |
---|
885 | |
---|
886 | // L = substpart(endid,endphi,homo,rw); |
---|
887 | |
---|
888 | // def lastRing=L[1]; |
---|
889 | // setring lastRing; |
---|
890 | |
---|
891 | attrib(endid,"onlySingularAtZero",0); |
---|
892 | map sigma=R,endphi; |
---|
893 | ideal an=sigma(ann); |
---|
894 | export(an); //noetig? |
---|
895 | //ideal te=an,endid; |
---|
896 | //if(isIso && (size(reduce(te,std(maxideal(1))))==0)) //#### ok??? |
---|
897 | // { |
---|
898 | // attrib(endid,"onlySingularAtZero",oSAZ); |
---|
899 | // } |
---|
900 | //kill te; |
---|
901 | attrib(endid,"isCohenMacaulay",isCo); //#### ok??? |
---|
902 | attrib(endid,"isPrim",isPr); |
---|
903 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
904 | attrib(endid,"isRegInCodim2",isRe); |
---|
905 | attrib(endid,"isEquidimensional",isEq); |
---|
906 | attrib(endid,"isHypersurface",0); |
---|
907 | attrib(endid,"isCompleteIntersection",0); |
---|
908 | attrib(endid,"isRadical",0); |
---|
909 | if(y>=1) |
---|
910 | { |
---|
911 | "// the new ring after reduction of the number of variables"; |
---|
912 | lastRing; |
---|
913 | "// the new ideal"; |
---|
914 | endid; ""; |
---|
915 | "// the old ring"; |
---|
916 | P; |
---|
917 | "// the old ideal"; |
---|
918 | setring P; |
---|
919 | id; |
---|
920 | " "; |
---|
921 | setring lastRing; |
---|
922 | "// the map to the new ring"; |
---|
923 | endphi; |
---|
924 | " "; |
---|
925 | pause(); |
---|
926 | ""; |
---|
927 | } |
---|
928 | L = lastRing; |
---|
929 | L = insert(L,0,1); |
---|
930 | L[3] = delt; |
---|
931 | setring(P); |
---|
932 | return(L); |
---|
933 | } |
---|
934 | example |
---|
935 | {"EXAMPLE:"; echo = 2; |
---|
936 | ring r = 0,(x,y),wp(2,3); |
---|
937 | ideal id = y^2-x^3; |
---|
938 | ideal J = x,y; |
---|
939 | poly p = x; |
---|
940 | list Li = std(id),id,J,p; |
---|
941 | list L = HomJJ(Li); |
---|
942 | def end = L[1]; // defines ring L[1], containing ideals endid, endphi |
---|
943 | setring end; // makes end the basering |
---|
944 | end; |
---|
945 | endid; // end/endid is isomorphic to End(r/id) as ring |
---|
946 | map psi = r,endphi;// defines the canonical map r/id -> End(r/id) |
---|
947 | psi; |
---|
948 | L[3]; // contribution to delta |
---|
949 | } |
---|
950 | |
---|
951 | |
---|
952 | /////////////////////////////////////////////////////////////////////////////// |
---|
953 | //compute intersection multiplicities as needed for delta(I) in |
---|
954 | //normalizationPrimes and normalP: |
---|
955 | |
---|
956 | proc iMult (list prim) |
---|
957 | "USAGE: iMult(L); L a list of ideals |
---|
958 | RETURN: int, the intersection multiplicity of the ideals of L; |
---|
959 | if iMult(L) is infinite, -1 is returned. |
---|
960 | THEORY: If r=size(L)=2 then iMult(L) = vdim(std(L[1]+L[2])) and in general |
---|
961 | iMult(L) = sum{ iMult(L[j],Lj) | j=1..r-1 } with Lj the intersection |
---|
962 | of L[j+1],...,L[r]. If I is the intersection of all ideals in L then |
---|
963 | we have delta(I) = delta(L[1])+...+delta(L[r]) + iMult(L) where |
---|
964 | delta(I) = vdim (normalisation(R/I)/(R/I)), R the basering. |
---|
965 | EXAMPLE: example iMult; shows an example |
---|
966 | " |
---|
967 | { |
---|
968 | ASSUME(0, not isQuotientRing(basering) ); |
---|
969 | |
---|
970 | int i,mul,mu; |
---|
971 | int sp = size(prim); |
---|
972 | int y = printlevel-voice+2; |
---|
973 | if ( sp > 1 ) |
---|
974 | { |
---|
975 | ideal I(sp-1) = prim[sp]; |
---|
976 | mu = vdim(std(I(sp-1)+prim[sp-1])); |
---|
977 | mul = mu; |
---|
978 | if ( y>=1 ) |
---|
979 | { |
---|
980 | "// intersection multiplicity of component",sp,"with",sp-1,":"; mu; |
---|
981 | } |
---|
982 | if ( mu >= 0 ) |
---|
983 | { |
---|
984 | for (i=sp-2; i>=1 ; i--) |
---|
985 | { |
---|
986 | ideal I(i) = intersect(I(i+1),prim[i+1]); |
---|
987 | mu = vdim(std(I(i)+prim[i])); |
---|
988 | if ( mu < 0 ) |
---|
989 | { |
---|
990 | break; |
---|
991 | } |
---|
992 | mul = mul + mu; |
---|
993 | if ( y>=1 ) |
---|
994 | { |
---|
995 | "// intersection multiplicity of components",sp,"...",i+1,"with",i; mu; |
---|
996 | } |
---|
997 | } |
---|
998 | } |
---|
999 | } |
---|
1000 | return(mul); |
---|
1001 | } |
---|
1002 | example |
---|
1003 | { "EXAMPLE:"; echo = 2; |
---|
1004 | ring s = 23,(x,y),dp; |
---|
1005 | list L = (x-y),(x3+y2); |
---|
1006 | iMult(L); |
---|
1007 | L = (x-y),(x3+y2),(x3-y4); |
---|
1008 | iMult(L); |
---|
1009 | } |
---|
1010 | /////////////////////////////////////////////////////////////////////////////// |
---|
1011 | //check if I has a singularity only at zero, as needed in normalizationPrimes |
---|
1012 | |
---|
1013 | proc locAtZero (ideal I) |
---|
1014 | "USAGE: locAtZero(I); I = ideal |
---|
1015 | RETURN: int, 1 if I has only one point which is located at zero, 0 otherwise |
---|
1016 | ASSUME: I is given as a standard bases in the basering |
---|
1017 | NOTE: only useful in affine rings, in local rings vdim does the check |
---|
1018 | EXAMPLE: example locAtZero; shows an example |
---|
1019 | " |
---|
1020 | { |
---|
1021 | ASSUME(0, not isQuotientRing(basering) ); |
---|
1022 | |
---|
1023 | int ii,jj, caz; //caz: conzentrated at zero |
---|
1024 | int dbp = printlevel-voice+2; |
---|
1025 | int nva = nvars(basering); |
---|
1026 | int vdi = vdim(I); |
---|
1027 | if ( vdi < 0 ) |
---|
1028 | { |
---|
1029 | if (dbp >=1) |
---|
1030 | { "// non-isolated singularitiy";""; } |
---|
1031 | return(caz); |
---|
1032 | } |
---|
1033 | |
---|
1034 | //Now the ideal is 0-dim |
---|
1035 | //First an easy test |
---|
1036 | //If I is homogenous and not constant it is concentrated at 0 |
---|
1037 | if( homog(I)==1 && size(jet(I,0))==0) |
---|
1038 | { |
---|
1039 | caz=1; |
---|
1040 | if (dbp >=1) |
---|
1041 | { "// isolated singularity and homogeneous";""; } |
---|
1042 | return(caz); |
---|
1043 | } |
---|
1044 | |
---|
1045 | //Now the general case with I 0-dim. Choose an appropriate power pot, |
---|
1046 | //and check each variable x whether x^pot is in I. |
---|
1047 | int mi1 = mindeg1(lead(I)); |
---|
1048 | int pot = vdi; |
---|
1049 | if ( (mi1+(mi1==1))^2 < vdi ) |
---|
1050 | { |
---|
1051 | pot = (mi1+(mi1==1))^2; //### alternativ: pot = vdi lassen |
---|
1052 | } |
---|
1053 | |
---|
1054 | while ( 1 ) |
---|
1055 | { |
---|
1056 | caz = 1; |
---|
1057 | for ( ii=1; ii<= nva; ii++ ) |
---|
1058 | { |
---|
1059 | if ( NF(var(ii)^pot,I) != 0 ) |
---|
1060 | { |
---|
1061 | caz = 0; break; |
---|
1062 | } |
---|
1063 | } |
---|
1064 | if ( caz == 1 || pot >= vdi ) |
---|
1065 | { |
---|
1066 | if (dbp >=1) |
---|
1067 | { |
---|
1068 | "// mindeg, exponent, vdim used in 'locAtZero':", mi1,pot,vdi; ""; |
---|
1069 | } |
---|
1070 | return(caz); |
---|
1071 | } |
---|
1072 | else |
---|
1073 | { |
---|
1074 | if ( pot^2 < vdi ) |
---|
1075 | { pot = pot^2; } |
---|
1076 | else |
---|
1077 | { pot = vdi; } |
---|
1078 | } |
---|
1079 | } |
---|
1080 | } |
---|
1081 | example |
---|
1082 | { "EXAMPLE:"; echo = 2; |
---|
1083 | ring r = 0,(x,y,z),dp; |
---|
1084 | poly f = z5+y4+x3+xyz; |
---|
1085 | ideal i = jacob(f),f; |
---|
1086 | i=std(i); |
---|
1087 | locAtZero(i); |
---|
1088 | i= std(i*ideal(x-1,y,z)); |
---|
1089 | locAtZero(i); |
---|
1090 | } |
---|
1091 | |
---|
1092 | /////////////////////////////////////////////////////////////////////////////// |
---|
1093 | |
---|
1094 | //The next procedure normalizationPrimes computes the normalization of an |
---|
1095 | //irreducible or an equidimensional ideal i. |
---|
1096 | //- If i is irreducuble, then the returned list, say nor, has size 2 |
---|
1097 | //with nor[1] the normalization ring and nor[2] the delta invariant. |
---|
1098 | //- If i is equidimensional, than the "splitting tools" can create a |
---|
1099 | //decomposition of i and nor can have more than 1 ring. |
---|
1100 | |
---|
1101 | static proc normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #) |
---|
1102 | "USAGE: normalizationPrimes(i,ihp,delt[,si]); i = equidimensional ideal, |
---|
1103 | ihp = map (partial normalization), delt = partial delta-invariant, |
---|
1104 | si = ideal s.t. V(si) contains singular locus (optional) |
---|
1105 | RETURN: a list of rings, say nor, and an integer, the delta-invariant |
---|
1106 | at the end of the list. |
---|
1107 | each ring nor[j], j = 1..size(nor)-1, contains two ideals |
---|
1108 | with given names norid and normap such that |
---|
1109 | - the direct sum of the rings nor[j]/norid is |
---|
1110 | the normalization of basering/i; |
---|
1111 | - normap gives the normalization map from basering/id |
---|
1112 | to nor[j]/norid (for each j) |
---|
1113 | nor[size(nor)] = dim_K(normalisation(P/i) / (P/i)) is the |
---|
1114 | delta-invariant, where P is the basering. |
---|
1115 | EXAMPLE: example normalizationPrimes; shows an example |
---|
1116 | " |
---|
1117 | { |
---|
1118 | ASSUME(1, not isQuotientRing(basering) ); |
---|
1119 | //Note: this procedure calls itself as long as the test for |
---|
1120 | //normality, i.e if R==Hom(J,J), is negative. |
---|
1121 | |
---|
1122 | int printlev = printlevel; //store printlevel in order to reset it later |
---|
1123 | int y = printlevel-voice+2; // y=printlevel (default: y=0) |
---|
1124 | if(y>=1) |
---|
1125 | { |
---|
1126 | ""; |
---|
1127 | "// START a normalization loop with the ideal"; |
---|
1128 | i; ""; |
---|
1129 | "// in the ring:"; |
---|
1130 | basering; ""; |
---|
1131 | pause(); |
---|
1132 | ""; |
---|
1133 | } |
---|
1134 | |
---|
1135 | def BAS=basering; |
---|
1136 | list result,keepresult1,keepresult2,JM,gnirlist; |
---|
1137 | ideal J,SB,MB; |
---|
1138 | int depth,lauf,prdim,osaz; |
---|
1139 | int ti=timer; |
---|
1140 | |
---|
1141 | gnirlist = ringlist(BAS); |
---|
1142 | |
---|
1143 | //----------- the trivial case of a zero ideal as input, RETURN ------------ |
---|
1144 | if(size(i)==0) |
---|
1145 | { |
---|
1146 | if(y>=1) |
---|
1147 | { |
---|
1148 | "// the ideal was the zero-ideal"; |
---|
1149 | } |
---|
1150 | def newR7 = ring(gnirlist); |
---|
1151 | setring newR7; |
---|
1152 | ideal norid=ideal(0); |
---|
1153 | ideal normap=fetch(BAS,ihp); |
---|
1154 | export norid; |
---|
1155 | export normap; |
---|
1156 | result=newR7; |
---|
1157 | result[size(result)+1]=list(delt,delti); |
---|
1158 | setring BAS; |
---|
1159 | return(result); |
---|
1160 | } |
---|
1161 | |
---|
1162 | //--------------- General NOTATION, compute SB of input ----------------- |
---|
1163 | // SM is a list, the result of mstd(i) |
---|
1164 | // SM[1] = SB of input ideal i, |
---|
1165 | // SM[2] = (minimal) generators for i. |
---|
1166 | // We work with SM and will copy the attributes from i to SM[2] |
---|
1167 | // JM will be a list, either JM[1]=maxideal(1),JM[2]=maxideal(1) |
---|
1168 | // in case i has onlySingularAtZero, or JM = mstd(si) where si = #[1], |
---|
1169 | // or JM = mstd(J) where J is the ideal of the singular locus |
---|
1170 | // JM[2] must be (made) radical |
---|
1171 | |
---|
1172 | if(y>=1) |
---|
1173 | { |
---|
1174 | "// SB-computation of the ideal"; |
---|
1175 | } |
---|
1176 | |
---|
1177 | list SM = mstd(i); //Now the work starts |
---|
1178 | int dimSM = dim(SM[1]); //dimension of variety to normalize |
---|
1179 | if(y>=1) |
---|
1180 | { |
---|
1181 | "// the dimension is:"; dimSM; |
---|
1182 | } |
---|
1183 | //----------------- the general case, set attributes ---------------- |
---|
1184 | //Note: onlySingularAtZero is NOT preserved under the ring extension |
---|
1185 | //basering --> Hom(J,J) (in contrast to isIsolatedSingularity), |
---|
1186 | //therefore we reset it: |
---|
1187 | |
---|
1188 | attrib(i,"onlySingularAtZero",0); |
---|
1189 | |
---|
1190 | if(attrib(i,"isPrim")==1) |
---|
1191 | { |
---|
1192 | attrib(SM[2],"isPrim",1); |
---|
1193 | } |
---|
1194 | else |
---|
1195 | { |
---|
1196 | attrib(SM[2],"isPrim",0); |
---|
1197 | } |
---|
1198 | if(attrib(i,"isIsolatedSingularity")==1) |
---|
1199 | { |
---|
1200 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
1201 | } |
---|
1202 | else |
---|
1203 | { |
---|
1204 | attrib(SM[2],"isIsolatedSingularity",0); |
---|
1205 | } |
---|
1206 | if(attrib(i,"isCohenMacaulay")==1) |
---|
1207 | { |
---|
1208 | attrib(SM[2],"isCohenMacaulay",1); |
---|
1209 | } |
---|
1210 | else |
---|
1211 | { |
---|
1212 | attrib(SM[2],"isCohenMacaulay",0); |
---|
1213 | } |
---|
1214 | if(attrib(i,"isRegInCodim2")==1) |
---|
1215 | { |
---|
1216 | attrib(SM[2],"isRegInCodim2",1); |
---|
1217 | } |
---|
1218 | else |
---|
1219 | { |
---|
1220 | attrib(SM[2],"isRegInCodim2",0); |
---|
1221 | } |
---|
1222 | if(attrib(i,"isEquidimensional")==1) |
---|
1223 | { |
---|
1224 | attrib(SM[2],"isEquidimensional",1); |
---|
1225 | } |
---|
1226 | else |
---|
1227 | { |
---|
1228 | attrib(SM[2],"isEquidimensional",0); |
---|
1229 | } |
---|
1230 | if(attrib(i,"isCompleteIntersection")==1) |
---|
1231 | { |
---|
1232 | attrib(SM[2],"isCompleteIntersection",1); |
---|
1233 | } |
---|
1234 | else |
---|
1235 | { |
---|
1236 | attrib(SM[2],"isCompleteIntersection",0); |
---|
1237 | } |
---|
1238 | if(attrib(i,"isHypersurface")==1) |
---|
1239 | { |
---|
1240 | attrib(SM[2],"isHypersurface",1); |
---|
1241 | } |
---|
1242 | else |
---|
1243 | { |
---|
1244 | attrib(SM[2],"isHypersurface",0); |
---|
1245 | } |
---|
1246 | |
---|
1247 | if(attrib(i,"onlySingularAtZero")==1) |
---|
1248 | { |
---|
1249 | attrib(SM[2],"onlySingularAtZero",1); |
---|
1250 | } |
---|
1251 | else |
---|
1252 | { |
---|
1253 | attrib(SM[2],"onlySingularAtZero",0); |
---|
1254 | } |
---|
1255 | |
---|
1256 | //------- an easy and cheap test for onlySingularAtZero --------- |
---|
1257 | if( (attrib(SM[2],"isIsolatedSingularity")==1) && (homog(SM[2])==1) ) |
---|
1258 | { |
---|
1259 | attrib(SM[2],"onlySingularAtZero",1); |
---|
1260 | } |
---|
1261 | |
---|
1262 | //-------------------- Trivial cases, in each case RETURN ------------------ |
---|
1263 | // input ideal is the ideal of a partial normalization |
---|
1264 | |
---|
1265 | // ------------ Trivial case: input ideal contains a unit --------------- |
---|
1266 | if( dimSM == -1) |
---|
1267 | { ""; |
---|
1268 | " // A unit ideal was found."; |
---|
1269 | " // Stop with partial result computed so far";""; |
---|
1270 | |
---|
1271 | MB=SM[2]; |
---|
1272 | intvec rw; |
---|
1273 | list LL=substpart(MB,ihp,0,rw); |
---|
1274 | def newR6=LL[1]; |
---|
1275 | setring newR6; |
---|
1276 | ideal norid=endid; |
---|
1277 | ideal normap=endphi; |
---|
1278 | kill endid,endphi; |
---|
1279 | export norid; |
---|
1280 | export normap; |
---|
1281 | result=newR6; |
---|
1282 | result[size(result)+1]=list(delt,delti); |
---|
1283 | setring BAS; |
---|
1284 | return(result); |
---|
1285 | } |
---|
1286 | |
---|
1287 | // --- Trivial case: input ideal is zero-dimensional and homog --- |
---|
1288 | if( (dim(SM[1])==0) && (homog(SM[2])==1) ) |
---|
1289 | { |
---|
1290 | if(y>=1) |
---|
1291 | { |
---|
1292 | "// the ideal was zero-dimensional and homogeneous"; |
---|
1293 | } |
---|
1294 | MB=maxideal(1); |
---|
1295 | intvec rw; |
---|
1296 | list LL=substpart(MB,ihp,0,rw); |
---|
1297 | def newR5=LL[1]; |
---|
1298 | setring newR5; |
---|
1299 | ideal norid=endid; |
---|
1300 | ideal normap=endphi; |
---|
1301 | kill endid,endphi; |
---|
1302 | export norid; |
---|
1303 | export normap; |
---|
1304 | result=newR5; |
---|
1305 | result[size(result)+1]=list(delt,delti); |
---|
1306 | setring BAS; |
---|
1307 | return(result); |
---|
1308 | } |
---|
1309 | |
---|
1310 | // --- Trivial case: input ideal defines a line --- |
---|
1311 | //the one-dimensional, homogeneous case and degree 1 case |
---|
1312 | if( (dim(SM[1])==1) && (maxdeg1(SM[2])==1) && (homog(SM[2])==1) ) |
---|
1313 | { |
---|
1314 | if(y>=1) |
---|
1315 | { |
---|
1316 | "// the ideal defines a line"; |
---|
1317 | } |
---|
1318 | MB=SM[2]; |
---|
1319 | intvec rw; |
---|
1320 | list LL=substpart(MB,ihp,0,rw); |
---|
1321 | def newR4=LL[1]; |
---|
1322 | setring newR4; |
---|
1323 | ideal norid=endid; |
---|
1324 | ideal normap=endphi; |
---|
1325 | kill endid,endphi; |
---|
1326 | export norid; |
---|
1327 | export normap; |
---|
1328 | result=newR4; |
---|
1329 | result[size(result)+1]=list(delt,delti); |
---|
1330 | setring BAS; |
---|
1331 | return(result); |
---|
1332 | } |
---|
1333 | |
---|
1334 | //---------------------- The non-trivial cases start ------------------- |
---|
1335 | //the higher dimensional case |
---|
1336 | //we test first hypersurface, CohenMacaulay and complete intersection |
---|
1337 | |
---|
1338 | if( ((size(SM[2])+dim(SM[1])) == nvars(basering)) ) |
---|
1339 | { |
---|
1340 | //the test for complete intersection |
---|
1341 | attrib(SM[2],"isCohenMacaulay",1); |
---|
1342 | attrib(SM[2],"isCompleteIntersection",1); |
---|
1343 | attrib(SM[2],"isEquidimensional",1); |
---|
1344 | if(y>=1) |
---|
1345 | { |
---|
1346 | "// the ideal is a complete intersection"; |
---|
1347 | } |
---|
1348 | } |
---|
1349 | if( size(SM[2]) == 1 ) |
---|
1350 | { |
---|
1351 | attrib(SM[2],"isHypersurface",1); |
---|
1352 | if(y>=1) |
---|
1353 | { |
---|
1354 | "// the ideal is a hypersurface"; |
---|
1355 | } |
---|
1356 | } |
---|
1357 | |
---|
1358 | //------------------- compute the singular locus ------------------- |
---|
1359 | // Computation if singular locus is critical |
---|
1360 | // Notation: J ideal of singular locus or (if given) containing it |
---|
1361 | // JM = mstd(J) or maxideal(1),maxideal(1) |
---|
1362 | // JM[1] SB of singular locus, JM[2] minbasis, dimJ = dim(JM[1]) |
---|
1363 | // SM[1] SB of the input ideal i, SM[2] minbasis |
---|
1364 | // Computation if singular locus is critical, because it determines the |
---|
1365 | // size of the ring Hom_R(J,J). We only need a test ideal contained in J. |
---|
1366 | |
---|
1367 | //----------------------- onlySingularAtZero ------------------------- |
---|
1368 | if( attrib(SM[2],"onlySingularAtZero") ) |
---|
1369 | { |
---|
1370 | JM = maxideal(1),maxideal(1); |
---|
1371 | attrib(JM[1],"isSB",1); |
---|
1372 | attrib(JM[2],"isRadical",1); |
---|
1373 | if( dim(SM[1]) >=2 ) |
---|
1374 | { |
---|
1375 | attrib(SM[2],"isRegInCodim2",1); |
---|
1376 | } |
---|
1377 | } |
---|
1378 | |
---|
1379 | //-------------------- not onlySingularAtZero ------------------------- |
---|
1380 | if( attrib(SM[2],"onlySingularAtZero") == 0 ) |
---|
1381 | { |
---|
1382 | //--- the case where an ideal #[1] is given: |
---|
1383 | if( size(#)>0 ) |
---|
1384 | { |
---|
1385 | J = #[1],SM[2]; |
---|
1386 | JM = mstd(J); |
---|
1387 | if( typeof(attrib(#[1],"isRadical"))!="int" ) |
---|
1388 | { |
---|
1389 | attrib(JM[2],"isRadical",0); |
---|
1390 | } |
---|
1391 | } |
---|
1392 | |
---|
1393 | //--- the case where an ideal #[1] is not given: |
---|
1394 | if( (size(#)==0) ) |
---|
1395 | { |
---|
1396 | if(y >=1 ) |
---|
1397 | { |
---|
1398 | "// singular locus will be computed"; |
---|
1399 | } |
---|
1400 | |
---|
1401 | J = SM[1],minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]); |
---|
1402 | if( y >=1 ) |
---|
1403 | { |
---|
1404 | "// SB of singular locus will be computed"; |
---|
1405 | } |
---|
1406 | JM = mstd(J); |
---|
1407 | } |
---|
1408 | |
---|
1409 | int dimJ = dim(JM[1]); |
---|
1410 | attrib(JM[1],"isSB",1); |
---|
1411 | if( y>=1 ) |
---|
1412 | { |
---|
1413 | "// the dimension of the singular locus is"; dimJ ; ""; |
---|
1414 | } |
---|
1415 | |
---|
1416 | if(dim(JM[1]) <= dim(SM[1])-2) |
---|
1417 | { |
---|
1418 | attrib(SM[2],"isRegInCodim2",1); |
---|
1419 | } |
---|
1420 | |
---|
1421 | //------------------ the smooth case, RETURN ------------------- |
---|
1422 | if( dimJ == -1 ) |
---|
1423 | { |
---|
1424 | if(y>=1) |
---|
1425 | { |
---|
1426 | "// the ideal is smooth"; |
---|
1427 | } |
---|
1428 | MB=SM[2]; |
---|
1429 | intvec rw; |
---|
1430 | list LL=substpart(MB,ihp,0,rw); |
---|
1431 | def newR3=LL[1]; |
---|
1432 | setring newR3; |
---|
1433 | ideal norid=endid; |
---|
1434 | ideal normap=endphi; |
---|
1435 | kill endid,endphi; |
---|
1436 | export norid; |
---|
1437 | export normap; |
---|
1438 | result=newR3; |
---|
1439 | result[size(result)+1]=list(delt,delti); |
---|
1440 | setring BAS; |
---|
1441 | return(result); |
---|
1442 | } |
---|
1443 | |
---|
1444 | //------- extra check for onlySingularAtZero, relatively cheap ---------- |
---|
1445 | //it uses the procedure 'locAtZero' from for testing |
---|
1446 | //if an ideal is concentrated at 0 |
---|
1447 | if(y>=1) |
---|
1448 | { |
---|
1449 | "// extra test for onlySingularAtZero:"; |
---|
1450 | } |
---|
1451 | if ( locAtZero(JM[1]) ) |
---|
1452 | { |
---|
1453 | attrib(SM[2],"onlySingularAtZero",1); |
---|
1454 | JM = maxideal(1),maxideal(1); |
---|
1455 | attrib(JM[1],"isSB",1); |
---|
1456 | attrib(JM[2],"isRadical",1); |
---|
1457 | } |
---|
1458 | else |
---|
1459 | { |
---|
1460 | attrib(SM[2],"onlySingularAtZero",0); |
---|
1461 | } |
---|
1462 | } |
---|
1463 | |
---|
1464 | //displaying the attributes: |
---|
1465 | if(y>=2) |
---|
1466 | { |
---|
1467 | "// the attributes of the ideal are:"; |
---|
1468 | "// isCohenMacaulay:", attrib(SM[2],"isCohenMacaulay"); |
---|
1469 | "// isCompleteIntersection:", attrib(SM[2],"isCompleteIntersection"); |
---|
1470 | "// isHypersurface:", attrib(SM[2],"isHypersurface"); |
---|
1471 | "// isEquidimensional:", attrib(SM[2],"isEquidimensional"); |
---|
1472 | "// isPrim:", attrib(SM[2],"isPrim"); |
---|
1473 | "// isRegInCodim2:", attrib(SM[2],"isRegInCodim2"); |
---|
1474 | "// isIsolatedSingularity:", attrib(SM[2],"isIsolatedSingularity"); |
---|
1475 | "// onlySingularAtZero:", attrib(SM[2],"onlySingularAtZero"); |
---|
1476 | "// isRad:", attrib(SM[2],"isRad");""; |
---|
1477 | } |
---|
1478 | |
---|
1479 | //------------- case: CohenMacaulay in codim 2, RETURN --------------- |
---|
1480 | if( (attrib(SM[2],"isRegInCodim2")==1) && |
---|
1481 | (attrib(SM[2],"isCohenMacaulay")==1) ) |
---|
1482 | { |
---|
1483 | if(y>=1) |
---|
1484 | { |
---|
1485 | "// the ideal was CohenMacaulay and regular in codim 2, hence normal"; |
---|
1486 | } |
---|
1487 | MB=SM[2]; |
---|
1488 | intvec rw; |
---|
1489 | list LL=substpart(MB,ihp,0,rw); |
---|
1490 | def newR6=LL[1]; |
---|
1491 | setring newR6; |
---|
1492 | ideal norid=endid; |
---|
1493 | ideal normap=endphi; |
---|
1494 | kill endid,endphi; |
---|
1495 | export norid; |
---|
1496 | export normap; |
---|
1497 | result=newR6; |
---|
1498 | result[size(result)+1]=list(delt,delti); |
---|
1499 | setring BAS; |
---|
1500 | return(result); |
---|
1501 | } |
---|
1502 | |
---|
1503 | //---------- case: isolated singularity only at 0, RETURN ------------ |
---|
1504 | // In this case things are easier, we can use the maximal ideal as radical |
---|
1505 | // of the singular locus; |
---|
1506 | // JM mstd of ideal of singular locus, SM mstd of input ideal |
---|
1507 | |
---|
1508 | if( attrib(SM[2],"onlySingularAtZero") ) |
---|
1509 | { |
---|
1510 | //------ check variables for being a non zero-divizor ------ |
---|
1511 | // SL = ideal of vars not contained in ideal SM[1]: |
---|
1512 | |
---|
1513 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
1514 | ideal SL = simplify(reduce(maxideal(1),SM[1]),2); |
---|
1515 | ideal Ann = quotient(SM[2],SL[1]); |
---|
1516 | ideal qAnn = simplify(reduce(Ann,SM[1]),2); |
---|
1517 | //NOTE: qAnn=0 if and only if first var (=SL[1]) not in SM is a nzd of R/SM |
---|
1518 | |
---|
1519 | //------------- We found a non-zerodivisor of R/SM ----------------------- |
---|
1520 | // here the enlarging of the ring via Hom_R(J,J) starts |
---|
1521 | |
---|
1522 | if( size(qAnn)==0 ) |
---|
1523 | { |
---|
1524 | if(y>=1) |
---|
1525 | { |
---|
1526 | ""; |
---|
1527 | "// the ideal rad(J):"; maxideal(1); |
---|
1528 | ""; |
---|
1529 | } |
---|
1530 | |
---|
1531 | // ------------- test for normality, compute Hom_R(J,J) ------------- |
---|
1532 | // Note: |
---|
1533 | // HomJJ (ideal SBid, ideal id, ideal J, poly p) with |
---|
1534 | // SBid = SB of id, J = radical ideal of basering P with: |
---|
1535 | // nonNormal(R) is in V(J), J contains the nonzero divisor p |
---|
1536 | // of R = P/id (J = test ideal) |
---|
1537 | // returns a list l of three objects |
---|
1538 | // l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi' |
---|
1539 | // s.t. l[1]/endid = Hom_R(J,J) and endphi= map R -> Hom_R(J,J) |
---|
1540 | // l[2] : an integer which is 1 if phi is an isomorphism, 0 if not |
---|
1541 | // l[3] : an integer, = dim_K(Hom_R(J,J)/R) if finite, -1 otherwise |
---|
1542 | |
---|
1543 | list RR; |
---|
1544 | RR = SM[1],SM[2],maxideal(1),SL[1]; |
---|
1545 | RR = HomJJ(RR,y); |
---|
1546 | // --------------------- non-normal case ------------------ |
---|
1547 | //RR[2]==0 means that the test for normality is negative |
---|
1548 | if( RR[2]==0 ) |
---|
1549 | { |
---|
1550 | def newR=RR[1]; |
---|
1551 | setring newR; |
---|
1552 | map psi=BAS,endphi; |
---|
1553 | list JM = psi(JM); //### |
---|
1554 | ideal J = JM[2]; |
---|
1555 | if ( delt>=0 && RR[3]>=0 ) |
---|
1556 | { |
---|
1557 | delt = delt+RR[3]; |
---|
1558 | } |
---|
1559 | else |
---|
1560 | { delt = -1; } |
---|
1561 | delti[size(delti)]=delt; |
---|
1562 | |
---|
1563 | // ---------- recursive call of normalizationPrimes ----------- |
---|
1564 | //normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #) |
---|
1565 | //ihp = (partial) normalisation map from basering |
---|
1566 | //#[1] ideal s.t. V(#[1]) contains singular locus of i (test ideal) |
---|
1567 | |
---|
1568 | if ( y>=1 ) |
---|
1569 | { |
---|
1570 | "// case: onlySingularAtZero, non-zerodivisor found"; |
---|
1571 | "// contribution of delta in ringextension R -> Hom_R(J,J):"; delt; |
---|
1572 | } |
---|
1573 | |
---|
1574 | //intvec atr=getAttrib(endid); |
---|
1575 | //"//### case: isolated singularity only at 0, recursive"; |
---|
1576 | //"size endid:", size(endid), size(string(endid)); |
---|
1577 | //"interred:"; |
---|
1578 | //endid = interred(endid); |
---|
1579 | //endid = setAttrib(endid,atr); |
---|
1580 | //"size endid:", size(endid), size(string(endid)); |
---|
1581 | |
---|
1582 | printlevel=printlevel+1; |
---|
1583 | list tluser = |
---|
1584 | normalizationPrimes(endid,psi(ihp),delt,delti); |
---|
1585 | //list tluser = |
---|
1586 | // normalizationPrimes(endid,psi(ihp),delt,delti,J); |
---|
1587 | //#### ??? improvement: give also the old ideal of sing locus??? |
---|
1588 | |
---|
1589 | printlevel = printlev; //reset printlevel |
---|
1590 | setring BAS; |
---|
1591 | return(tluser); |
---|
1592 | } |
---|
1593 | |
---|
1594 | // ------------------ the normal case, RETURN ----------------- |
---|
1595 | // Now RR[2] must be 1, hence the test for normality was positive |
---|
1596 | MB=SM[2]; |
---|
1597 | def newR7 = ring(gnirlist); |
---|
1598 | setring newR7; |
---|
1599 | ideal norid=fetch(BAS,MB); |
---|
1600 | ideal normap=fetch(BAS,ihp); |
---|
1601 | if ( delt>=0 && RR[3]>=0 ) |
---|
1602 | { |
---|
1603 | delt = delt+RR[3]; |
---|
1604 | } |
---|
1605 | else |
---|
1606 | { delt = -1; } |
---|
1607 | delti[size(delti)]=delt; |
---|
1608 | |
---|
1609 | intvec atr = getAttrib(norid); |
---|
1610 | |
---|
1611 | //"//### case: isolated singularity only at 0, final"; |
---|
1612 | //"size norid:", size(norid), size(string(norid)); |
---|
1613 | //"interred:"; |
---|
1614 | //norid = interred(norid); |
---|
1615 | //norid = setAttrib(norid,atr); |
---|
1616 | //"size norid:", size(norid), size(string(norid)); |
---|
1617 | |
---|
1618 | export norid; |
---|
1619 | export normap; |
---|
1620 | result=newR7; |
---|
1621 | result[size(result)+1]=list(delt,delti); |
---|
1622 | setring BAS; |
---|
1623 | return(result); |
---|
1624 | } |
---|
1625 | |
---|
1626 | //------ zerodivisor of R/SM was found, gives a splitting ------------ |
---|
1627 | //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM |
---|
1628 | //and we have found a splitting: id and id1 |
---|
1629 | //id = Ann defines components of R/SM in the complement of V(SL[1]) |
---|
1630 | //id1 defines components of R/SM in the complement of V(id) |
---|
1631 | |
---|
1632 | else |
---|
1633 | { |
---|
1634 | ideal id = Ann; |
---|
1635 | attrib(id,"isCohenMacaulay",0); |
---|
1636 | attrib(id,"isPrim",0); |
---|
1637 | attrib(id,"isIsolatedSingularity",1); |
---|
1638 | attrib(id,"isRegInCodim2",0); |
---|
1639 | attrib(id,"isHypersurface",0); |
---|
1640 | attrib(id,"isCompleteIntersection",0); |
---|
1641 | attrib(id,"isEquidimensional",0); |
---|
1642 | attrib(id,"onlySingularAtZero",1); |
---|
1643 | |
---|
1644 | ideal id1 = quotient(SM[2],Ann); |
---|
1645 | attrib(id1,"isCohenMacaulay",0); |
---|
1646 | attrib(id1,"isPrim",0); |
---|
1647 | attrib(id1,"isIsolatedSingularity",1); |
---|
1648 | attrib(id1,"isRegInCodim2",0); |
---|
1649 | attrib(id1,"isHypersurface",0); |
---|
1650 | attrib(id1,"isCompleteIntersection",0); |
---|
1651 | attrib(id1,"isEquidimensional",0); |
---|
1652 | attrib(id1,"onlySingularAtZero",1); |
---|
1653 | |
---|
1654 | // ---------- recursive call of normalizationPrimes ----------- |
---|
1655 | if ( y>=1 ) |
---|
1656 | { |
---|
1657 | "// case: onlySingularAtZero, zerodivisor found, splitting:"; |
---|
1658 | "// total delta before splitting:", delt; |
---|
1659 | "// splitting in two components:"; |
---|
1660 | } |
---|
1661 | |
---|
1662 | printlevel = printlevel+1; //to see comments in normalizationPrimes |
---|
1663 | keepresult1 = normalizationPrimes(id,ihp,0,0); //1st split factor |
---|
1664 | keepresult2 = normalizationPrimes(id1,ihp,0,0); //2nd split factor |
---|
1665 | printlevel = printlev; //reset printlevel |
---|
1666 | |
---|
1667 | int delt1 = keepresult1[size(keepresult1)][1]; |
---|
1668 | int delt2 = keepresult2[size(keepresult2)][1]; |
---|
1669 | intvec delti1 = keepresult1[size(keepresult1)][2]; |
---|
1670 | intvec delti2 = keepresult2[size(keepresult2)][2]; |
---|
1671 | |
---|
1672 | if( delt>=0 && delt1>=0 && delt2>=0 ) |
---|
1673 | { ideal idid1=id,id1; |
---|
1674 | int mul = vdim(std(idid1)); |
---|
1675 | if ( mul>=0 ) |
---|
1676 | { |
---|
1677 | delt = delt+mul+delt1+delt2; |
---|
1678 | } |
---|
1679 | else |
---|
1680 | { |
---|
1681 | delt = -1; |
---|
1682 | } |
---|
1683 | } |
---|
1684 | if ( y>=1 ) |
---|
1685 | { |
---|
1686 | "// delta of first component:", delt1; |
---|
1687 | "// delta of second componenet:", delt2; |
---|
1688 | "// intersection multiplicity of both components:", mul; |
---|
1689 | "// total delta after splitting:", delt; |
---|
1690 | } |
---|
1691 | |
---|
1692 | else |
---|
1693 | { |
---|
1694 | delt = -1; |
---|
1695 | } |
---|
1696 | for(lauf=1;lauf<=size(keepresult2)-1;lauf++) |
---|
1697 | { |
---|
1698 | keepresult1=insert(keepresult1,keepresult2[lauf]); |
---|
1699 | } |
---|
1700 | keepresult1[size(keepresult1)]=list(delt,delti); |
---|
1701 | |
---|
1702 | return(keepresult1); |
---|
1703 | } |
---|
1704 | } |
---|
1705 | // Case "onlySingularAtZero" has finished and returned result |
---|
1706 | |
---|
1707 | //-------------- General case, not onlySingularAtZero, RETURN --------------- |
---|
1708 | //test for non-normality, i.e. if Hom(I,I)<>R |
---|
1709 | //we can use Hom(I,I) to continue |
---|
1710 | |
---|
1711 | //------ check variables for being a non zero-divizor ------ |
---|
1712 | // SL = ideal of vars not contained in ideal SM[1]: |
---|
1713 | |
---|
1714 | ideal SL = simplify(reduce(JM[2],SM[1]),2); |
---|
1715 | ideal Ann = quotient(SM[2],SL[1]); |
---|
1716 | ideal qAnn = simplify(reduce(Ann,SM[1]),2); |
---|
1717 | //NOTE: qAnn=0 <==> first var (=SL[1]) not contained in SM is a nzd of R/SM |
---|
1718 | |
---|
1719 | //------------- We found a non-zerodivisor of R/SM ----------------------- |
---|
1720 | //SM = mstd of ideal of variety, JM = mstd of ideal of singular locus |
---|
1721 | |
---|
1722 | if( size(qAnn)==0 ) |
---|
1723 | { |
---|
1724 | list RR; |
---|
1725 | list RS; |
---|
1726 | // ----------------- Computation of the radical ----------------- |
---|
1727 | if(y>=1) |
---|
1728 | { |
---|
1729 | "// radical computation of singular locus"; |
---|
1730 | } |
---|
1731 | J = radical(JM[2]); //the radical of singular locus |
---|
1732 | JM = mstd(J); |
---|
1733 | |
---|
1734 | if(y>=1) |
---|
1735 | { |
---|
1736 | "// radical is equal to:";""; JM[2]; |
---|
1737 | ""; |
---|
1738 | } |
---|
1739 | // ------------ choose non-zerodivisor of smaller degree ---------- |
---|
1740 | //### evtl. fuer SL[1] anderen Nichtnullteiler aus J waehlen ? |
---|
1741 | if( deg(SL[1]) > deg(J[1]) ) |
---|
1742 | { |
---|
1743 | Ann=quotient(SM[2],J[1]); |
---|
1744 | qAnn=simplify(reduce(Ann,SM[1]),2); |
---|
1745 | if(size(qAnn)==0) |
---|
1746 | { |
---|
1747 | SL[1]=J[1]; |
---|
1748 | } |
---|
1749 | } |
---|
1750 | |
---|
1751 | // --------------- computation of Hom(rad(J),rad(J)) -------------- |
---|
1752 | RR=SM[1],SM[2],JM[2],SL[1]; |
---|
1753 | |
---|
1754 | if(y>=1) |
---|
1755 | { |
---|
1756 | "// compute Hom(rad(J),rad(J))"; |
---|
1757 | } |
---|
1758 | |
---|
1759 | RS=HomJJ(RR,y); //most important subprocedure |
---|
1760 | |
---|
1761 | // ------------------ the normal case, RETURN ----------------- |
---|
1762 | // RS[2]==1 means that the test for normality was positive |
---|
1763 | if(RS[2]==1) |
---|
1764 | { |
---|
1765 | def lastR=RS[1]; |
---|
1766 | setring lastR; |
---|
1767 | map psi1=BAS,endphi; |
---|
1768 | ideal norid=endid; |
---|
1769 | ideal normap=psi1(ihp); |
---|
1770 | kill endid,endphi; |
---|
1771 | |
---|
1772 | intvec atr=getAttrib(norid); |
---|
1773 | |
---|
1774 | //"//### general case: not isolated singularity only at 0, final"; |
---|
1775 | //"size norid:", size(norid), size(string(norid)); |
---|
1776 | //"interred:"; |
---|
1777 | //norid = interred(norid); |
---|
1778 | //norid = setAttrib(norid,atr); |
---|
1779 | //"size norid:", size(norid), size(string(norid)); |
---|
1780 | |
---|
1781 | export norid; |
---|
1782 | export normap; |
---|
1783 | result=lastR; |
---|
1784 | if ( y>=1 ) |
---|
1785 | { |
---|
1786 | "// case: not onlySingularAtZero, last ring Hom_R(J,J) computed"; |
---|
1787 | "// delta before last ring:", delt; |
---|
1788 | } |
---|
1789 | |
---|
1790 | if ( delt>=0 && RS[3]>=0 ) |
---|
1791 | { |
---|
1792 | delt = delt+RS[3]; |
---|
1793 | } |
---|
1794 | else |
---|
1795 | { delt = -1; } |
---|
1796 | |
---|
1797 | // delti = delti,delt; |
---|
1798 | delti[size(delti)]=delt; |
---|
1799 | |
---|
1800 | if ( y>=1 ) |
---|
1801 | { |
---|
1802 | "// delta of last ring:", delt; |
---|
1803 | } |
---|
1804 | |
---|
1805 | result[size(result)+1]=list(delt,delti); |
---|
1806 | setring BAS; |
---|
1807 | return(result); |
---|
1808 | } |
---|
1809 | |
---|
1810 | // ----- the non-normal case, recursive call of normalizationPrimes ------- |
---|
1811 | // RS=HomJJ(RR,y) was computed above, RS[1] contains endid and endphi |
---|
1812 | // RS[1] = new ring Hom_R(J,J), RS[2]= 0 or 1, RS[2]=contribution to delta |
---|
1813 | // now RS[2]must be 0, i.e. the test for normality was negative |
---|
1814 | |
---|
1815 | int n = nvars(basering); |
---|
1816 | ideal MJ = JM[2]; |
---|
1817 | |
---|
1818 | def newR=RS[1]; |
---|
1819 | setring newR; |
---|
1820 | map psi=BAS,endphi; |
---|
1821 | if ( y>=1 ) |
---|
1822 | { |
---|
1823 | "// case: not onlySingularAtZero, compute new ring = Hom_R(J,J)"; |
---|
1824 | "// delta of old ring:", delt; |
---|
1825 | } |
---|
1826 | if ( delt>=0 && RS[3]>=0 ) |
---|
1827 | { |
---|
1828 | delt = delt+RS[3]; |
---|
1829 | } |
---|
1830 | else |
---|
1831 | { delt = -1; } |
---|
1832 | if ( y>=1 ) |
---|
1833 | { |
---|
1834 | "// delta of new ring:", delt; |
---|
1835 | } |
---|
1836 | |
---|
1837 | delti[size(delti)]=delt; |
---|
1838 | intvec atr=getAttrib(endid); |
---|
1839 | |
---|
1840 | //"//### general case: not isolated singularity only at 0, recursive"; |
---|
1841 | //"size endid:", size(endid), size(string(endid)); |
---|
1842 | //"interred:"; |
---|
1843 | //endid = interred(endid); |
---|
1844 | //endid = setAttrib(endid,atr); |
---|
1845 | //"size endid:", size(endid), size(string(endid)); |
---|
1846 | |
---|
1847 | printlevel = printlevel+1; |
---|
1848 | list tluser= |
---|
1849 | normalizationPrimes(endid,psi(ihp),delt,delti,psi(MJ)); |
---|
1850 | printlevel = printlev; //reset printlevel |
---|
1851 | setring BAS; |
---|
1852 | return(tluser); |
---|
1853 | } |
---|
1854 | |
---|
1855 | //---- A whole singular component was found, RETURN ----- |
---|
1856 | if( Ann == 1) |
---|
1857 | { |
---|
1858 | "// Input appeared not to be a radical ideal!"; |
---|
1859 | "// A (everywhere singular) component with ideal"; |
---|
1860 | "// equal to its Jacobian ideal was found"; |
---|
1861 | "// Procedure will stop with partial result computed so far";""; |
---|
1862 | |
---|
1863 | MB=SM[2]; |
---|
1864 | intvec rw; |
---|
1865 | list LL=substpart(MB,ihp,0,rw); |
---|
1866 | def newR6=LL[1]; |
---|
1867 | setring newR6; |
---|
1868 | ideal norid=endid; |
---|
1869 | ideal normap=endphi; |
---|
1870 | kill endid,endphi; |
---|
1871 | export norid; |
---|
1872 | export normap; |
---|
1873 | result=newR6; |
---|
1874 | result[size(result)+1]=lst(delt,delti); |
---|
1875 | setring BAS; |
---|
1876 | return(result); |
---|
1877 | } |
---|
1878 | |
---|
1879 | //------ zerodivisor of R/SM was found, gives a splitting ------------ |
---|
1880 | //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM |
---|
1881 | //and we have found a splitting: new1 and new2 |
---|
1882 | //id = Ann defines components of R/SM in the complement of V(SL[1]) |
---|
1883 | //id1 defines components of R/SM in the complement of V(id) |
---|
1884 | |
---|
1885 | else |
---|
1886 | { |
---|
1887 | if(y>=1) |
---|
1888 | { |
---|
1889 | "// zero-divisor found"; |
---|
1890 | } |
---|
1891 | int equi = attrib(SM[2],"isEquidimensional"); |
---|
1892 | int oSAZ = attrib(SM[2],"onlySingularAtZero"); |
---|
1893 | int isIs = attrib(SM[2],"isIsolatedSingularity"); |
---|
1894 | |
---|
1895 | ideal new1 = Ann; |
---|
1896 | ideal new2 = quotient(SM[2],Ann); |
---|
1897 | //ideal new2=SL[1],SM[2]; |
---|
1898 | |
---|
1899 | def newR1 = ring(gnirlist); |
---|
1900 | setring newR1; |
---|
1901 | |
---|
1902 | ideal vid = fetch(BAS,new1); |
---|
1903 | ideal ihp = fetch(BAS,ihp); |
---|
1904 | attrib(vid,"isCohenMacaulay",0); |
---|
1905 | attrib(vid,"isPrim",0); |
---|
1906 | attrib(vid,"isIsolatedSingularity",isIs); |
---|
1907 | attrib(vid,"isRegInCodim2",0); |
---|
1908 | attrib(vid,"onlySingularAtZero",oSAZ); |
---|
1909 | attrib(vid,"isEquidimensional",equi); |
---|
1910 | attrib(vid,"isHypersurface",0); |
---|
1911 | attrib(vid,"isCompleteIntersection",0); |
---|
1912 | |
---|
1913 | // ---------- recursive call of normalizationPrimes ----------- |
---|
1914 | if ( y>=1 ) |
---|
1915 | { |
---|
1916 | "// total delta before splitting:", delt; |
---|
1917 | "// splitting in two components:"; |
---|
1918 | } |
---|
1919 | printlevel = printlevel+1; |
---|
1920 | keepresult1 = |
---|
1921 | normalizationPrimes(vid,ihp,0,0); //1st split factor |
---|
1922 | |
---|
1923 | list delta1 = keepresult1[size(keepresult1)]; |
---|
1924 | |
---|
1925 | setring BAS; |
---|
1926 | def newR2 = ring(gnirlist); |
---|
1927 | setring newR2; |
---|
1928 | |
---|
1929 | ideal vid = fetch(BAS,new2); |
---|
1930 | ideal ihp = fetch(BAS,ihp); |
---|
1931 | attrib(vid,"isCohenMacaulay",0); |
---|
1932 | attrib(vid,"isPrim",0); |
---|
1933 | attrib(vid,"isIsolatedSingularity",isIs); |
---|
1934 | attrib(vid,"isRegInCodim2",0); |
---|
1935 | attrib(vid,"isEquidimensional",equi); |
---|
1936 | attrib(vid,"isHypersurface",0); |
---|
1937 | attrib(vid,"isCompleteIntersection",0); |
---|
1938 | attrib(vid,"onlySingularAtZero",oSAZ); |
---|
1939 | |
---|
1940 | keepresult2 = |
---|
1941 | normalizationPrimes(vid,ihp,0,0); |
---|
1942 | list delta2 = keepresult2[size(keepresult2)]; //2nd split factor |
---|
1943 | printlevel = printlev; //reset printlevel |
---|
1944 | |
---|
1945 | setring BAS; |
---|
1946 | |
---|
1947 | //compute intersection multiplicity of both components: |
---|
1948 | new1 = new1,new2; |
---|
1949 | int mul=vdim(std(new1)); |
---|
1950 | |
---|
1951 | // ----- normalizationPrimes finished, add up results, RETURN -------- |
---|
1952 | for(lauf=1;lauf<=size(keepresult2)-1;lauf++) |
---|
1953 | { |
---|
1954 | keepresult1 = insert(keepresult1,keepresult2[lauf]); |
---|
1955 | } |
---|
1956 | if ( delt >=0 && delta1[1] >=0 && delta2[1] >=0 && mul >=0 ) |
---|
1957 | { |
---|
1958 | delt = delt+mul+delta1[1]+delta2[1]; |
---|
1959 | } |
---|
1960 | else |
---|
1961 | { delt = -1; } |
---|
1962 | delti = -2; |
---|
1963 | |
---|
1964 | if ( y>=1 ) |
---|
1965 | { |
---|
1966 | "// zero divisor produced a splitting into two components"; |
---|
1967 | "// delta of first component:", delta1; |
---|
1968 | "// delta of second componenet:", delta2; |
---|
1969 | "// intersection multiplicity of both components:", mul; |
---|
1970 | "// total delta after splitting:", delt; |
---|
1971 | } |
---|
1972 | keepresult1[size(keepresult1)] = list(delt,delti); |
---|
1973 | return(keepresult1); |
---|
1974 | } |
---|
1975 | } |
---|
1976 | example |
---|
1977 | { "EXAMPLE:";echo = 2; |
---|
1978 | // Huneke |
---|
1979 | ring qr=31991,(a,b,c,d,e),dp; |
---|
1980 | ideal i= |
---|
1981 | 5abcde-a5-b5-c5-d5-e5, |
---|
1982 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
1983 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
1984 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
1985 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
1986 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
1987 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
1988 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
1989 | |
---|
1990 | list pr=normalizationPrimes(i); |
---|
1991 | def r1 = pr[1]; |
---|
1992 | setring r1; |
---|
1993 | norid; |
---|
1994 | normap; |
---|
1995 | } |
---|
1996 | |
---|
1997 | /////////////////////////////////////////////////////////////////////////////// |
---|
1998 | static proc substpart(ideal endid, ideal endphi, int homo, intvec rw) |
---|
1999 | |
---|
2000 | "//Repeated application of elimpart to endid, until no variables can be |
---|
2001 | //directy substituded. homo=1 if input is homogeneous, rw contains |
---|
2002 | //original weights, endphi (partial) normalization map"; |
---|
2003 | |
---|
2004 | //NOTE concerning iteration of maps: Let phi: x->f(y,z), y->g(x,z) then |
---|
2005 | //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 |
---|
2006 | //and so on: none of the x or y will be eliminated |
---|
2007 | //Now subst: first x and then y: x+y+z->f(g(x,z),z)+g(x,z)+z eliminates y |
---|
2008 | //further subst replaces x by y, makes no sense (objects more compicated). |
---|
2009 | //Subst first y and then x eliminates x |
---|
2010 | //In our situation we have triangular form: x->f(y,z), y->g(z). |
---|
2011 | //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 |
---|
2012 | //subst x,y: x+y+z->f(g(z),z)+g(z)+z, eliminates x,y |
---|
2013 | //subst y,x: x+y+z->f(y,z)+g(z)+z eliminates only x |
---|
2014 | //HENCE: substitute vars depending on most other vars first |
---|
2015 | //However, if the sytem xi-fi is reduced then xi does not appear in any of the |
---|
2016 | //fj and hence the order does'nt matter when substitutinp xi by fi |
---|
2017 | |
---|
2018 | { |
---|
2019 | ASSUME(1, not isQuotientRing(basering) ); |
---|
2020 | |
---|
2021 | def newRing = basering; |
---|
2022 | int ii,jj; |
---|
2023 | map phi = newRing,maxideal(1); //identity map |
---|
2024 | list Le = elimpart(endid); |
---|
2025 | //this proc and the next loop try to substitute as many variables as |
---|
2026 | //possible indices of substituted variables |
---|
2027 | |
---|
2028 | int q = size(Le[2]); //q vars, stored in Le[2], have been substitutet |
---|
2029 | intvec rw1 = 0; //will become indices of substituted variables |
---|
2030 | rw1[nvars(basering)] = 0; |
---|
2031 | rw1 = rw1+1; //rw1=1,..,1 (as many 1 as nvars(basering)) |
---|
2032 | |
---|
2033 | while( size(Le[2]) != 0 ) |
---|
2034 | { |
---|
2035 | endid = Le[1]; |
---|
2036 | if ( defined(ps) ) |
---|
2037 | { kill ps; } |
---|
2038 | map ps = newRing,Le[5]; |
---|
2039 | phi = ps(phi); |
---|
2040 | for(ii=1;ii<=size(Le[2]);ii++) |
---|
2041 | { |
---|
2042 | phi=phi(phi); |
---|
2043 | } |
---|
2044 | //eingefuegt wegen x2-y2z2+z3 |
---|
2045 | |
---|
2046 | for( ii=1; ii<=size(rw1); ii++ ) |
---|
2047 | { |
---|
2048 | if( Le[4][ii]==0 ) //ii = index of var which was substituted |
---|
2049 | { |
---|
2050 | rw1[ii]=0; //substituted vars have entry 0 in rw1 |
---|
2051 | } |
---|
2052 | } |
---|
2053 | Le=elimpart(endid); //repeated application of elimpart |
---|
2054 | q = q + size(Le[2]); |
---|
2055 | } |
---|
2056 | endphi = phi(endphi); |
---|
2057 | //---------- return ----------------------------------------------------------- |
---|
2058 | // first the trivial case, where all variable have been eliminated |
---|
2059 | if( nvars(newRing) == q ) |
---|
2060 | { |
---|
2061 | ring lastRing = char(basering),T(1),dp; |
---|
2062 | ideal endid = T(1); |
---|
2063 | ideal endphi = T(1); |
---|
2064 | for(ii=2; ii<=q; ii++ ) |
---|
2065 | { |
---|
2066 | endphi[ii] = 0; |
---|
2067 | } |
---|
2068 | export(endid,endphi); |
---|
2069 | list L = lastRing; |
---|
2070 | setring newRing; |
---|
2071 | return(L); |
---|
2072 | } |
---|
2073 | |
---|
2074 | // in the homogeneous case put weights for the remaining vars correctly, i.e. |
---|
2075 | // delete from rw those weights for which the corresponding entry of rw1 is 0 |
---|
2076 | |
---|
2077 | if (homo==1 && nvars(newRing)-q >1 && size(endid) >0 ) |
---|
2078 | { |
---|
2079 | jj=1; |
---|
2080 | for( ii=2; ii<size(rw1); ii++) |
---|
2081 | { |
---|
2082 | jj++; |
---|
2083 | if( rw1[ii]==0 ) |
---|
2084 | { |
---|
2085 | rw=rw[1..jj-1],rw[jj+1..size(rw)]; |
---|
2086 | jj=jj-1; |
---|
2087 | } |
---|
2088 | } |
---|
2089 | if( rw1[1]==0 ) { rw=rw[2..size(rw)]; } |
---|
2090 | if( rw1[size(rw1)]==0 ){ rw=rw[1..size(rw)-1]; } |
---|
2091 | |
---|
2092 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),(a(rw),dp); |
---|
2093 | } |
---|
2094 | else |
---|
2095 | { |
---|
2096 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),dp; |
---|
2097 | } |
---|
2098 | ideal lastmap; |
---|
2099 | jj = 1; |
---|
2100 | |
---|
2101 | for(ii=1; ii<=size(rw1); ii++ ) |
---|
2102 | { |
---|
2103 | if ( rw1[ii]==1 ) { lastmap[ii] = T(jj); jj=jj+1; } |
---|
2104 | if ( rw1[ii]==0 ) { lastmap[ii] = 0; } |
---|
2105 | } |
---|
2106 | map phi1 = newRing,lastmap; |
---|
2107 | ideal endid = phi1(endid); //### bottelneck |
---|
2108 | ideal endphi = phi1(endphi); |
---|
2109 | |
---|
2110 | /* |
---|
2111 | Versuch: subst statt phi |
---|
2112 | for(ii=1; ii<=size(rw1); ii++ ) |
---|
2113 | { |
---|
2114 | if ( rw1[ii]==1 ) { endid = subst(endid,var(ii),T(jj)); } |
---|
2115 | if ( rw1[ii]==0 ) { endid = subst(endid,var(ii),0); } |
---|
2116 | } |
---|
2117 | */ |
---|
2118 | export(endid); |
---|
2119 | export(endphi); |
---|
2120 | list L = lastRing; |
---|
2121 | setring newRing; |
---|
2122 | return(L); |
---|
2123 | } |
---|
2124 | /////////////////////////////////////////////////////////////////////////////// |
---|
2125 | static proc deltaP(ideal I) |
---|
2126 | { |
---|
2127 | ASSUME(1, not isQuotientRing(basering) ); |
---|
2128 | def R=basering; |
---|
2129 | int c,d,i; |
---|
2130 | int n=nvars(R); |
---|
2131 | list nor; |
---|
2132 | if(size(I)>1){ERROR("no hypersurface");} |
---|
2133 | ideal J=std(slocus(I)); |
---|
2134 | if(dim(J)<=0){return(0);} |
---|
2135 | poly h; |
---|
2136 | d=1; |
---|
2137 | while((d)&&(i<n)) |
---|
2138 | { |
---|
2139 | i++; |
---|
2140 | h=var(i); |
---|
2141 | d=dim(std(J+ideal(h))); |
---|
2142 | } |
---|
2143 | i=0; |
---|
2144 | while(d) |
---|
2145 | { |
---|
2146 | i++; |
---|
2147 | if(i>10){ERROR("delta not found, please inform the authors")}; |
---|
2148 | h=randomLast(100)[n]; |
---|
2149 | d=dim(std(J+ideal(h))); |
---|
2150 | } |
---|
2151 | I=I,h-1; |
---|
2152 | if(char(R)<=19) |
---|
2153 | { |
---|
2154 | nor=normalP(I); |
---|
2155 | } |
---|
2156 | else |
---|
2157 | { |
---|
2158 | nor=normal(I); |
---|
2159 | } |
---|
2160 | return(nor[2][2]); |
---|
2161 | } |
---|
2162 | |
---|
2163 | proc genus(ideal I,list #) |
---|
2164 | "USAGE: genus(I) or genus(I,<option>); I a 1-dimensional ideal over a perfect field |
---|
2165 | RETURN: an integer, the geometric genus p_g = p_a - delta of the projective |
---|
2166 | curve defined by i, where p_a is the arithmetic genus. |
---|
2167 | NOTE: genus always treats projective curves and takes projective closure if input is affine 1-dim variety. |
---|
2168 | delta is the sum of all local delta-invariants of the singularities, |
---|
2169 | i.e. dim(R'/R), R' the normalization of the local ring R of the |
---|
2170 | singularity. @* |
---|
2171 | genus(I,"nor") uses the normalization to compute delta. Usually genus(I,"nor") |
---|
2172 | is slower than genus(I) but sometimes not. @* |
---|
2173 | genus(I,"pri") starts with a primary decompsition. |
---|
2174 | EXAMPLE: example genus; shows an example |
---|
2175 | " |
---|
2176 | { |
---|
2177 | ASSUME(0, not isQuotientRing(basering) ); |
---|
2178 | if ( string(minpoly) !="0" ) |
---|
2179 | { |
---|
2180 | ERROR("genus does not yet support extension fields"); |
---|
2181 | } |
---|
2182 | |
---|
2183 | int w = printlevel-voice+2; // w=printlevel (default: w=0) |
---|
2184 | |
---|
2185 | int ono,rpr,ll; |
---|
2186 | if(size(#)>0) |
---|
2187 | { |
---|
2188 | if(typeof(#[1])=="string") |
---|
2189 | { |
---|
2190 | if(#[1]=="nor"){ono=1;} |
---|
2191 | if(#[1]=="pri"){rpr=1;} |
---|
2192 | } |
---|
2193 | else { ERROR("invalid option for genus");} |
---|
2194 | } |
---|
2195 | def R0=basering; |
---|
2196 | if((char(basering)>0)||(ono)) |
---|
2197 | { |
---|
2198 | def R1=changeord(list(list("dp",1:nvars(basering)))); |
---|
2199 | setring R1; |
---|
2200 | ideal I=imap(R0,I); |
---|
2201 | I=radical(I); |
---|
2202 | I=std(I); |
---|
2203 | if(dim(I)!=1) |
---|
2204 | { |
---|
2205 | if(((homog(I))&&(dim(I)!=2))||(!homog(I))) |
---|
2206 | { |
---|
2207 | ERROR("This is not a curve"); |
---|
2208 | } |
---|
2209 | } |
---|
2210 | if(homog(I)&&(dim(I)==2)) |
---|
2211 | { |
---|
2212 | def S=R0; |
---|
2213 | setring S; |
---|
2214 | ideal J=I; |
---|
2215 | } |
---|
2216 | else |
---|
2217 | { |
---|
2218 | def S=changevar(varstr(R0)+",@t"); |
---|
2219 | setring S; |
---|
2220 | ideal J=imap(R1,I); |
---|
2221 | J=homog(J,@t); |
---|
2222 | J=std(J); |
---|
2223 | } |
---|
2224 | |
---|
2225 | list LL=normal(J,"prim"); |
---|
2226 | int pa,i; |
---|
2227 | for(i=1;i<=size(LL[1]);i++) |
---|
2228 | { |
---|
2229 | def T=LL[1][i]; |
---|
2230 | setring T; |
---|
2231 | pa=pa-hilbPoly(std(norid))[1]; |
---|
2232 | setring S; |
---|
2233 | kill T; |
---|
2234 | } |
---|
2235 | pa=pa+1; |
---|
2236 | setring R0; |
---|
2237 | return(pa); |
---|
2238 | } |
---|
2239 | if(rpr) |
---|
2240 | { |
---|
2241 | list LZ=minAssGTZ(I); |
---|
2242 | if(size(LZ)>1) |
---|
2243 | { |
---|
2244 | int p_g; |
---|
2245 | for(ll=1;ll<=size(LZ);ll++) |
---|
2246 | { |
---|
2247 | p_g=p_g+genus(LZ[ll],"pri")-1; |
---|
2248 | } |
---|
2249 | return(p_g+1); |
---|
2250 | } |
---|
2251 | else |
---|
2252 | { |
---|
2253 | I=LZ[1]; |
---|
2254 | } |
---|
2255 | } |
---|
2256 | else |
---|
2257 | { |
---|
2258 | I=radical(I); |
---|
2259 | } |
---|
2260 | I=std(I); |
---|
2261 | if(dim(I)!=1) |
---|
2262 | { |
---|
2263 | if(((homog(I))&&(dim(I)!=2))||(!homog(I))) |
---|
2264 | { |
---|
2265 | // ERROR("This is not a curve"); |
---|
2266 | if(w==1){"** WARNING: Input does not define a curve **"; "";} |
---|
2267 | } |
---|
2268 | } |
---|
2269 | list L=elimpart(I); |
---|
2270 | if(size(L[2])!=0) |
---|
2271 | { |
---|
2272 | map psi=R0,L[5]; |
---|
2273 | I=std(psi(I)); |
---|
2274 | } |
---|
2275 | if(size(I)==0) |
---|
2276 | { |
---|
2277 | return(0); |
---|
2278 | } |
---|
2279 | ideal N=variables(I); |
---|
2280 | if(size(N)==1) |
---|
2281 | { |
---|
2282 | poly p=I[1]; |
---|
2283 | // if(deg(squarefree(p))<deg(p)){ERROR("Curve is not reduced");} |
---|
2284 | return(-deg(p)+1); |
---|
2285 | } |
---|
2286 | if(size(N) < nvars(R0)) |
---|
2287 | { |
---|
2288 | string newvar=string(N); |
---|
2289 | execute("ring R=("+charstr(R0)+"),("+newvar+"),dp;"); |
---|
2290 | ideal I =imap(R0,I); |
---|
2291 | if((ringlist(R0)[3][1][1]=="dp")&&(size(ringlist(R0)[3])==2)) |
---|
2292 | { |
---|
2293 | attrib(I,"isSB",1); |
---|
2294 | } |
---|
2295 | else |
---|
2296 | { |
---|
2297 | I=std(I); |
---|
2298 | } |
---|
2299 | } |
---|
2300 | else |
---|
2301 | { |
---|
2302 | def R=changeord(list(list("dp",1:nvars(basering)))); |
---|
2303 | setring R; |
---|
2304 | ideal I=imap(R0,I); |
---|
2305 | I=std(I); |
---|
2306 | } |
---|
2307 | if(dim(I)==2) |
---|
2308 | { |
---|
2309 | def newR=basering; |
---|
2310 | } |
---|
2311 | else |
---|
2312 | { |
---|
2313 | short=0; |
---|
2314 | string smp = string(minpoly); |
---|
2315 | if(dim(I)==0) |
---|
2316 | { |
---|
2317 | execute("ring Rhelp=("+charstr(R0)+"),(@s,@t),dp;"); |
---|
2318 | } |
---|
2319 | else |
---|
2320 | { |
---|
2321 | execute("ring Rhelp=("+charstr(R0)+"),(@s),dp;"); |
---|
2322 | } |
---|
2323 | if (smp!="0") |
---|
2324 | { execute("minpoly = "+smp+";");} |
---|
2325 | def newR=R+Rhelp; |
---|
2326 | setring newR; |
---|
2327 | ideal I=imap(R,I); |
---|
2328 | I=homog(I,@s); |
---|
2329 | attrib(I,"isSB",1); |
---|
2330 | } |
---|
2331 | |
---|
2332 | if((nvars(basering)<=3)&&(size(I)>1)) |
---|
2333 | { |
---|
2334 | ERROR("This is not equidimensional"); |
---|
2335 | } |
---|
2336 | |
---|
2337 | intvec hp=hilbPoly(I); |
---|
2338 | int p_a=1-hp[1]; |
---|
2339 | int d=hp[2]; |
---|
2340 | |
---|
2341 | if(w>=1) |
---|
2342 | { |
---|
2343 | "";"The ideal of the projective curve:";"";I;""; |
---|
2344 | "The coefficients of the Hilbert polynomial";hp; |
---|
2345 | "arithmetic genus:";p_a; |
---|
2346 | "degree:";d;""; |
---|
2347 | } |
---|
2348 | |
---|
2349 | intvec v = hilb(I,1); |
---|
2350 | int i,o; |
---|
2351 | if(nvars(basering)>3) |
---|
2352 | { |
---|
2353 | map phi=newR,maxideal(1); |
---|
2354 | int de; |
---|
2355 | ideal K,L1; |
---|
2356 | matrix M; |
---|
2357 | poly m=var(4); |
---|
2358 | poly he; |
---|
2359 | for(i=5;i<=nvars(basering);i++){m=m*var(i);} |
---|
2360 | K=eliminate(I,m,v); |
---|
2361 | if(size(K)==1){de=deg(K[1]);} |
---|
2362 | m=var(1); |
---|
2363 | for(i=2;i<=nvars(basering)-3;i++){m=m*var(i);} |
---|
2364 | i=0; |
---|
2365 | while(d!=de) |
---|
2366 | { |
---|
2367 | o=1; |
---|
2368 | i++; |
---|
2369 | K=phi(I); |
---|
2370 | K=eliminate(K,m,v); |
---|
2371 | if(size(K)==1){de=deg(K[1]);} |
---|
2372 | if((i==5)&&(d!=de)) |
---|
2373 | { |
---|
2374 | K=reduce(equidimMax(I),I); |
---|
2375 | if(size(K)!=0){ERROR("This is not equidimensional");} |
---|
2376 | } |
---|
2377 | if(i==10) |
---|
2378 | { |
---|
2379 | J;K; |
---|
2380 | ERROR("genus: did not find a good projection for to |
---|
2381 | the plain"); |
---|
2382 | } |
---|
2383 | if(i<5) |
---|
2384 | { |
---|
2385 | M=sparsetriag(nvars(newR),nvars(newR),80-5*i,i); |
---|
2386 | } |
---|
2387 | else |
---|
2388 | { |
---|
2389 | if(i<8) |
---|
2390 | { |
---|
2391 | M=transpose(sparsetriag(nvars(newR),nvars(newR),80-5*i,i)); |
---|
2392 | } |
---|
2393 | else |
---|
2394 | { |
---|
2395 | he=0; |
---|
2396 | while(he==0) |
---|
2397 | { |
---|
2398 | M=randommat(nvars(newR),nvars(newR),ideal(1),20); |
---|
2399 | he=det(M); |
---|
2400 | } |
---|
2401 | } |
---|
2402 | } |
---|
2403 | L1=M*transpose(maxideal(1)); |
---|
2404 | phi=newR,L1; |
---|
2405 | } |
---|
2406 | I=K; |
---|
2407 | } |
---|
2408 | poly p=I[1]; |
---|
2409 | |
---|
2410 | execute("ring S=("+charstr(R)+"),(x,y,t),dp;"); |
---|
2411 | ideal L=maxideal(1); |
---|
2412 | execute("ring C=("+charstr(R)+"),(x,y),ds;"); |
---|
2413 | ideal I; |
---|
2414 | execute("ring A=("+charstr(R)+"),(x,t),dp;"); |
---|
2415 | map phi=S,1,x,t; |
---|
2416 | map psi=S,x,1,t; |
---|
2417 | poly g,h; |
---|
2418 | ideal I,I1; |
---|
2419 | execute("ring B=("+charstr(R)+"),(x,t),ds;"); |
---|
2420 | |
---|
2421 | setring S; |
---|
2422 | if(o) |
---|
2423 | { |
---|
2424 | for(i=1;i<=nvars(newR)-3;i++){L[i]=0;} |
---|
2425 | L=L,maxideal(1); |
---|
2426 | } |
---|
2427 | map sigma=newR,L; |
---|
2428 | poly F=sigma(p); |
---|
2429 | if(w>=1){"the projected curve:";"";F;"";} |
---|
2430 | |
---|
2431 | kill newR; |
---|
2432 | |
---|
2433 | int genus=(d-1)*(d-2) div 2; |
---|
2434 | if(w>=1){"the arithmetic genus of the plane curve:";genus;pause();} |
---|
2435 | |
---|
2436 | int delt,deltaloc,deltainf,tau,tauinf,cusps,iloc,iglob,l,nsing, |
---|
2437 | tauloc,tausing,k,rat,nbranchinf,nbranch,nodes,cuspsinf,nodesinf; |
---|
2438 | list inv; |
---|
2439 | |
---|
2440 | if(w>=1) |
---|
2441 | {"";"analyse the singularities at oo";"";"singular locus at (1,x,0):";"";} |
---|
2442 | setring A; |
---|
2443 | g=phi(F); |
---|
2444 | h=psi(F); |
---|
2445 | I=g,jacob(g),var(2); |
---|
2446 | I=std(I); |
---|
2447 | if(deg(I[1])>0) |
---|
2448 | { |
---|
2449 | list qr=minAssGTZ(I); |
---|
2450 | if(w>=1){qr;"";} |
---|
2451 | |
---|
2452 | for(k=1;k<=size(qr);k++) |
---|
2453 | { |
---|
2454 | if(w>=1){ nsing=nsing+vdim(std(qr[k]));} |
---|
2455 | inv=deltaLoc(g,qr[k]); |
---|
2456 | deltainf=deltainf+inv[1]; |
---|
2457 | tauinf=tauinf+inv[2]; |
---|
2458 | l=vdim(std(qr[k])); |
---|
2459 | if(inv[2]==l){nodesinf=nodesinf+l;} |
---|
2460 | if(inv[2]==2*l){cuspsinf=cuspsinf+l;} |
---|
2461 | nbranchinf=nbranchinf+inv[3]; |
---|
2462 | } |
---|
2463 | } |
---|
2464 | else |
---|
2465 | { |
---|
2466 | if(w>=1){" the curve is smooth at (1,x,0)";"";} |
---|
2467 | } |
---|
2468 | if(w>=1){"singular locus at (0,1,0):";"";} |
---|
2469 | inv=deltaLoc(h,maxideal(1)); |
---|
2470 | if((w>=1)&&(inv[2]!=0)){ nsing++;} |
---|
2471 | deltainf=deltainf+inv[1]; |
---|
2472 | tauinf=tauinf+inv[2]; |
---|
2473 | if(inv[2]==1){nodesinf++;} |
---|
2474 | if(inv[2]==2){cuspsinf++;} |
---|
2475 | |
---|
2476 | if((w>=1)&&(inv[2]==0)){" the curve is smooth at (0,1,0)";"";} |
---|
2477 | if(inv[2]>0){nbranchinf=nbranchinf+inv[3];} |
---|
2478 | |
---|
2479 | if(w>=1) |
---|
2480 | { |
---|
2481 | if(tauinf==0) |
---|
2482 | { |
---|
2483 | " the curve is smooth at oo";""; |
---|
2484 | } |
---|
2485 | else |
---|
2486 | { |
---|
2487 | "number of singularities at oo:";nsing; |
---|
2488 | "nodes at oo:";nodesinf; |
---|
2489 | "cusps at oo:";cuspsinf; |
---|
2490 | "branches at oo:";nbranchinf; |
---|
2491 | "Tjurina number at oo:";tauinf; |
---|
2492 | "delta at oo:";deltainf; |
---|
2493 | "Milnor number at oo:";2*deltainf-nbranchinf+nsing; |
---|
2494 | pause(); |
---|
2495 | } |
---|
2496 | "singularities at (x,y,1):";""; |
---|
2497 | } |
---|
2498 | execute("ring newR=("+charstr(R)+"),(x,y),dp;"); |
---|
2499 | //the singularities at the affine part |
---|
2500 | map sigma=S,var(1),var(2),1; |
---|
2501 | ideal I=sigma(F); |
---|
2502 | |
---|
2503 | ideal I1=jacob(I); |
---|
2504 | matrix Hess[2][2]=jacob(I1); |
---|
2505 | ideal ID=I+I1+ideal(det(Hess));//singular locus of I+I1 |
---|
2506 | |
---|
2507 | ideal radID=std(radical(ID));//the non-nodal locus |
---|
2508 | if(w>=1){"the non-nodal locus:";"";radID;pause();"";} |
---|
2509 | if(deg(radID[1])==0) |
---|
2510 | { |
---|
2511 | ideal IDsing=1; |
---|
2512 | } |
---|
2513 | else |
---|
2514 | { |
---|
2515 | ideal IDsing=minor(jacob(ID),2)+radID;//singular locus of ID |
---|
2516 | } |
---|
2517 | |
---|
2518 | iglob=vdim(std(IDsing)); |
---|
2519 | |
---|
2520 | if(iglob!=0)//computation of the radical of IDsing |
---|
2521 | { |
---|
2522 | ideal radIDsing=reduce(IDsing,radID); |
---|
2523 | if(size(radIDsing)==0) |
---|
2524 | { |
---|
2525 | radIDsing=radID; |
---|
2526 | attrib(radIDsing,"isSB",1); |
---|
2527 | } |
---|
2528 | else |
---|
2529 | { |
---|
2530 | radIDsing=std(radical(IDsing)); |
---|
2531 | } |
---|
2532 | iglob=vdim(radIDsing); |
---|
2533 | if((w>=1)&&(iglob)) |
---|
2534 | {"the non-nodal-cuspidal locus:";radIDsing;pause();"";} |
---|
2535 | } |
---|
2536 | cusps=vdim(radID)-iglob; |
---|
2537 | nsing=nsing+cusps; |
---|
2538 | |
---|
2539 | if(iglob==0) |
---|
2540 | { |
---|
2541 | if(w>=1){" there are only cusps and nodes";"";} |
---|
2542 | tau=vdim(std(I+jacob(I))); |
---|
2543 | tauinf=tauinf+tau; |
---|
2544 | nodes=tau-2*cusps; |
---|
2545 | delt=nodes+cusps; |
---|
2546 | nbranch=2*tau-3*cusps; |
---|
2547 | nsing=nsing+nodes; |
---|
2548 | } |
---|
2549 | else |
---|
2550 | { |
---|
2551 | if(w>=1){"the non-nodal-cuspidal singularities";"";} |
---|
2552 | setring C; |
---|
2553 | ideal I1=imap(newR,radIDsing); |
---|
2554 | iloc=vdim(std(I1)); |
---|
2555 | if(iglob==iloc) |
---|
2556 | { |
---|
2557 | if(w>=1){"only cusps and nodes outside (0,0,1)";} |
---|
2558 | setring newR; |
---|
2559 | tau=vdim(std(I+jacob(I))); |
---|
2560 | tauinf=tauinf+tau; |
---|
2561 | inv=deltaLoc(I[1],maxideal(1)); |
---|
2562 | delt=inv[1]; |
---|
2563 | tauloc=inv[2]; |
---|
2564 | nodes=tau-tauloc-2*cusps; |
---|
2565 | nsing=nsing+nodes; |
---|
2566 | if (inv[2]!=0) { nsing++; } |
---|
2567 | nbranch=inv[3]+ 2*nodes+cusps; |
---|
2568 | delt=delt+nodes+cusps; |
---|
2569 | if((w>=1)&&(inv[2]==0)){"smooth at (0,0,1)";} |
---|
2570 | } |
---|
2571 | else |
---|
2572 | { |
---|
2573 | setring newR; |
---|
2574 | list pr=minAssGTZ(radIDsing); |
---|
2575 | if(w>=1){pr;} |
---|
2576 | |
---|
2577 | for(k=1;k<=size(pr);k++) |
---|
2578 | { |
---|
2579 | if(w>=1){nsing=nsing+vdim(std(pr[k]));} |
---|
2580 | inv=deltaLoc(I[1],pr[k]); |
---|
2581 | delt=delt+inv[1]; |
---|
2582 | tausing=tausing+inv[2]; |
---|
2583 | nbranch=nbranch+inv[3]; |
---|
2584 | } |
---|
2585 | tau=vdim(std(I+jacob(I))); |
---|
2586 | tauinf=tauinf+tau; |
---|
2587 | nodes=tau-tausing-2*cusps; |
---|
2588 | nsing=nsing+nodes; |
---|
2589 | delt=delt+nodes+cusps; |
---|
2590 | nbranch=nbranch+2*nodes+cusps; |
---|
2591 | } |
---|
2592 | } |
---|
2593 | genus=genus-delt-deltainf; |
---|
2594 | if(w>=1) |
---|
2595 | { |
---|
2596 | "The projected plane curve has locally:";""; |
---|
2597 | "singularities:";nsing; |
---|
2598 | "branches:";nbranch+nbranchinf; |
---|
2599 | "nodes:"; nodes+nodesinf; |
---|
2600 | "cusps:";cusps+cuspsinf; |
---|
2601 | "Tjurina number:";tauinf; |
---|
2602 | "Milnor number:";2*(delt+deltainf)-nbranch-nbranchinf+nsing; |
---|
2603 | "delta of the projected curve:";delt+deltainf; |
---|
2604 | "delta of the curve:";p_a-genus; |
---|
2605 | "genus:";genus; |
---|
2606 | "===================================================="; |
---|
2607 | ""; |
---|
2608 | } |
---|
2609 | setring R0; |
---|
2610 | return(genus); |
---|
2611 | } |
---|
2612 | example |
---|
2613 | { "EXAMPLE:"; echo = 2; |
---|
2614 | ring r=0,(x,y),dp; |
---|
2615 | ideal i=y^9 - x^2*(x - 1)^9; |
---|
2616 | genus(i); |
---|
2617 | ring r7=7,(x,y),dp; |
---|
2618 | ideal i=y^9 - x^2*(x - 1)^9; |
---|
2619 | genus(i); |
---|
2620 | } |
---|
2621 | |
---|
2622 | /////////////////////////////////////////////////////////////////////////////// |
---|
2623 | proc deltaLoc(poly f,ideal singL) |
---|
2624 | "USAGE: deltaLoc(f,J); f poly, J ideal |
---|
2625 | ASSUME: f is reduced bivariate polynomial; basering has exactly two variables; |
---|
2626 | J is irreducible prime component of the singular locus of f (e.g., one |
---|
2627 | entry of the output of @code{minAssGTZ(I);}, I = <f,jacob(f)>). |
---|
2628 | RETURN: list L: |
---|
2629 | @texinfo |
---|
2630 | @table @asis |
---|
2631 | @item @code{L[1]}; int: |
---|
2632 | the sum of (local) delta invariants of f at the (conjugated) singular |
---|
2633 | points given by J. |
---|
2634 | @item @code{L[2]}; int: |
---|
2635 | the sum of (local) Tjurina numbers of f at the (conjugated) singular |
---|
2636 | points given by J. |
---|
2637 | @item @code{L[3]}; int: |
---|
2638 | the sum of (local) number of branches of f at the (conjugated) |
---|
2639 | singular points given by J. |
---|
2640 | @end table |
---|
2641 | @end texinfo |
---|
2642 | NOTE: procedure makes use of @code{execute}; increasing printlevel displays |
---|
2643 | more comments (default: printlevel=0). |
---|
2644 | SEE ALSO: delta, tjurina |
---|
2645 | KEYWORDS: delta invariant; Tjurina number |
---|
2646 | EXAMPLE: example deltaLoc; shows an example |
---|
2647 | " |
---|
2648 | { |
---|
2649 | ASSUME(0, not isQuotientRing(basering) ); |
---|
2650 | |
---|
2651 | intvec save_opt=option(get); |
---|
2652 | option(redSB); |
---|
2653 | def R=basering; |
---|
2654 | execute("ring S=("+charstr(R)+"),(x,y),lp;"); |
---|
2655 | map phi=R,x,y; |
---|
2656 | ideal singL=phi(singL); |
---|
2657 | singL=simplify(std(singL),1); |
---|
2658 | attrib(singL,"isSB",1); |
---|
2659 | int d=vdim(singL); |
---|
2660 | poly f=phi(f); |
---|
2661 | int i; |
---|
2662 | int w = printlevel-voice+2; // w=printlevel (default: w=0) |
---|
2663 | if(d==1) |
---|
2664 | { |
---|
2665 | map alpha=S,var(1)-singL[2][2],var(2)-singL[1][2]; |
---|
2666 | f=alpha(f); |
---|
2667 | execute("ring C=("+charstr(S)+"),("+varstr(S)+"),ds;"); |
---|
2668 | poly f=imap(S,f); |
---|
2669 | ideal singL=imap(S,singL); |
---|
2670 | if((w>=1)&&(ord(f)>=2)) |
---|
2671 | { |
---|
2672 | "local analysis of the singularities";""; |
---|
2673 | basering; |
---|
2674 | singL; |
---|
2675 | f; |
---|
2676 | pause(); |
---|
2677 | } |
---|
2678 | } |
---|
2679 | else |
---|
2680 | { |
---|
2681 | poly p; |
---|
2682 | poly c; |
---|
2683 | map psi; |
---|
2684 | number co; |
---|
2685 | |
---|
2686 | while((deg(lead(singL[1]))>1)&&(deg(lead(singL[2]))>1)) |
---|
2687 | { |
---|
2688 | psi=S,x,y+random(-100,100)*x; |
---|
2689 | singL=psi(singL); |
---|
2690 | singL=std(singL); |
---|
2691 | f=psi(f); |
---|
2692 | } |
---|
2693 | |
---|
2694 | if(deg(lead(singL[2]))==1) |
---|
2695 | { |
---|
2696 | p=singL[1]; |
---|
2697 | c=singL[2]-lead(singL[2]); |
---|
2698 | co=leadcoef(singL[2]); |
---|
2699 | } |
---|
2700 | if(deg(lead(singL[1]))==1) |
---|
2701 | { |
---|
2702 | psi=S,y,x; |
---|
2703 | f=psi(f); |
---|
2704 | singL=psi(singL); |
---|
2705 | p=singL[2]; |
---|
2706 | c=singL[1]-lead(singL[1]); |
---|
2707 | co=leadcoef(singL[1]); |
---|
2708 | } |
---|
2709 | |
---|
2710 | execute("ring B=("+charstr(S)+"),a,dp;"); |
---|
2711 | map beta=S,a,a; |
---|
2712 | poly p=beta(p); |
---|
2713 | |
---|
2714 | execute("ring C=("+charstr(S)+",a),("+varstr(S)+"),ds;"); |
---|
2715 | number p=number(imap(B,p)); |
---|
2716 | |
---|
2717 | minpoly=p; |
---|
2718 | map iota=S,a,a; |
---|
2719 | number c=number(iota(c)); |
---|
2720 | number co=iota(co); |
---|
2721 | |
---|
2722 | map alpha=S,x-c/co,y+a; |
---|
2723 | poly f=alpha(f); |
---|
2724 | f=cleardenom(f); |
---|
2725 | if((w>=1)&&(ord(f)>=2)) |
---|
2726 | { |
---|
2727 | "local analysis of the singularities";""; |
---|
2728 | basering; |
---|
2729 | alpha; |
---|
2730 | f; |
---|
2731 | pause(); |
---|
2732 | ""; |
---|
2733 | } |
---|
2734 | } |
---|
2735 | option(noredSB); |
---|
2736 | ideal fstd=std(ideal(f)+jacob(f)); |
---|
2737 | poly hc=highcorner(fstd); |
---|
2738 | int tau=vdim(fstd); |
---|
2739 | int o=ord(f); |
---|
2740 | int delt,nb; |
---|
2741 | |
---|
2742 | if(tau==0) //smooth case |
---|
2743 | { |
---|
2744 | setring R; |
---|
2745 | option(set,save_opt); |
---|
2746 | return(list(0,0,1)); |
---|
2747 | } |
---|
2748 | if((char(basering)>=181)||(char(basering)==0)) |
---|
2749 | { |
---|
2750 | if(o==2) //A_k-singularity |
---|
2751 | { |
---|
2752 | if(w>=1){"A_k-singularity";"";} |
---|
2753 | setring R; |
---|
2754 | delt=(tau+1) div 2; |
---|
2755 | option(set,save_opt); |
---|
2756 | return(list(d*delt,d*tau,d*(2*delt-tau+1))); |
---|
2757 | } |
---|
2758 | if((lead(f)==var(1)*var(2)^2)||(lead(f)==var(1)^2*var(2))) |
---|
2759 | { |
---|
2760 | if(w>=1){"D_k- singularity";"";} |
---|
2761 | |
---|
2762 | setring R; |
---|
2763 | delt=(tau+2) div 2; |
---|
2764 | option(set,save_opt); |
---|
2765 | return(list(d*delt,d*tau,d*(2*delt-tau+1))); |
---|
2766 | } |
---|
2767 | |
---|
2768 | int mu=vdim(std(jacob(f))); |
---|
2769 | |
---|
2770 | poly g=f+var(1)^mu+var(2)^mu; //to obtain a convenient Newton-polygon |
---|
2771 | |
---|
2772 | list NP=newtonpoly(g); |
---|
2773 | if(w>=1){"Newton-Polygon:";NP;"";} |
---|
2774 | int s=size(NP); |
---|
2775 | |
---|
2776 | if(is_NND(f,mu,NP)) |
---|
2777 | { // the Newton-polygon is non-degenerate |
---|
2778 | // compute nb, the number of branches |
---|
2779 | for(i=1;i<=s-1;i++) |
---|
2780 | { |
---|
2781 | nb=nb+gcd(NP[i][2]-NP[i+1][2],NP[i][1]-NP[i+1][1]); |
---|
2782 | } |
---|
2783 | if(w>=1){"Newton-Polygon is non-degenerated";"";} |
---|
2784 | setring R; |
---|
2785 | option(set,save_opt); |
---|
2786 | return(list(d*(mu+nb-1) div 2,d*tau,d*nb)); |
---|
2787 | } |
---|
2788 | |
---|
2789 | if(w>=1){"Newton-Polygon is degenerated";"";} |
---|
2790 | /* need to re-consider the degree bound (de): |
---|
2791 | // the following can certainly be made more efficient when replacing |
---|
2792 | // 'hnexpansion' (used only for computing number of branches) by |
---|
2793 | // successive blowing-up + test if Newton polygon degenerate: |
---|
2794 | if(s>2) // splitting of f |
---|
2795 | { |
---|
2796 | if(w>=1){"Newton polygon can be used for splitting";"";} |
---|
2797 | intvec v=NP[1][2]-NP[2][2],NP[2][1]; |
---|
2798 | int de=w_deg(g,v); |
---|
2799 | //int st=w_deg(hc,v)+v[1]+v[2]; |
---|
2800 | int st=w_deg(var(1)^NP[size(NP)][1],v)+1; |
---|
2801 | poly f1=var(2)^NP[2][2]; |
---|
2802 | poly f2=jet(g,de,v)/var(2)^NP[2][2]; |
---|
2803 | poly h=g-f1*f2; |
---|
2804 | de=w_deg(h,v); |
---|
2805 | poly k; |
---|
2806 | ideal wi=var(2)^NP[2][2],f2; |
---|
2807 | matrix li; |
---|
2808 | while(de<st) |
---|
2809 | { |
---|
2810 | k=jet(h,de,v); |
---|
2811 | li=lift(wi,k); |
---|
2812 | f1=f1+li[2,1]; |
---|
2813 | f2=f2+li[1,1]; |
---|
2814 | h=g-f1*f2; |
---|
2815 | de=w_deg(h,v); |
---|
2816 | } |
---|
2817 | nb=deltaLoc(f1,maxideal(1))[3]+deltaLoc(f2,maxideal(1))[3]; |
---|
2818 | |
---|
2819 | setring R; |
---|
2820 | option(set,save_opt); |
---|
2821 | return(list(d*(mu+nb-1) div 2,d*tau,d*nb)); |
---|
2822 | } |
---|
2823 | */ |
---|
2824 | f=jet(f,deg(hc)+2); |
---|
2825 | if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";} |
---|
2826 | ideal fac=factorize(f,1); |
---|
2827 | if(size(fac)>1) |
---|
2828 | { |
---|
2829 | nb=0; |
---|
2830 | for(i=1;i<=size(fac);i++) |
---|
2831 | { |
---|
2832 | nb=nb+deltaLoc(fac[i],maxideal(1))[3]; |
---|
2833 | } |
---|
2834 | setring R; |
---|
2835 | option(set,save_opt); |
---|
2836 | return(list(d*(mu+nb-1) div 2,d*tau,d*nb)); |
---|
2837 | } |
---|
2838 | list HNEXP=hnexpansion(f); |
---|
2839 | if (typeof(HNEXP[1])=="ring") |
---|
2840 | { |
---|
2841 | def altring = basering; |
---|
2842 | def HNEring = HNEXP[1]; setring HNEring; |
---|
2843 | nb=size(hne); |
---|
2844 | setring R; |
---|
2845 | kill HNEring; |
---|
2846 | } |
---|
2847 | else |
---|
2848 | { |
---|
2849 | nb=size(HNEXP); |
---|
2850 | } |
---|
2851 | setring R; |
---|
2852 | option(set,save_opt); |
---|
2853 | return(list(d*(mu+nb-1) div 2,d*tau,d*nb)); |
---|
2854 | } |
---|
2855 | else //the case of small characteristic |
---|
2856 | { |
---|
2857 | f=jet(f,deg(hc)+2); |
---|
2858 | if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";} |
---|
2859 | delt=delta(f); |
---|
2860 | setring R; |
---|
2861 | option(set,save_opt); |
---|
2862 | return(list(d*delt,d*tau,d)); |
---|
2863 | } |
---|
2864 | option(set,save_opt); |
---|
2865 | } |
---|
2866 | example |
---|
2867 | { "EXAMPLE:"; echo = 2; |
---|
2868 | ring r=0,(x,y),dp; |
---|
2869 | poly f=(x2+y^2-1)^3 +27x2y2; |
---|
2870 | ideal I=f,jacob(f); |
---|
2871 | I=std(I); |
---|
2872 | list qr=minAssGTZ(I); |
---|
2873 | size(qr); |
---|
2874 | // each component of the singular locus either describes a cusp or a pair |
---|
2875 | // of conjugated nodes: |
---|
2876 | deltaLoc(f,qr[1]); |
---|
2877 | deltaLoc(f,qr[2]); |
---|
2878 | deltaLoc(f,qr[3]); |
---|
2879 | deltaLoc(f,qr[4]); |
---|
2880 | deltaLoc(f,qr[5]); |
---|
2881 | deltaLoc(f,qr[6]); |
---|
2882 | } |
---|
2883 | /////////////////////////////////////////////////////////////////////////////// |
---|
2884 | // compute the weighted degree of p; |
---|
2885 | // this code is an exact copy of the proc in paraplanecurves.lib |
---|
2886 | // (since we do not want to make it non-static) |
---|
2887 | static proc w_deg(poly p, intvec v) |
---|
2888 | { |
---|
2889 | if(p==0){return(-1);} |
---|
2890 | int d=0; |
---|
2891 | while(jet(p,d,v)==0){d++;} |
---|
2892 | d=(transpose(leadexp(jet(p,d,v)))*v)[1]; |
---|
2893 | return(d); |
---|
2894 | } |
---|
2895 | |
---|
2896 | //proc hilbPoly(ideal J) |
---|
2897 | //{ |
---|
2898 | // poly hp; |
---|
2899 | // int i; |
---|
2900 | // if(!attrib(J,"isSB")){J=std(J);} |
---|
2901 | // intvec v = hilb(J,2); |
---|
2902 | // for(i=1; i<=size(v); i++){ hp=hp+v[i]*(var(1)-i+2);} |
---|
2903 | // return(hp); |
---|
2904 | //} |
---|
2905 | |
---|
2906 | |
---|
2907 | ////////////////////////////////////////////////////////////////////////////// |
---|
2908 | |
---|
2909 | proc primeClosure (list L, list #) |
---|
2910 | "USAGE: primeClosure(L [,c]); L a list of a ring containing a prime ideal |
---|
2911 | ker, c an optional integer |
---|
2912 | RETURN: a list L (of size n+1) consisting of rings L[1],...,L[n] such that |
---|
2913 | - L[1] is a copy of (not a reference to!) the input ring L[1] |
---|
2914 | - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi |
---|
2915 | such that |
---|
2916 | L[1]/ker --> ... --> L[n]/ker |
---|
2917 | are injections given by the corresponding ideals phi, and L[n]/ker |
---|
2918 | is the integral closure of L[1]/ker in its quotient field. |
---|
2919 | - all rings L[i] contain a polynomial nzd such that elements of |
---|
2920 | L[i]/ker are quotients of elements of L[i-1]/ker with denominator |
---|
2921 | nzd via the injection phi. |
---|
2922 | L[n+1] is the delta invariant |
---|
2923 | NOTE: - L is constructed by recursive calls of primeClosure itself. |
---|
2924 | - c determines the choice of nzd: |
---|
2925 | - c not given or equal to 0: first generator of the ideal SL, |
---|
2926 | the singular locus of Spec(L[i]/ker) |
---|
2927 | - c<>0: the generator of SL with least number of monomials. |
---|
2928 | EXAMPLE: example primeClosure; shows an example |
---|
2929 | " |
---|
2930 | { |
---|
2931 | //---- Start with a consistency check: |
---|
2932 | |
---|
2933 | if (!(typeof(L[1])=="ring")) |
---|
2934 | { |
---|
2935 | "// Parameter must be a ring or a list containing a ring!"; |
---|
2936 | return(-1); |
---|
2937 | } |
---|
2938 | |
---|
2939 | int dblvl = printlevel-voice+2; |
---|
2940 | list gnirlist = ringlist(basering); |
---|
2941 | |
---|
2942 | //---- Some auxiliary variables: |
---|
2943 | int delt; //finally the delta invariant |
---|
2944 | if ( size(L) == 1 ) |
---|
2945 | { |
---|
2946 | L[2] = delt; //set delta to 0 |
---|
2947 | } |
---|
2948 | int n = size(L)-1; //L without delta invariant |
---|
2949 | |
---|
2950 | //---- How to choose the non-zerodivisor later on? |
---|
2951 | |
---|
2952 | int nzdoption=0; |
---|
2953 | if (size(#)>0) |
---|
2954 | { |
---|
2955 | nzdoption=#[1]; |
---|
2956 | } |
---|
2957 | |
---|
2958 | // R0 below is the ring to work with, if we are in step one, make a copy of the |
---|
2959 | // input ring, so that all objects are created in the copy, not in the original |
---|
2960 | // ring (therefore a copy, not a reference is defined). |
---|
2961 | |
---|
2962 | if (n==1) |
---|
2963 | { |
---|
2964 | def R = L[1]; |
---|
2965 | list Rlist = ringlist(R); |
---|
2966 | def BAS = basering; |
---|
2967 | setring R; |
---|
2968 | if (!(typeof(ker)=="ideal")) |
---|
2969 | { |
---|
2970 | "// No ideal ker in the input ring!"; |
---|
2971 | return (-1); |
---|
2972 | } |
---|
2973 | ker=simplify(interred(ker),15); |
---|
2974 | //execute ("ring R0="+charstr(R)+",("+varstr(R)+"),("+ordstr(R)+");"); |
---|
2975 | // Rlist may be not defined in this new ring, so we define it again. |
---|
2976 | list Rlist2 = ringlist(R); |
---|
2977 | def R0 = ring(Rlist2); |
---|
2978 | setring R0; |
---|
2979 | ideal ker=fetch(R,ker); |
---|
2980 | // check whether we compute the normalization of the blow up of |
---|
2981 | // an isolated singularity at the origin (checked in normalI) |
---|
2982 | |
---|
2983 | if (typeof(attrib(L[1],"iso_sing_Rees"))=="int") |
---|
2984 | { |
---|
2985 | attrib(R0,"iso_sing_Rees",attrib(L[1],"iso_sing_Rees")); |
---|
2986 | } |
---|
2987 | L[1]=R0; |
---|
2988 | } |
---|
2989 | else |
---|
2990 | { |
---|
2991 | def R0 = L[n]; |
---|
2992 | setring R0; |
---|
2993 | } |
---|
2994 | |
---|
2995 | // In order to apply HomJJ from normal.lib, we need the radical of the singular |
---|
2996 | // locus of ker, J:=rad(ker): |
---|
2997 | |
---|
2998 | list SM=mstd(ker); |
---|
2999 | |
---|
3000 | // In the first iteration, we have to compute the singular locus "from |
---|
3001 | // scratch". |
---|
3002 | // In further iterations, we can fetch it from the previous one but |
---|
3003 | // have to compute its radical |
---|
3004 | // the next rings R1 contain already the (fetched) ideal |
---|
3005 | |
---|
3006 | if (n==1) //we are in R0=L[1] |
---|
3007 | { |
---|
3008 | if (typeof(attrib(R0,"iso_sing_Rees"))=="int") |
---|
3009 | { |
---|
3010 | ideal J; |
---|
3011 | for (int s=1;s<=attrib(R0,"iso_sing_Rees");s++) |
---|
3012 | { |
---|
3013 | J=J,var(s); |
---|
3014 | } |
---|
3015 | J = J,SM[2]; |
---|
3016 | list JM = mstd(J); |
---|
3017 | } |
---|
3018 | else |
---|
3019 | { |
---|
3020 | if ( dblvl >= 1 ) |
---|
3021 | {""; |
---|
3022 | "// compute the singular locus"; |
---|
3023 | } |
---|
3024 | //### Berechnung des singulaeren Orts geaendert (ist so schneller) |
---|
3025 | ideal J = minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]); |
---|
3026 | J = J,SM[2]; |
---|
3027 | list JM = mstd(J); |
---|
3028 | } |
---|
3029 | |
---|
3030 | if ( dblvl >= 1 ) |
---|
3031 | {""; |
---|
3032 | "// dimension of singular locus is", dim(JM[1]); |
---|
3033 | if ( dblvl >= 2 ) |
---|
3034 | {""; |
---|
3035 | "// the singular locus is:"; JM[2]; |
---|
3036 | } |
---|
3037 | } |
---|
3038 | |
---|
3039 | if ( dblvl >= 1 ) |
---|
3040 | {""; |
---|
3041 | "// compute radical of singular locus"; |
---|
3042 | } |
---|
3043 | |
---|
3044 | J = simplify(radical(JM[2]),2); |
---|
3045 | if ( dblvl >= 1 ) |
---|
3046 | {""; |
---|
3047 | "// radical of singular locus is:"; J; |
---|
3048 | pause(); |
---|
3049 | } |
---|
3050 | } |
---|
3051 | else |
---|
3052 | { |
---|
3053 | if ( dblvl >= 1 ) |
---|
3054 | {""; |
---|
3055 | "// compute radical of test ideal in ideal of singular locus"; |
---|
3056 | } |
---|
3057 | J = simplify(radical(J),2); |
---|
3058 | if ( dblvl >= 1 ) |
---|
3059 | {""; |
---|
3060 | "// radical of test ideal is:"; J; |
---|
3061 | pause(); |
---|
3062 | } |
---|
3063 | } |
---|
3064 | |
---|
3065 | // having computed the radical J of/in the ideal of the singular locus, |
---|
3066 | // we now need to pick an element nzd of J; |
---|
3067 | // NOTE: nzd must be a non-zero divisor mod ker, i.e. not contained in ker |
---|
3068 | |
---|
3069 | poly nzd = J[1]; |
---|
3070 | poly nzd1 = NF(nzd,SM[1]); |
---|
3071 | if (nzd1 != 0) |
---|
3072 | { |
---|
3073 | if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) ) |
---|
3074 | { |
---|
3075 | nzd = nzd1; |
---|
3076 | } |
---|
3077 | } |
---|
3078 | |
---|
3079 | if (nzdoption || nzd1==0) |
---|
3080 | { |
---|
3081 | for (int ii=2;ii<=ncols(J);ii++) |
---|
3082 | { |
---|
3083 | nzd1 = NF(J[ii],SM[1]); |
---|
3084 | if ( nzd1 != 0 ) |
---|
3085 | { |
---|
3086 | if ( (deg(nzd)>=deg(J[ii])) && (size(nzd)>size(J[ii])) ) |
---|
3087 | { |
---|
3088 | nzd=J[ii]; |
---|
3089 | } |
---|
3090 | if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) ) |
---|
3091 | { |
---|
3092 | nzd = nzd1; |
---|
3093 | } |
---|
3094 | } |
---|
3095 | } |
---|
3096 | } |
---|
3097 | |
---|
3098 | export nzd; |
---|
3099 | // In this case we do not eliminate variables, so that the maps |
---|
3100 | // are well defined. |
---|
3101 | list RR = SM[1],SM[2],J,nzd,1; |
---|
3102 | |
---|
3103 | if ( dblvl >= 1 ) |
---|
3104 | {""; |
---|
3105 | "// compute the first ring extension:"; |
---|
3106 | "RR: "; |
---|
3107 | RR; |
---|
3108 | } |
---|
3109 | |
---|
3110 | list RS = HomJJ(RR); |
---|
3111 | //NOTE: HomJJ creates new ring with variables X(i) and T(j) |
---|
3112 | //------------------------------------------------------------------------- |
---|
3113 | // If we've reached the integral closure (as determined by the result of |
---|
3114 | // HomJJ), then we are done, otherwise we have to prepare the next iteration. |
---|
3115 | |
---|
3116 | if (RS[2]==1) // we've reached the integral closure, we are still in R0 |
---|
3117 | { |
---|
3118 | kill J; |
---|
3119 | if ( n== 1) |
---|
3120 | { |
---|
3121 | def R1 = RS[1]; |
---|
3122 | setring R1; |
---|
3123 | ideal norid, normap = endid, endphi; |
---|
3124 | kill endid, endphi; |
---|
3125 | |
---|
3126 | //"//### case: primeClosure, final"; |
---|
3127 | //"size norid:", size(norid), size(string(norid)); |
---|
3128 | //"interred:"; |
---|
3129 | //norid = interred(norid); |
---|
3130 | //"size norid:", size(norid), size(string(norid)); |
---|
3131 | |
---|
3132 | export (norid, normap); |
---|
3133 | L[1] = R1; |
---|
3134 | } |
---|
3135 | return(L); |
---|
3136 | } |
---|
3137 | else // prepare the next iteration |
---|
3138 | { |
---|
3139 | if (n==1) // In the first iteration: keep only the data |
---|
3140 | { // needed later on. |
---|
3141 | kill RR,SM; |
---|
3142 | export(ker); |
---|
3143 | } |
---|
3144 | if ( dblvl >= 1 ) |
---|
3145 | {""; |
---|
3146 | "// computing the next ring extension, we are in loop"; n+1; |
---|
3147 | } |
---|
3148 | |
---|
3149 | def R1 = RS[1]; // The data of the next ring R1: |
---|
3150 | delt = RS[3]; // the delta invariant of the ring extension |
---|
3151 | setring R1; // keep only what is necessary and kill |
---|
3152 | ideal ker=endid; // everything else. |
---|
3153 | export(ker); |
---|
3154 | ideal norid=endid; |
---|
3155 | |
---|
3156 | //"//### case: primeClosure, loop", n+1; |
---|
3157 | //"size norid:", size(norid), size(string(norid)); |
---|
3158 | //"interred:"; |
---|
3159 | //norid = interred(norid); //???? |
---|
3160 | //"size norid:", size(norid), size(string(norid)); |
---|
3161 | |
---|
3162 | export(norid); |
---|
3163 | kill endid; |
---|
3164 | |
---|
3165 | map phi = R0,endphi; // fetch the singular locus |
---|
3166 | ideal J = mstd(simplify(phi(J)+ker,4))[2]; // ideal J in R1 |
---|
3167 | export(J); |
---|
3168 | if(n>1) |
---|
3169 | { |
---|
3170 | ideal normap=phi(normap); |
---|
3171 | } |
---|
3172 | else |
---|
3173 | { |
---|
3174 | ideal normap=endphi; |
---|
3175 | } |
---|
3176 | export(normap); |
---|
3177 | kill phi; // we save phi as ideal, not as map, so that |
---|
3178 | ideal phi=endphi; // we have more flexibility in the ring names |
---|
3179 | kill endphi; // later on. |
---|
3180 | export(phi); |
---|
3181 | L=insert(L,R1,n); // Add the new ring R1 and go on with the |
---|
3182 | // next iteration |
---|
3183 | if ( L[size(L)] >= 0 && delt >= 0 ) |
---|
3184 | { |
---|
3185 | delt = L[size(L)] + delt; |
---|
3186 | } |
---|
3187 | else |
---|
3188 | { |
---|
3189 | delt = -1; |
---|
3190 | } |
---|
3191 | L[size(L)] = delt; |
---|
3192 | |
---|
3193 | if (size(#)>0) |
---|
3194 | { |
---|
3195 | return (primeClosure(L,#)); |
---|
3196 | } |
---|
3197 | else |
---|
3198 | { |
---|
3199 | return(primeClosure(L)); // next iteration. |
---|
3200 | } |
---|
3201 | } |
---|
3202 | } |
---|
3203 | example |
---|
3204 | { |
---|
3205 | "EXAMPLE:"; echo=2; |
---|
3206 | ring R=0,(x,y),dp; |
---|
3207 | ideal I=x4,y4; |
---|
3208 | def K=ReesAlgebra(I)[1]; // K contains ker such that K/ker=R[It] |
---|
3209 | list L=primeClosure(K); |
---|
3210 | def R(1)=L[1]; // L[4] contains ker, L[4]/ker is the |
---|
3211 | def R(4)=L[4]; // integral closure of L[1]/ker |
---|
3212 | setring R(1); |
---|
3213 | R(1); |
---|
3214 | ker; |
---|
3215 | setring R(4); |
---|
3216 | R(4); |
---|
3217 | ker; |
---|
3218 | } |
---|
3219 | |
---|
3220 | /////////////////////////////////////////////////////////////////////////////// |
---|
3221 | |
---|
3222 | proc closureFrac(list L) |
---|
3223 | "USAGE: closureFrac (L); L a list of size n+1 as in the result of |
---|
3224 | primeClosure, L[n] contains an additional polynomial f |
---|
3225 | CREATE: a list fraction of two elements of L[1], such that |
---|
3226 | f=fraction[1]/fraction[2] via the injections phi L[i]-->L[i+1]. |
---|
3227 | EXAMPLE: example closureFrac; shows an example |
---|
3228 | " |
---|
3229 | { |
---|
3230 | // Define some auxiliary variables: |
---|
3231 | |
---|
3232 | int n=size(L)-1; |
---|
3233 | int i,j,k,l,n2,n3; |
---|
3234 | intvec V; |
---|
3235 | string mapstr; |
---|
3236 | for (i=1; i<=n; i++) |
---|
3237 | { |
---|
3238 | ASSUME(0, not isQuotientRing( L[i] ) ); |
---|
3239 | def R(i) = L[i]; |
---|
3240 | } |
---|
3241 | |
---|
3242 | // The quotient representing f is computed as in 'closureGenerators' with |
---|
3243 | // the differences that |
---|
3244 | // - the loop is done twice: for the numerator and for the denominator; |
---|
3245 | // - the result is stored in the list fraction and |
---|
3246 | // - we have to make sure that no more objects of the rings R(i) survive. |
---|
3247 | |
---|
3248 | for (j=1; j<=2; j++) |
---|
3249 | { |
---|
3250 | setring R(n); |
---|
3251 | if (j==1) |
---|
3252 | { |
---|
3253 | poly p=f; |
---|
3254 | } |
---|
3255 | else |
---|
3256 | { |
---|
3257 | p=1; |
---|
3258 | } |
---|
3259 | |
---|
3260 | for (k=n; k>1; k--) |
---|
3261 | { |
---|
3262 | if (j==1) |
---|
3263 | { |
---|
3264 | map phimap=R(k-1),phi; |
---|
3265 | } |
---|
3266 | |
---|
3267 | p=p*phimap(nzd); |
---|
3268 | |
---|
3269 | if (j==2) |
---|
3270 | { |
---|
3271 | kill phimap; |
---|
3272 | } |
---|
3273 | |
---|
3274 | if (j==1) |
---|
3275 | { |
---|
3276 | //### noch abfragen ob Z(i) definiert ist |
---|
3277 | list gnirlist = ringlist(R(k)); |
---|
3278 | n2 = size(gnirlist[2]); |
---|
3279 | n3 = size(gnirlist[3]); |
---|
3280 | for( i=1; i<=ncols(phi); i++) |
---|
3281 | { |
---|
3282 | gnirlist[2][n2+i] = "Z("+string(i)+")"; |
---|
3283 | } |
---|
3284 | V=0; |
---|
3285 | V[ncols(phi)]=0; V=V+1; |
---|
3286 | gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1); |
---|
3287 | def S(k) = ring(gnirlist); |
---|
3288 | setring S(k); |
---|
3289 | |
---|
3290 | //execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+", |
---|
3291 | // Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k))) |
---|
3292 | // +"),dp("+string(ncols(phi))+"));"); |
---|
3293 | |
---|
3294 | ideal phi = imap(R(k),phi); |
---|
3295 | ideal J = imap (R(k),ker); |
---|
3296 | for (l=1;l<=ncols(phi);l++) |
---|
3297 | { |
---|
3298 | J=J+(Z(l)-phi[l]); |
---|
3299 | } |
---|
3300 | J=groebner(J); |
---|
3301 | poly h=NF(imap(R(k),p),J); |
---|
3302 | } |
---|
3303 | else |
---|
3304 | { |
---|
3305 | setring S(k); |
---|
3306 | h=NF(imap(R(k),p),J); |
---|
3307 | setring R(k); |
---|
3308 | kill p; |
---|
3309 | } |
---|
3310 | |
---|
3311 | setring R(k-1); |
---|
3312 | |
---|
3313 | if (j==1) |
---|
3314 | { |
---|
3315 | ideal maxi; |
---|
3316 | maxi[nvars(R(k))] = 0; |
---|
3317 | maxi = maxi,maxideal(1); |
---|
3318 | map backmap = S(k),maxi; |
---|
3319 | |
---|
3320 | //mapstr=" map backmap = S(k),"; |
---|
3321 | //for (l=1;l<=nvars(R(k));l++) |
---|
3322 | //{ |
---|
3323 | // mapstr=mapstr+"0,"; |
---|
3324 | //} |
---|
3325 | //execute (mapstr+"maxideal(1);"); |
---|
3326 | poly p; |
---|
3327 | } |
---|
3328 | p=NF(backmap(h),std(ker)); |
---|
3329 | if (j==2) |
---|
3330 | { |
---|
3331 | kill backmap; |
---|
3332 | } |
---|
3333 | } |
---|
3334 | |
---|
3335 | if (j==1) |
---|
3336 | { |
---|
3337 | if (defined(fraction)) |
---|
3338 | { |
---|
3339 | kill fraction; |
---|
3340 | list fraction=p; |
---|
3341 | } |
---|
3342 | else |
---|
3343 | { |
---|
3344 | list fraction=p; |
---|
3345 | } |
---|
3346 | } |
---|
3347 | else |
---|
3348 | { |
---|
3349 | fraction=insert(fraction,p,1); |
---|
3350 | } |
---|
3351 | } |
---|
3352 | export(fraction); |
---|
3353 | return (); |
---|
3354 | } |
---|
3355 | example |
---|
3356 | { |
---|
3357 | "EXAMPLE:"; echo=2; |
---|
3358 | ring R=0,(x,y),dp; |
---|
3359 | ideal ker=x2+y2; |
---|
3360 | export ker; |
---|
3361 | list L=primeClosure(R); // We normalize R/ker |
---|
3362 | for (int i=1;i<=size(L);i++) { def R(i)=L[i]; } |
---|
3363 | setring R(2); |
---|
3364 | kill R; |
---|
3365 | phi; // The map R(1)-->R(2) |
---|
3366 | poly f=T(2); // We will get a representation of f |
---|
3367 | export f; |
---|
3368 | L[2]=R(2); |
---|
3369 | closureFrac(L); |
---|
3370 | setring R(1); |
---|
3371 | kill R(2); |
---|
3372 | fraction; // f=fraction[1]/fraction[2] via phi |
---|
3373 | kill R(1); |
---|
3374 | } |
---|
3375 | |
---|
3376 | /////////////////////////////////////////////////////////////////////////////// |
---|
3377 | // closureGenerators is called inside proc normal (option "withGens" ) |
---|
3378 | // |
---|
3379 | |
---|
3380 | // INPUT is the output of proc primeClosure (except for the last element, the |
---|
3381 | // delta invariant) : hence input is a list L consisting of rings |
---|
3382 | // L[1],...,L[n] (denoted R(1)...R(n) below) such that |
---|
3383 | // - L[1] is a copy of (not a reference to!) the input ring L[1] |
---|
3384 | // - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi |
---|
3385 | // such that |
---|
3386 | // L[1]/ker --> ... --> L[n]/ker |
---|
3387 | // are injections given by the corresponding ideals phi, and L[n]/ker |
---|
3388 | // is the integral closure of L[1]/ker in its quotient field. |
---|
3389 | // - all rings L[i] contain a polynomial nzd such that elements of |
---|
3390 | // L[i]/ker are quotients of elements of L[i-1]/ker with denominator |
---|
3391 | // nzd via the injection phi. |
---|
3392 | |
---|
3393 | // COMPUTE: In the list L of rings R(1),...,R(n), compute representations of |
---|
3394 | // the ring variables of the last ring R(n) as fractions of elements of R(1): |
---|
3395 | // The proc returns an ideal preim s.t. preim[i]/preim[size(preim)] expresses |
---|
3396 | // the ith variable of R(n) as fraction of elements of the basering R(1) |
---|
3397 | // preim[size(preim)] is a non-zero divisor of basering/i. |
---|
3398 | |
---|
3399 | proc closureGenerators(list L); |
---|
3400 | { |
---|
3401 | def Rees=basering; // when called inside normalI (in reesclos.lib) |
---|
3402 | // the Rees Algebra is the current basering |
---|
3403 | |
---|
3404 | // ------- First of all we need some variable declarations ----------- |
---|
3405 | int n = size(L); // the number of rings R(1)-->...-->R(n) |
---|
3406 | int length = nvars(L[n]); // the number of variables of the last ring |
---|
3407 | int j,k,l,n2,n3; |
---|
3408 | intvec V; |
---|
3409 | string mapstr; |
---|
3410 | list preimages; |
---|
3411 | //Note: the empty list belongs to no ring, hence preimages can be used |
---|
3412 | //later in R(1) |
---|
3413 | //this is not possible for ideals (belong always to some ring) |
---|
3414 | |
---|
3415 | for (int i=1; i<=n; i++) |
---|
3416 | { |
---|
3417 | ASSUME(0, not isQuotientRing(L[i]) ); |
---|
3418 | def R(i) = L[i]; //give the rings from L a name |
---|
3419 | } |
---|
3420 | |
---|
3421 | // For each variable (counter j) and for each intermediate ring (counter k): |
---|
3422 | // Find a preimage of var_j*phi(nzd(k-1)) in R(k-1). |
---|
3423 | // Finally, do the same for nzd. |
---|
3424 | |
---|
3425 | for (j=1; j <= length+1; j++ ) |
---|
3426 | { |
---|
3427 | setring R(n); |
---|
3428 | |
---|
3429 | if (j==1) |
---|
3430 | { |
---|
3431 | poly p; |
---|
3432 | } |
---|
3433 | if (j <= length ) |
---|
3434 | { |
---|
3435 | p=var(j); |
---|
3436 | } |
---|
3437 | else |
---|
3438 | { |
---|
3439 | p=1; |
---|
3440 | } |
---|
3441 | //i.e. p=j-th var of R(n) for j<=length and p=1 for j=length+1 |
---|
3442 | |
---|
3443 | for (k=n; k>1; k--) |
---|
3444 | { |
---|
3445 | |
---|
3446 | if (j==1) |
---|
3447 | { |
---|
3448 | map phimap=R(k-1),phi; //phimap:R(k-1)-->R(n), k=2..n, is the map |
---|
3449 | //belonging to phi in R(n) |
---|
3450 | } |
---|
3451 | |
---|
3452 | p = p*phimap(nzd); |
---|
3453 | |
---|
3454 | // Compute the preimage of [p mod ker(k)] under phi in R(k-1): |
---|
3455 | // As p is an element of Image(phi), there is a polynomial h such |
---|
3456 | // that h is mapped to [p mod ker(k)], and h can be computed as the |
---|
3457 | // normal form of p w.r.t. a Groebner basis of |
---|
3458 | // J(k) := <ker(k),Z(l)-phi(k)(l)> in R(k)[Z]=:S(k) |
---|
3459 | |
---|
3460 | if (j==1) // In the first iteration: Create S(k), fetch phi and |
---|
3461 | // ker(k) and construct the ideal J(k). |
---|
3462 | { |
---|
3463 | //### noch abfragen ob Z(i) definiert ist |
---|
3464 | list gnirlist = ringlist(R(k)); |
---|
3465 | n2 = size(gnirlist[2]); |
---|
3466 | n3 = size(gnirlist[3]); |
---|
3467 | for( i=1; i<=ncols(phi); i++) |
---|
3468 | { |
---|
3469 | gnirlist[2][n2+i] = "Z("+string(i)+")"; |
---|
3470 | } |
---|
3471 | V=0; |
---|
3472 | V[ncols(phi)]=0; |
---|
3473 | V=V+1; |
---|
3474 | gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1); |
---|
3475 | def S(k) = ring(gnirlist); |
---|
3476 | setring S(k); |
---|
3477 | |
---|
3478 | // execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+", |
---|
3479 | // Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k))) |
---|
3480 | // +"),dp("+string(ncols(phi))+"));"); |
---|
3481 | |
---|
3482 | ideal phi = imap(R(k),phi); |
---|
3483 | ideal J = imap (R(k),ker); |
---|
3484 | for ( l=1; l<=ncols(phi); l++ ) |
---|
3485 | { |
---|
3486 | J=J+(Z(l)-phi[l]); |
---|
3487 | } |
---|
3488 | J = groebner(J); |
---|
3489 | poly h = NF(imap(R(k),p),J); |
---|
3490 | } |
---|
3491 | else |
---|
3492 | { |
---|
3493 | setring S(k); |
---|
3494 | h = NF(imap(R(k),p),J); |
---|
3495 | } |
---|
3496 | |
---|
3497 | setring R(k-1); |
---|
3498 | |
---|
3499 | if (j==1) // In the first iteration: Compute backmap:S(k)-->R(k-1) |
---|
3500 | { |
---|
3501 | ideal maxi; |
---|
3502 | maxi[nvars(R(k))] = 0; |
---|
3503 | maxi = maxi,maxideal(1); |
---|
3504 | map backmap = S(k),maxi; |
---|
3505 | |
---|
3506 | //mapstr=" map backmap = S(k),"; |
---|
3507 | //for (l=1;l<=nvars(R(k));l++) |
---|
3508 | //{ |
---|
3509 | // mapstr=mapstr+"0,"; |
---|
3510 | //} |
---|
3511 | //execute (mapstr+"maxideal(1);"); |
---|
3512 | |
---|
3513 | poly p; |
---|
3514 | } |
---|
3515 | p = NF(backmap(h),std(ker)); |
---|
3516 | } |
---|
3517 | // Whe are down to R(1), store here the result in the list preimages |
---|
3518 | preimages = insert(preimages,p,j-1); |
---|
3519 | } |
---|
3520 | ideal preim; //make the list preimages to an ideal preim |
---|
3521 | for ( i=1; i<=size(preimages); i++ ) |
---|
3522 | { |
---|
3523 | preim[i] = preimages[i]; |
---|
3524 | } |
---|
3525 | // R(1) was a copy of Rees, so we have to get back to the basering Rees from |
---|
3526 | // the beginning and fetch the result (the ideal preim) to this ring. |
---|
3527 | setring Rees; |
---|
3528 | return (fetch(R(1),preim)); |
---|
3529 | } |
---|
3530 | |
---|
3531 | /////////////////////////////////////////////////////////////////////////////// |
---|
3532 | // From here: procedures for char p with Frobenius |
---|
3533 | /////////////////////////////////////////////////////////////////////////////// |
---|
3534 | |
---|
3535 | proc normalP(ideal id,list #) |
---|
3536 | "USAGE: normalP(id [,choose]); id = radical ideal, choose = optional list of |
---|
3537 | strings. |
---|
3538 | Optional parameters in list choose (can be entered in any order):@* |
---|
3539 | \"withRing\", \"isPrim\", \"noFac\", \"noRed\", where@* |
---|
3540 | - \"noFac\" -> factorization is avoided during the computation |
---|
3541 | of the minimal associated primes.@* |
---|
3542 | - \"isPrim\" -> assumes that the ideal is prime. If the assumption |
---|
3543 | does not hold, output might be wrong.@* |
---|
3544 | - \"withRing\" -> the ring structure of the normalization is |
---|
3545 | computed. The number of variables in the new ring is reduced as much |
---|
3546 | as possible.@* |
---|
3547 | - \"noRed\" -> when computing the ring structure, no reduction on the |
---|
3548 | number of variables is done, it creates one new variable for every |
---|
3549 | new module generator of the integral closure in the quotient field.@* |
---|
3550 | ASSUME: The characteristic of the ground field must be positive. If the |
---|
3551 | option \"isPrim\" is not set, the minimal associated primes of id |
---|
3552 | are computed first and hence normalP computes the normalization of |
---|
3553 | the radical of id. If option \"isPrim\" is set, the ideal must be |
---|
3554 | a prime ideal otherwise the result may be wrong. |
---|
3555 | RETURN: a list, say 'nor' of size 2 (resp. 3 if \"withRing\" is set).@* |
---|
3556 | ** If option \"withRing\" is not set: @* |
---|
3557 | Only the module structure is computed: @* |
---|
3558 | * nor[1] is a list of ideals Ii, i=1..r, in the basering R where r |
---|
3559 | is the number of minimal associated prime ideals P_i of the input |
---|
3560 | ideal id, describing the module structure:@* |
---|
3561 | If Ii is given by polynomials g_1,...,g_k in R, then c:=g_k is |
---|
3562 | non-zero in the ring R/P_i and g_1/c,...,g_k/c generate the integral |
---|
3563 | closure of R/P_i as R-module in the quotient field of R/P_i.@* |
---|
3564 | * nor[2] shows the delta invariants: it is a list of an intvec |
---|
3565 | of size r, the delta invariants of the r components, and an integer, |
---|
3566 | the total delta invariant of R/id |
---|
3567 | (-1 means infinite, and 0 that R/P_i resp. R/id is normal). @* |
---|
3568 | ** If option \"withRing\" is set: @* |
---|
3569 | The ring structure is also computed, and in this case:@* |
---|
3570 | * nor[1] is a list of r rings.@* |
---|
3571 | Each ring Ri = nor[1][i], i=1..r, contains two ideals with given |
---|
3572 | names @code{norid} and @code{normap} such that @* |
---|
3573 | - Ri/norid is the normalization of R/P_i, i.e. isomorphic as |
---|
3574 | K-algebra (K the ground field) to the integral closure of R/P_i in |
---|
3575 | the field of fractions of R/P_i; @* |
---|
3576 | - the direct sum of the rings Ri/norid is the normalization |
---|
3577 | of R/id; @* |
---|
3578 | - @code{normap} gives the normalization map from R to Ri/norid.@* |
---|
3579 | * nor[2] gives the module generators of the normalization of R/P_i, |
---|
3580 | it is the same as nor[1] if \"withRing\" is not set.@* |
---|
3581 | * nor[3] shows the delta invariants, it is the same as nor[2] if |
---|
3582 | \"withRing\" is not set. |
---|
3583 | THEORY: normalP uses the Leonard-Pellikaan-Singh-Swanson algorithm (using the |
---|
3584 | Frobenius) cf. [A. K. Singh, I. Swanson: An algorithm for computing |
---|
3585 | the integral closure, arXiv:0901.0871]. |
---|
3586 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
3587 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
3588 | id. The procedure returns the delta invariants of the components P_i |
---|
3589 | and of id. |
---|
3590 | NOTE: To use the i-th ring type: @code{def R=nor[1][i]; setring R;}. |
---|
3591 | @* Increasing/decreasing printlevel displays more/less comments |
---|
3592 | (default: printlevel = 0). |
---|
3593 | @* Not implemented for local or mixed orderings or quotient rings. |
---|
3594 | For local or mixed orderings use proc 'normal'. |
---|
3595 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
3596 | be used (qhweight(id); computes weights). |
---|
3597 | @* Works only in characteristic p > 0; use proc normal in char 0. |
---|
3598 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
3599 | SEE ALSO: normal, normalC |
---|
3600 | EXAMPLE: example normalP; shows an example |
---|
3601 | " |
---|
3602 | { |
---|
3603 | ASSUME(0, not isQuotientRing(basering) ); |
---|
3604 | |
---|
3605 | int i,j,y, sr, del, co; |
---|
3606 | intvec deli; |
---|
3607 | list resu, Resu, prim, Gens, mstdid; |
---|
3608 | ideal gens; |
---|
3609 | |
---|
3610 | // Default options |
---|
3611 | int wring = 0; // The ring structure is not computed. |
---|
3612 | int noRed = 0; // No reduction is done in the ring structure |
---|
3613 | int isPrim = 0; // Ideal is not assumed to be prime |
---|
3614 | int noFac = 0; // Use facstd when computing the decomposition |
---|
3615 | |
---|
3616 | |
---|
3617 | y = printlevel-voice+2; |
---|
3618 | |
---|
3619 | if ( attrib(basering,"global") != 1) |
---|
3620 | { |
---|
3621 | ""; |
---|
3622 | "// Not implemented for this ordering,"; |
---|
3623 | "// please change to global ordering!"; |
---|
3624 | return(resu); |
---|
3625 | } |
---|
3626 | if ( char(basering) <= 0) |
---|
3627 | { |
---|
3628 | ""; |
---|
3629 | "// Algorithm works only in positive characteristic,"; |
---|
3630 | "// use procedure 'normal' if the characteristic is 0"; |
---|
3631 | return(resu); |
---|
3632 | } |
---|
3633 | |
---|
3634 | //--------------------------- define the method --------------------------- |
---|
3635 | string method; //make all options one string in order to use |
---|
3636 | //all combinations of options simultaneously |
---|
3637 | for ( i=1; i<= size(#); i++ ) |
---|
3638 | { |
---|
3639 | if ( typeof(#[i]) == "string" ) |
---|
3640 | { |
---|
3641 | method = method + #[i]; |
---|
3642 | } |
---|
3643 | } |
---|
3644 | |
---|
3645 | if ( find(method,"withring") or find(method,"withRing") ) |
---|
3646 | { |
---|
3647 | wring=1; |
---|
3648 | } |
---|
3649 | if ( find(method,"noRed") or find(method,"nored") ) |
---|
3650 | { |
---|
3651 | noRed=1; |
---|
3652 | } |
---|
3653 | if ( find(method,"isPrim") or find(method,"isprim") ) |
---|
3654 | { |
---|
3655 | isPrim=1; |
---|
3656 | } |
---|
3657 | if ( find(method,"noFac") or find(method,"nofac")) |
---|
3658 | { |
---|
3659 | noFac=1; |
---|
3660 | } |
---|
3661 | |
---|
3662 | kill #; |
---|
3663 | list #; |
---|
3664 | //--------------------------- start computation --------------------------- |
---|
3665 | ideal II,K1,K2; |
---|
3666 | |
---|
3667 | //----------- check first (or ignore) if input id is prime ------------- |
---|
3668 | |
---|
3669 | if ( isPrim ) |
---|
3670 | { |
---|
3671 | prim[1] = id; |
---|
3672 | if( y >= 0 ) |
---|
3673 | { ""; |
---|
3674 | "// ** WARNING: result is correct if ideal is prime (not checked) **"; |
---|
3675 | "// disable option \"isPrim\" to decompose ideal into prime components";""; |
---|
3676 | } |
---|
3677 | } |
---|
3678 | else |
---|
3679 | { |
---|
3680 | if(y>=1) |
---|
3681 | { "// compute minimal associated primes"; } |
---|
3682 | |
---|
3683 | if( noFac ) |
---|
3684 | { prim = minAssGTZ(id,1); } |
---|
3685 | else |
---|
3686 | { prim = minAssGTZ(id); } |
---|
3687 | |
---|
3688 | if(y>=1) |
---|
3689 | { |
---|
3690 | prim;""; |
---|
3691 | "// number of irreducible components is", size(prim); |
---|
3692 | } |
---|
3693 | } |
---|
3694 | |
---|
3695 | //----------- compute integral closure for every component ------------- |
---|
3696 | |
---|
3697 | for(i=1; i<=size(prim); i++) |
---|
3698 | { |
---|
3699 | if(y>=1) |
---|
3700 | { |
---|
3701 | ""; pause(); ""; |
---|
3702 | "// start computation of component",i; |
---|
3703 | " --------------------------------"; |
---|
3704 | } |
---|
3705 | if(y>=1) |
---|
3706 | { "// compute SB of ideal"; |
---|
3707 | } |
---|
3708 | mstdid = mstd(prim[i]); |
---|
3709 | if(y>=1) |
---|
3710 | { "// dimension of component is", dim(mstdid[1]);"";} |
---|
3711 | |
---|
3712 | //------- 1-st main subprocedure: compute module generators ---------- |
---|
3713 | printlevel = printlevel+1; |
---|
3714 | II = normalityTest(mstdid); |
---|
3715 | |
---|
3716 | //------ compute also the ringstructure if "withRing" is given ------- |
---|
3717 | if ( wring ) |
---|
3718 | { |
---|
3719 | //------ 2-nd main subprocedure: compute ring structure ----------- |
---|
3720 | if(noRed == 0){ |
---|
3721 | resu = list(computeRing(II,prim[i])) + resu; |
---|
3722 | } |
---|
3723 | else |
---|
3724 | { |
---|
3725 | resu = list(computeRing(II,prim[i], "noRed")) + resu; |
---|
3726 | } |
---|
3727 | } |
---|
3728 | printlevel = printlevel-1; |
---|
3729 | |
---|
3730 | //----- rearrange module generators s.t. denominator comes last ------ |
---|
3731 | gens=0; |
---|
3732 | for( j=2; j<=size(II); j++ ) |
---|
3733 | { |
---|
3734 | gens[j-1]=II[j]; |
---|
3735 | } |
---|
3736 | gens[size(gens)+1]=II[1]; |
---|
3737 | Gens = list(gens) + Gens; |
---|
3738 | //------------------------------ compute delta ----------------------- |
---|
3739 | K1 = mstdid[1]+II; |
---|
3740 | K1 = std(K1); |
---|
3741 | K2 = mstdid[1]+II[1]; |
---|
3742 | K2 = std(K2); |
---|
3743 | // K1 = std(mstdid[1],II); //### besser |
---|
3744 | // K2 = std(mstdid[1],II[1]); //### besser: Hannes, fixen! |
---|
3745 | co = codim(K1,K2); |
---|
3746 | deli = co,deli; |
---|
3747 | if ( co >= 0 && del >= 0 ) |
---|
3748 | { |
---|
3749 | del = del + co; |
---|
3750 | } |
---|
3751 | else |
---|
3752 | { del = -1; } |
---|
3753 | } |
---|
3754 | |
---|
3755 | if ( del >= 0 ) |
---|
3756 | { |
---|
3757 | int mul = iMult(prim); |
---|
3758 | del = del + mul; |
---|
3759 | } |
---|
3760 | else |
---|
3761 | { del = -1; } |
---|
3762 | |
---|
3763 | deli = deli[1..size(deli)-1]; |
---|
3764 | if ( wring ) |
---|
3765 | { Resu = resu,Gens,list(deli,del); } |
---|
3766 | else |
---|
3767 | { Resu = Gens,list(deli,del); } |
---|
3768 | |
---|
3769 | sr = size(prim); |
---|
3770 | |
---|
3771 | //-------------------- Finally print comments and return -------------------- |
---|
3772 | if(y >= 0) |
---|
3773 | {""; |
---|
3774 | if ( wring ) |
---|
3775 | { |
---|
3776 | "// 'normalP' created a list, say nor, of three lists: |
---|
3777 | // To see the result, type |
---|
3778 | nor; |
---|
3779 | |
---|
3780 | // * nor[1] is a list of",sr,"ring(s): |
---|
3781 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
3782 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
3783 | // for the other rings type first setring R; (if R is the name of your |
---|
3784 | // original basering) and then continue as for R1; |
---|
3785 | // Ri/norid is the affine algebra of the normalization of the i-th |
---|
3786 | // component R/P_i (where P_i is a min. associated prime of the input ideal) |
---|
3787 | // and normap the normalization map from R to Ri/norid; |
---|
3788 | |
---|
3789 | // * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of |
---|
3790 | // elements g1..gk of r such that the gj/gk generate the integral |
---|
3791 | // closure of R/P_i as R-module in the quotient field of R/P_i. |
---|
3792 | |
---|
3793 | // * nor[3] shows the delta-invariant of each component and of the input |
---|
3794 | // ideal (-1 means infinite, and 0 that r/P_i is normal)."; |
---|
3795 | } |
---|
3796 | else |
---|
3797 | { |
---|
3798 | "// 'normalP' computed a list, say nor, of two lists: |
---|
3799 | // To see the result, type |
---|
3800 | nor; |
---|
3801 | |
---|
3802 | // * nor[1] is a list of",sr,"ideal(s), where each ideal nor[1][i] consists |
---|
3803 | // of elements g1..gk of the basering R such that gj/gk generate the integral |
---|
3804 | // closure of R/P_i (where P_i is a min. associated prime of the input ideal) |
---|
3805 | // as R-module in the quotient field of R/P_i; |
---|
3806 | |
---|
3807 | // * nor[2] shows the delta-invariant of each component and of the input ideal |
---|
3808 | // (-1 means infinite, and 0 that R/P_i is normal)."; |
---|
3809 | } |
---|
3810 | } |
---|
3811 | |
---|
3812 | return(Resu); |
---|
3813 | } |
---|
3814 | example |
---|
3815 | { "EXAMPLE:"; echo = 2; |
---|
3816 | ring r = 11,(x,y,z),wp(2,1,2); |
---|
3817 | ideal i = x*(z3 - xy4 + x2); |
---|
3818 | list nor= normalP(i); nor; |
---|
3819 | //the result says that both components of i are normal, but i itself |
---|
3820 | //has infinite delta |
---|
3821 | pause("hit return to continue"); |
---|
3822 | |
---|
3823 | ring s = 2,(x,y),dp; |
---|
3824 | ideal i = y*((x-y^2)^2 - x^3); |
---|
3825 | list nor = normalP(i,"withRing"); nor; |
---|
3826 | |
---|
3827 | def R2 = nor[1][2]; setring R2; |
---|
3828 | norid; normap; |
---|
3829 | } |
---|
3830 | |
---|
3831 | /////////////////////////////////////////////////////////////////////////////// |
---|
3832 | // Assume: mstdid is the result of mstd(prim[i]), prim[i] a prime component of |
---|
3833 | // the input ideal id of normalP. |
---|
3834 | // Output is an ideal U s.t. U[i]/U[1] are module generators. |
---|
3835 | |
---|
3836 | static proc normalityTest(list mstdid) |
---|
3837 | { |
---|
3838 | ASSUME(1, not isQuotientRing(basering) ); |
---|
3839 | |
---|
3840 | int y = printlevel-voice+2; |
---|
3841 | intvec op = option(get); |
---|
3842 | option(redSB); |
---|
3843 | def R = basering; |
---|
3844 | int n, p = nvars(R), char(R); |
---|
3845 | int ii; |
---|
3846 | |
---|
3847 | ideal J = mstdid[1]; //J is the SB of I |
---|
3848 | ideal I = mstdid[2]; |
---|
3849 | int h = n-dim(J); //codimension of V(I), I is a prime ideal |
---|
3850 | |
---|
3851 | //-------------------------- compute singular locus ---------------------- |
---|
3852 | qring Q = J; //pass to quotient ring |
---|
3853 | ideal I = imap(R,I); |
---|
3854 | ideal J = imap(R,J); |
---|
3855 | attrib(J,"isSB",1); |
---|
3856 | if ( y >= 1) |
---|
3857 | { "start normality test"; "compute singular locus";} |
---|
3858 | |
---|
3859 | ideal M = minor(jacob(I),h,J); //use the command minor modulo J (hence J=0) |
---|
3860 | M = std(M); //this makes M much smaller |
---|
3861 | //keep only minors which are not 0 mod I (!) this is important since we |
---|
3862 | //need a nzd mod I |
---|
3863 | |
---|
3864 | //---------------- choose nzd from ideal of singular locus -------------- |
---|
3865 | ideal D = M[1]; |
---|
3866 | for( ii=2; ii<=size(M); ii++ ) //look for the shortest one |
---|
3867 | { |
---|
3868 | if( size(M[ii]) < size(D[1]) ) |
---|
3869 | { |
---|
3870 | D = M[ii]; |
---|
3871 | } |
---|
3872 | } |
---|
3873 | |
---|
3874 | //--------------- start p-th power algorithm and return ---------------- |
---|
3875 | ideal F = var(1)^p; |
---|
3876 | for(ii=2; ii<=n; ii++) |
---|
3877 | { |
---|
3878 | F=F,var(ii)^p; |
---|
3879 | } |
---|
3880 | |
---|
3881 | ideal Dp=D^(p-1); |
---|
3882 | ideal U=1; |
---|
3883 | ideal K,L; |
---|
3884 | map phi=Q,F; |
---|
3885 | if ( y >= 1) |
---|
3886 | { "compute module generators of integral closure"; |
---|
3887 | "denominator D is:"; D; |
---|
3888 | pause(); |
---|
3889 | } |
---|
3890 | |
---|
3891 | ii=0; |
---|
3892 | list LK; |
---|
3893 | while(1) |
---|
3894 | { |
---|
3895 | ii=ii+1; |
---|
3896 | if ( y >= 1) |
---|
3897 | { "iteration", ii; } |
---|
3898 | L = U*Dp + I; |
---|
3899 | //### L=interred(L) oder mstd(L)[2]? |
---|
3900 | //Wird dadurch kleiner aber string(L) wird groesser |
---|
3901 | K = preimage(Q,phi,L); //### Improvement by block ordering? |
---|
3902 | option(returnSB); |
---|
3903 | K = intersect(U,K); //K is the new U, it is a SB |
---|
3904 | LK = mstd(K); |
---|
3905 | K = LK[2]; |
---|
3906 | |
---|
3907 | //---------------------------- simplify output -------------------------- |
---|
3908 | if(size(reduce(U,LK[1]))==0) //previous U coincides with new U |
---|
3909 | { //i.e. we reached the integral closure |
---|
3910 | U=simplify(reduce(U,groebner(D)),2); |
---|
3911 | U = D,U; |
---|
3912 | poly gg = gcd(U[1],U[size(U)]); |
---|
3913 | for(ii=2; ii<=size(U)-1 ;ii++) |
---|
3914 | { |
---|
3915 | gg = gcd(gg,U[ii]); |
---|
3916 | } |
---|
3917 | for(ii=1; ii<=size(U); ii++) |
---|
3918 | { |
---|
3919 | U[ii]=U[ii]/gg; |
---|
3920 | } |
---|
3921 | U = simplify(U,6); |
---|
3922 | //if ( y >= 1) |
---|
3923 | //{ "module generators are U[i]/U[1], with U:"; U; |
---|
3924 | // ""; pause(); } |
---|
3925 | setring R; |
---|
3926 | option(set,op); |
---|
3927 | ideal U = imap(Q,U); |
---|
3928 | return(U); |
---|
3929 | } |
---|
3930 | U=K; |
---|
3931 | } |
---|
3932 | } |
---|
3933 | |
---|
3934 | /////////////////////////////////////////////////////////////////////////////// |
---|
3935 | |
---|
3936 | static proc substpartSpecial(ideal endid, ideal endphi) |
---|
3937 | { |
---|
3938 | ASSUME(1, not isQuotientRing(basering) ); |
---|
3939 | |
---|
3940 | //Note: newRing is of the form (R the original basering): |
---|
3941 | //char(R),(T(1..N),X(1..nvars(R))),(dp(N),...); |
---|
3942 | |
---|
3943 | int ii,jj,kk; |
---|
3944 | def BAS = basering; |
---|
3945 | int n = nvars(basering); |
---|
3946 | |
---|
3947 | list Le = elimpart(endid); |
---|
3948 | int q = size(Le[2]); //q variables have been substituted |
---|
3949 | //Le;""; |
---|
3950 | if ( q == 0 ) |
---|
3951 | { |
---|
3952 | ideal normap = endphi; |
---|
3953 | ideal norid = endid; |
---|
3954 | export(norid); |
---|
3955 | export(normap); |
---|
3956 | list L = BAS; |
---|
3957 | return(L); |
---|
3958 | } |
---|
3959 | |
---|
3960 | list gnirlist = ringlist(basering); |
---|
3961 | endid = Le[1]; |
---|
3962 | //endphi;""; |
---|
3963 | for( ii=1; ii<=n; ii++) |
---|
3964 | { |
---|
3965 | if( Le[4][ii] == 0 ) //ii=index of substituted var |
---|
3966 | { |
---|
3967 | endphi = subst(endphi,var(ii),Le[5][ii]); |
---|
3968 | } |
---|
3969 | } |
---|
3970 | //endphi;""; |
---|
3971 | list g2 = gnirlist[2]; //the varlist |
---|
3972 | list g3 = gnirlist[3]; //contains blocks of orderings |
---|
3973 | int n3 = size(g3); |
---|
3974 | |
---|
3975 | //----------------- first identify module ordering ------------------ |
---|
3976 | if ( g3[n3][1]== "c" or g3[n3][1] == "C" ) |
---|
3977 | { |
---|
3978 | list gm = g3[n3]; //last blockis module ordering |
---|
3979 | g3 = delete(g3,n3); |
---|
3980 | int m = 0; |
---|
3981 | } |
---|
3982 | else |
---|
3983 | { |
---|
3984 | list gm = g3[1]; //first block is module ordering |
---|
3985 | g3 = delete(g3,1); |
---|
3986 | int m = 1; |
---|
3987 | } |
---|
3988 | //---- delete variables which were substituted and weights -------- |
---|
3989 | intvec V; |
---|
3990 | int n(0); |
---|
3991 | list newg2; |
---|
3992 | list newg3; |
---|
3993 | for ( ii=1; ii<=n3-1; ii++ ) |
---|
3994 | { |
---|
3995 | // If order is a matrix ordering, it is replaced by dp ordering. |
---|
3996 | // TODO: replace it only when some of the original |
---|
3997 | // variables are eliminated. |
---|
3998 | if(g3[ii][1] == "M"){ |
---|
3999 | g3[ii][1] = "dp"; |
---|
4000 | g3[ii][2] = (1..sqroot(size(g3[ii][2])))*0+1; |
---|
4001 | } |
---|
4002 | V = V,g3[ii][2]; //copy weights for ordering in each block |
---|
4003 | if ( ii==1 ) //into one intvector |
---|
4004 | { |
---|
4005 | V = V[2..size(V)]; |
---|
4006 | } |
---|
4007 | // int n(ii) = size(g3[ii][2]); |
---|
4008 | int n(ii) = size(V); |
---|
4009 | intvec V(ii); |
---|
4010 | |
---|
4011 | for ( jj = n(ii-1)+1; jj<=n(ii); jj++) |
---|
4012 | { |
---|
4013 | if( Le[4][jj] !=0 or // jj=index of var which was not substituted |
---|
4014 | ( (ii==n3-1) and ( jj==n(ii) ) and (size(newg2)==0) ) // or we have no variables yet in the new ring and |
---|
4015 | // want to keep at least the last one! |
---|
4016 | ) |
---|
4017 | { |
---|
4018 | kk=kk+1; |
---|
4019 | newg2[kk] = g2[jj]; //not substituted var from varlist |
---|
4020 | V(ii)=V(ii),V[jj]; //weight of not substituted variable |
---|
4021 | } |
---|
4022 | } |
---|
4023 | if ( size(V(ii)) >= 2 ) |
---|
4024 | { |
---|
4025 | V(ii) = V(ii)[2..size(V(ii))]; |
---|
4026 | list g3(ii)=g3[ii][1],V(ii); |
---|
4027 | newg3 = insert(newg3,g3(ii),size(newg3)); |
---|
4028 | //"newg3"; newg3; |
---|
4029 | } |
---|
4030 | } |
---|
4031 | //"newg3"; newg3; |
---|
4032 | //newg3 = delete(newg3,1); //delete empty list |
---|
4033 | |
---|
4034 | /* |
---|
4035 | //### neue Ordnung, 1 Block fuer alle vars, aber Gewichte erhalten; |
---|
4036 | //vorerst nicht realisiert, da bei leonhard1 alte Version (neue Variable T(i) |
---|
4037 | //ein neuer Block) ein kuerzeres Ergebnis liefert |
---|
4038 | kill g3; |
---|
4039 | list g3; |
---|
4040 | V=0; |
---|
4041 | for ( ii= 1; ii<=n3-1; ii++ ) |
---|
4042 | { |
---|
4043 | V=V,V(ii); |
---|
4044 | } |
---|
4045 | V = V[2..size(V)]; |
---|
4046 | |
---|
4047 | if ( V==1 ) |
---|
4048 | { |
---|
4049 | g3[1] = list("dp",V); |
---|
4050 | } |
---|
4051 | else |
---|
4052 | { |
---|
4053 | g3[1] = lis("wp",V); |
---|
4054 | } |
---|
4055 | newg3 = g3; |
---|
4056 | |
---|
4057 | //"newg3";newg3;""; |
---|
4058 | //### Ende neue Ordnung |
---|
4059 | */ |
---|
4060 | |
---|
4061 | if ( m == 0 ) |
---|
4062 | { |
---|
4063 | newg3 = insert(newg3,gm,size(newg3)); |
---|
4064 | } |
---|
4065 | else |
---|
4066 | { |
---|
4067 | newg3 = insert(newg3,gm); |
---|
4068 | } |
---|
4069 | gnirlist[2] = newg2; |
---|
4070 | gnirlist[3] = newg3; |
---|
4071 | |
---|
4072 | //gnirlist; |
---|
4073 | def newBAS = ring(gnirlist); //change of ring to less vars |
---|
4074 | setring newBAS; |
---|
4075 | ideal normap = imap(BAS,endphi); |
---|
4076 | //normap = simplify(normap,2); |
---|
4077 | ideal norid = imap(BAS,endid); |
---|
4078 | export(norid); |
---|
4079 | export(normap); |
---|
4080 | list L = newBAS; |
---|
4081 | setring BAS; |
---|
4082 | return(L); |
---|
4083 | |
---|
4084 | //Hier scheint interred gut zu sein, da es Ergebnis relativ schnell |
---|
4085 | //verkleinert. Hier wird z.B. bei leonard1 size(norid) verkleinert aber |
---|
4086 | //size(string(norid)) stark vergroessert, aber es hat keine Auswirkungen |
---|
4087 | //da keine map mehr folgt. |
---|
4088 | //### Bei Leonard2 haengt interred (BUG) |
---|
4089 | //mstd[2] verkleinert norid nocheinmal um die Haelfte, dauert aber 3.71 sec |
---|
4090 | //### Ev. Hinweis auf mstd in der Hilfe? |
---|
4091 | |
---|
4092 | } |
---|
4093 | |
---|
4094 | /////////////////////////////////////////////////////////////////////////////// |
---|
4095 | // Computes the ring structure of a ring given by module generators. |
---|
4096 | // Assume: J[i]/J[1] are the module generators in the quotient field |
---|
4097 | // with J[1] as universal denominator. |
---|
4098 | // If option "noRed" is not given, a reduction in the number of variables is |
---|
4099 | // attempted. |
---|
4100 | static proc computeRing(ideal J, ideal I, list #) |
---|
4101 | { |
---|
4102 | ASSUME(1, not isQuotientRing(basering) ); |
---|
4103 | |
---|
4104 | int i, ii,jj; |
---|
4105 | intvec V; // to be used for variable weights |
---|
4106 | int y = printlevel-voice+2; |
---|
4107 | def R = basering; |
---|
4108 | poly c = J[1]; // the denominator |
---|
4109 | list gnirlist = ringlist(basering); |
---|
4110 | string svars = varstr(basering); |
---|
4111 | int nva = nvars(basering); |
---|
4112 | string svar; |
---|
4113 | ideal maxid = maxideal(1); |
---|
4114 | |
---|
4115 | int noRed = 0; // By default, we try to reduce the number of generators. |
---|
4116 | if(size(#) > 0){ |
---|
4117 | if ( typeof(#[1]) == "string" ) |
---|
4118 | { |
---|
4119 | if (#[1] == "noRed"){noRed = 1;} |
---|
4120 | } |
---|
4121 | } |
---|
4122 | |
---|
4123 | if ( y >= 1){"// computing the ring structure...";} |
---|
4124 | |
---|
4125 | if(c==1) |
---|
4126 | { |
---|
4127 | /* if( defined(norid) ) { kill norid; } |
---|
4128 | if( defined(normap) ) { kill normap; } |
---|
4129 | ideal norid = I; |
---|
4130 | ideal normap = maxid; */ |
---|
4131 | |
---|
4132 | def R1 = ring(gnirlist); |
---|
4133 | setring R1; |
---|
4134 | ideal norid = imap(R, I); |
---|
4135 | ideal normap = imap(R, maxid); |
---|
4136 | export norid; |
---|
4137 | export normap; |
---|
4138 | |
---|
4139 | if(noRed == 1){ |
---|
4140 | setring R; |
---|
4141 | return(R1); |
---|
4142 | } |
---|
4143 | else |
---|
4144 | { |
---|
4145 | list L = substpartSpecial(norid,normap); |
---|
4146 | def lastRing = L[1]; |
---|
4147 | setring R; |
---|
4148 | return(lastRing); |
---|
4149 | } |
---|
4150 | } |
---|
4151 | |
---|
4152 | |
---|
4153 | //-------------- Enlarge ring by creating new variables ------------------ |
---|
4154 | //check first whether variables T(i) and then whether Z(i),...,A(i) exist |
---|
4155 | //old variable names are not touched |
---|
4156 | |
---|
4157 | if ( find(svars,"T(") == 0 ) |
---|
4158 | { |
---|
4159 | svar = "T"; |
---|
4160 | } |
---|
4161 | else |
---|
4162 | { |
---|
4163 | for (ii=90; ii>=65; ii--) |
---|
4164 | { |
---|
4165 | if ( find(svars,ASCII(ii)+"(") == 0 ) |
---|
4166 | { |
---|
4167 | svar = ASCII(ii); break; |
---|
4168 | } |
---|
4169 | } |
---|
4170 | } |
---|
4171 | |
---|
4172 | int q = size(J)-1; |
---|
4173 | if ( size(svar) != 0 ) |
---|
4174 | { |
---|
4175 | for ( ii=q; ii>=1; ii-- ) |
---|
4176 | { |
---|
4177 | gnirlist[2] = insert(gnirlist[2],svar+"("+string(ii)+")"); |
---|
4178 | } |
---|
4179 | } |
---|
4180 | else |
---|
4181 | { |
---|
4182 | for ( ii=q; ii>=1; ii-- ) |
---|
4183 | { |
---|
4184 | gnirlist[2] = insert(gnirlist[2],"T("+string(100*nva+ii)+")"); |
---|
4185 | } |
---|
4186 | } |
---|
4187 | |
---|
4188 | V[q]=0; //create intvec of variable weights |
---|
4189 | V=V+1; |
---|
4190 | gnirlist[3] = insert(gnirlist[3],list("dp",V)); |
---|
4191 | |
---|
4192 | //this is a block ordering with one dp-block (1st block) for new vars |
---|
4193 | //the remaining weights and blocks for old vars are kept |
---|
4194 | //### perhaps better to make only one block, keeping weights ? |
---|
4195 | //this might effect syz below |
---|
4196 | //alt: ring newR = char(R),(X(1..nvars(R)),T(1..q)),dp; |
---|
4197 | //Reihenfolge geaendert:neue Variablen kommen zuerst, Namen ev. nicht T(i) |
---|
4198 | |
---|
4199 | def newR = ring(gnirlist); |
---|
4200 | setring newR; //new extended ring |
---|
4201 | ideal I = imap(R,I); |
---|
4202 | |
---|
4203 | //------------- Compute linear and quadratic relations --------------- |
---|
4204 | if(y>=1) |
---|
4205 | { |
---|
4206 | "// compute linear relations:"; |
---|
4207 | } |
---|
4208 | qring newQ = std(I); |
---|
4209 | |
---|
4210 | ideal f = imap(R,J); |
---|
4211 | module syzf = syz(f); |
---|
4212 | ideal pf = f[1]*f; |
---|
4213 | //f[1] is the denominator D from normalityTest, a non zero divisor of R/I |
---|
4214 | |
---|
4215 | ideal newT = maxideal(1); |
---|
4216 | newT = 1,newT[1..q]; |
---|
4217 | //matrix T = matrix(ideal(1,T(1..q)),1,q+1); //alt |
---|
4218 | matrix T = matrix(newT,1,q+1); |
---|
4219 | ideal Lin = ideal(T*syzf); |
---|
4220 | //Lin=interred(Lin); |
---|
4221 | //### interred reduziert ev size aber size(string(LIN)) wird groesser |
---|
4222 | |
---|
4223 | if(y>=1) |
---|
4224 | { |
---|
4225 | if(y>=3) |
---|
4226 | { |
---|
4227 | "// the linear relations:"; Lin; pause();""; |
---|
4228 | } |
---|
4229 | "// the ring structure of the normalization as affine algebra"; |
---|
4230 | "// number of linear relations:", size(Lin); |
---|
4231 | } |
---|
4232 | |
---|
4233 | if(y>=1) |
---|
4234 | { |
---|
4235 | "// compute quadratic relations:"; |
---|
4236 | } |
---|
4237 | matrix A; |
---|
4238 | ideal Quad; |
---|
4239 | poly ff; |
---|
4240 | newT = newT[2..size(newT)]; |
---|
4241 | matrix u; // The units for non-global orderings. |
---|
4242 | |
---|
4243 | // Quadratic relations |
---|
4244 | for (ii=2; ii<=q+1; ii++ ) |
---|
4245 | { |
---|
4246 | for ( jj=2; jj<=ii; jj++ ) |
---|
4247 | { |
---|
4248 | ff = NF(f[ii]*f[jj],std(0)); // this makes lift much faster |
---|
4249 | // For non-global orderings, we have to take care of the units. |
---|
4250 | if(attrib(basering,"global") != 1) |
---|
4251 | { |
---|
4252 | A = lift(pf, ff, u); |
---|
4253 | Quad = Quad,ideal(newT[jj-1]*newT[ii-1] * u[1, 1]- T*A); |
---|
4254 | } |
---|
4255 | else |
---|
4256 | { |
---|
4257 | A = lift(pf,ff); // ff lin. comb. of elts of pf mod I |
---|
4258 | Quad = Quad,ideal(newT[jj-1]*newT[ii-1] - T*A); |
---|
4259 | } |
---|
4260 | //A = lift(pf, f[ii]*f[jj]); |
---|
4261 | //Quad = Quad, ideal(T(jj-1)*T(ii-1) - T*A); |
---|
4262 | } |
---|
4263 | } |
---|
4264 | Quad = Quad[2..ncols(Quad)]; |
---|
4265 | |
---|
4266 | if(y>=1) |
---|
4267 | { |
---|
4268 | if(y>=3) |
---|
4269 | { |
---|
4270 | "// the quadratic relations"; Quad; pause();""; |
---|
4271 | } |
---|
4272 | "// number of quadratic relations:", size(Quad); |
---|
4273 | } |
---|
4274 | ideal Q1 = Lin,Quad; //elements of Q1 are in NF w.r.t. I |
---|
4275 | |
---|
4276 | //Q1 = mstd(Q1)[2]; |
---|
4277 | //### weglassen, ist sehr zeitaufwendig. |
---|
4278 | //Ebenso interred, z.B. bei Leonard1 (1. Komponente von Leonard): |
---|
4279 | //"size Q1:", size(Q1), size(string(Q1)); //75 60083 |
---|
4280 | //Q1 = interred(Q1); |
---|
4281 | //"size Q1:", size(Q1), size(string(Q1)); //73 231956 (!) |
---|
4282 | //### Speicherueberlauf bei substpartSpecial bei 'ideal norid = phi1(endid)' |
---|
4283 | //Beispiel fuer Hans um map zu testen! |
---|
4284 | |
---|
4285 | setring newR; |
---|
4286 | ideal endid = imap(newQ,Q1),I; |
---|
4287 | ideal endphi = imap(R,maxid); |
---|
4288 | |
---|
4289 | if(noRed == 0){ |
---|
4290 | list L=substpartSpecial(endid,endphi); |
---|
4291 | def lastRing=L[1]; |
---|
4292 | if(y>=1) |
---|
4293 | { |
---|
4294 | "// number of substituted variables:", nvars(newR)-nvars(lastRing); |
---|
4295 | pause();""; |
---|
4296 | } |
---|
4297 | setring R; |
---|
4298 | return(lastRing); |
---|
4299 | } |
---|
4300 | else |
---|
4301 | { |
---|
4302 | ideal norid = endid; |
---|
4303 | ideal normap = endphi; |
---|
4304 | export(norid); |
---|
4305 | export(normap); |
---|
4306 | setring R; |
---|
4307 | return(newR); |
---|
4308 | } |
---|
4309 | } |
---|
4310 | |
---|
4311 | // Up to here: procedures for char p with Frobenius |
---|
4312 | /////////////////////////////////////////////////////////////////////////////// |
---|
4313 | |
---|
4314 | /////////////////////////////////////////////////////////////////////////////// |
---|
4315 | // From here: subprocedures for normal |
---|
4316 | |
---|
4317 | // inputJ is used in parametrization of rational curves algorithms, to specify |
---|
4318 | // a different test ideal. |
---|
4319 | |
---|
4320 | static proc normalM(ideal I, int decomp, int withDelta, int denomOption, ideal inputJ, ideal inputC){ |
---|
4321 | // Computes the normalization of a ring R / I using the module structure as far |
---|
4322 | // as possible. |
---|
4323 | // The ring R is the basering. |
---|
4324 | // Input: ideal I |
---|
4325 | // Output: a list of 3 elements (resp 4 if withDelta = 1), say nor. |
---|
4326 | // - nor[1] = U, an ideal of R. |
---|
4327 | // - nor[2] = c, an element of R. |
---|
4328 | // U and c satisfy that 1/c * U is the normalization of R / I in the |
---|
4329 | // quotient field Q(R/I). |
---|
4330 | // - nor[3] = ring say T, containing two ideals norid and normap such that |
---|
4331 | // normap gives the normalization map from R / I to T / norid. |
---|
4332 | // - nor[4] = the delta invariant, if withDelta = 1. |
---|
4333 | |
---|
4334 | // Details: |
---|
4335 | // -------- |
---|
4336 | // Computes the ideal of the minors in the first step and then reuses it in all |
---|
4337 | // steps. |
---|
4338 | // In step s, the denominator is D^s, where D is a nzd of the original quotient |
---|
4339 | // ring, contained in the radical of the singular locus. |
---|
4340 | // This denominator is used except when the degree of D^i is greater than the |
---|
4341 | // degree of a universal denominator. |
---|
4342 | // The nzd is taken as the smallest degree polynomial in the radical of the |
---|
4343 | // singular locus. |
---|
4344 | |
---|
4345 | // It assumes that the ideal I is equidimensional radical. This is not checked |
---|
4346 | // in the procedure! |
---|
4347 | // If decomp = 0 or decomp = 3 it assumes further that I is prime. Therefore |
---|
4348 | // any non-zero element in the jacobian ideal is assumed to be a |
---|
4349 | // non-zerodivisor. |
---|
4350 | |
---|
4351 | // It works over the given basering. |
---|
4352 | // If it has a non-global ordering, it changes it to dp global only for |
---|
4353 | // computing radical. |
---|
4354 | |
---|
4355 | // The delta invariant is only computed if withDelta = 1, and decomp = 0 or |
---|
4356 | // decomp = 3 (meaning that the ideal is prime). |
---|
4357 | |
---|
4358 | // denomOption = 0 -> Uses the smallest degree polynomial |
---|
4359 | // denomOption = i > 0 -> Uses a polynomial in the i-th variable |
---|
4360 | |
---|
4361 | ASSUME(1, not isQuotientRing(basering) ); |
---|
4362 | |
---|
4363 | intvec save_opt=option(get); |
---|
4364 | option(redSB); |
---|
4365 | option(returnSB); |
---|
4366 | int step = 0; // Number of steps. (for debugging) |
---|
4367 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4368 | int i; // counter |
---|
4369 | int isGlobal = attrib(basering,"global"); |
---|
4370 | |
---|
4371 | poly c; // The common denominator. |
---|
4372 | |
---|
4373 | def R = basering; |
---|
4374 | |
---|
4375 | //------------------------ Groebner bases and dimension of I----------------- |
---|
4376 | if(isGlobal == 1) |
---|
4377 | { |
---|
4378 | list IM = mstd(I); |
---|
4379 | I = IM[1]; |
---|
4380 | ideal IMin = IM[2]; // A minimal set of generators in the groebner basis. |
---|
4381 | } |
---|
4382 | else |
---|
4383 | { |
---|
4384 | // The minimal set of generators is not computed by mstd for |
---|
4385 | // non-global orderings. |
---|
4386 | I = groebner(I); |
---|
4387 | ideal IMin = I; |
---|
4388 | } |
---|
4389 | int d = dim(I); |
---|
4390 | |
---|
4391 | // ---------------- computation of the singular locus --------------------- |
---|
4392 | // We compute the radical of the ideal of minors modulo the original ideal. |
---|
4393 | // This is done only in the first step. |
---|
4394 | qring Q = I; // We work in the quotient by the groebner base of the ideal I |
---|
4395 | option(redSB); |
---|
4396 | option(returnSB); |
---|
4397 | |
---|
4398 | // If a conductor ideal was given as input, we use it instead of the |
---|
4399 | // singular locus. If a test ideal was given as input, we do not compute the |
---|
4400 | // singular locus. |
---|
4401 | ideal inputC = fetch(R, inputC); |
---|
4402 | ideal inputJ = fetch(R, inputJ); |
---|
4403 | if((inputC == 0) && (inputJ == 0)) |
---|
4404 | { |
---|
4405 | // We compute the radical of the ideal of minors modulo the original ideal. |
---|
4406 | // This is done only in the first step. |
---|
4407 | ideal I = fetch(R, I); |
---|
4408 | attrib(I, "isSB", 1); |
---|
4409 | ideal IMin = fetch(R, IMin); |
---|
4410 | |
---|
4411 | dbprint(dbg, "Computing the jacobian ideal..."); |
---|
4412 | |
---|
4413 | // If a given conductor ideal is given, we use it. |
---|
4414 | // If a given test ideal is given, we don't need to compute the jacobian |
---|
4415 | |
---|
4416 | // reduction mod I in 'minor' is not working for local orderings! |
---|
4417 | if(attrib(basering,"global")) |
---|
4418 | { |
---|
4419 | ideal J = minor(jacob(IMin), nvars(basering) - d, I); |
---|
4420 | } |
---|
4421 | else |
---|
4422 | { |
---|
4423 | ideal J = minor(jacob(IMin), nvars(basering) - d); |
---|
4424 | J = reduce(J, groebner(I)); |
---|
4425 | } |
---|
4426 | J = groebner(J); |
---|
4427 | } |
---|
4428 | else |
---|
4429 | { |
---|
4430 | ideal J = fetch(R, inputC); |
---|
4431 | J = groebner(J); |
---|
4432 | } |
---|
4433 | |
---|
4434 | //------------------ We check if the singular locus is empty ------------- |
---|
4435 | if(J[1] == 1) |
---|
4436 | { |
---|
4437 | // The original ring R/I was normal. Nothing to do. |
---|
4438 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
4439 | setring R; |
---|
4440 | list lR = ringlist(R); |
---|
4441 | def ROut = ring(lR); |
---|
4442 | setring ROut; |
---|
4443 | ideal norid = fetch(R, I); |
---|
4444 | ideal normap = maxideal(1); |
---|
4445 | export norid; |
---|
4446 | export normap; |
---|
4447 | setring R; |
---|
4448 | if(withDelta) |
---|
4449 | { |
---|
4450 | list output = ideal(1), poly(1), ROut, 0; |
---|
4451 | } |
---|
4452 | else |
---|
4453 | { |
---|
4454 | list output = ideal(1), poly(1), ROut; |
---|
4455 | } |
---|
4456 | option(set,save_opt); |
---|
4457 | return(list(output)); |
---|
4458 | } |
---|
4459 | |
---|
4460 | |
---|
4461 | // -------------------- election of the universal denominator---------------- |
---|
4462 | // We first check if a conductor ideal was computed. If not, we don't |
---|
4463 | // compute a universal denominator. |
---|
4464 | ideal Id1; |
---|
4465 | if(J != 0) |
---|
4466 | { |
---|
4467 | if(denomOption == 0) |
---|
4468 | { |
---|
4469 | poly condu = getSmallest(J); // Choses the polynomial of smallest degree |
---|
4470 | // of J as universal denominator. |
---|
4471 | } |
---|
4472 | else |
---|
4473 | { |
---|
4474 | poly condu = getOneVar(J, denomOption); |
---|
4475 | } |
---|
4476 | if(dbg >= 1) |
---|
4477 | { |
---|
4478 | ""; |
---|
4479 | "The universal denominator is ", condu; |
---|
4480 | } |
---|
4481 | |
---|
4482 | // ----- splitting the ideal by the universal denominator (if possible) ----- |
---|
4483 | // If the ideal is equidimensional, but not necessarily prime, we check if |
---|
4484 | // the universal denominator is a non-zerodivisor of R/I. |
---|
4485 | // If not, we split I. |
---|
4486 | if((decomp == 1) or (decomp == 2)) |
---|
4487 | { |
---|
4488 | Id1 = quotient(0, condu); |
---|
4489 | if(size(Id1) > 0) |
---|
4490 | { |
---|
4491 | // We have to split. |
---|
4492 | if(dbg >= 1) |
---|
4493 | { |
---|
4494 | "A zerodivisor was found. We split the ideal. The zerodivisor is ", condu; |
---|
4495 | } |
---|
4496 | setring R; |
---|
4497 | ideal Id1 = fetch(Q, Id1), I; |
---|
4498 | Id1 = groebner(Id1); |
---|
4499 | ideal Id2 = quotient(I, Id1); |
---|
4500 | // I = I1 \cap I2 |
---|
4501 | printlevel = printlevel + 1; |
---|
4502 | ideal JDefault = 0; // Now it uses the default J; |
---|
4503 | list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault); |
---|
4504 | list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault); |
---|
4505 | printlevel = printlevel - 1; |
---|
4506 | option(set,save_opt); |
---|
4507 | list res = nor1 + nor2; |
---|
4508 | return(res); |
---|
4509 | } |
---|
4510 | } |
---|
4511 | } |
---|
4512 | else |
---|
4513 | { |
---|
4514 | poly condu = 0; |
---|
4515 | } |
---|
4516 | |
---|
4517 | // --------------- computation of the first test ideal --------------------- |
---|
4518 | // To compute the radical we go back to the original ring. |
---|
4519 | // If we are using a non-global ordering, we must change to the global |
---|
4520 | // ordering. |
---|
4521 | setring R; |
---|
4522 | // If a test ideal is given at the input, we use it. |
---|
4523 | if(inputJ == 0) |
---|
4524 | { |
---|
4525 | if(isGlobal == 1) |
---|
4526 | { |
---|
4527 | ideal J = fetch(Q, J); |
---|
4528 | J = J, I; |
---|
4529 | if(dbg >= 1) |
---|
4530 | { |
---|
4531 | "The original singular locus is"; |
---|
4532 | groebner(J); |
---|
4533 | if(dbg >= 2){pause();} |
---|
4534 | ""; |
---|
4535 | } |
---|
4536 | // We check if the only singular point is the origin. |
---|
4537 | // If so, the radical is the maximal ideal at the origin. |
---|
4538 | J = groebner(J); |
---|
4539 | if(locAtZero(J)) |
---|
4540 | { |
---|
4541 | J = maxideal(1); |
---|
4542 | } |
---|
4543 | else |
---|
4544 | { |
---|
4545 | J = radical(J); |
---|
4546 | } |
---|
4547 | } |
---|
4548 | else |
---|
4549 | { |
---|
4550 | // We change to global dp ordering. |
---|
4551 | list rl = ringlist(R); |
---|
4552 | list origOrd = rl[3]; |
---|
4553 | list newOrd = list("dp", intvec(1:nvars(R))), list("C", 0); |
---|
4554 | rl[3] = newOrd; |
---|
4555 | def globR = ring(rl); |
---|
4556 | setring globR; |
---|
4557 | ideal J = fetch(Q, J); |
---|
4558 | ideal I = fetch(R, I); |
---|
4559 | J = J, I; |
---|
4560 | if(dbg >= 1) |
---|
4561 | { |
---|
4562 | "The original singular locus is"; |
---|
4563 | groebner(J); |
---|
4564 | if(dbg>=2){pause();} |
---|
4565 | ""; |
---|
4566 | } |
---|
4567 | J = radical(J); |
---|
4568 | setring R; |
---|
4569 | ideal J = fetch(globR, J); |
---|
4570 | } |
---|
4571 | } |
---|
4572 | else |
---|
4573 | { |
---|
4574 | ideal J = inputJ; |
---|
4575 | } |
---|
4576 | |
---|
4577 | if(dbg >= 1) |
---|
4578 | { |
---|
4579 | "The radical of the original singular locus is"; |
---|
4580 | J; |
---|
4581 | if(dbg>=2){pause();} |
---|
4582 | } |
---|
4583 | |
---|
4584 | // ---------------- election of the non zero divisor --------------------- |
---|
4585 | setring Q; |
---|
4586 | J = fetch(R, J); |
---|
4587 | J = interred(J); |
---|
4588 | if(denomOption == 0) |
---|
4589 | { |
---|
4590 | poly D = getSmallest(J); // Chooses the polynomial of smallest degree as |
---|
4591 | // non-zerodivisor. |
---|
4592 | } |
---|
4593 | else |
---|
4594 | { |
---|
4595 | poly D = getOneVar(J, denomOption); |
---|
4596 | } |
---|
4597 | if(dbg >= 1) |
---|
4598 | { |
---|
4599 | "The non zero divisor is ", D; |
---|
4600 | ""; |
---|
4601 | } |
---|
4602 | |
---|
4603 | // ------- splitting the ideal by the non-zerodivisor (if possible) -------- |
---|
4604 | // If the ideal is equidimensional, but not necessarily prime, we check if D |
---|
4605 | // is actually a non-zerodivisor of R/I. |
---|
4606 | // If not, we split I. |
---|
4607 | if((decomp == 1) or (decomp == 2)) |
---|
4608 | { |
---|
4609 | // We check if D is actually a non-zerodivisor of R/I. |
---|
4610 | // If not, we split I. |
---|
4611 | Id1 = quotient(0, D); |
---|
4612 | if(size(Id1) > 0) |
---|
4613 | { |
---|
4614 | // We have to split. |
---|
4615 | if(dbg >= 1) |
---|
4616 | { |
---|
4617 | "A zerodivisor was found. We split the ideal. The zerodivisor is ", D; |
---|
4618 | } |
---|
4619 | setring R; |
---|
4620 | ideal Id1 = fetch(Q, Id1), I; |
---|
4621 | Id1 = groebner(Id1); |
---|
4622 | ideal Id2 = quotient(I, Id1); |
---|
4623 | // I = Id1 \cap Id2 |
---|
4624 | printlevel = printlevel + 1; |
---|
4625 | |
---|
4626 | ideal JDefault = 0; // Now it uses the default J; |
---|
4627 | list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault); |
---|
4628 | list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault); |
---|
4629 | printlevel = printlevel - 1; |
---|
4630 | option(set,save_opt); |
---|
4631 | list res = nor1 + nor2; |
---|
4632 | return(res); |
---|
4633 | } |
---|
4634 | } |
---|
4635 | |
---|
4636 | // --------------------- normalization ------------------------------------ |
---|
4637 | // We call normalMEqui to compute the normalization. |
---|
4638 | setring R; |
---|
4639 | poly D = fetch(Q, D); |
---|
4640 | poly condu = fetch(Q, condu); |
---|
4641 | J = fetch(Q, J); |
---|
4642 | printlevel = printlevel + 1; |
---|
4643 | list result = normalMEqui(I, J, condu, D, withDelta, denomOption); |
---|
4644 | printlevel = printlevel - 1; |
---|
4645 | option(set,save_opt); |
---|
4646 | return(list(result)); |
---|
4647 | } |
---|
4648 | |
---|
4649 | /////////////////////////////////////////////////////////////////////////////// |
---|
4650 | |
---|
4651 | static proc normalMEqui(ideal I, ideal origJ, poly condu, poly D, int withDelta) |
---|
4652 | // Here is where the normalization is actually computed. |
---|
4653 | |
---|
4654 | // Computes the normalization of R/I. (basering is R) |
---|
4655 | // I is assumed to be radical and equidimensional. |
---|
4656 | // origJ is the first test ideal. |
---|
4657 | // D is a non-zerodivisor of R/I. |
---|
4658 | // condu is a non-zerodivisor in the conductor or 0 if it was not computed. |
---|
4659 | // If withDelta = 1, computes the delta invariant. |
---|
4660 | { |
---|
4661 | ASSUME(1, not isQuotientRing(basering) ); |
---|
4662 | int step = 0; // Number of steps. (for debugging) |
---|
4663 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4664 | int i; // counter |
---|
4665 | int isNormal = 0; // check for exiting the loop |
---|
4666 | int isGlobal = attrib(basering,"global"); |
---|
4667 | int delt; |
---|
4668 | |
---|
4669 | def R = basering; |
---|
4670 | poly c = D; |
---|
4671 | ideal U; |
---|
4672 | ideal cJ; |
---|
4673 | list testOut; // Output of proc testIdeal |
---|
4674 | // (the test ideal and the ring structure) |
---|
4675 | |
---|
4676 | qring Q = groebner(I); |
---|
4677 | intvec save_opt=option(get); |
---|
4678 | option(redSB); |
---|
4679 | option(returnSB); |
---|
4680 | ideal J = imap(R, origJ); |
---|
4681 | poly c = imap(R, c); |
---|
4682 | poly D = imap(R, D); |
---|
4683 | poly condu = imap(R, condu); |
---|
4684 | ideal cJ; |
---|
4685 | ideal cJMod; |
---|
4686 | |
---|
4687 | dbprint(dbg, "Preliminar step begins."); |
---|
4688 | |
---|
4689 | // --------------------- computation of A1 ------------------------------- |
---|
4690 | dbprint(dbg, "Computing the quotient (DJ : J)..."); |
---|
4691 | ideal U = groebner(quotient(D*J, J)); |
---|
4692 | ideal oldU = 1; |
---|
4693 | |
---|
4694 | if(dbg >= 2) { "The quotient is"; U; } |
---|
4695 | |
---|
4696 | // ----------------- Grauer-Remmert criterion check ----------------------- |
---|
4697 | // We check if the equality in Grauert - Remmert criterion is satisfied. |
---|
4698 | isNormal = checkInclusions(D*oldU, U); |
---|
4699 | if(isNormal == 0) |
---|
4700 | { |
---|
4701 | if(dbg >= 1) |
---|
4702 | { |
---|
4703 | "In this step, we have the ring 1/c * U, with c =", c; |
---|
4704 | "and U = "; U; |
---|
4705 | } |
---|
4706 | } |
---|
4707 | else |
---|
4708 | { |
---|
4709 | // The original ring R/I was normal. Nothing to do. |
---|
4710 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
4711 | setring R; |
---|
4712 | list lR = ringlist(R); |
---|
4713 | def ROut = ring(lR); |
---|
4714 | setring ROut; |
---|
4715 | ideal norid = fetch(R, I); |
---|
4716 | ideal normap = maxideal(1); |
---|
4717 | export norid; |
---|
4718 | export normap; |
---|
4719 | setring R; |
---|
4720 | if(withDelta) |
---|
4721 | { |
---|
4722 | list output = ideal(1), poly(1), ROut, 0; |
---|
4723 | } |
---|
4724 | else |
---|
4725 | { |
---|
4726 | list output = ideal(1), poly(1), ROut; |
---|
4727 | } |
---|
4728 | option(set,save_opt); |
---|
4729 | return(output); |
---|
4730 | } |
---|
4731 | |
---|
4732 | // ----- computation of the chain of ideals A1 c A2 c ... c An ------------ |
---|
4733 | while(isNormal == 0) |
---|
4734 | { |
---|
4735 | step++; |
---|
4736 | if(dbg >= 1) { ""; "Step ", step, " begins."; } |
---|
4737 | dbprint(dbg, "Computing the test ideal..."); |
---|
4738 | |
---|
4739 | // --------------- computation of the test ideal ------------------------ |
---|
4740 | // Computes a test ideal for the new ring. |
---|
4741 | // The test ideal will be the radical in the new ring of the original |
---|
4742 | // test ideal. |
---|
4743 | setring R; |
---|
4744 | U = imap(Q, U); |
---|
4745 | c = imap(Q, c); |
---|
4746 | testOut = testIdeal(I, U, origJ, c, D); |
---|
4747 | cJ = testOut[1]; |
---|
4748 | |
---|
4749 | setring Q; |
---|
4750 | cJ = imap(R, cJ); |
---|
4751 | cJ = groebner(cJ); |
---|
4752 | |
---|
4753 | // cJ / c is now the ideal mapped back. |
---|
4754 | // We have the generators as an ideal in the new ring, |
---|
4755 | // but we want the generators as an ideal in the original ring. |
---|
4756 | cJMod = getGenerators(cJ, U, c); |
---|
4757 | |
---|
4758 | if(dbg >= 2) { "The test ideal in this step is "; cJMod; } |
---|
4759 | |
---|
4760 | cJ = cJMod; |
---|
4761 | |
---|
4762 | // ------------- computation of the quotient (DJ : J)-------------------- |
---|
4763 | oldU = U; |
---|
4764 | dbprint(dbg, "Computing the quotient (c*D*cJ : cJ)..."); |
---|
4765 | U = quotient(c*D*cJ, cJ); |
---|
4766 | if(dbg >= 2){"The quotient is "; U;} |
---|
4767 | |
---|
4768 | // ------------- Grauert - Remmert criterion check ---------------------- |
---|
4769 | // We check if the equality in Grauert - Remmert criterion is satisfied. |
---|
4770 | isNormal = checkInclusions(D*oldU, U); |
---|
4771 | |
---|
4772 | if(isNormal == 1) |
---|
4773 | { |
---|
4774 | // We go one step back. In the last step we didnt get antyhing new, |
---|
4775 | // we just verified that the ring was already normal. |
---|
4776 | dbprint(dbg, "The ring in the previous step was already normal."); |
---|
4777 | dbprint(dbg, ""); |
---|
4778 | U = oldU; |
---|
4779 | } |
---|
4780 | else |
---|
4781 | { |
---|
4782 | // ------------- preparation for next iteration ---------------------- |
---|
4783 | // We have to go on. |
---|
4784 | // The new denominator is chosen. |
---|
4785 | c = D * c; |
---|
4786 | |
---|
4787 | // If we have a universal denominator of smaller degree than c, |
---|
4788 | // we replace c by it. |
---|
4789 | if(condu != 0) |
---|
4790 | { |
---|
4791 | if(deg(c) > deg(condu)) |
---|
4792 | { |
---|
4793 | U = changeDenominatorQ(U, c, condu); |
---|
4794 | c = condu; |
---|
4795 | } |
---|
4796 | } |
---|
4797 | if(dbg >= 1) |
---|
4798 | { |
---|
4799 | "In this step, we have the ring 1/c * U, with c =", c; |
---|
4800 | "and U = "; |
---|
4801 | U; |
---|
4802 | if(dbg>=2){pause();} |
---|
4803 | } |
---|
4804 | } |
---|
4805 | } |
---|
4806 | |
---|
4807 | // ------------------------- delta computation ---------------------------- |
---|
4808 | if(withDelta) |
---|
4809 | { |
---|
4810 | ideal UD = groebner(U); |
---|
4811 | delt = vdim(std(modulo(UD, c))); |
---|
4812 | } |
---|
4813 | |
---|
4814 | // -------------------------- prepare output ----------------------------- |
---|
4815 | setring R; |
---|
4816 | U = fetch(Q, U); |
---|
4817 | c = fetch(Q, c); |
---|
4818 | |
---|
4819 | // Ring structure of the new ring |
---|
4820 | def ere = testOut[2]; |
---|
4821 | if(withDelta) |
---|
4822 | { |
---|
4823 | list output = U, c, ere, delt; |
---|
4824 | } |
---|
4825 | else |
---|
4826 | { |
---|
4827 | list output = U, c, ere; |
---|
4828 | } |
---|
4829 | option(set,save_opt); |
---|
4830 | return(output); |
---|
4831 | } |
---|
4832 | |
---|
4833 | /////////////////////////////////////////////////////////////////////////////// |
---|
4834 | |
---|
4835 | static proc lineUpLast(ideal U, poly c) |
---|
4836 | // Sets c as the last generator of U. |
---|
4837 | { |
---|
4838 | int i; |
---|
4839 | ideal newU; |
---|
4840 | for (i = 1; i <= ncols(U); i++) |
---|
4841 | { |
---|
4842 | if(U[i] != c) |
---|
4843 | { |
---|
4844 | if(size(newU) == 0) |
---|
4845 | { newU = U[i]; } |
---|
4846 | else |
---|
4847 | { newU = newU, U[i]; } |
---|
4848 | } |
---|
4849 | } |
---|
4850 | if(size(newU) == 0) |
---|
4851 | { newU = c; } |
---|
4852 | else |
---|
4853 | { newU = newU, c; } |
---|
4854 | return(newU); |
---|
4855 | } |
---|
4856 | |
---|
4857 | /////////////////////////////////////////////////////////////////////////////// |
---|
4858 | |
---|
4859 | static proc lineUp(ideal U, poly c) |
---|
4860 | // Sets c as the first generator of U. |
---|
4861 | { |
---|
4862 | int i; |
---|
4863 | ideal newU = c; |
---|
4864 | for (i = 1; i <= ncols(U); i++) |
---|
4865 | { |
---|
4866 | if(U[i] != c) |
---|
4867 | { |
---|
4868 | newU = newU, U[i]; |
---|
4869 | } |
---|
4870 | } |
---|
4871 | return(newU); |
---|
4872 | } |
---|
4873 | |
---|
4874 | /////////////////////////////////////////////////////////////////////////////// |
---|
4875 | |
---|
4876 | //WARNING - elim is not working here!! Check!! |
---|
4877 | //It is now replaced by computing an eliminating groebner basis. |
---|
4878 | proc getOneVar(ideal J, int vari) |
---|
4879 | "USAGE: getOneVar(J, vari); J is a 0-dimensional ideal, vari is an integer. |
---|
4880 | RETURN: a polynomial of J in the variable indicated by vari of smallest |
---|
4881 | degree.@* |
---|
4882 | NOTE: Works only over rings of two variables.@* |
---|
4883 | It is intended mainly as an auxiliary procedure for computing |
---|
4884 | integral bases. @* |
---|
4885 | EXAMPLE: example getOneVar; shows an example |
---|
4886 | " |
---|
4887 | { |
---|
4888 | ASSUME(0, nvars(basering)==2 ); |
---|
4889 | ASSUME(0, (vari==2) || (vari==1) ); |
---|
4890 | |
---|
4891 | def R = basering; |
---|
4892 | list RL = ringlist(R); |
---|
4893 | // We keep everything from R but we change the ordering to lp, and we |
---|
4894 | // order the variables as needed. |
---|
4895 | RL[3] = list(list("lp", 1:2), list("C", 0:1)); |
---|
4896 | RL[2] = list(var(3-vari), var(vari)); |
---|
4897 | RL[4]=ideal(0); // does not work with qrings: Ex.7 of paraplanecurves |
---|
4898 | def RR = ring(RL); |
---|
4899 | setring RR; |
---|
4900 | ideal J = imap(R, J); |
---|
4901 | J = groebner(J); |
---|
4902 | poly g = J[1]; |
---|
4903 | setring R; |
---|
4904 | poly g = imap(RR, g); |
---|
4905 | return(g); |
---|
4906 | } |
---|
4907 | example |
---|
4908 | { "EXAMPLE:"; |
---|
4909 | printlevel = printlevel+1; |
---|
4910 | echo = 2; |
---|
4911 | ring s = 0,(x,y),dp; |
---|
4912 | ideal J = x3-y, y3; |
---|
4913 | getOneVar(J, 1); |
---|
4914 | |
---|
4915 | echo = 0; |
---|
4916 | printlevel = printlevel-1; |
---|
4917 | } |
---|
4918 | /////////////////////////////////////////////////////////////////////////////// |
---|
4919 | |
---|
4920 | proc getSmallest(ideal J) |
---|
4921 | "USAGE: getSmallest(J); J is an ideal. |
---|
4922 | RETURN: the generator of J of smallest degree. If there are more than one, it |
---|
4923 | chooses the one with smallest number of monomials.@* |
---|
4924 | NOTE: It looks only at the generator of J, not at all the polynomials in |
---|
4925 | the ideal.@* |
---|
4926 | It is intended maninly to compute a good universal denominator in the |
---|
4927 | normalization algorithms.@* |
---|
4928 | EXAMPLE: example getSmallest; shows an example |
---|
4929 | " |
---|
4930 | { |
---|
4931 | |
---|
4932 | // Computes the polynomial of smallest degree of J. |
---|
4933 | // |
---|
4934 | int i; |
---|
4935 | poly p = J[1]; |
---|
4936 | int d = deg(p); |
---|
4937 | int di; |
---|
4938 | for(i = 2; i <= ncols(J); i++) |
---|
4939 | { |
---|
4940 | if(J[i] != 0) |
---|
4941 | { |
---|
4942 | di = deg(J[i]); |
---|
4943 | if(di < d) |
---|
4944 | { |
---|
4945 | p = J[i]; |
---|
4946 | d = di; |
---|
4947 | } |
---|
4948 | else |
---|
4949 | { |
---|
4950 | if(di == d) |
---|
4951 | { |
---|
4952 | if(size(J[i]) < size(p)) |
---|
4953 | { |
---|
4954 | p = J[i]; |
---|
4955 | } |
---|
4956 | } |
---|
4957 | } |
---|
4958 | } |
---|
4959 | } |
---|
4960 | return(p); |
---|
4961 | } |
---|
4962 | example |
---|
4963 | { "EXAMPLE:"; |
---|
4964 | printlevel = printlevel+1; |
---|
4965 | echo = 2; |
---|
4966 | ring s = 0,(x,y),dp; |
---|
4967 | ideal J = x3-y, y5, x2-y2+1; |
---|
4968 | getSmallest(J); |
---|
4969 | |
---|
4970 | echo = 0; |
---|
4971 | printlevel = printlevel-1; |
---|
4972 | } |
---|
4973 | |
---|
4974 | /////////////////////////////////////////////////////////////////////////////// |
---|
4975 | |
---|
4976 | static proc getGenerators(ideal J, ideal U, poly c) |
---|
4977 | { |
---|
4978 | |
---|
4979 | // Computes the generators of J as an ideal in the original ring, |
---|
4980 | // where J is given by generators in the new ring. |
---|
4981 | |
---|
4982 | // The new ring is given by 1/c * U in the total ring of fractions. |
---|
4983 | |
---|
4984 | int i, j; // counters; |
---|
4985 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
4986 | poly p; // The lifted polynomial |
---|
4987 | ideal JGr = groebner(J); // Groebner base of J |
---|
4988 | |
---|
4989 | if(dbg>1){"Checking for new generators...";} |
---|
4990 | for(i = 1; i <= ncols(J); i++) |
---|
4991 | { |
---|
4992 | for(j = 1; j <= ncols(U); j++) |
---|
4993 | { |
---|
4994 | p = lift(c, J[i]*U[j])[1,1]; |
---|
4995 | p = reduce(p, JGr); |
---|
4996 | if(p != 0) |
---|
4997 | { |
---|
4998 | if(dbg>1) |
---|
4999 | { |
---|
5000 | "New polynoial added:", p; |
---|
5001 | if(dbg>4) {pause();} |
---|
5002 | } |
---|
5003 | JGr = JGr, p; |
---|
5004 | JGr = groebner(JGr); |
---|
5005 | J = J, p; |
---|
5006 | } |
---|
5007 | } |
---|
5008 | } |
---|
5009 | return(J); |
---|
5010 | } |
---|
5011 | |
---|
5012 | /////////////////////////////////////////////////////////////////////////////// |
---|
5013 | |
---|
5014 | static proc testIdeal(ideal I, ideal U, ideal origJ, poly c, poly D) |
---|
5015 | { |
---|
5016 | |
---|
5017 | ASSUME(1, not isQuotientRing(basering) ); |
---|
5018 | |
---|
5019 | // Internal procedure, used in normalM. |
---|
5020 | // Computes the test ideal in the new ring. |
---|
5021 | // It takes the original test ideal and computes the radical of it in the |
---|
5022 | // new ring. |
---|
5023 | |
---|
5024 | // The new ring is 1/c * U. |
---|
5025 | // The original test ideal is origJ. |
---|
5026 | // The original ring is R / I, where R is the basering. |
---|
5027 | intvec save_opt=option(get); |
---|
5028 | int i; // counter |
---|
5029 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
5030 | def R = basering; // We dont work in the quo |
---|
5031 | ideal J = origJ; |
---|
5032 | |
---|
5033 | // ---------- computation of the ring structure of 1/c * U ---------------- |
---|
5034 | U = lineUp(U, c); |
---|
5035 | |
---|
5036 | if(dbg > 1){"Computing the new ring structure...";} |
---|
5037 | list ele = computeRing(U, I, "noRed"); |
---|
5038 | |
---|
5039 | def origEre = ele[1]; |
---|
5040 | setring origEre; |
---|
5041 | if(dbg > 1){"The relations are"; norid;} |
---|
5042 | |
---|
5043 | // ---------------- setting the ring to work in -------------------------- |
---|
5044 | int isGlobal = attrib(origEre,"global"); // Checks if the original ring has |
---|
5045 | // global ordering. |
---|
5046 | if(isGlobal != 1) |
---|
5047 | { |
---|
5048 | list rl = ringlist(origEre); |
---|
5049 | list origOrd = rl[3]; |
---|
5050 | list newOrd = list("dp", intvec(1:nvars(origEre))), list("C", 0); |
---|
5051 | rl[3] = newOrd; |
---|
5052 | def ere = ring(rl); // globR is the original ring but |
---|
5053 | // with a global ordering. |
---|
5054 | setring ere; |
---|
5055 | ideal norid = imap(origEre, norid); |
---|
5056 | } |
---|
5057 | else |
---|
5058 | { |
---|
5059 | def ere = origEre; |
---|
5060 | } |
---|
5061 | |
---|
5062 | ideal I = imap(R, I); |
---|
5063 | ideal J = imap(R, J); |
---|
5064 | J = J, norid, I; |
---|
5065 | |
---|
5066 | |
---|
5067 | // ----- computation of the test ideal using the ring structure of Ai ----- |
---|
5068 | |
---|
5069 | option(redSB); |
---|
5070 | option(returnSB); |
---|
5071 | |
---|
5072 | if(dbg > 1){"Computing the radical of J...";} |
---|
5073 | J = radical(J); |
---|
5074 | if(dbg > 1){"Computing the interreduction of the radical...";} |
---|
5075 | J = groebner(J); |
---|
5076 | //J = interred(J); |
---|
5077 | if(dbg > 1) |
---|
5078 | { |
---|
5079 | "The radical in the generated ring is"; |
---|
5080 | J; |
---|
5081 | if(dbg>4){pause();} |
---|
5082 | } |
---|
5083 | |
---|
5084 | setring ere; |
---|
5085 | |
---|
5086 | // -------------- map from Ai to the total ring of fractions --------------- |
---|
5087 | // Now we must map back this ideal J to U_i / c in the total ring of |
---|
5088 | // fractions. |
---|
5089 | // The map sends T_j -> u_j / c. |
---|
5090 | // The map is built by the following steps: |
---|
5091 | // 1) We compute the degree of the generators of J with respect to the |
---|
5092 | // new variables T_j. |
---|
5093 | // 2) For each generator, we multiply each term by a power of c, as if |
---|
5094 | // taking c^n as a common denominator (considering the new variables as |
---|
5095 | // a polynomial in the old variables divided by c). |
---|
5096 | // 3) We replace the new variables T_j by the corresponding numerator u_j. |
---|
5097 | // 4) We lift the resulting polynomial to change the denominator |
---|
5098 | // from c^n to c. |
---|
5099 | int nNewVars = nvars(ere) - nvars(R); // Number of new variables |
---|
5100 | poly c = imap(R, c); |
---|
5101 | intvec @v = 1..nNewVars; // Vector of the new variables. |
---|
5102 | // They must be the first ones. |
---|
5103 | if(dbg > 1){"The indices of the new variables are", @v;} |
---|
5104 | |
---|
5105 | // ---------------------- step 1 of the mapping --------------------------- |
---|
5106 | intvec degs; |
---|
5107 | for(i = 1; i<=ncols(J); i++) |
---|
5108 | { |
---|
5109 | degs[i] = degSubring(J[i], @v); |
---|
5110 | } |
---|
5111 | if(dbg > 1) |
---|
5112 | { |
---|
5113 | "The degrees with respect to the new variables are"; |
---|
5114 | degs; |
---|
5115 | } |
---|
5116 | |
---|
5117 | // ---------------------- step 2 of the mapping --------------------------- |
---|
5118 | ideal mapJ = mapBackIdeal(J, c, @v); |
---|
5119 | |
---|
5120 | setring R; |
---|
5121 | |
---|
5122 | // ---------------------- step 3 of the mapping --------------------------- |
---|
5123 | ideal z; // The variables of the original ring in order. |
---|
5124 | for(i = 1; i<=nvars(R); i++) |
---|
5125 | { |
---|
5126 | z[i] = var(i); |
---|
5127 | } |
---|
5128 | |
---|
5129 | map f = ere, U[2..ncols(U)], z[1..ncols(z)]; // The map to the original ring. |
---|
5130 | if(dbg > 1) |
---|
5131 | { |
---|
5132 | "The map is "; |
---|
5133 | f; |
---|
5134 | if(dbg>4){pause();} |
---|
5135 | } |
---|
5136 | |
---|
5137 | if(dbg > 1){ "Computing the map..."; } |
---|
5138 | |
---|
5139 | J = f(mapJ); |
---|
5140 | if(dbg > 1) |
---|
5141 | { |
---|
5142 | "The ideal J mapped back (before lifting) is"; |
---|
5143 | J; |
---|
5144 | if(dbg>4){pause();} |
---|
5145 | } |
---|
5146 | |
---|
5147 | // ---------------------- step 4 of the mapping --------------------------- |
---|
5148 | qring Q = groebner(I); |
---|
5149 | ideal J = imap(R, J); |
---|
5150 | poly c = imap(R, c); |
---|
5151 | for(i = 1; i<=ncols(J); i++) |
---|
5152 | { |
---|
5153 | if(degs[i]>1) |
---|
5154 | { |
---|
5155 | J[i] = lift(c^(degs[i]-1), J[i])[1,1]; |
---|
5156 | } |
---|
5157 | else |
---|
5158 | { |
---|
5159 | if(degs[i]==0) { J[i] = c*J[i]; } |
---|
5160 | } |
---|
5161 | } |
---|
5162 | |
---|
5163 | if(dbg > 1) |
---|
5164 | { |
---|
5165 | "The ideal J lifted is"; |
---|
5166 | J; |
---|
5167 | if(dbg>4){pause();} |
---|
5168 | } |
---|
5169 | |
---|
5170 | // --------------------------- prepare output ---------------------------- |
---|
5171 | J = groebner(J); |
---|
5172 | |
---|
5173 | setring R; |
---|
5174 | J = imap(Q, J); |
---|
5175 | |
---|
5176 | option(set,save_opt); |
---|
5177 | return(list(J, ele[1])); |
---|
5178 | } |
---|
5179 | |
---|
5180 | /////////////////////////////////////////////////////////////////////////////// |
---|
5181 | |
---|
5182 | proc changeDenominator(ideal U1, poly c1, poly c2, ideal I) |
---|
5183 | "USAGE: changeDenominator(U1, c1, c2, I); U1 and I ideals, c1 and c2 |
---|
5184 | polynomials.@* |
---|
5185 | RETURN: an ideal U2 such that the A-modules 1/c1 * U1 and 1/c2 * U2 are equal, |
---|
5186 | where A = R/I and R is the basering.@* |
---|
5187 | NOTE: It assumes that such U2 exists. It is intended maninly as an auxiliary |
---|
5188 | procedure in the normalization algorithms.@* |
---|
5189 | EXAMPLE: example changeDenominator; shows an example |
---|
5190 | " |
---|
5191 | { |
---|
5192 | ASSUME(0, not isQuotientRing(basering) ); |
---|
5193 | // Let A = R / I. Given an A-module in the form 1/c1 * U1 (U1 ideal of A), it |
---|
5194 | // computes a new ideal U2 such that the the A-module is 1/c2 * U2. |
---|
5195 | // The base ring is R, but the computations are to be done in R / I. |
---|
5196 | int a; // counter |
---|
5197 | def R = basering; |
---|
5198 | qring Q = I; |
---|
5199 | ideal U1 = fetch(R, U1); |
---|
5200 | poly c1 = fetch(R, c1); |
---|
5201 | poly c2 = fetch(R, c2); |
---|
5202 | ideal U2 = changeDenominatorQ(U1, c1, c2); |
---|
5203 | setring R; |
---|
5204 | ideal U2 = fetch(Q, U2); |
---|
5205 | return(U2); |
---|
5206 | } |
---|
5207 | example |
---|
5208 | { |
---|
5209 | "EXAMPLE:"; |
---|
5210 | echo = 2; |
---|
5211 | ring s = 0,(x,y),dp; |
---|
5212 | ideal I = y5-y4x+4y2x2-x4; |
---|
5213 | ideal U1 = normal(I)[2][1]; |
---|
5214 | poly c1 = U1[4]; |
---|
5215 | U1;c1; |
---|
5216 | // 1/c1 * U1 is the normalization of I. |
---|
5217 | ideal U2 = changeDenominator(U1, c1, x3, I); |
---|
5218 | U2; |
---|
5219 | // 1/x3 * U2 is also the normalization of I, but with a different denominator. |
---|
5220 | echo = 0; |
---|
5221 | } |
---|
5222 | |
---|
5223 | /////////////////////////////////////////////////////////////////////////////// |
---|
5224 | |
---|
5225 | static proc changeDenominatorQ(ideal U1, poly c1, poly c2) |
---|
5226 | { |
---|
5227 | // Given a ring in the form 1/c1 * U, it computes a new U2 st the ring |
---|
5228 | // is 1/c2 * U2. |
---|
5229 | // The base ring is already a quotient ring R / I. |
---|
5230 | int a; // counter |
---|
5231 | ideal U2; |
---|
5232 | poly p; |
---|
5233 | for(a = 1; a <= ncols(U1); a++) |
---|
5234 | { |
---|
5235 | p = lift(c1, c2*U1[a])[1,1]; |
---|
5236 | U2[a] = p; |
---|
5237 | } |
---|
5238 | return(U2); |
---|
5239 | } |
---|
5240 | |
---|
5241 | /////////////////////////////////////////////////////////////////////////////// |
---|
5242 | |
---|
5243 | static proc checkInclusions(ideal U1, ideal U2) |
---|
5244 | { |
---|
5245 | // Checks if the identity A = Hom(J, J) of Grauert-Remmert criterion is |
---|
5246 | // satisfied. |
---|
5247 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
5248 | list reduction1; |
---|
5249 | list reduction2; |
---|
5250 | |
---|
5251 | // ---------------------- inclusion Hom(J, J) c A ------------------------- |
---|
5252 | if(dbg > 1){"Checking the inclusion Hom(J, J) c A:";} |
---|
5253 | // This interred is used only because a bug in groebner! |
---|
5254 | U1 = groebner(U1); |
---|
5255 | reduction1 = reduce(U2, U1); |
---|
5256 | if(dbg > 1){reduction1[1];} |
---|
5257 | |
---|
5258 | // ---------------------- inclusion A c Hom(J, J) ------------------------- |
---|
5259 | // The following check should always be satisfied. |
---|
5260 | // This is only used for debugging. |
---|
5261 | if(dbg > 1) |
---|
5262 | { |
---|
5263 | "and the inclusion A c Hom(J, J): (this should always be satisfied)"; |
---|
5264 | // This interred is used only because a bug in groebner! |
---|
5265 | U2 = groebner(U2); |
---|
5266 | reduction2 = reduce(U1, groebner(U2)); |
---|
5267 | reduction2[1]; |
---|
5268 | if(size(reduction2[1]) > 0) |
---|
5269 | { |
---|
5270 | "Something went wrong... (this inclusion should always be satisfied)"; |
---|
5271 | ~; |
---|
5272 | } |
---|
5273 | else |
---|
5274 | { |
---|
5275 | if(dbg>4){pause();} |
---|
5276 | } |
---|
5277 | } |
---|
5278 | |
---|
5279 | if(size(reduction1[1]) == 0) |
---|
5280 | { |
---|
5281 | // We are done! The ring computed in the last step was normal. |
---|
5282 | return(1); |
---|
5283 | } |
---|
5284 | else |
---|
5285 | { |
---|
5286 | return(0); |
---|
5287 | } |
---|
5288 | } |
---|
5289 | |
---|
5290 | /////////////////////////////////////////////////////////////////////////////// |
---|
5291 | |
---|
5292 | static proc degSubring(poly p, intvec @v) |
---|
5293 | { |
---|
5294 | ASSUME(1, not isQuotientRing(basering) ); |
---|
5295 | // Computes the degree of a polynomial taking only some variables as variables |
---|
5296 | // and the others as parameters. |
---|
5297 | |
---|
5298 | // The degree is taken w.r.t. the variables indicated in v. |
---|
5299 | int i; // Counter |
---|
5300 | int d = 0; // The degree |
---|
5301 | int e; // Degree (auxiliar variable) |
---|
5302 | for(i = 1; i <= size(p); i++) |
---|
5303 | { |
---|
5304 | e = sum(leadexp(p[i]), @v); |
---|
5305 | if(e > d){d = e;} |
---|
5306 | } |
---|
5307 | return(d); |
---|
5308 | } |
---|
5309 | |
---|
5310 | /////////////////////////////////////////////////////////////////////////////// |
---|
5311 | |
---|
5312 | static proc mapBackIdeal(ideal I, poly c, intvec @v) |
---|
5313 | { |
---|
5314 | ASSUME(1, not isQuotientRing(basering) ); |
---|
5315 | |
---|
5316 | // Modifies all polynomials in I so that a map x(i) -> y(i)/c can be |
---|
5317 | // carried out. |
---|
5318 | |
---|
5319 | // v indicates wicih variables x(i) of the ring will be mapped to y(i)/c. |
---|
5320 | |
---|
5321 | int i; // counter |
---|
5322 | for(i = 1; i <= ncols(I); i++) |
---|
5323 | { |
---|
5324 | I[i] = mapBackPoly(I[i], c, @v); |
---|
5325 | } |
---|
5326 | return(I); |
---|
5327 | } |
---|
5328 | |
---|
5329 | /////////////////////////////////////////////////////////////////////////////// |
---|
5330 | |
---|
5331 | static proc mapBackPoly(poly p, poly c, intvec @v) |
---|
5332 | { |
---|
5333 | ASSUME(1, not isQuotientRing(basering) ); |
---|
5334 | |
---|
5335 | // Multiplies each monomial of p by a power of c so that a map x(i) -> y(i)/c |
---|
5336 | // can be carried out. |
---|
5337 | |
---|
5338 | // v indicates wicih variables x(i) of the ring will be mapped to y(i)/c. |
---|
5339 | int i; // counter |
---|
5340 | int e; // exponent |
---|
5341 | int d = degSubring(p, @v); |
---|
5342 | poly g = 0; |
---|
5343 | int size_p=size(p); |
---|
5344 | for(i = 1; i <= size_p; i++) |
---|
5345 | { |
---|
5346 | e = sum(leadexp(p[i]), @v); |
---|
5347 | g = g + p[i] * c^(d-e); |
---|
5348 | } |
---|
5349 | return(g); |
---|
5350 | } |
---|
5351 | |
---|
5352 | // End procedures for normal |
---|
5353 | /////////////////////////////////////////////////////////////////////////////// |
---|
5354 | |
---|
5355 | |
---|
5356 | /////////////////////////////////////////////////////////////////////////////// |
---|
5357 | // Begin procedures for normalC |
---|
5358 | |
---|
5359 | // We first define resp. copy some attributes to be used in proc normal and |
---|
5360 | // static proc normalizationPrimes, and ..., to speed up computation in |
---|
5361 | // special cases |
---|
5362 | //NOTE: We use the following attributes: |
---|
5363 | // 1 attrib(id,"isCohenMacaulay"); //--- Cohen Macaulay |
---|
5364 | // 2 attrib(id,"isCompleteIntersection"); //--- complete intersection |
---|
5365 | // 3 attrib(id,"isHypersurface"); //--- hypersurface |
---|
5366 | // 4 attrib(id,"isEquidimensional"); //--- equidimensional ideal |
---|
5367 | // 5 attrib(id,"isPrim"); //--- prime ideal |
---|
5368 | // 6 attrib(id,"isRegInCodim2"); //--- regular in codimension 2 |
---|
5369 | // 7 attrib(id,"isIsolatedSingularity"); //--- isolated singularities |
---|
5370 | // 8 attrib(id,"onlySingularAtZero"); //--- only singular at 0 |
---|
5371 | // 9 attrib(id,"isRadical"); //--- radical ideal |
---|
5372 | //Recall: (attrib(id,"xy"),1) sets attrib xy to TRUE and |
---|
5373 | // (attrib(id,"xy"),0) to FALSE |
---|
5374 | |
---|
5375 | static proc getAttrib (ideal id) |
---|
5376 | "USAGE: getAttrib(id); id=ideal |
---|
5377 | COMPUTE: check attributes for id. If the attributes above are defined, |
---|
5378 | take its value, otherwise define it and set it to 0 |
---|
5379 | RETURN: intvec of size 9, with entries 0 or 1, values of attributes defined |
---|
5380 | above (in this order) |
---|
5381 | EXAMPLE: no example |
---|
5382 | " |
---|
5383 | { |
---|
5384 | int isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad; |
---|
5385 | |
---|
5386 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
5387 | { |
---|
5388 | if( attrib(id,"isCohenMacaulay")==1 ) |
---|
5389 | { isCoM=1; isEq=1; } |
---|
5390 | } |
---|
5391 | |
---|
5392 | if( typeof(attrib(id,"isCompleteIntersection"))=="int" ) |
---|
5393 | { |
---|
5394 | if(attrib(id,"isCompleteIntersection")==1) |
---|
5395 | { isCoI=1; isCoM=1; isEq=1; } |
---|
5396 | } |
---|
5397 | |
---|
5398 | if( typeof(attrib(id,"isHypersurface"))=="int" ) |
---|
5399 | { |
---|
5400 | if(attrib(id,"isHypersurface")==1) |
---|
5401 | { isHy=1; isCoI=1; isCoM=1; isEq=1; } |
---|
5402 | } |
---|
5403 | |
---|
5404 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
5405 | { |
---|
5406 | if(attrib(id,"isEquidimensional")==1) |
---|
5407 | { isEq=1; } |
---|
5408 | } |
---|
5409 | |
---|
5410 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
5411 | { |
---|
5412 | if(attrib(id,"isPrim")==1) |
---|
5413 | { isPr=1; } |
---|
5414 | } |
---|
5415 | |
---|
5416 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
5417 | { |
---|
5418 | if(attrib(id,"isRegInCodim2")==1) |
---|
5419 | { isReg=1; } |
---|
5420 | } |
---|
5421 | |
---|
5422 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
5423 | { |
---|
5424 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
5425 | { isIso=1; } |
---|
5426 | } |
---|
5427 | |
---|
5428 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
5429 | { |
---|
5430 | if(attrib(id,"onlySingularAtZero")==1) |
---|
5431 | { oSAZ=1; } |
---|
5432 | } |
---|
5433 | |
---|
5434 | if( typeof(attrib(id,"isRad"))=="int" ) |
---|
5435 | { |
---|
5436 | if(attrib(id,"isRad")==1) |
---|
5437 | { isRad=1; } |
---|
5438 | } |
---|
5439 | |
---|
5440 | intvec atr = isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad; |
---|
5441 | return(atr); |
---|
5442 | } |
---|
5443 | |
---|
5444 | /////////////////////////////////////////////////////////////////////////////// |
---|
5445 | |
---|
5446 | static proc setAttrib (ideal id, intvec atr) |
---|
5447 | "USAGE: setAttrib(id,atr); id ideal, atr intvec |
---|
5448 | COMPUTE: set attributes to id specified by atr |
---|
5449 | RETURN: id, with assigned attributes from atr |
---|
5450 | EXAMPLE: no example |
---|
5451 | " |
---|
5452 | { |
---|
5453 | attrib(id,"isCohenMacaulay",atr[1]); //--- Cohen Macaulay |
---|
5454 | attrib(id,"isCompleteIntersection",atr[2]); //--- complete intersection |
---|
5455 | attrib(id,"isHypersurface",atr[3]); //--- hypersurface |
---|
5456 | attrib(id,"isEquidimensional",atr[4]); //--- equidimensional ideal |
---|
5457 | attrib(id,"isPrim",atr[5]); //--- prime ideal |
---|
5458 | attrib(id,"isRegInCodim2",atr[6]); //--- regular in codimension 2 |
---|
5459 | attrib(id,"isIsolatedSingularity",atr[7]); //--- isolated singularities |
---|
5460 | attrib(id,"onlySingularAtZero",atr[8]); //--- only singular at 0 |
---|
5461 | attrib(id,"isRadical",atr[9]); //--- radical ideal |
---|
5462 | |
---|
5463 | return(id); |
---|
5464 | } |
---|
5465 | |
---|
5466 | /////////////////////////////////////////////////////////////////////////////// |
---|
5467 | // copyAttribs is not used anywhere so far |
---|
5468 | |
---|
5469 | static proc copyAttribs (ideal id1, ideal id) |
---|
5470 | "USAGE: copyAttribs(id1,id); id1, id ideals |
---|
5471 | COMPUTE: copy attributes from id1 to id |
---|
5472 | RETURN: id, with assigned attributes from id1 |
---|
5473 | EXAMPLE: no example |
---|
5474 | " |
---|
5475 | { |
---|
5476 | if( typeof(attrib(id1,"isCohenMacaulay"))=="int" ) |
---|
5477 | { |
---|
5478 | if( attrib(id1,"isCohenMacaulay")==1 ) |
---|
5479 | { |
---|
5480 | attrib(id,"isEquidimensional",1); |
---|
5481 | } |
---|
5482 | } |
---|
5483 | else |
---|
5484 | { |
---|
5485 | attrib(id,"isCohenMacaulay",0); |
---|
5486 | } |
---|
5487 | |
---|
5488 | if( typeof(attrib(id1,"isCompleteIntersection"))=="int" ) |
---|
5489 | { |
---|
5490 | if(attrib(id1,"isCompleteIntersection")==1) |
---|
5491 | { |
---|
5492 | attrib(id,"isCohenMacaulay",1); |
---|
5493 | attrib(id,"isEquidimensional",1); |
---|
5494 | } |
---|
5495 | } |
---|
5496 | else |
---|
5497 | { |
---|
5498 | attrib(id,"isCompleteIntersection",0); |
---|
5499 | } |
---|
5500 | |
---|
5501 | if( typeof(attrib(id1,"isHypersurface"))=="int" ) |
---|
5502 | { |
---|
5503 | if(attrib(id1,"isHypersurface")==1) |
---|
5504 | { |
---|
5505 | attrib(id,"isCompleteIntersection",1); |
---|
5506 | attrib(id,"isCohenMacaulay",1); |
---|
5507 | attrib(id,"isEquidimensional",1); |
---|
5508 | } |
---|
5509 | } |
---|
5510 | else |
---|
5511 | { |
---|
5512 | attrib(id,"isHypersurface",0); |
---|
5513 | } |
---|
5514 | |
---|
5515 | if( (typeof(attrib(id1,"isEquidimensional"))=="int") ) |
---|
5516 | { |
---|
5517 | if(attrib(id1,"isEquidimensional")==1) |
---|
5518 | { |
---|
5519 | attrib(id,"isEquidimensional",1); |
---|
5520 | } |
---|
5521 | } |
---|
5522 | else |
---|
5523 | { |
---|
5524 | attrib(id,"isEquidimensional",0); |
---|
5525 | } |
---|
5526 | |
---|
5527 | if( typeof(attrib(id1,"isPrim"))=="int" ) |
---|
5528 | { |
---|
5529 | if(attrib(id1,"isPrim")==1) |
---|
5530 | { |
---|
5531 | attrib(id,"isEquidimensional",1); |
---|
5532 | } |
---|
5533 | } |
---|
5534 | else |
---|
5535 | { |
---|
5536 | attrib(id,"isPrim",0); |
---|
5537 | } |
---|
5538 | |
---|
5539 | if( (typeof(attrib(id1,"isRegInCodim2"))=="int") ) |
---|
5540 | { |
---|
5541 | if(attrib(id1,"isRegInCodim2")==1) |
---|
5542 | { |
---|
5543 | attrib(id,"isRegInCodim2",1); |
---|
5544 | } |
---|
5545 | } |
---|
5546 | else |
---|
5547 | { |
---|
5548 | attrib(id,"isRegInCodim2",0); |
---|
5549 | } |
---|
5550 | |
---|
5551 | if( (typeof(attrib(id1,"isIsolatedSingularity"))=="int") ) |
---|
5552 | { |
---|
5553 | if(attrib(id1,"isIsolatedSingularity")==1) |
---|
5554 | { |
---|
5555 | attrib(id,"isIsolatedSingularity",1); |
---|
5556 | } |
---|
5557 | } |
---|
5558 | else |
---|
5559 | { |
---|
5560 | attrib(id,"isIsolatedSingularity",0); |
---|
5561 | } |
---|
5562 | |
---|
5563 | if( typeof(attrib(id1,"onlySingularAtZero"))=="int" ) |
---|
5564 | { |
---|
5565 | if(attrib(id1,"onlySingularAtZero")==1) |
---|
5566 | { |
---|
5567 | attrib(id,"isIsolatedSingularity",1); |
---|
5568 | } |
---|
5569 | } |
---|
5570 | else |
---|
5571 | { |
---|
5572 | attrib(id,"onlySingularAtZero",0); |
---|
5573 | } |
---|
5574 | |
---|
5575 | if( typeof(attrib(id1,"isRad"))=="int" ) |
---|
5576 | { |
---|
5577 | if(attrib(id1,"isRad")==1) |
---|
5578 | { |
---|
5579 | attrib(id,"isRad",1); |
---|
5580 | } |
---|
5581 | } |
---|
5582 | else |
---|
5583 | { |
---|
5584 | attrib(id,"isRad",0); |
---|
5585 | } |
---|
5586 | return(id); |
---|
5587 | } |
---|
5588 | /////////////////////////////////////////////////////////////////////////////// |
---|
5589 | |
---|
5590 | proc normalC(ideal id, list #) |
---|
5591 | "USAGE: normalC(id [,choose]); id = radical ideal, choose = optional list |
---|
5592 | of string. |
---|
5593 | Optional parameters in list choose (can be entered in any order):@* |
---|
5594 | Decomposition:@* |
---|
5595 | - \"equidim\" -> computes first an equidimensional decomposition, |
---|
5596 | and then the normalization of each component (default).@* |
---|
5597 | - \"prim\" -> computes first the minimal associated primes, and then |
---|
5598 | the normalization of each prime. @* |
---|
5599 | - \"noDeco\" -> no preliminary decomposition is done. If the ideal is |
---|
5600 | not equidimensional radical, output might be wrong.@* |
---|
5601 | - \"isPrim\" -> assumes that the ideal is prime. If the assumption does |
---|
5602 | not hold, output might be wrong.@* |
---|
5603 | - \"noFac\" -> factorization is avoided in the computation of the |
---|
5604 | minimal associated primes; |
---|
5605 | Other:@* |
---|
5606 | - \"withGens\" -> the minimal associated primes P_i of id are |
---|
5607 | computed and for each P_i, algebra generators of the integral closure |
---|
5608 | of basering/P_i are computed as elements of its quotient field;@* |
---|
5609 | If choose is not given or empty, the default options are used.@* |
---|
5610 | ASSUME: The ideal must be radical, for non-radical ideals the output may |
---|
5611 | be wrong (id=radical(id); makes id radical). However, if option |
---|
5612 | \"prim\" is set the minimal associated primes are computed first |
---|
5613 | and hence normalC computes the normalization of the radical of id. |
---|
5614 | \"isPrim\" should only be used if id is known to be irreducible. |
---|
5615 | RETURN: a list, say nor, of size 2 (resp. 3 if option \"withGens\" is set).@* |
---|
5616 | * nor[1] is always a of r rings, where r is the number of associated |
---|
5617 | primes with option \"prim\" (resp. >= no of equidimenensional |
---|
5618 | components with option \"equidim\").@* |
---|
5619 | Each ring Ri=nor[1][i], i=1..r, contains two ideals with given |
---|
5620 | names @code{norid} and @code{normap} such that @* |
---|
5621 | - Ri/norid is the normalization of the i-th component, i.e. the |
---|
5622 | integral closure in its field of fractions as affine ring, i.e. Ri is |
---|
5623 | given in the form K[X(1..p),T(1..q)], where K is the ground field; |
---|
5624 | - normap gives the normalization map from basering/id to |
---|
5625 | Ri/norid for each i (the j-th element of normap is mapped to the |
---|
5626 | j-th variable of R).@* |
---|
5627 | - the direct sum of the rings Ri/norid is the normalization |
---|
5628 | of basering/id; @* |
---|
5629 | ** If option \"withGens\" is not set: @* |
---|
5630 | * nor[2] shows the delta invariants: nor[2] is a list of an intvec of |
---|
5631 | size r, the delta invariants of the r components, and an integer, the |
---|
5632 | delta invariant of basering/id. (-1 means infinite, 0 that basering/P_i |
---|
5633 | resp. basering/input is normal, -2 means that delta resp. delta of one |
---|
5634 | of the components is not computed (which may happen if \"equidim\" is |
---|
5635 | given). @* |
---|
5636 | ** If option \"withGens\" is set: |
---|
5637 | * nor[2] is a list of ideals Ii=nor[2][i], i=1..r, in the basering, |
---|
5638 | generating the integral closure of basering/P_i in its quotient field |
---|
5639 | as K-algebra (K the ground field):@* |
---|
5640 | If Ii is given by polynomials g_1,...,g_k, then c:=g_k is a non-zero |
---|
5641 | divisor and the j-th variables of the ring Ri satisfies var(j)=g_j/c, |
---|
5642 | j=1..k-1, as element in the quotient field of basering/P_i. The |
---|
5643 | g_j/g_k+1 are K-algebra generators of the integral closure of |
---|
5644 | basering/P_i.@* |
---|
5645 | * nor[3] shows the delta invariant as above. |
---|
5646 | THEORY: We use the Grauert-Remmert-de Jong algorithm [c.f. G.-M. Greuel, |
---|
5647 | G. Pfister: A SINGULAR Introduction to Commutative Algebra, 2nd Edition. |
---|
5648 | Springer Verlag (2007)]. |
---|
5649 | The procedure computes the algebra structure and the delta invariant of |
---|
5650 | the normalization of R/id:@* |
---|
5651 | The normalization is an affine algebra over the ground field K |
---|
5652 | and nor[1] presents it as such: Ri = K[X(1..p),T(1..q)] and Ri/norid |
---|
5653 | is the integral closure of R/P_i; if option \"withGens\" is set the |
---|
5654 | X(j) and T(j) are expressed as quotients in the total ring of |
---|
5655 | fractions. Note that the X(j) and T(j) generate the integral closure |
---|
5656 | as K-algebra, but not necessarily as R-module (since relations of the |
---|
5657 | form X(1)=T(1)*T(2) may have been eliminated). Geometrically the |
---|
5658 | algebra structure is relevant since the variety of the ideal norid in |
---|
5659 | Ri is the normalization of the variety of the ideal P_i in R.@* |
---|
5660 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
5661 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
5662 | id. nor[3] returns the delta invariants of the components P_i and of |
---|
5663 | id. |
---|
5664 | NOTE: To use the i-th ring type: @code{def R=nor[1][i]; setring R;}. |
---|
5665 | @* Increasing/decreasing printlevel displays more/less comments |
---|
5666 | (default: printlevel=0). |
---|
5667 | @* Not implemented for local or mixed orderings or quotient rings. |
---|
5668 | For local or mixed orderings use proc 'normal'. |
---|
5669 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
5670 | be used (qhweight(id); computes weights). |
---|
5671 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
5672 | SEE ALSO: normal, normalP. |
---|
5673 | EXAMPLE: example normalC; shows an example |
---|
5674 | " |
---|
5675 | { |
---|
5676 | ASSUME(0, not isQuotientRing(basering) ); |
---|
5677 | |
---|
5678 | int i,j; |
---|
5679 | int withGens, withEqui, withPrim, isPrim, noFac; |
---|
5680 | int dbg = printlevel-voice+2; |
---|
5681 | int nvar = nvars(basering); |
---|
5682 | int chara = char(basering); |
---|
5683 | list result, prim, keepresult; |
---|
5684 | |
---|
5685 | int decomp; // Preliminar decomposition: |
---|
5686 | // 0 -> no decomposition (id is assumed to be prime) |
---|
5687 | // 1 -> no decomposition |
---|
5688 | // (id is assumed to be equidimensional radical) |
---|
5689 | // 2 -> equidimensional decomposition |
---|
5690 | // 3 -> minimal associated primes |
---|
5691 | |
---|
5692 | // Default methods: |
---|
5693 | noFac = 0; // Use facstd when computing minimal associated primes |
---|
5694 | decomp = 2; // Equidimensional decomposition for nvar > 2 |
---|
5695 | if (nvar <= 2) |
---|
5696 | { decomp = 3; } // Compute minimal associated primes if nvar <= 2 |
---|
5697 | |
---|
5698 | if ( attrib(basering,"global") != 1 ) |
---|
5699 | { |
---|
5700 | ""; |
---|
5701 | "// Not implemented for this ordering,"; |
---|
5702 | "// please change to global ordering or use proc normal"; |
---|
5703 | return(result); |
---|
5704 | } |
---|
5705 | |
---|
5706 | //--------------------------- define the method --------------------------- |
---|
5707 | string method; //make all options one string in order to use |
---|
5708 | //all combinations of options simultaneously |
---|
5709 | for ( i=1; i <= size(#); i++ ) |
---|
5710 | { |
---|
5711 | if ( typeof(#[i]) == "string" ) |
---|
5712 | { |
---|
5713 | method = method + #[i]; |
---|
5714 | } |
---|
5715 | } |
---|
5716 | |
---|
5717 | //--------------------------- choosen methods ----------------------- |
---|
5718 | // "withGens": computes algebra generators for each irreducible component |
---|
5719 | // ### the extra code for withGens should be incorporated in the general case |
---|
5720 | |
---|
5721 | if ( find(method,"withgens") or find(method,"withGens")) |
---|
5722 | { |
---|
5723 | withGens = 1; |
---|
5724 | } |
---|
5725 | |
---|
5726 | // the general case: either equidim or minAssGTZ or no decomposition |
---|
5727 | |
---|
5728 | if ( find(method,"isprim") or find(method,"isPrim") ) |
---|
5729 | {decomp = 0; isPrim=1;} |
---|
5730 | |
---|
5731 | if ( find(method,"nodeco") or find(method,"noDeco") ) |
---|
5732 | {decomp = 1;} |
---|
5733 | |
---|
5734 | if ( find(method,"equidim") ) |
---|
5735 | { decomp = 2; } |
---|
5736 | |
---|
5737 | if ( find(method,"prim") ) |
---|
5738 | { decomp = 3; } |
---|
5739 | |
---|
5740 | if ( find(method,"nofac") or find(method,"noFac") ) |
---|
5741 | { noFac = 1; } |
---|
5742 | |
---|
5743 | kill #; |
---|
5744 | list #; |
---|
5745 | |
---|
5746 | //------- Special algorithm with computation of the generators, RETURN ------- |
---|
5747 | //--------------------- method "withGens" ---------------------------------- |
---|
5748 | //the integral closure is computed in proc primeClosure. In the general case |
---|
5749 | //it is computed in normalizationPrimes. The main difference is that in |
---|
5750 | //primeClosure the singular locus is only computed in the first iteration, |
---|
5751 | //that no attributes are used, and that the generators are computed. |
---|
5752 | //In primeClosure the (algebra) generators for each irreducible component |
---|
5753 | //are computed in the static proc closureGenerators |
---|
5754 | |
---|
5755 | if( withGens ) |
---|
5756 | { |
---|
5757 | if( dbg >= 1 ) |
---|
5758 | { ""; |
---|
5759 | "// We use method 'withGens'"; |
---|
5760 | } |
---|
5761 | if ( decomp == 0 or decomp == 1 ) |
---|
5762 | { |
---|
5763 | prim[1] = id; |
---|
5764 | if( dbg >= 0 ) |
---|
5765 | { |
---|
5766 | ""; |
---|
5767 | "// ** WARNING: result is correct if ideal is prime (not checked) **"; |
---|
5768 | "// if procedure is called with string \"prim\", primality is checked"; |
---|
5769 | } |
---|
5770 | } |
---|
5771 | else |
---|
5772 | { |
---|
5773 | if(dbg >= 1) |
---|
5774 | { "// Computing minimal associated primes..."; } |
---|
5775 | |
---|
5776 | if( noFac ) |
---|
5777 | { prim = minAssGTZ(id,1); } |
---|
5778 | else |
---|
5779 | { prim = minAssGTZ(id); } |
---|
5780 | |
---|
5781 | if(dbg >= 2) |
---|
5782 | { prim;""; } |
---|
5783 | if(dbg >= 1) |
---|
5784 | { |
---|
5785 | "// number of irreducible components is", size(prim); |
---|
5786 | } |
---|
5787 | } |
---|
5788 | //----------- compute integral closure for every component ------------- |
---|
5789 | int del; |
---|
5790 | intvec deli; |
---|
5791 | list Gens,l,resu,Resu; |
---|
5792 | ideal gens; |
---|
5793 | def R = basering; |
---|
5794 | poly gg; |
---|
5795 | |
---|
5796 | for(i=1; i<=size(prim); i++) |
---|
5797 | { |
---|
5798 | if(dbg>=1) |
---|
5799 | { |
---|
5800 | ""; pause(); ""; |
---|
5801 | "// Computing normalization of component",i; |
---|
5802 | " ---------------------------------------"; |
---|
5803 | } |
---|
5804 | |
---|
5805 | if( defined(ker) ) { kill ker; } |
---|
5806 | ideal ker = prim[i]; |
---|
5807 | export(ker); |
---|
5808 | l = R; |
---|
5809 | l = primeClosure(l,1); //here the work is done |
---|
5810 | // primeClosure is called with list l consisting of the basering |
---|
5811 | //### ausprobieren ob primeClosure(l,1) schneller als primeClosure(l) |
---|
5812 | // 1 bedeutet: kuerzester nzd |
---|
5813 | // l[size(l)] is the delta invariant |
---|
5814 | |
---|
5815 | if ( l[size(l)] >= 0 && del >= 0 ) |
---|
5816 | { |
---|
5817 | del = del + l[size(l)]; |
---|
5818 | } |
---|
5819 | else |
---|
5820 | { del = -1; } |
---|
5821 | deli = l[size(l)],deli; |
---|
5822 | |
---|
5823 | l = l[1..size(l)-1]; |
---|
5824 | resu = list(l[size(l)]) + resu; |
---|
5825 | gens = closureGenerators(l); //computes algebra(!) generators |
---|
5826 | |
---|
5827 | //NOTE: gens[i]/gens[size(gens)] expresses the ith variable of resu[1] |
---|
5828 | //(the normalization) as fraction of elements of the basering; |
---|
5829 | //the variables of resu[1] are algebra generators. |
---|
5830 | //gens[size(gens)] is a non-zero divisor of basering/i |
---|
5831 | |
---|
5832 | //divide by the greatest common divisor: |
---|
5833 | gg = gcd( gens[1],gens[size(gens)] ); |
---|
5834 | for(j=2; j<=size(gens)-1; j++) |
---|
5835 | { |
---|
5836 | gg=gcd(gg,gens[j]); |
---|
5837 | } |
---|
5838 | for(j=1; j<=size(gens); j++) |
---|
5839 | { |
---|
5840 | gens[j]=gens[j]/gg; |
---|
5841 | } |
---|
5842 | Gens = list(gens) + Gens; |
---|
5843 | |
---|
5844 | /* ### Da die gens Algebra-Erzeuger sind, ist reduce nach Bestimmung |
---|
5845 | der Algebra-Variablen T(i) nicht zulaessig! |
---|
5846 | for(i=1;i<=size(gens)-1;i++) |
---|
5847 | { |
---|
5848 | gens[i]= reduce(gens[i],std(gens[size(gens)])); |
---|
5849 | } |
---|
5850 | for(i=size(gens)-1; i>=1; i--) |
---|
5851 | { |
---|
5852 | if(gens[i]==0) |
---|
5853 | { gens = delete(gens,i); } |
---|
5854 | } |
---|
5855 | */ |
---|
5856 | if( defined(ker) ) { kill ker; } |
---|
5857 | } |
---|
5858 | |
---|
5859 | if ( del >= 0 ) |
---|
5860 | { |
---|
5861 | int mul = iMult(prim); |
---|
5862 | del = del + mul; |
---|
5863 | } |
---|
5864 | else |
---|
5865 | { del = -1; } |
---|
5866 | deli = deli[1..size(deli)-1]; |
---|
5867 | Resu = resu,Gens,list(deli,del); |
---|
5868 | int sr = size(resu); |
---|
5869 | |
---|
5870 | if ( dbg >= 0 ) |
---|
5871 | {""; |
---|
5872 | "// 'normalC' created a list, say nor, of three lists: |
---|
5873 | // To see the list type |
---|
5874 | nor; |
---|
5875 | |
---|
5876 | // * nor[1] is a list of",sr,"ring(s) |
---|
5877 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
5878 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
5879 | // For the other rings type first (if R is the name of your original basering) |
---|
5880 | setring R; |
---|
5881 | // and then continue as for R1. |
---|
5882 | // Ri/norid is the affine algebra of the normalization of the i-th |
---|
5883 | // component R/P_i (where P_i is an associated prime of the input ideal id) |
---|
5884 | // and normap the normalization map from R to Ri/norid. |
---|
5885 | |
---|
5886 | // * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of |
---|
5887 | // elements g1..gk of R such that the gj/gk generate the integral |
---|
5888 | // closure of R/P_i as sub-algebra in the quotient field of R/P_i, with |
---|
5889 | // gj/gk being mapped by normap to the j-th variable of Ri; |
---|
5890 | |
---|
5891 | // * nor[3] shows the delta-invariant of each component and of id |
---|
5892 | // (-1 means infinite, and 0 that R/P_i resp. R/id is normal)."; |
---|
5893 | } |
---|
5894 | return(Resu); |
---|
5895 | } |
---|
5896 | //----------------- end method "withGens" -------------------------------- |
---|
5897 | |
---|
5898 | //-------- The general case without computation of the generators ----------- |
---|
5899 | // (attrib(id,"xy"),1) sets attrib xy to TRUE and (attrib(id,"xy"),0) to FALSE |
---|
5900 | // We use the following attributes: |
---|
5901 | // attrib(id,"isCohenMacaulay"); //--- Cohen Macaulay |
---|
5902 | // attrib(id,"isCompleteIntersection"); //--- complete intersection |
---|
5903 | // attrib(id,"isHypersurface"); //--- hypersurface |
---|
5904 | // attrib(id,"isEquidimensional",-1); //--- equidimensional ideal |
---|
5905 | // attrib(id,"isPrim"); //--- prime ideal |
---|
5906 | // attrib(id,"isRegInCodim2"); //--- regular in codimension 2 |
---|
5907 | // attrib(id,"isIsolatedSingularity"; //--- isolated singularities |
---|
5908 | // attrib(id,"onlySingularAtZero"); //--- only singular at 0 |
---|
5909 | |
---|
5910 | //------------------- first set the attributes ---------------------- |
---|
5911 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
5912 | { |
---|
5913 | if( attrib(id,"isCohenMacaulay")==1 ) |
---|
5914 | { |
---|
5915 | attrib(id,"isEquidimensional",1); |
---|
5916 | } |
---|
5917 | } |
---|
5918 | else |
---|
5919 | { |
---|
5920 | attrib(id,"isCohenMacaulay",0); |
---|
5921 | } |
---|
5922 | |
---|
5923 | if( typeof(attrib(id,"isCompleteIntersection"))=="int" ) |
---|
5924 | { |
---|
5925 | if(attrib(id,"isCompleteIntersection")==1) |
---|
5926 | { |
---|
5927 | attrib(id,"isCohenMacaulay",1); |
---|
5928 | attrib(id,"isEquidimensional",1); |
---|
5929 | } |
---|
5930 | } |
---|
5931 | else |
---|
5932 | { |
---|
5933 | attrib(id,"isCompleteIntersection",0); |
---|
5934 | } |
---|
5935 | |
---|
5936 | if( typeof(attrib(id,"isHypersurface"))=="int" ) |
---|
5937 | { |
---|
5938 | if(attrib(id,"isHypersurface")==1) |
---|
5939 | { |
---|
5940 | attrib(id,"isCompleteIntersection",1); |
---|
5941 | attrib(id,"isCohenMacaulay",1); |
---|
5942 | attrib(id,"isEquidimensional",1); |
---|
5943 | } |
---|
5944 | } |
---|
5945 | else |
---|
5946 | { |
---|
5947 | attrib(id,"isHypersurface",0); |
---|
5948 | } |
---|
5949 | |
---|
5950 | if( ! (typeof(attrib(id,"isEquidimensional"))=="int") ) |
---|
5951 | { |
---|
5952 | attrib(id,"isEquidimensional",0); |
---|
5953 | } |
---|
5954 | |
---|
5955 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
5956 | { |
---|
5957 | if(attrib(id,"isPrim")==1) |
---|
5958 | { |
---|
5959 | attrib(id,"isEquidimensional",1); |
---|
5960 | } |
---|
5961 | } |
---|
5962 | else |
---|
5963 | { |
---|
5964 | attrib(id,"isPrim",0); |
---|
5965 | } |
---|
5966 | |
---|
5967 | if( ! (typeof(attrib(id,"isRegInCodim2"))=="int") ) |
---|
5968 | { |
---|
5969 | attrib(id,"isRegInCodim2",0); |
---|
5970 | } |
---|
5971 | |
---|
5972 | if( ! (typeof(attrib(id,"isIsolatedSingularity"))=="int") ) |
---|
5973 | { |
---|
5974 | attrib(id,"isIsolatedSingularity",0); |
---|
5975 | } |
---|
5976 | |
---|
5977 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
5978 | { |
---|
5979 | if(attrib(id,"onlySingularAtZero")==1) |
---|
5980 | { |
---|
5981 | attrib(id,"isIsolatedSingularity",1); |
---|
5982 | } |
---|
5983 | } |
---|
5984 | else |
---|
5985 | { |
---|
5986 | attrib(id,"onlySingularAtZero",0); |
---|
5987 | } |
---|
5988 | |
---|
5989 | //-------------- compute equidimensional decomposition -------------------- |
---|
5990 | //If the method "equidim" is given, compute the equidim decomposition |
---|
5991 | //and goto the next step (no normalization |
---|
5992 | //ACHTUNG: equidim berechnet bei nicht reduzierten id die eingebetteten |
---|
5993 | //Komponenten als niederdim Komponenten, waehrend diese bei primdecGTZ |
---|
5994 | //nicht auftauchen: ideal(x,y)*xy |
---|
5995 | //this is default for nvars > 2 |
---|
5996 | |
---|
5997 | if( decomp == 2 ) |
---|
5998 | { |
---|
5999 | withPrim = 0; //this is used to check later that prim |
---|
6000 | //contains equidim but not prime components |
---|
6001 | if( dbg >= 1 ) |
---|
6002 | { |
---|
6003 | "// We use method 'equidim'"; |
---|
6004 | } |
---|
6005 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
6006 | { |
---|
6007 | if(attrib(id,"isEquidimensional")==1) |
---|
6008 | { |
---|
6009 | prim[1] = id; |
---|
6010 | } |
---|
6011 | else |
---|
6012 | { |
---|
6013 | prim = equidim(id); |
---|
6014 | } |
---|
6015 | } |
---|
6016 | else |
---|
6017 | { |
---|
6018 | prim = equidim(id); |
---|
6019 | } |
---|
6020 | if(dbg>=1) |
---|
6021 | { ""; |
---|
6022 | "// number of equidimensional components:", size(prim); |
---|
6023 | } |
---|
6024 | if ( !noFac ) |
---|
6025 | { |
---|
6026 | intvec opt = option(get); |
---|
6027 | option(redSB); |
---|
6028 | for(j=1; j<=size(prim); j++) |
---|
6029 | { |
---|
6030 | keepresult = keepresult+facstd(prim[j]); |
---|
6031 | } |
---|
6032 | prim = keepresult; |
---|
6033 | if ( size(prim) == 0 ) |
---|
6034 | { |
---|
6035 | prim=ideal(0); //Bug in facstd, liefert leere Liste bei 0-Ideal |
---|
6036 | } |
---|
6037 | |
---|
6038 | if(dbg>=1) |
---|
6039 | { ""; |
---|
6040 | "// number of components after application of facstd:", size(prim); |
---|
6041 | } |
---|
6042 | option(set,opt); |
---|
6043 | } |
---|
6044 | } |
---|
6045 | |
---|
6046 | //------------------- compute associated primes ------------------------- |
---|
6047 | //the case where withEqui = 0, here the min. ass. primes are computed |
---|
6048 | //start with the computation of the minimal associated primes: |
---|
6049 | |
---|
6050 | else |
---|
6051 | { |
---|
6052 | if( isPrim ) |
---|
6053 | { |
---|
6054 | if( dbg >= 0 ) |
---|
6055 | { |
---|
6056 | "// ** WARNING: result is correct if ideal is prime"; |
---|
6057 | "// or equidimensional (not checked) **"; |
---|
6058 | "// disable option \"isPrim\" to decompose ideal into prime"; |
---|
6059 | "// or equidimensional components";""; |
---|
6060 | } |
---|
6061 | if( dbg >= 1 ) |
---|
6062 | { |
---|
6063 | "// We use method 'isPrim'";""; |
---|
6064 | } |
---|
6065 | prim[1]=id; |
---|
6066 | } |
---|
6067 | else |
---|
6068 | { |
---|
6069 | withPrim = 1; //this is used to check later that prim |
---|
6070 | //contains prime but not equidim components |
---|
6071 | if( dbg >= 1 ) |
---|
6072 | { |
---|
6073 | "// We use method 'prim'"; |
---|
6074 | } |
---|
6075 | |
---|
6076 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
6077 | { |
---|
6078 | if(attrib(id,"isPrim")==1) |
---|
6079 | { |
---|
6080 | prim[1]=id; |
---|
6081 | } |
---|
6082 | else |
---|
6083 | { |
---|
6084 | if( noFac ) |
---|
6085 | { prim=minAssGTZ(id,1); } //does not use factorizing groebner |
---|
6086 | else |
---|
6087 | { prim=minAssGTZ(id); } //uses factorizing groebner |
---|
6088 | } |
---|
6089 | } |
---|
6090 | else |
---|
6091 | { |
---|
6092 | if( noFac ) |
---|
6093 | { prim=minAssGTZ(id,1); } |
---|
6094 | else |
---|
6095 | { prim=minAssGTZ(id); } |
---|
6096 | } |
---|
6097 | if(dbg>=1) |
---|
6098 | { ""; |
---|
6099 | "// number of irreducible components:", size(prim); |
---|
6100 | } |
---|
6101 | } |
---|
6102 | } |
---|
6103 | |
---|
6104 | //----- for each component (equidim or irred) compute normalization ----- |
---|
6105 | int sr, skr, del; |
---|
6106 | intvec deli; |
---|
6107 | int sp = size(prim); //size of list prim (# irred or equidim comp) |
---|
6108 | |
---|
6109 | for(i=1; i<=sp; i++) |
---|
6110 | { |
---|
6111 | if(dbg>=1) |
---|
6112 | { ""; |
---|
6113 | "// computing the normalization of component",i; |
---|
6114 | " ----------------------------------------"; |
---|
6115 | } |
---|
6116 | //-------------- first set attributes for components ------------------ |
---|
6117 | attrib(prim[i],"isEquidimensional",1); |
---|
6118 | if( withPrim ) |
---|
6119 | { |
---|
6120 | attrib(prim[i],"isPrim",1); |
---|
6121 | } |
---|
6122 | else |
---|
6123 | { attrib(prim[i],"isPrim",0); } |
---|
6124 | |
---|
6125 | if(attrib(id,"onlySingularAtZero")==1) |
---|
6126 | { attrib(prim[i],"onlySingularAtZero",1); } |
---|
6127 | else |
---|
6128 | { attrib(prim[i],"onlySingularAtZero",0); } |
---|
6129 | |
---|
6130 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
6131 | { attrib(prim[i],"isIsolatedSingularity",1); } |
---|
6132 | else |
---|
6133 | { attrib(prim[i],"isIsolatedSingularity",0); } |
---|
6134 | |
---|
6135 | if( attrib(id,"isHypersurface")==1 ) |
---|
6136 | { |
---|
6137 | attrib(prim[i],"isHypersurface",1); |
---|
6138 | attrib(prim[i],"isCompleteIntersection",1); |
---|
6139 | attrib(prim[i],"isCohenMacaulay",1); |
---|
6140 | } |
---|
6141 | else |
---|
6142 | { attrib(prim[i],"isHypersurface",0); } |
---|
6143 | |
---|
6144 | if ( sp == 1) //the case of one component: copy attribs from id |
---|
6145 | { |
---|
6146 | if(attrib(id,"isRegInCodim2")==1) |
---|
6147 | {attrib(prim[i],"isRegInCodim2",1); } |
---|
6148 | else |
---|
6149 | {attrib(prim[i],"isRegInCodim2",0); } |
---|
6150 | |
---|
6151 | if(attrib(id,"isCohenMacaulay")==1) |
---|
6152 | {attrib(prim[i],"isCohenMacaulay",1); } |
---|
6153 | else |
---|
6154 | {attrib(prim[i],"isCohenMacaulay",0); } |
---|
6155 | |
---|
6156 | if(attrib(id,"isCompleteIntersection")==1) |
---|
6157 | {attrib(prim[i],"isCompleteIntersection",1); } |
---|
6158 | else |
---|
6159 | {attrib(prim[i],"isCompleteIntersection",0); } |
---|
6160 | } |
---|
6161 | else |
---|
6162 | { |
---|
6163 | attrib(prim[i],"isRegInCodim2",0); |
---|
6164 | attrib(prim[i],"isCohenMacaulay",0); |
---|
6165 | attrib(prim[i],"isCompleteIntersection",0); |
---|
6166 | } |
---|
6167 | |
---|
6168 | //------ Now compute the normalization of each component --------- |
---|
6169 | //note: for equidimensional components the "splitting tools" can |
---|
6170 | //create further decomposition |
---|
6171 | //We now start normalizationPrimes with |
---|
6172 | //ihp = partial normalisation map = identity map = maxideal(1) |
---|
6173 | //del = partial delta invariant = 0 |
---|
6174 | //deli= intvec of partial delta invariants of components |
---|
6175 | //in normalizationPrimes all the work is done: |
---|
6176 | |
---|
6177 | keepresult = normalizationPrimes(prim[i],maxideal(1),0,0); |
---|
6178 | |
---|
6179 | for(j=1; j<=size(keepresult)-1; j++) |
---|
6180 | { |
---|
6181 | result=insert(result,keepresult[j]); |
---|
6182 | } |
---|
6183 | skr = size(keepresult); |
---|
6184 | |
---|
6185 | //compute delta: |
---|
6186 | if( del >= 0 && keepresult[skr][1] >=0 ) |
---|
6187 | { |
---|
6188 | del = del + keepresult[skr][1]; |
---|
6189 | } |
---|
6190 | else |
---|
6191 | { |
---|
6192 | del = -1; |
---|
6193 | } |
---|
6194 | deli = keepresult[skr][2],deli; |
---|
6195 | |
---|
6196 | if ( dbg>=1 ) |
---|
6197 | { |
---|
6198 | "// delta of component",i; keepresult[skr][1]; |
---|
6199 | } |
---|
6200 | } |
---|
6201 | sr = size(result); |
---|
6202 | |
---|
6203 | // -------------- Now compute intersection multiplicities ------------- |
---|
6204 | //intersection multiplicities of list prim, sp=size(prim). |
---|
6205 | if ( dbg>=1 ) |
---|
6206 | { |
---|
6207 | "// Sum of delta for all components"; del; |
---|
6208 | if ( sp>1 ) |
---|
6209 | { |
---|
6210 | "// Compute intersection multiplicities of the components"; |
---|
6211 | } |
---|
6212 | } |
---|
6213 | |
---|
6214 | if ( sp > 1 ) |
---|
6215 | { |
---|
6216 | int mul = iMult(prim); |
---|
6217 | if ( mul < 0 ) |
---|
6218 | { |
---|
6219 | del = -1; |
---|
6220 | } |
---|
6221 | else |
---|
6222 | { |
---|
6223 | del = del + mul; |
---|
6224 | } |
---|
6225 | } |
---|
6226 | deli = deli[1..size(deli)-1]; |
---|
6227 | result = result,list(deli,del); |
---|
6228 | |
---|
6229 | //--------------- Finally print comments and return ------------------ |
---|
6230 | if ( dbg >= 0) |
---|
6231 | {""; |
---|
6232 | "// 'normalC' created a list, say nor, of two lists: |
---|
6233 | // To see the result, type |
---|
6234 | nor; |
---|
6235 | |
---|
6236 | // * nor[1] is a list of",sr,"ring(s). |
---|
6237 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
6238 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
6239 | // and similair for the other rings nor[1][i]; |
---|
6240 | // Ri/norid is the affine algebra of the normalization of r/P_i (where P_i |
---|
6241 | // is an associated prime or an equidimensional part of the input ideal id) |
---|
6242 | // and normap the normalization map from the basering to Ri/norid; |
---|
6243 | |
---|
6244 | // * nor[2] shows the delta-invariant of each component and of id |
---|
6245 | // (-1 means infinite, 0 that r/P_i resp. r/id is normal, and -2 that delta |
---|
6246 | // of a component was not computed)."; |
---|
6247 | } |
---|
6248 | return(result); |
---|
6249 | } |
---|
6250 | |
---|
6251 | example |
---|
6252 | { "EXAMPLE:"; |
---|
6253 | printlevel = printlevel+1; |
---|
6254 | echo = 2; |
---|
6255 | ring s = 0,(x,y),dp; |
---|
6256 | ideal i = (x2-y3)*(x2+y2)*x; |
---|
6257 | |
---|
6258 | list nor = normalC(i); |
---|
6259 | |
---|
6260 | nor; |
---|
6261 | // 2 branches have delta = 1, and 1 branch has delta = 0 |
---|
6262 | // the total delta invariant is 13 |
---|
6263 | |
---|
6264 | def R2 = nor[1][2]; setring R2; |
---|
6265 | norid; normap; |
---|
6266 | |
---|
6267 | echo = 0; |
---|
6268 | printlevel = printlevel-1; |
---|
6269 | pause(" hit return to continue"); echo=2; |
---|
6270 | |
---|
6271 | ring r = 2,(x,y,z),dp; |
---|
6272 | ideal i = z3-xy4; |
---|
6273 | nor = normalC(i); nor; |
---|
6274 | // the delta invariant is infinite |
---|
6275 | // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module |
---|
6276 | // in its quotient field Quot(r/i) |
---|
6277 | |
---|
6278 | // the normalization as affine algebra over the ground field: |
---|
6279 | def R = nor[1][1]; setring R; |
---|
6280 | norid; normap; |
---|
6281 | |
---|
6282 | echo = 0; |
---|
6283 | pause(" hit return to continue");echo = 2; |
---|
6284 | |
---|
6285 | setring r; |
---|
6286 | nor = normalC(i, "withGens", "prim"); // a different algorithm |
---|
6287 | nor; |
---|
6288 | } |
---|
6289 | |
---|
6290 | ////////////////////////////////////////////////////////////////////////////// |
---|
6291 | //closureRingtower seems not to be used anywhere |
---|
6292 | static proc closureRingtower(list L) |
---|
6293 | "USAGE: closureRingtower(list L); L a list of rings |
---|
6294 | CREATE: rings R(1),...,R(n) such that R(i)=L[i] for all i |
---|
6295 | EXAMPLE: example closureRingtower; shows an example |
---|
6296 | " |
---|
6297 | { |
---|
6298 | int n=size(L); |
---|
6299 | for (int i=1;i<=n;i++) |
---|
6300 | { |
---|
6301 | if (defined(R(i))) |
---|
6302 | { |
---|
6303 | string s="Fixed name R("+string(i)+") leads to conflict with existing " |
---|
6304 | +"object having this name"; |
---|
6305 | ERROR(s); |
---|
6306 | } |
---|
6307 | def R(i)=L[i]; |
---|
6308 | export R(i); |
---|
6309 | } |
---|
6310 | |
---|
6311 | return(); |
---|
6312 | } |
---|
6313 | example |
---|
6314 | { |
---|
6315 | "EXAMPLE:"; echo=2; |
---|
6316 | ring R=0,(x,y),dp; |
---|
6317 | ideal I=x4,y4; |
---|
6318 | list L=primeClosure(ReesAlgebra(I)[1]); |
---|
6319 | L=delete(L,size(L)); |
---|
6320 | L; |
---|
6321 | closureRingtower(L); |
---|
6322 | R(1); |
---|
6323 | R(4); |
---|
6324 | kill R(1),R(2),R(3),R(4); |
---|
6325 | } |
---|
6326 | |
---|
6327 | // Up to here: procedures for normalC |
---|
6328 | /////////////////////////////////////////////////////////////////////////////// |
---|
6329 | |
---|
6330 | /////////////////////////////////////////////////////////////////////////////// |
---|
6331 | // From here: miscellaneous procedures |
---|
6332 | |
---|
6333 | // Used for timing and comparing the different normalization procedures. |
---|
6334 | // Option (can be entered in any order) |
---|
6335 | // "normal" -> uses the new algortihm (normal) |
---|
6336 | // "normalP" -> uses normalP |
---|
6337 | // "normalC" -> uses normalC, without "withGens" option |
---|
6338 | // "primCl" -> uses normalC, with option "withGens". |
---|
6339 | // "111" -> checks the output of normalM using norTest. |
---|
6340 | // "p" -> compares the output of norM with the output of normalP |
---|
6341 | // ("normalP" option must also be set). |
---|
6342 | // "pc" -> compares the output of norM with the output of normalC with |
---|
6343 | // option "withGens" |
---|
6344 | // ("primCl" option must also be set). |
---|
6345 | |
---|
6346 | proc timeNormal(ideal I, list #) |
---|
6347 | { |
---|
6348 | ASSUME(0, not isQuotientRing(basering) ); |
---|
6349 | |
---|
6350 | def r = basering; |
---|
6351 | |
---|
6352 | //--------------------------- define the method --------------------------- |
---|
6353 | int isPrim, useRing; |
---|
6354 | int decomp = -1; |
---|
6355 | int norM, norC, norP, primCl; |
---|
6356 | int checkP, check111, checkPC; |
---|
6357 | int i; |
---|
6358 | ideal U1, U2, W; |
---|
6359 | poly c1, c2; |
---|
6360 | int ch; |
---|
6361 | string check; |
---|
6362 | string method; //make all options one string in order to use |
---|
6363 | //all combinations of options simultaneously |
---|
6364 | for ( i=1; i <= size(#); i++ ) |
---|
6365 | { |
---|
6366 | if ( typeof(#[i]) == "string" ) |
---|
6367 | { |
---|
6368 | method = method + #[i]; |
---|
6369 | } |
---|
6370 | } |
---|
6371 | if ( find(method, "normal")) |
---|
6372 | {norM = 1;} |
---|
6373 | if ( find(method, "normalP") and (char(basering) > 0)) |
---|
6374 | {norP = 1;} |
---|
6375 | if ( find(method, "normalC")) |
---|
6376 | {norC = 1;} |
---|
6377 | if ( find(method, "primCl")) |
---|
6378 | {primCl = 1;} |
---|
6379 | if ( find(method, "isprim") or find(method,"isPrim") ) |
---|
6380 | {decomp = 0;} |
---|
6381 | if ( find(method, "p") ) |
---|
6382 | {checkP = 1;} |
---|
6383 | if ( find(method, "pc") ) |
---|
6384 | {checkPC = 1;} |
---|
6385 | if ( find(method, "111") ) |
---|
6386 | {check111 = 1;} |
---|
6387 | |
---|
6388 | int tt; |
---|
6389 | if(norM) |
---|
6390 | { |
---|
6391 | tt = timer; |
---|
6392 | if(decomp == 0) |
---|
6393 | { |
---|
6394 | "Running normal(useRing, isPrim)..."; |
---|
6395 | list a1 = normal(I, "useRing", "isPrim"); |
---|
6396 | "Time normal(useRing, isPrim): ", timer - tt; |
---|
6397 | } |
---|
6398 | else |
---|
6399 | { |
---|
6400 | "Running normal(useRing)..."; |
---|
6401 | list a1 = normal(I, "useRing"); |
---|
6402 | "Time normal(useRing): ", timer - tt; |
---|
6403 | } |
---|
6404 | ""; |
---|
6405 | } |
---|
6406 | if(norP) |
---|
6407 | { |
---|
6408 | tt = timer; |
---|
6409 | if(decomp == 0) |
---|
6410 | { |
---|
6411 | "Running normalP(isPrim)..."; |
---|
6412 | list a2 = normalP(I, "isPrim"); |
---|
6413 | "Time normalP(isPrim): ", timer - tt; |
---|
6414 | } |
---|
6415 | else |
---|
6416 | { |
---|
6417 | "Running normalP()..."; |
---|
6418 | list a2 = normalP(I); |
---|
6419 | "Time normalP(): ", timer - tt; |
---|
6420 | } |
---|
6421 | ""; |
---|
6422 | } |
---|
6423 | |
---|
6424 | if(norC) |
---|
6425 | { |
---|
6426 | tt = timer; |
---|
6427 | if(decomp == 0) |
---|
6428 | { |
---|
6429 | "Running normalC(isPrim)..."; |
---|
6430 | list a3 = normalC(I, "isPrim"); |
---|
6431 | "Time normalC(isPrim): ", timer - tt; |
---|
6432 | } |
---|
6433 | else |
---|
6434 | { |
---|
6435 | "Running normalC()..."; |
---|
6436 | list a3 = normalC(I); |
---|
6437 | "Time normalC(): ", timer - tt; |
---|
6438 | } |
---|
6439 | ""; |
---|
6440 | } |
---|
6441 | |
---|
6442 | if(primCl) |
---|
6443 | { |
---|
6444 | tt = timer; |
---|
6445 | if(decomp == 0) |
---|
6446 | { |
---|
6447 | "Running normalC(withGens, isPrim)..."; |
---|
6448 | list a4 = normalC(I, "isPrim", "withGens"); |
---|
6449 | "Time normalC(withGens, isPrim): ", timer - tt; |
---|
6450 | } |
---|
6451 | else |
---|
6452 | { |
---|
6453 | "Running normalC(withGens)..."; |
---|
6454 | list a4 = normalC(I, "withGens"); |
---|
6455 | "Time normalC(withGens): ", timer - tt; |
---|
6456 | } |
---|
6457 | ""; |
---|
6458 | } |
---|
6459 | |
---|
6460 | if(check111 and norM) |
---|
6461 | { |
---|
6462 | "Checking output with norTest..."; |
---|
6463 | "WARNING: this checking only works if the original ideal was prime."; |
---|
6464 | norTest(I, a1); |
---|
6465 | ""; |
---|
6466 | } |
---|
6467 | |
---|
6468 | if(checkP and norP and norM) |
---|
6469 | { |
---|
6470 | "Comparing with normalP output..."; |
---|
6471 | if(size(a2) > 0) |
---|
6472 | { |
---|
6473 | "WARNING: this checking only works if the original ideal was prime."; |
---|
6474 | U1 = a1[2][1]; |
---|
6475 | c1 = U1[size(U1)]; |
---|
6476 | U2 = a2[1][1]; |
---|
6477 | c2 = a2[1][1][size(a2[1][1])]; |
---|
6478 | W = changeDenominator(U1, c1, c2, groebner(I)); |
---|
6479 | qring q = groebner(I); |
---|
6480 | ideal U2 = fetch(r, U2); |
---|
6481 | ideal W = fetch(r, W); |
---|
6482 | ch = 0; |
---|
6483 | if(size(reduce(U2, groebner(W))) == 0) |
---|
6484 | { |
---|
6485 | "U2 c U1"; |
---|
6486 | ch = 1; |
---|
6487 | } |
---|
6488 | if(size(reduce(W, groebner(U2))) == 0) |
---|
6489 | { |
---|
6490 | "U1 c U2"; |
---|
6491 | ch = ch + 1; |
---|
6492 | } |
---|
6493 | if(ch == 2) |
---|
6494 | { |
---|
6495 | "Output of normalP is equal."; |
---|
6496 | } |
---|
6497 | else |
---|
6498 | { |
---|
6499 | "ERROR: Output of normalP is different."; |
---|
6500 | } |
---|
6501 | setring r; |
---|
6502 | kill q; |
---|
6503 | } |
---|
6504 | else |
---|
6505 | { |
---|
6506 | "normalP returned no output. Comparison is not possible."; |
---|
6507 | } |
---|
6508 | ""; |
---|
6509 | } |
---|
6510 | |
---|
6511 | if(checkPC and norM and primCl) |
---|
6512 | { |
---|
6513 | "Comparing with primeClosure output..."; |
---|
6514 | if(size(a4) > 0) |
---|
6515 | { |
---|
6516 | "WARNING: this checking only works if the original ideal was prime."; |
---|
6517 | // primeClosure check |
---|
6518 | U1 = a1[2][1]; |
---|
6519 | c1 = U1[size(U1)]; |
---|
6520 | U2 = a4[2][1]; |
---|
6521 | c2 = a4[2][1][size(a4[2][1])]; |
---|
6522 | W = changeDenominator(U1, c1, c2, groebner(I)); |
---|
6523 | qring q = groebner(I); |
---|
6524 | ideal U2 = fetch(r, U2); |
---|
6525 | ideal W = fetch(r, W); |
---|
6526 | ch = 0; |
---|
6527 | if(size(reduce(U2, groebner(W))) == 0) |
---|
6528 | { |
---|
6529 | "U2 c U1"; |
---|
6530 | ch = 1; |
---|
6531 | } |
---|
6532 | if(size(reduce(W, groebner(U2))) == 0) |
---|
6533 | { |
---|
6534 | "U1 c U2"; |
---|
6535 | ch = ch + 1; |
---|
6536 | } |
---|
6537 | if(ch == 2) |
---|
6538 | { |
---|
6539 | "Output of normalC(withGens) is equal."; |
---|
6540 | } |
---|
6541 | else |
---|
6542 | { |
---|
6543 | "ERROR: Output of normalC(withGens) is different."; |
---|
6544 | } |
---|
6545 | setring r; |
---|
6546 | kill q; |
---|
6547 | } |
---|
6548 | else |
---|
6549 | { |
---|
6550 | "normalC(withGens) returned no output. Comparison is not possible."; |
---|
6551 | } |
---|
6552 | ""; |
---|
6553 | } |
---|
6554 | } |
---|
6555 | |
---|
6556 | /////////////////////////////////////////////////////////////////////////// |
---|
6557 | static proc sqroot(int n); |
---|
6558 | { |
---|
6559 | int s = 1; |
---|
6560 | while(s*s < n) { s++; } |
---|
6561 | return(s); |
---|
6562 | } |
---|
6563 | |
---|
6564 | /////////////////////////////////////////////////////////////////////////// |
---|
6565 | proc norTest (ideal i, list nor, list #) |
---|
6566 | "USAGE: norTest(i,nor,[n]); i=prime ideal, nor=list, n=optional integer |
---|
6567 | ASSUME: nor is the output of normal(i) (any options) or |
---|
6568 | normalP(i,"withRing") or normalC(i) (any options). |
---|
6569 | In particular, the ring nor[1][1] contains the ideal norid |
---|
6570 | and the map normap: basering/i --> nor[1][1]/norid. |
---|
6571 | RETURN: an intvec v such that: |
---|
6572 | @format |
---|
6573 | v[1] = 1 if the normap is injective and 0 otherwise |
---|
6574 | v[2] = 1 if the normap is finite and 0 otherwise |
---|
6575 | v[3] = 1 if nor[1][1]/norid is normal and 0 otherwise |
---|
6576 | @end format |
---|
6577 | If n=1 (resp n=2) only v[1] (resp. v[2]) is computed and returned |
---|
6578 | THEORY: The procedure can be used to test whether the computation of the |
---|
6579 | normalization was correct: basering/i --> nor[1][1]/norid is the |
---|
6580 | normalization of basering/i if and only if v=1,1,0. |
---|
6581 | NOTE: For big examples it can be hard to fully test correctness; the |
---|
6582 | partial test norTest(i,nor,2) is usually fast |
---|
6583 | EXAMPLE: example norTest; shows an example |
---|
6584 | " |
---|
6585 | { |
---|
6586 | ASSUME(0, not isQuotientRing(basering) ); |
---|
6587 | //### Sollte erweitert werden auf den reduziblen Fall: einen neuen affinen |
---|
6588 | // Ring nor[1][1]+...+nor[1][r] (direkte Summe) erzeugen, map dorthin |
---|
6589 | // definieren und dann testen. |
---|
6590 | |
---|
6591 | int prl = printlevel - voice + 2; |
---|
6592 | int a,b,d; |
---|
6593 | int n,ii; |
---|
6594 | if (size(#) > 0) { n = #[1]; } |
---|
6595 | |
---|
6596 | def BAS = basering; |
---|
6597 | |
---|
6598 | //### make a copy of nor to have a cpoy of nor[1][1] (not a reference to) |
---|
6599 | // in order not to override norid and normap. |
---|
6600 | // delete nor[2] (if it contains the module generators, which are not used) |
---|
6601 | // s.t. newnor does not belong to a ring. |
---|
6602 | |
---|
6603 | list newnor = nor; |
---|
6604 | if ( size(newnor) == 3 ) |
---|
6605 | { |
---|
6606 | newnor = delete(newnor,2); |
---|
6607 | } |
---|
6608 | def R = newnor[1][1]; |
---|
6609 | qring QAS = std(i); |
---|
6610 | |
---|
6611 | |
---|
6612 | setring R; |
---|
6613 | int nva = nvars(R); |
---|
6614 | string svars = varstr(R); |
---|
6615 | string svar; |
---|
6616 | |
---|
6617 | norid = interred(norid); |
---|
6618 | |
---|
6619 | //--------- create new ring with one dp block keeping weights ------------ |
---|
6620 | list LR = ringlist(R); |
---|
6621 | list g3 = LR[3]; |
---|
6622 | int n3 = size(g3); |
---|
6623 | list newg3; |
---|
6624 | intvec V; |
---|
6625 | |
---|
6626 | //--------- check first whether variables Z(i),...,A(i) exist ----------- |
---|
6627 | for (ii=90; ii>=65; ii--) |
---|
6628 | { |
---|
6629 | if ( find(svars,ASCII(ii)+"(") == 0 ) |
---|
6630 | { |
---|
6631 | svar = ASCII(ii); break; |
---|
6632 | } |
---|
6633 | } |
---|
6634 | if ( size(svar) != 0 ) |
---|
6635 | { |
---|
6636 | for ( ii = 1; ii <= nva; ii++ ) |
---|
6637 | { |
---|
6638 | LR[2][ii] = svar+"("+string(ii)+")"; |
---|
6639 | V[ii] = 1; |
---|
6640 | } |
---|
6641 | } |
---|
6642 | else |
---|
6643 | { |
---|
6644 | for ( ii = 1; ii <= nva; ii++ ) |
---|
6645 | { |
---|
6646 | LR[2][ii] = "Z("+string(100*nva+ii)+")"; |
---|
6647 | V[ii] = 1; |
---|
6648 | } |
---|
6649 | } |
---|
6650 | |
---|
6651 | if ( g3[n3][1]== "c" or g3[n3][1] == "C" ) |
---|
6652 | { |
---|
6653 | list gm = g3[n3]; //last blockis module ordering |
---|
6654 | newg3[1] = list("dp",V); |
---|
6655 | newg3 = insert(newg3,gm,size(newg3)); |
---|
6656 | } |
---|
6657 | else |
---|
6658 | { |
---|
6659 | list gm = g3[1]; //first block is module ordering |
---|
6660 | newg3[1] = list("dp",V); |
---|
6661 | newg3 = insert(newg3,gm); |
---|
6662 | } |
---|
6663 | LR[3] = newg3; |
---|
6664 | //LR;""; |
---|
6665 | def newR = ring(LR); |
---|
6666 | |
---|
6667 | setring newR; |
---|
6668 | ideal norid = fetch(R,norid); |
---|
6669 | ideal normap = fetch(R,normap); |
---|
6670 | if( defined(lnorid) ) { kill lnorid; } //um ** redefinig zu beheben |
---|
6671 | if( defined(snorid) ) { kill snorid; } //sollte nicht noetig sein |
---|
6672 | |
---|
6673 | //----------- go to quotient ring for checking injectivity ------------- |
---|
6674 | //"mstd"; |
---|
6675 | list lnorid = mstd(norid); |
---|
6676 | ideal snorid = lnorid[1]; |
---|
6677 | //"size mstdnorid:", size(snorid),size(lnorid[2]); |
---|
6678 | //"size string mstdnorid:", size(string(snorid)),size(string(lnorid[2])); |
---|
6679 | qring QR = snorid; |
---|
6680 | ideal qnormap = fetch(newR,normap); |
---|
6681 | //ideal qnormap = imap(newR,normap); |
---|
6682 | //ideal qnormap = imap(R,normap); |
---|
6683 | map Qnormap = QAS,qnormap; //r/id --> R/norid |
---|
6684 | |
---|
6685 | //------------------------ check injectivity --------------------------- |
---|
6686 | //"injective:"; |
---|
6687 | a = is_injective(Qnormap,QAS); //a. Test for injectivity of Qnormap |
---|
6688 | dbprint ( prl, "injective: "+string(a) ); |
---|
6689 | if ( n==1 ) |
---|
6690 | { |
---|
6691 | intvec result = intvec(a); |
---|
6692 | setring BAS; |
---|
6693 | return (result); |
---|
6694 | } |
---|
6695 | a; |
---|
6696 | |
---|
6697 | //------------------------ check finiteness --------------------------- |
---|
6698 | setring newR; |
---|
6699 | b = mapIsFinite(normap,BAS,lnorid[2]); //b. Test for finiteness of normap |
---|
6700 | dbprint ( prl, "finite: "+string(b) ); |
---|
6701 | if ( n==2 ) |
---|
6702 | { |
---|
6703 | intvec result = intvec(a,b); |
---|
6704 | setring BAS; |
---|
6705 | return (result); |
---|
6706 | } |
---|
6707 | b; |
---|
6708 | |
---|
6709 | //------------------------ check normality --------------------------- |
---|
6710 | list testnor = normal(lnorid[2],"isPrim","noFac", "withDelta"); |
---|
6711 | //### Problem: bei mehrfachem Aufruf von norTest gibt es |
---|
6712 | // ** redefining norid & ** redefining normap |
---|
6713 | //Dies produziert Fehler, da alte norid und normap ueberschrieben werden |
---|
6714 | //norid und normap werden innnerhalb von proc computeRing ueberschrieben |
---|
6715 | //Die Kopie newR scheint das Problem zu loesen |
---|
6716 | |
---|
6717 | |
---|
6718 | d = testnor[3][2]; //d = delta |
---|
6719 | kill testnor; //### sollte ueberfluessig sein |
---|
6720 | int d1 = (d==0); //d1=1 if delta=0 |
---|
6721 | dbprint ( prl, "delta: "+string(d) ); |
---|
6722 | intvec result = intvec(a,b,d1); |
---|
6723 | setring BAS; |
---|
6724 | return(result); |
---|
6725 | } |
---|
6726 | example |
---|
6727 | { "EXAMPLE:"; echo = 2; |
---|
6728 | int prl = printlevel; |
---|
6729 | printlevel = -1; |
---|
6730 | ring r = 0,(x,y),dp; |
---|
6731 | ideal i = (x-y^2)^2 - y*x^3; |
---|
6732 | list nor = normal(i); |
---|
6733 | norTest(i,nor); //1,1,1 means that normal was correct |
---|
6734 | |
---|
6735 | nor = normalC(i); |
---|
6736 | norTest(i,nor); //1,1,1 means that normal was correct |
---|
6737 | |
---|
6738 | ring s = 2,(x,y),dp; |
---|
6739 | ideal i = (x-y^2)^2 - y*x^3; |
---|
6740 | nor = normalP(i,"withRing"); |
---|
6741 | norTest(i,nor); //1,1,1 means that normalP was correct |
---|
6742 | printlevel = prl; |
---|
6743 | } |
---|
6744 | |
---|
6745 | /////////////////////////////////////////////////////////////////////////// |
---|
6746 | // |
---|
6747 | // EXAMPLES |
---|
6748 | // |
---|
6749 | /////////////////////////////////////////////////////////////////////////// |
---|
6750 | /* |
---|
6751 | //commands for computing the normalization: |
---|
6752 | // options for normal: "equidim", "prim" |
---|
6753 | // "noDeco", "isPrim", "noFac" |
---|
6754 | // (prim by default) |
---|
6755 | // options for normalP: "withRing", "isPrim" or "noFac" |
---|
6756 | // options for normalC: "equidim", "prim", "withGens", |
---|
6757 | // "noDeco", "isPrim", "noFac" |
---|
6758 | |
---|
6759 | //Commands for testing 'normal' |
---|
6760 | list nor = normal(i); nor; |
---|
6761 | list nor = normal(i,"isPrim");nor; |
---|
6762 | list nor = normal(i,"equidim");nor; |
---|
6763 | list nor = normal(i,"prim");nor; |
---|
6764 | list nor = normal(i,"equidim","noFac");nor; |
---|
6765 | list nor = normal(i,"prim","noFac");nor; |
---|
6766 | |
---|
6767 | //Commands for testing 'normalP' in positive char |
---|
6768 | list nor = normalP(i);nor; //withGens but no ringstructure |
---|
6769 | list nor = normalP(i,"withRing"); nor; //compute the ringstructure |
---|
6770 | list nor = normalP(i,"isPrim"); nor; //if i is known to be prime |
---|
6771 | |
---|
6772 | //Commands for testing 'normalC' |
---|
6773 | list nor = normal(i); nor; |
---|
6774 | list nor = normal(i,"withGens");nor; |
---|
6775 | list nor = normal(i,"isPrim");nor; |
---|
6776 | list nor = normal(i,"equidim");nor; |
---|
6777 | list nor = normal(i,"prim");nor; |
---|
6778 | list nor = normal(i,"equidim","noFac");nor; |
---|
6779 | list nor = normal(i,"prim","noFac");nor; |
---|
6780 | |
---|
6781 | //Commands for testing correctness (i must be prime): |
---|
6782 | list nor = normalP(i,"withRing","isPrim"); |
---|
6783 | list nor = normal(i,"isPrim"); |
---|
6784 | norTest(i,nor); //full test for not too big examples (1,1,1 => ok) |
---|
6785 | norTest(i,nor,2); //partial test for big examples (1,1 => ok) |
---|
6786 | factorize(i[1]); //checks for irreducibility |
---|
6787 | |
---|
6788 | ///////////////////////////////////////////////////////////////////////////// |
---|
6789 | |
---|
6790 | //----------------------Examples for normal (new algorithm)------------------ |
---|
6791 | // Timings with Computeserver Dual AMD Opteron 242 1.60GHz. |
---|
6792 | // Examples from "Normalization of Rings" paper. |
---|
6793 | |
---|
6794 | // Example 1 |
---|
6795 | // char 0 : normal = 0 secs (7 steps) - normalC = 75 secs |
---|
6796 | // char 2 : normal = 0 secs (7 steps) - normalP = 0 secs - normalC = 0 secs |
---|
6797 | // char 5 : normal = 1 secs (7 steps) - normalP = 71 - normalC = 1 secs |
---|
6798 | // char 11 : normal = 2 secs (7 steps) - normalP = 12 secs - normalC doesn't finish |
---|
6799 | // char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 1 sec |
---|
6800 | LIB"normal.lib"; |
---|
6801 | ring r = 2, (x, y), dp; |
---|
6802 | ideal i = (x-y)*x*(y+x^2)^3-y^3*(x^3+x*y-y^2); |
---|
6803 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
6804 | |
---|
6805 | // Example 2 |
---|
6806 | // char 0 : normal = 1 sec (7 steps) - normalC doesn't finish |
---|
6807 | // char 3 : normal = 1 secs (8 steps) - normalP = 0 secs - normalC = 4 secs |
---|
6808 | // char 13 : normal = 1 sec (7 steps) - normalP doesn't finish - normalC = 13 secs |
---|
6809 | // char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 10 sec |
---|
6810 | //Example is reducible in char 5 and 7 |
---|
6811 | LIB"normal.lib"; |
---|
6812 | ring r = 3, (x, y), dp; |
---|
6813 | 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; |
---|
6814 | timeNormal(i, "normal", "normalC", "normalP", "p", "isPrim"); |
---|
6815 | |
---|
6816 | // Example 3 |
---|
6817 | // char 0 : normal = 3 secs (6 steps) - normalC doesn't finish |
---|
6818 | // char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
6819 | // char 5 : normal = 0 secs (6 steps) - normalP = 8 secs - normalC doesn't finish |
---|
6820 | LIB"normal.lib"; |
---|
6821 | ring r=5,(x, y),dp; |
---|
6822 | ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9; |
---|
6823 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
6824 | |
---|
6825 | // Example 4 |
---|
6826 | // char 0 : normal = 0 secs (1 step) - normalC = 0 secs |
---|
6827 | // char 5 : normal = 0 secs (1 step) - normalP = 3 secs - normalC = 0 secs |
---|
6828 | // char 11 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
6829 | // char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
6830 | LIB"normal.lib"; |
---|
6831 | ring r=5,(x,y),dp; // genus 0 4 nodes and 6 cusps im P2 |
---|
6832 | ideal i=(x2+y^2-1)^3 +27x2y2; |
---|
6833 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
6834 | |
---|
6835 | // Example 5 |
---|
6836 | // char 0 : normal = 0 secs (1 step) - normalC = 0 secs |
---|
6837 | // char 5 : normal = 1 secs (3 step) - normalP doesn't finish - normalC doesn't finish |
---|
6838 | // char 11 : normal = 0 secs (1 step) - normalP 0 secs - normalC = 0 secs |
---|
6839 | // char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
6840 | LIB"normal.lib"; |
---|
6841 | ring r=11,(x,y),dp; //24 sing, delta 24 |
---|
6842 | ideal i=-x10+x8y2-x6y4-x2y8+2y10-x8+2x6y2+x4y4-x2y6-y8+2x6-x4y2+x2y4+2x4+2x2y2-y4-x2+y2-1; |
---|
6843 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
6844 | |
---|
6845 | // Example 6 |
---|
6846 | // char 2 : normal = 5 secs (2 steps) - normalP = 25 secs - normalC = 166 secs |
---|
6847 | LIB"normal.lib"; |
---|
6848 | ring r=2,(v,u,z,y,x),dp; |
---|
6849 | 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; |
---|
6850 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
6851 | |
---|
6852 | // Example 7 |
---|
6853 | // char 0 : normal = 11 secs (6 steps) - normalC = 11 secs |
---|
6854 | // char 2 : normal = 11 secs (6 steps) - normalP = 0 secs - normalC = 11 secs |
---|
6855 | // char 5 : normal = 11 secs (6 steps) - normalP = 3 secs - normalC = 11 secs |
---|
6856 | // char 11 : normal = 11 secs (6 steps) - normalP = 43 secs - normalC = 11 secs |
---|
6857 | // char 32003 : normal = 11 secs (6 steps) - normalP doesn't finish - normalC = 11 secs |
---|
6858 | LIB"normal.lib"; |
---|
6859 | ring r=11,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
6860 | ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3; |
---|
6861 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
6862 | |
---|
6863 | //////////////////////////////////////////////////////////////////////////////// |
---|
6864 | |
---|
6865 | // Other examples with new algorithm |
---|
6866 | |
---|
6867 | // Example 1 |
---|
6868 | // char 0 : normal = 1 secs (13 steps) - normalC doesn't finish |
---|
6869 | // char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
6870 | // char 5 : normal = 1 secs (13 steps) - normalP = 29 secs - normalC doesn't finish |
---|
6871 | ring r=2,(x,y),dp; //genus 35 |
---|
6872 | ideal i=y30+y13x+x4y5+x3*(x+1)^2; |
---|
6873 | timeNormal(i, "normal", "normalC", "normalP"); |
---|
6874 | |
---|
6875 | // Example 2 |
---|
6876 | // char 0 : normal = 1 secs (13 steps) - normalC doesn't finish |
---|
6877 | // char 3 : normal = 2 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
6878 | ring r=3,(x,y),dp; //genus 19, delta 21 |
---|
6879 | ideal i=y20+y13x+x4y5+x3*(x+1)^2; |
---|
6880 | timeNormal(i, "normal", "normalC", "normalP"); |
---|
6881 | |
---|
6882 | // Example 3 |
---|
6883 | // Very fast with all algorithms |
---|
6884 | ring r = 3, (x, y), dp; |
---|
6885 | ideal I = (x-y^2)^2-x*y^3; |
---|
6886 | timeNormal(I, "normal", "normalC", "normalP", "primCl", "111", "p", "pc"); |
---|
6887 | |
---|
6888 | |
---|
6889 | |
---|
6890 | //----------------------Test Example for charp ------------------- |
---|
6891 | //Zu tun: |
---|
6892 | //### nach minor nur std statt mstd verwenden |
---|
6893 | //***hat bei keinem Beisp etwas gebracht -> wieder zurueck |
---|
6894 | //### wenn interred ok, dann wieder einsetzen (am Schluss) |
---|
6895 | //### bottelnecks bei maps beheben |
---|
6896 | //### minor verbessern |
---|
6897 | //### preimage verbessern (Ist imm Kern map oder imap verwendet?) |
---|
6898 | //### Gleich in Ordnung dp wechseln, ringlist verwenden |
---|
6899 | //### interred ev nur zum Schluss |
---|
6900 | // (z.B. wenn nacher std; wenn nacher minor: testen ) |
---|
6901 | |
---|
6902 | //Zeiten mit normalV5.lib (mstd aktiv, interred inaktiv) |
---|
6903 | |
---|
6904 | //SWANSON EXAMPLES: (Macaulay2, icFracP=normalP, icFractions<->normal) |
---|
6905 | //--------------------------------------------------------------------- |
---|
6906 | //1. Series Fp[x,y,u,v]/(x2v-y2u) |
---|
6907 | //------------------------------- |
---|
6908 | //characteristic p 2 3 5 7 11 13 17 37 97 |
---|
6909 | //icFracP 0.04 0.03 0.04 0.04 0.04 0.05 0.05 0.13 0.59 Mac |
---|
6910 | //normalP 0 0 0 0 0 0 0 0 1 Sing |
---|
6911 | //icFractions 0.08 0.09 0.09 0.09 0.14 0.15 0.15 0.15 0.15 Mac |
---|
6912 | //normal 0 0 0 0 0 0 0 0 0 Sing |
---|
6913 | |
---|
6914 | 2. Series Fp[u, v, w, x, y, z]/u2x4+uvy4+v2z4 |
---|
6915 | //-------------------------------------------- |
---|
6916 | //characteristic p 2 3 5 7 11 |
---|
6917 | //icFracP 0.07 0.22 9.67 143 12543 |
---|
6918 | //normalP 0 0 5 42 1566 |
---|
6919 | //icFractions 1.16 * * * * *: > 6h |
---|
6920 | //normal 0 0 0 0 0 |
---|
6921 | |
---|
6922 | //3. Series Fp[u, v, w, x, y, z]/(u2xp+uvyp+v2zp) |
---|
6923 | //----------------------------------------------- |
---|
6924 | //characteristic p 2 3 5 7 11 13 17 19 23 |
---|
6925 | //icFracP 0.06 0.07 0.09 0.27 1.81 4.89 26 56 225 |
---|
6926 | //normalP 0 0 0 0 1 2 6 10 27 |
---|
6927 | //icFractions 0.16 1.49 75.00 4009 * * * * * |
---|
6928 | //normal 0 0 2 836 |
---|
6929 | //normal(neu) 0 0 1 2 10 155 |
---|
6930 | //### p=7 normal braucht 807 sec in: |
---|
6931 | // ideal endid = phi1(endid); //### bottelneck' |
---|
6932 | |
---|
6933 | //1. |
---|
6934 | int p = 2; ring r = p,(u,v,x,y,z),dp; ideal i = x2v-y2u; |
---|
6935 | //2. |
---|
6936 | int p = 7; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2x4+uvy4+v2z4; |
---|
6937 | //3. |
---|
6938 | int p=11; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2*x^p+uv*y^p+v2*z^p; |
---|
6939 | |
---|
6940 | //IRREDUCIBLE EXAMPLES: |
---|
6941 | //--------------------- |
---|
6942 | //timing for MacBookPro 2.2GHz Intel Core 2 Duo, 4GB Ram |
---|
6943 | //Sing. ix86Mac-darwin version 3-1-0 (3100-2008101314) Oct 13 2008 14:46:59 |
---|
6944 | //if no time is given: < 1 sec |
---|
6945 | |
---|
6946 | //Apply: |
---|
6947 | list nor = normal(i,"isPrim"); nor; |
---|
6948 | list nor = normalP(i,"withRing","isPrim"); nor; |
---|
6949 | def R=nor[1][1]; setring R; norid; normap; |
---|
6950 | setring r; |
---|
6951 | norTest(i,nor); |
---|
6952 | |
---|
6953 | int tt = timer; |
---|
6954 | list nor = normalP(i,"withRing","isPrim"); nor; |
---|
6955 | timer-tt; |
---|
6956 | int tt = timer; |
---|
6957 | list nor = normal(i,"isPrim"); |
---|
6958 | timer-tt; |
---|
6959 | |
---|
6960 | ring r=19,(x,y,u,v),dp; //delta -1 |
---|
6961 | ideal i=x2v-y2u; |
---|
6962 | //norTest 2 sec |
---|
6963 | |
---|
6964 | ring r=2,(y,x2,x1),lp; //delta -1 |
---|
6965 | ideal i=y^4+y^2*x2*x1+x2^3*x1^2+x2^2*x1^3; |
---|
6966 | //### norid hat 1 Element nach interred |
---|
6967 | |
---|
6968 | ring r = 11,(x,y,z),wp(2,1,2); //alles < 1 sec |
---|
6969 | ideal i=z3 - xy4 + x2; //not reduced, delta =0 ok |
---|
6970 | ideal i=y4+x5+y2x; //not reduced, delta -1 |
---|
6971 | //interred verkleinert norid |
---|
6972 | |
---|
6973 | ring r=3,(u,v,x,y,z),dp; //delta -1 |
---|
6974 | ideal i=u2x3+uvy3+v2z3; |
---|
6975 | |
---|
6976 | ring r=3,(u,v,x,y,z),dp; //delta -1 |
---|
6977 | ideal i=u2x4+uvy4+v2z4; |
---|
6978 | //norTest(i,nor); 0 sec, norTest(i,nor) haengt! |
---|
6979 | |
---|
6980 | ring r=5,(u,v,x,y,z),dp; //delta -1 |
---|
6981 | ideal i=u2x6+uvy6+v2z6; |
---|
6982 | //normalP 5sec, normalC 1sec |
---|
6983 | //V5: norTest(i,nor); 45 sec bei normalP, V6 12 sec |
---|
6984 | //28 sec bei normal |
---|
6985 | |
---|
6986 | ring r=5,(u,v,x,y,z),dp; //delta -1 |
---|
6987 | ideal i=u2x5+uvy5+v2z5; |
---|
6988 | //normalP 1sec, normalC 1 sec, |
---|
6989 | //norTest lange: minor(jacob(I),h,J) 193 (308)sec, haengt dann bei M = std(M); |
---|
6990 | //norTest(i,nor,2); verwenden! |
---|
6991 | //Sing 3.0-4 orig >9h! haengt bei Q = mstd(Q)[2]; |
---|
6992 | |
---|
6993 | ring r=2,(y,x),wp(12,5); //delta 3 |
---|
6994 | ideal i=y5+y2x4+y2x+yx2+x12; |
---|
6995 | //normalP 0 sec (Test 0 sec), normalC 2 sec (Test 2 sec) |
---|
6996 | //normalC withGens (ohne interred) 0sec |
---|
6997 | |
---|
6998 | ring r=2,(y,x),dp; //delta= 22 |
---|
6999 | ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9; |
---|
7000 | //normalP 1sec, interred verkleinert norid betraechtlich |
---|
7001 | //normalC haengt bei minor, ideal im loop wird zu gross ### |
---|
7002 | //interred bei normalC vergroeesert string um Faktor 4000! |
---|
7003 | //withGens haengt bei interred in loop 4 (> 10 h) oder |
---|
7004 | //(nach Ausschalten von interred) bei |
---|
7005 | //int delt=vdim(std(modulo(f,ideal(p)))); (>?h) |
---|
7006 | |
---|
7007 | //Leonard1: (1. Komponente von Leonard), delta -1 |
---|
7008 | ring r=2,(v,u,z,y,x),dp; |
---|
7009 | ideal i = z3+zyx+y3x2+y2x3, uyx+z2,uz+z+y2x+yx2, u2+u+zy+zx, |
---|
7010 | v3+vux+vz2+vzyx+vzx+uz3+uz2y+z3+z2yx2; |
---|
7011 | //normalP 5 sec (withRing 9 sec), norTest(i,nor,2); 45 sec |
---|
7012 | //normalC 102sec, 99sec |
---|
7013 | //### Zeit wird bei ideal Ann = quotient(SM[2],SL[1]); und bei |
---|
7014 | // f = quotient(p*J,J); verbraucht |
---|
7015 | //withGens (ohne interred) 131sec, norTest(i,nor,2); 2min25sec |
---|
7016 | //norTest(i,nor,2); 45 sec |
---|
7017 | |
---|
7018 | ring r=2,(y,x),wp(25,21); //Leonard2, delta 232 |
---|
7019 | ring r=2,(y,x),dp; |
---|
7020 | ideal i= |
---|
7021 | y^21+y^20*x +y^18*(x^3+x+1) +y^17*(x^3+1) +y^16*(x^4+x) |
---|
7022 | +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) |
---|
7023 | +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) |
---|
7024 | +y^10*(x^12+x^9+x^8+x^7+x^5+x^3+x+1) |
---|
7025 | +y^9*(x^14+x^13+x^10+x^9+x^8+x^7+x^6+x^3+x^2+1) |
---|
7026 | +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) |
---|
7027 | +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) |
---|
7028 | +y^4*(x^19+x^16+x^15+x^12+x^6+x^5+x^3+1) |
---|
7029 | +y^3*(x^18+x^15+x^12+x^10+x^9+x^7+x^4+x) |
---|
7030 | +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) |
---|
7031 | +y*(x^23+x^22+x^20+x^17+x^15+x^14+x^12+x^9) |
---|
7032 | +(x^25+x^23+x^19+x^17+x^15+x^13+x^11+x^5); |
---|
7033 | //normalP: dp 2sec withRing 8sec, |
---|
7034 | //wp 4sec, withRing:51sec Zeit in lin = subst(lin, var(ii), vip); in elimpart ), |
---|
7035 | //norTest(i,nor,2): haengt bei mstd(norid); |
---|
7036 | //### normalC: (m. interred): haengt bei endid = interred(endid); |
---|
7037 | //GEFIXTES INTERRED ABWARTEN. Dann interred aktivieren |
---|
7038 | //interred(norid) haengt u. mst(norid) zu lange |
---|
7039 | //(o.interred): haengt bei haengt bei list SM = mstd(i); |
---|
7040 | //ideal in der Mitte zu gross |
---|
7041 | //i = Ideal (size 118, 13 var) fuer die neue Normalisierung |
---|
7042 | //normal(neu) haengt bei return(std(i)) (offensichtlich in eineranderen lib) |
---|
7043 | |
---|
7044 | REDUCIBLE EXAMPLES: |
---|
7045 | ------------------ |
---|
7046 | //Apply: |
---|
7047 | int tt = timer; |
---|
7048 | list nor=normalP(i,"isPrim","withRing"); |
---|
7049 | timer-tt; |
---|
7050 | |
---|
7051 | list nor = normal(i); nor; |
---|
7052 | list nor = normalC(i); nor; |
---|
7053 | list nor = normalC(i, "withGens"); nor; |
---|
7054 | list nor = normalP(i,"withRing"); nor; |
---|
7055 | list nor = normalP(i); nor; |
---|
7056 | def R=nor[1][1]; setring R; norid; normap; |
---|
7057 | |
---|
7058 | //Leonhard 4 Komponenten, dim=2, delta: 0,0,0,-1 |
---|
7059 | ring r=2,(v,u,z,y,x),dp; //lp zu lange |
---|
7060 | ideal i=z3+zyx+y3x2+y2x3, uyx+z2, v3+vuyx+vux+vzyx+vzx+uy3x2+uy2x+zy3x+zy2x2; |
---|
7061 | //normalP: 19 sec, withRing: 22 sec |
---|
7062 | //normalC ohne (mit) interred: 112 (113)sec, equidim: 99sec |
---|
7063 | //normalC 1. mal 111 sec, (2.mal) 450sec!! 3.mal 172 sec |
---|
7064 | //(unterschiedlich lange primdec, mit Auswirkungen) |
---|
7065 | //char 19: normalC: 15sec , withGens: 14sec (o.interr.) |
---|
7066 | |
---|
7067 | //----------------------Test Example for special cases ------------------- |
---|
7068 | int tt = timer; |
---|
7069 | list nor=normalP(i,"withRing");nor; |
---|
7070 | //list nor=normalP(i,"withRing", "isPrim");nor; |
---|
7071 | timer-tt; |
---|
7072 | def R1 = nor[1][1]; setring R1; norid; normap; interred(norid); |
---|
7073 | setring r; |
---|
7074 | |
---|
7075 | int tt = timer; |
---|
7076 | list nor=normal(i,"isPrim");nor; |
---|
7077 | timer-tt; |
---|
7078 | |
---|
7079 | ring r = 29,(x,y,z),dp; |
---|
7080 | ideal i = x2y2,x2z2; //Nicht equidimensional, equidim reduziert nicht, ok |
---|
7081 | ideal i = xyz*(z3-xy4); //### interred(norid) verkuerzt |
---|
7082 | //je 0 sec |
---|
7083 | |
---|
7084 | ideal j = x,y; |
---|
7085 | ideal i = j*xy; |
---|
7086 | equidim(i); |
---|
7087 | //hat eingebettete Komponente, equidim rechnet wie in Beschreibung (ok) |
---|
7088 | |
---|
7089 | ring r = 19,(x,y),dp; |
---|
7090 | ideal i = x3-y4; //delta = 3 |
---|
7091 | ideal i = y*x*(x3-y4); //delta = 11; 0,0,3 |
---|
7092 | ideal i = (x2-y3)*(x3-y4); //delta = 13; 1,3 |
---|
7093 | ideal i = (x-y)*(x3+y2)*(x3-y4); //delta = 23; 0,1,3 |
---|
7094 | ideal i = (x-1)*(x3+y2)*(x2-y3); //delta = 16; 0,1,1 |
---|
7095 | ideal i = (x-y^2)^2 - y*x^3; //delta = 3 |
---|
7096 | //singularities at not only at 0, hier rechnet equidim falsch |
---|
7097 | |
---|
7098 | // -------------------------- General Examples ---------------------------//Huneke, irred., delta=2 (Version 3-0-4: < 1sec) |
---|
7099 | //Version 3-0-6 default: 1sec, mit gens 2sec, mit delta 5 sec |
---|
7100 | //(prim,noFac):ca 7 Min, prim:ca 10 min(wg facstd) |
---|
7101 | // |
---|
7102 | // "equidim" < 1sec irred. 5sec |
---|
7103 | // ring r=31991,(a,b,c,d,e),dp; |
---|
7104 | ring r=2,(a,b,c,d,e),dp; //delta=2 |
---|
7105 | ideal i= |
---|
7106 | 5abcde-a5-b5-c5-d5-e5, |
---|
7107 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
7108 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
7109 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
7110 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
7111 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
7112 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
7113 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
7114 | //normalC: char 2, 31991: 0 sec (isPrim); char 2, equidim: 7 sec |
---|
7115 | //norTest(i,nor,2); 1sec |
---|
7116 | //normalP char 2: 1sec (isPrim) |
---|
7117 | //size(norid); size(string(norid));21 1219 interred(norid): 21 1245 (0 sec) |
---|
7118 | |
---|
7119 | int tt = timer; |
---|
7120 | list nor=normalC(i);nor; |
---|
7121 | timer-tt; |
---|
7122 | |
---|
7123 | list nor = normalP(i,"isPrim"); |
---|
7124 | |
---|
7125 | //Vasconcelos irred., delta -1 (dauert laenger) |
---|
7126 | //auf macbook pro = 20 sec mit alter Version, |
---|
7127 | //Sing 3-0-6: |
---|
7128 | // Char 32003: "equidim" 30 sec, "noFac": 30sec |
---|
7129 | //gens: nach 9 min abgebr (haengt in Lin = ideal(T*syzf);) !!!! Hans zu tun |
---|
7130 | //Char 2: default (charp) 2 sec, normalC ca 30 sec |
---|
7131 | //ring r=32003,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
7132 | ring r=2,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
7133 | ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3; |
---|
7134 | //normalC: char 2: 22, sec (mit und ohne isPrim) |
---|
7135 | //normalP char 2: 0sec (isPrim) o. interred |
---|
7136 | //char 32003: ### haengt in ideal endid = phi1(endid); |
---|
7137 | |
---|
7138 | //------------------------------------------------------- |
---|
7139 | //kleine Beispiele: |
---|
7140 | |
---|
7141 | //Theo1, irred, delta=-1 |
---|
7142 | //normalC: 1sec, normalP: 3 sec |
---|
7143 | ring r=32003,(x,y,z),wp(2,3,6); //dim 2,dim slocus 1 |
---|
7144 | ideal i=zy2-zx3-x6; |
---|
7145 | //normalC: char 2,19,32003: 0 sec (isPrim) |
---|
7146 | //normalP (isPrim) char 2,19: 0sec, char 29: 1sec |
---|
7147 | |
---|
7148 | //Theo1a, CohenMacaulay regular in codim 2, dim slocus=1, delta=0 |
---|
7149 | //normalC: 0 sec, normalP: haegt in K=preimage(R,phi,L); |
---|
7150 | ring r=32003,(x,y,z,u),dp; |
---|
7151 | ideal i=zy2-zx3-x6+u2; |
---|
7152 | //normalC: char 2,32003: 0 sec (isPrim) |
---|
7153 | //normalP (isPrim) char 2: 0sec, char 19: haengt in K = preimage(Q,phi,L); |
---|
7154 | |
---|
7155 | //Theo2, irreduzibel, reduziert, < 1sec, delta -1 |
---|
7156 | ring r=0,(x,y,z),wp(3,4,12); |
---|
7157 | ideal i=z*(y3-x4)+x8; |
---|
7158 | //normalC: char 2,32003,0: 0 sec (isPrim) |
---|
7159 | //normalP (isPrim) char 2: 0 1sec, char 19: 1sec char 29: 7 sec |
---|
7160 | |
---|
7161 | //Theo2a, reduiziert, 2-dim, dim_slocus=1, alte Version 3 sec, |
---|
7162 | //normalP ca 30 sec, normalC ca 4sec, delta -1 |
---|
7163 | //ring r=32003,(T(1..4)),wp(3,4,12,17); |
---|
7164 | //ring r=11,(T(1..4)),dp; |
---|
7165 | ring r=11,(T(1..4)),wp(3,4,12,17); |
---|
7166 | ideal i= |
---|
7167 | T(1)^8-T(1)^4*T(3)+T(2)^3*T(3), |
---|
7168 | T(1)^4*T(2)^2-T(2)^2*T(3)+T(1)*T(4), |
---|
7169 | T(1)^7+T(1)^3*T(2)^3-T(1)^3*T(3)+T(2)*T(4), |
---|
7170 | 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; |
---|
7171 | //normalC: char 2,32003: 0 sec (isPrim) |
---|
7172 | //normalP (isPrim) char 2: 0sec, char 11 2se, char 19: 13sec |
---|
7173 | //norTest 48sec in char11 |
---|
7174 | //### interred verkuerzt |
---|
7175 | //char 29: haengt in K = preimage(Q,phi,L); |
---|
7176 | |
---|
7177 | //Theo3, irred, 2-dim, 1-dim sing, < 1sec |
---|
7178 | ring r=11,(x,y,z),wp(3,5,15); |
---|
7179 | ideal i=z*(y3-x5)+x10; |
---|
7180 | //normalC: char 2,0: 0 sec (withRing) |
---|
7181 | //normalP (withRing) char 2,11: 0sec, char 19: 13sec norTest 12sec(char 11) |
---|
7182 | |
---|
7183 | //Theo4 reducible, delta (0,0,0) -1 |
---|
7184 | ring r=29,(x,y,z),dp; |
---|
7185 | ideal i=(x-y)*(x-z)*(y-z); |
---|
7186 | //normalC: char 2,32003: 0 sec |
---|
7187 | //normalP char withRing 2, 29: 0sec, 6sec |
---|
7188 | |
---|
7189 | //Theo6 |
---|
7190 | ring r=32003,(x,y,z),dp; |
---|
7191 | ideal i=x2y2+x2z2+y2z2; |
---|
7192 | //normalC: char 2,32003: 0 sec |
---|
7193 | //normalP char withRing 2, 29: 0sec, 4sec |
---|
7194 | |
---|
7195 | //Sturmfels, CM, 15 componenten, alle glatt |
---|
7196 | ring r=0,(b,s,t,u,v,w,x,y,z),dp; |
---|
7197 | ideal i= bv+su, bw+tu, sw+tv, by+sx, bz+tx, sz+ty,uy+vx,uz+wx,vz+wy,bvz; |
---|
7198 | //normalC car 11, 0: 1sec, normalP 0 sec |
---|
7199 | |
---|
7200 | //riemenschneider, , dim 3, 5 Komp. delta (0,0,0,0,0), -1 |
---|
7201 | ring r=2,(p,q,s,t,u,v,w,x,y,z),wp(1,1,1,1,1,1,2,1,1,1); |
---|
7202 | ideal i=xz,vx,ux,su,qu,txy,stx,qtx,uv2z-uwz,uv3-uvw,puv2-puw; |
---|
7203 | //alles 0 sec in char 2 |
---|
7204 | |
---|
7205 | //4 Komponenten, alle glatt, 0sec |
---|
7206 | ring r=11,(x,y,z,t),dp; |
---|
7207 | ideal i=x2z+xzt,xyz,xy2-xyt,x2y+xyt; |
---|
7208 | |
---|
7209 | //dim 3, 2 Komponenten delta (-1,0), -1 |
---|
7210 | ring r=2,(u,v,w,x,y,z),wp(1,1,1,3,2,1); |
---|
7211 | ideal i=wx,wy,wz,vx,vy,vz,ux,uy,uz,y3-x2; |
---|
7212 | //alles 0 sec in char 2 |
---|
7213 | //--------------------------------------------------------- |
---|
7214 | int tt = timer; |
---|
7215 | list nor=normalP(i,"normalC","withRing");nor; |
---|
7216 | timer-tt; |
---|
7217 | |
---|
7218 | //St_S/Y, 3 Komponenten, 2 glatt, 1 normal |
---|
7219 | //charp haengt (in char 20) in K=preimage(R,phi,L); |
---|
7220 | //ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
7221 | ring r=11,(b,s,t,u,v,w,x,y,z),dp; |
---|
7222 | ideal i=wy-vz,vx-uy,tv-sw,su-bv,tuy-bvz; |
---|
7223 | //normalC: char 2,32003: 0 sec |
---|
7224 | //normalP char withRing 2: 1sec, char 11: 40sec |
---|
7225 | |
---|
7226 | //Horrocks: cahr 0: 17 (8 in char 11) Komponenten alle normal, delta 1 |
---|
7227 | //char 11: 8 Komponenten alle normal, delta -1 |
---|
7228 | ring r=0,(a,b,c,d,e,f),dp; |
---|
7229 | //ring r=11,(a,b,c,d,e,f),dp; //Charp bis p = 200 ca 3sec |
---|
7230 | ideal i= |
---|
7231 | adef-16000be2f+16001cef2, ad2f+8002bdef+8001cdf2, abdf-16000b2ef+16001bcf2, |
---|
7232 | a2df+8002abef+8001acf2, ad2e-8000bde2-7999cdef, acde-16000bce2+16001c2ef, |
---|
7233 | a2de-8000abe2-7999acef, acd2+8002bcde+8001c2df, abd2-8000b2de-7999bcdf, |
---|
7234 | a2d2+9603abde-10800b2e2-9601acdf+800bcef+11601c2f2, |
---|
7235 | abde-8000b2e2-acdf-16001bcef-8001c2f2, abcd-16000b2ce+16001bc2f, |
---|
7236 | a2cd+8002abce+8001ac2f, a2bd-8000ab2e-7999abcf, ab3f-3bdf3, |
---|
7237 | a2b2f-2adf3-16000bef3+16001cf4, a3bf+4aef3, ac3e-10668cde3, |
---|
7238 | a2c2e+10667ade3+16001be4+5334ce3f, a3ce+10669ae3f, bc3d+8001cd3e, |
---|
7239 | ac3d+8000bc3e+16001cd2e2+8001c4f, b2c2d+16001ad4+4000bd3e+12001cd3f, |
---|
7240 | b2c2e-10668bc3f-10667cd2ef, abc2e-cde2f, b3cd-8000bd3f, b3ce-10668b2c2f-10667bd2ef, abc2f-cdef2, a2bce-16000be3f+16001ce2f2, |
---|
7241 | ab3d-8000b4e-8001b3cf+16000bd2f2, ab2cf-bdef2, |
---|
7242 | a2bcf-16000be2f2+16001cef3, a4d-8000a3be+8001a3cf-2ae2f2; |
---|
7243 | //normalC: char 0: 1sec char 11: 0sec |
---|
7244 | //normalP: char 11: 0sec |
---|
7245 | |
---|
7246 | //2sec mit normalC, in char 2 ebenfalls (char 20 mit charp >1 min) |
---|
7247 | //4 Komp. in char 2, delta (0,0,0,0) -1, char 11:delta (-1,0,0,0) -1 |
---|
7248 | ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
7249 | ideal i= |
---|
7250 | wx2y3-vx2y2z+wx2yz2+wy3z2-vx2z3-vy2z3, |
---|
7251 | vx3y2-ux2y3+vx3z2-ux2yz2+vxy2z2-uy3z2, |
---|
7252 | tvx2y2-swx2y2+tvx2z2-swx2z2+tvy2z2-swy2z2, |
---|
7253 | sux2y2-bvx2y2+sux2z2-bvx2z2+suy2z2-bvy2z2, |
---|
7254 | tux2y3-bvx2y2z+tux2yz2+tuy3z2-bvx2z3-bvy2z3; |
---|
7255 | //normalC: char 2,32003: 1 sec |
---|
7256 | //normalP char withRing 2: 1sec, char 11: 40sec |
---|
7257 | |
---|
7258 | //--------------------------------------------------------- |
---|
7259 | //genus: |
---|
7260 | int tt = timer; |
---|
7261 | list nor=normal(i, "noFac");nor; |
---|
7262 | timer-tt; |
---|
7263 | |
---|
7264 | //Yoshihiko Sakai, irred, 0sec, delta = 8 |
---|
7265 | ring r=0,(x,y),dp; //genus 0 4 nodes and 6 cusps im P2 |
---|
7266 | //ring r=7,(x,y),dp; //charp haengt in K = preimage(Q,phi,L) |
---|
7267 | ideal i=(x2+y^2-1)^3 +27x2y2; |
---|
7268 | |
---|
7269 | ring r=0,(x,y),dp; //genus 0 |
---|
7270 | ideal i=(x-y^2)^2 - y*x^3; |
---|
7271 | |
---|
7272 | ring r=0,(x,y),dp; //genus 4 |
---|
7273 | ideal i=y3-x6+1; |
---|
7274 | |
---|
7275 | int m=9; // q=9: genus 0 |
---|
7276 | int p=2; |
---|
7277 | int q=9;//2,...,9 |
---|
7278 | ring r=0,(x,y),dp; |
---|
7279 | ideal i=y^m - x^p*(x - 1)^q; |
---|
7280 | |
---|
7281 | ring r=0,(x,y),dp; //genus 19 |
---|
7282 | 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; |
---|
7283 | |
---|
7284 | ring r=23,(x,y),dp; //genus 34, delta 2 |
---|
7285 | ideal i=y10+(-2494x2+474)*y8+(84366+2042158x4-660492)*y6 |
---|
7286 | +(128361096x4-47970216x2+6697080-761328152x6)*y4 |
---|
7287 | +(-12024807786x4-506101284x2+15052058268x6+202172841-3212x8)*y2 |
---|
7288 | +34263110700x4-228715574724x6+5431439286x2+201803238 |
---|
7289 | -9127158539954x10-3212722859346x8; |
---|
7290 | //normalC, normalP 0 sec |
---|
7291 | |
---|
7292 | //Rob Koelman |
---|
7293 | //ring r=0,(x,y,z),dp; //dim sing = 1 (nach ca 15 min abgebrochen) |
---|
7294 | ring r=32003,(x,y,z),dp; |
---|
7295 | ideal i= |
---|
7296 | 761328152*x^6*z^4-5431439286*x^2*y^8+2494*x^2*z^8+228715574724*x^6*y^4+ |
---|
7297 | 9127158539954*x^10-15052058268*x^6*y^2*z^2+3212722859346*x^8*y^2- |
---|
7298 | 134266087241*x^8*z^2-202172841*y^8*z^2-34263110700*x^4*y^6-6697080*y^6*z^4- |
---|
7299 | 2042158*x^4*z^6-201803238*y^10+12024807786*x^4*y^4*z^2-128361096*x^4*y^2*z^4+ |
---|
7300 | 506101284*x^2*z^2*y^6+47970216*x^2*z^4*y^4+660492*x^2*z^6*y^2- |
---|
7301 | z^10-474*z^8*y^2-84366*z^6*y^4; |
---|
7302 | //normalC char 32003: 10 sec, char 0 : |
---|
7303 | |
---|
7304 | //ring r=0,(x,y),dp;//genus 10 with 26 cusps (nach ca 4 min abgebrochen) |
---|
7305 | ring r=32003,(x,y),dp; //24 sing, delta 24 |
---|
7306 | ideal i=9127158539954x10+3212722859346x8y2+228715574724x6y4-34263110700x4y6 |
---|
7307 | -5431439286x2y8-201803238y10-134266087241x8-15052058268x6y2+12024807786x4y4 |
---|
7308 | +506101284x2y6-202172841y8+761328152x6-128361096x4y2+47970216x2y4-6697080y6 |
---|
7309 | -2042158x4+660492x2y2-84366y4+2494x2-474y2-1; |
---|
7310 | //normalC 32003: 4 sec, char 0: abgebrochen bei pr = facstd(i); ### |
---|
7311 | |
---|
7312 | ring r=0,(x,y),dp; //irred, genus 1 with 5 cusps, delta 5 |
---|
7313 | ideal i=57y5+516x4y-320x4+66y4-340x2y3+73y3+128x2-84x2y2-96x2y; |
---|
7314 | //normalC 0 sec |
---|
7315 | |
---|
7316 | ring r=2,(x,y),dp; //genus 4, 2 Zweige, delta (13,9) 89 |
---|
7317 | ideal i=((x2+y3)^2+xy6)*((x3+y2)^2+x10y); |
---|
7318 | //normalC: char 2 : 1sec, char 0: lange |
---|
7319 | //normalP char 2 withRing: 0sec |
---|
7320 | |
---|
7321 | ring r=2,(y,z,w,u),dp; //2 Komp. genus -5 |
---|
7322 | ideal i=y2+z2+w2+u2,w4-u4; |
---|
7323 | //normalC: char 2 : 0sec, char 0: 1sec |
---|
7324 | //normalP char 2 withRing: 0sec |
---|
7325 | |
---|
7326 | ring r=0,(y,z,w,u),dp; //irred. genus 9 |
---|
7327 | ideal i=y2+z2+w2+u2,z4+w4+u4; |
---|
7328 | //char 0: 0sec |
---|
7329 | |
---|
7330 | ring r=0,(x,y,t),dp; //irred, delta -1 |
---|
7331 | 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; |
---|
7332 | //char 0: 0sec |
---|
7333 | |
---|
7334 | ring r=0,(x,y,z,w,u),dp; |
---|
7335 | ideal i=x2+y2+z2+w2+u2,x3+y3+z3,z4+w4+u4; |
---|
7336 | //char 0: 0sec |
---|
7337 | |
---|
7338 | //--------------------------------------------------------- |
---|
7339 | //Probleme mit normalC in char 2 und char 0 |
---|
7340 | |
---|
7341 | int tt = timer; |
---|
7342 | list nor=normalC(i,"withRing");nor; |
---|
7343 | timer-tt; |
---|
7344 | |
---|
7345 | //Mark van Hoeij |
---|
7346 | ring r=3,(x,y),dp; //genus 19, delta 21 |
---|
7347 | ideal i=y20+y13x+x4y5+x3*(x+1)^2; |
---|
7348 | //normalC: char 2 > 10 min bei list SM = mstd(i);### |
---|
7349 | //normalP char 2 withRing: 0sec, char 11: haengt bei K = preimage(Q,phi,L); |
---|
7350 | |
---|
7351 | ring r=2,(x,y),dp; //genus 35 |
---|
7352 | ideal i=y30+y13x+x4y5+x3*(x+1)^2; |
---|
7353 | //char 0 abgebrochen bei list SM = mstd(i); ### |
---|
7354 | //char 2 nach ca 30 min |
---|
7355 | //normalC: char 2: abgebr. bei list SM = mstd(i); //Now the work starts' |
---|
7356 | //normalC, withGens, char 2: abgebrochen bei Q=mstd(Q)[2]; |
---|
7357 | //normalP char 2 withRing: 0sec |
---|
7358 | |
---|
7359 | ring r=0,(x,y),dp; //irred, genus 55, delta 21 |
---|
7360 | ideal i=y40+y13x+x4y5+x3*(x+1)^2; |
---|
7361 | //normalC: char 2 lange |
---|
7362 | //normalP char 2 withRing: 0sec |
---|
7363 | |
---|
7364 | ring r=29,(x,y,t),dp; //char 0: genus -5, 4 Komp, delta (-1,-1,0,0), -1 |
---|
7365 | 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; |
---|
7366 | //normalC: char 29 : 0sec, char 0: 0sec //char 29 6 Komponenten |
---|
7367 | //normalP char 29 withRing: 1sec |
---|
7368 | |
---|
7369 | //-------------------------- problematic examples ------------------------ |
---|
7370 | //ring r=0,(x,y,t),dp; |
---|
7371 | ring r=32003,(x,y,t),dp; |
---|
7372 | ideal i= |
---|
7373 | 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; |
---|
7374 | //char 0: lange (es liegt an den grossen Zahlen), char 32003: 0 sec |
---|
7375 | |
---|
7376 | //dasselbe Beipiel in char 19: irred |
---|
7377 | ring r=0,(x,y,t),dp; |
---|
7378 | ideal i= |
---|
7379 | 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; |
---|
7380 | //normalP: char 2,3: 0sec, norTest 0,2 sec, char 11 haengt bei peimage |
---|
7381 | //normalC: char 3: 0 sec, char 0: 1sec |
---|
7382 | |
---|
7383 | //ring r=0,(x,y),dp; |
---|
7384 | ring r=32003,(x,y),dp; |
---|
7385 | ideal i= |
---|
7386 | x30y21+21x29y20+210x28y19+10x27y19+1330x27y18+190x26y18+5985x26y17 |
---|
7387 | +1710x25y17+20349x25y16+45x24y17+9690x24y16+54264x24y15+765x23y16 |
---|
7388 | +38760x23y15+116280x23y14+6120x22y15+116280x22y14+120x21y15 |
---|
7389 | +203490x22y13+30600x21y14+271320x21y13+1799x20y14+293930x21y12+107100x20y13 |
---|
7390 | +503880x20y12+12586x19y13+352716x20y11+278460x19y12+210x18y13+755820x19y11 |
---|
7391 | +54509x18y12+352716x19y10+556920x18y11+2723x17y12+923780x18y10+163436x17y11 |
---|
7392 | +293930x18y9+875160x17y10+16296x16y11+923780x17y9+359359x16y10+252x15y11 |
---|
7393 | +203490x17y8+1093950x16y9+59598x15y10+755820x16y8+598598x15y9+2751x14y10 |
---|
7394 | +116280x16y7+1093950x15y8+148610x14y9+503880x15y7+769197x14y8+13650x13y9 |
---|
7395 | +54264x15y6+875160x14y7+266805x13y8+210x12y9+271320x14y6+768768x13y7 |
---|
7396 | +40635x12y8+20349x14y5+556920x13y6+354816x12y7+1855x11y8+116280x13y5 |
---|
7397 | +597597x12y6+80640x11y7+5985x13y4+278460x12y5+353892x11y6+7280x10y7+38760x12y4 |
---|
7398 | +358358x11y5+112014x10y6+120x9y7+1330x12y3+107100x11y4+264726x10y5+16660x9y6 |
---|
7399 | +9690x11y3+162799x10y4+111132x9y5+805x8y6+210x11y2+30600x10y3+146685x9y4 |
---|
7400 | +24500x8y5+1710x10y2+54236x9y3+78750x8y4+2310x7y5+21x10y+6120x9y2+58520x8y3 |
---|
7401 | +24010x7y4+45x6y5+190x9y+12509x8y2+39060x7y3+3675x6y4+x9+765x8y+15918x7y2 |
---|
7402 | +15680x6y3+204x5y4+10x8+1786x7y+12915x6y2+3500x5y3+45x7+2646x6y+6580x5y2 |
---|
7403 | +366x4y3+119x6+2562x5y+1995x4y2+10x3y3+203x5+1610x4y+324x3y2+231x4+630x3y |
---|
7404 | +23x2y2+175x3+141x2y+85x2+16xy+24x+y+4; |
---|
7405 | list nor = normal(i); |
---|
7406 | //normalC: char 0: ### haengt in SB of singular locus JM = mstd(J); |
---|
7407 | //normalC: char 32003,"noFac","equidim": 0sec, "noFac": 1sec |
---|
7408 | // ev neues interred |
---|
7409 | genus(i); // haengt bei int mu=vdim(std(jacob(f))); |
---|
7410 | //### ist das noetig? |
---|
7411 | |
---|
7412 | //Singular rechnet genus richtig, auch im Fall, dass Kurve irreduzibel, |
---|
7413 | //aber nicht absolut irreduzibel ist: |
---|
7414 | ring r = 0,(x,y),dp; |
---|
7415 | ideal i = x2+y2; //irreduzibel /Q aber reduzibel /C (x-iy)*(x+iy) |
---|
7416 | factorize( x2+y2); //liefert irreduzibel |
---|
7417 | genus(i); //sollte 0+0-2+1= -1 sein |
---|
7418 | genus(i,1); //beides ist korrekt in Singular |
---|
7419 | |
---|
7420 | */ |
---|