[1598658] | 1 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2 | version="$Id$"; |
---|
| 3 | category="Commutative Algebra"; |
---|
| 4 | info=" |
---|
| 5 | LIBRARY: normal.lib Normalization of Affine Rings |
---|
| 6 | AUTHORS: G.-M. Greuel, greuel@mathematik.uni-kl.de, |
---|
| 7 | @* S. Laplagne, slaplagn@dm.uba.ar, |
---|
| 8 | @* G. Pfister, pfister@mathematik.uni-kl.de |
---|
| 9 | |
---|
| 10 | |
---|
| 11 | MAIN PROCEDURES: |
---|
| 12 | normal(I,[...]); normalization of an affine ring |
---|
| 13 | normalP(I,[...]); normalization of an affine ring in positive characteristic |
---|
| 14 | normalC(I,[...]); normalization of an affine ring through a chain of rings |
---|
| 15 | HomJJ(L); presentation of End_R(J) as affine ring, J an ideal |
---|
| 16 | genus(I); computes the geometric genus of a projective curve |
---|
| 17 | primeClosure(L); integral closure of R/p, p a prime ideal |
---|
| 18 | closureFrac(L); 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 | AUXILIARY PROCEDURES: |
---|
| 22 | deltaLoc(f,S); sum of delta invariants at conjugated singular points |
---|
| 23 | locAtZero(I); checks whether the zero set of I is located at 0 |
---|
| 24 | norTest(I,nor); checks the output of normal, normalP, normalC |
---|
| 25 | getSmallest(J); computes the polynomial of smallest degree of J |
---|
| 26 | getOneVar(J, vari); computes a polynomial of J in the variable vari |
---|
| 27 | changeDenominator(U1, c1, c2, I); computes ideal U2 such that 1/c1*U1=1/c2*U2 |
---|
| 28 | "; |
---|
| 29 | |
---|
| 30 | LIB "general.lib"; |
---|
| 31 | LIB "poly.lib"; |
---|
| 32 | LIB "sing.lib"; |
---|
| 33 | LIB "primdec.lib"; |
---|
| 34 | LIB "elim.lib"; |
---|
| 35 | LIB "presolve.lib"; |
---|
| 36 | LIB "inout.lib"; |
---|
| 37 | LIB "ring.lib"; |
---|
| 38 | LIB "hnoether.lib"; |
---|
| 39 | LIB "reesclos.lib"; |
---|
| 40 | LIB "algebra.lib"; |
---|
| 41 | |
---|
| 42 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 43 | |
---|
| 44 | proc normal(ideal id, list #) |
---|
| 45 | "USAGE: normal(id [,choose]); id = radical ideal, choose = list of options. @* |
---|
| 46 | Optional parameters in list choose (can be entered in any order):@* |
---|
| 47 | Decomposition:@* |
---|
| 48 | - \"equidim\" -> computes first an equidimensional decomposition, |
---|
| 49 | and then the normalization of each component (default).@* |
---|
| 50 | - \"prim\" -> computes first the minimal associated primes, and then |
---|
| 51 | the normalization of each prime. @* |
---|
| 52 | - \"noDeco\" -> no preliminary decomposition is done. If the ideal is |
---|
| 53 | not equidimensional radical, output might be wrong.@* |
---|
| 54 | - \"isPrim\" -> assumes that the ideal is prime. If this assumption |
---|
| 55 | does not hold, the output might be wrong.@* |
---|
| 56 | - \"noFac\" -> factorization is avoided in the computation of the |
---|
| 57 | minimal associated primes; |
---|
| 58 | Other:@* |
---|
| 59 | - \"useRing\" -> uses the original ring ordering.@* |
---|
| 60 | If this option is set and if the ring ordering is not global, normal |
---|
| 61 | will change to a global ordering only for computing radicals and prime |
---|
| 62 | or equidimensional decompositions.@* |
---|
| 63 | If this option is not set, normal changes to dp ordering and performs |
---|
| 64 | all computations with respect to this ordering.@* |
---|
| 65 | - \"withDelta\" (or \"wd\") -> returns also the delta invariants.@* |
---|
| 66 | If the optional parameter choose is not given or empty, only |
---|
| 67 | \"equidim\" but no other option is used.@* |
---|
| 68 | - list(\"inputJ\", ideal inputJ) -> takes as initial test ideal the |
---|
| 69 | ideal inputJ. This option is only for use in other procedures. Using |
---|
| 70 | this option, the result might not be the normalization.@* |
---|
| 71 | (Option only valid for global algorithm.)@* |
---|
| 72 | - list(\"inputC\", ideal inputC) -> takes as initial conductor the |
---|
| 73 | ideal inputC. This option is only for use in other procedures. Using |
---|
| 74 | this option, the result might not be the normalization.@* |
---|
| 75 | (Option only valid for global algorithm.)@* |
---|
| 76 | Options used for computing integral basis (over rings of two |
---|
| 77 | variables):@* |
---|
| 78 | - \"var1\" -> uses a polynomial in the first variable as |
---|
| 79 | universal denominator.@* |
---|
| 80 | - \"var2\" -> uses a polynomial in the second variable as universal |
---|
| 81 | denominator.@* |
---|
| 82 | If the optional parameter choose is not given or empty, only |
---|
| 83 | \"equidim\" but no other option is used.@* |
---|
| 84 | ASSUME: The ideal must be radical, for non-radical ideals the output may |
---|
| 85 | be wrong (id=radical(id); makes id radical). However, when using the |
---|
| 86 | \"prim\" option the minimal associated primes of id are computed first |
---|
| 87 | and hence normal computes the normalization of the radical of id.@* |
---|
| 88 | NOTE: \"isPrim\" should only be used if id is known to be prime. |
---|
| 89 | RETURN: a list, say nor, of size 2 (resp. 3 with option \"withDelta\"). |
---|
| 90 | @format Let R denote the basering and id the input ideal. |
---|
| 91 | * nor[1] is a list of r rings, where r is the number of associated |
---|
| 92 | primes P_i with option \"prim\" (resp. >= no of equidimenensional |
---|
| 93 | components P_i with option \"equidim\").@* |
---|
| 94 | Each ring Ri := nor[1][i], i=1..r, contains two ideals with given |
---|
| 95 | names @code{norid} and @code{normap} such that: @* |
---|
| 96 | - Ri/norid is the normalization of the i-th component, i.e. the |
---|
| 97 | integral closure of R/P_i in its field of fractions (as affine ring); |
---|
| 98 | - @code{normap} gives the normalization map from R/id to |
---|
| 99 | Ri/norid for each i.@* |
---|
| 100 | - the direct sum of the rings Ri/norid, i=1,..r, is the normalization |
---|
| 101 | of R/id as affine algebra; @* |
---|
| 102 | * nor[2] is a list of size r with information on the normalization of |
---|
| 103 | the i-th component as module over the basering R:@* |
---|
| 104 | nor[2][i] is an ideal, say U, in R such that the integral closure |
---|
| 105 | of basering/P_i is generated as module over R by 1/c * U, with c |
---|
| 106 | the last element U[size(U)] of U.@* |
---|
| 107 | * nor[3] (if option \"withDelta\" is set) is a list of an intvec |
---|
| 108 | of size r, the delta invariants of the r components, and an integer, |
---|
| 109 | the total delta invariant of basering/id (-1 means infinite, and 0 |
---|
| 110 | that R/P_i resp. R/id is normal). |
---|
| 111 | @end format |
---|
| 112 | THEORY: We use here a general algorithm described in [G.-M.Greuel, S.Laplagne, |
---|
| 113 | F.Seelisch: Normalization of Rings (2009)].@* |
---|
| 114 | The procedure computes the R-module structure, the algebra structure |
---|
| 115 | and the delta invariant of the normalization of R/id:@* |
---|
| 116 | The normalization of R/id is the integral closure of R/id in its total |
---|
| 117 | ring of fractions. It is a finitely generated R-module and nor[2] |
---|
| 118 | computes R-module generators of it. More precisely: If U:=nor[2][i] |
---|
| 119 | and c:=U[size(U)], then c is a non-zero divisor and U/c is an R-module |
---|
| 120 | in the total ring of fractions, the integral closure of R/P_i. Since |
---|
| 121 | U[size(U)]/c is equal to 1, R/P_i resp. R/id is contained in the |
---|
| 122 | integral closure.@* |
---|
| 123 | The normalization is also an affine algebra over the ground field |
---|
| 124 | and nor[1] presents it as such. For geometric considerations nor[1] is |
---|
| 125 | relevant since the variety of the ideal norid in Ri is the |
---|
| 126 | normalization of the variety of the ideal P_i in R.@* |
---|
| 127 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
| 128 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
| 129 | id. nor[3] returns the delta invariants of the components P_i and of |
---|
| 130 | id. |
---|
| 131 | NOTE: To use the i-th ring type e.g.: @code{def R=nor[1][i]; setring R;}. |
---|
| 132 | @* Increasing/decreasing printlevel displays more/less comments |
---|
| 133 | (default: printlevel=0). |
---|
| 134 | @* Implementation works also for local rings. |
---|
| 135 | @* Not implemented for quotient rings. |
---|
| 136 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
| 137 | be used together with the useRing-option (qhweight(id); computes |
---|
| 138 | weights). |
---|
| 139 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
| 140 | SEE ALSO: normalC, normalP. |
---|
| 141 | EXAMPLE: example normal; shows an example |
---|
| 142 | " |
---|
| 143 | { |
---|
| 144 | intvec opt = option(get); // Save current options |
---|
| 145 | |
---|
| 146 | int i,j; |
---|
| 147 | int decomp; // Preliminary decomposition: |
---|
| 148 | // 0 -> no decomposition (id is assumed to be prime) |
---|
| 149 | // 1 -> no decomposition |
---|
| 150 | // (id is assumed to be equidimensional radical) |
---|
| 151 | // 2 -> equidimensional decomposition |
---|
| 152 | // 3 -> minimal associated primes |
---|
| 153 | int noFac, useRing, withDelta; |
---|
| 154 | int dbg = printlevel - voice + 2; |
---|
| 155 | int nvar = nvars(basering); |
---|
| 156 | int chara = char(basering); |
---|
| 157 | int denomOption; // Method for choosing the conductor |
---|
| 158 | |
---|
| 159 | ideal inputJ = 0; // Test ideal given in the input (if any). |
---|
| 160 | ideal inputC = 0; // Conductor ideal given in the input (if any). |
---|
| 161 | |
---|
| 162 | list result, resultNew; |
---|
| 163 | list keepresult; |
---|
| 164 | list ringStruc; |
---|
| 165 | ideal U; |
---|
| 166 | poly c; |
---|
| 167 | int sp; // Number of components. |
---|
| 168 | |
---|
| 169 | // Default methods: |
---|
| 170 | noFac = 0; // Use facSTD when computing minimal associated primes |
---|
| 171 | decomp = 2; // Equidimensional decomposition |
---|
| 172 | useRing = 0; // Change first to dp ordering, and perform all |
---|
| 173 | // computations there. |
---|
| 174 | withDelta = 0; // Do not compute the delta invariant. |
---|
| 175 | denomOption = 0; // The default universal denominator is the smallest |
---|
| 176 | // degree polynomial. |
---|
| 177 | |
---|
| 178 | //--------------------------- define the method --------------------------- |
---|
| 179 | for ( i=1; i <= size(#); i++ ) |
---|
| 180 | { |
---|
| 181 | if ( typeof(#[i]) == "string" ) |
---|
| 182 | { |
---|
| 183 | //--------------------------- choosen methods ----------------------- |
---|
| 184 | if ( (#[i]=="isprim") or (#[i]=="isPrim") ) |
---|
| 185 | {decomp = 0;} |
---|
| 186 | |
---|
| 187 | if ( (#[i]=="nodeco") or (#[i]=="noDeco") ) |
---|
| 188 | {decomp = 1;} |
---|
| 189 | |
---|
| 190 | if (#[i]=="prim") |
---|
| 191 | {decomp = 3;} |
---|
| 192 | |
---|
| 193 | if (#[i]=="equidim") |
---|
| 194 | {decomp = 2;} |
---|
| 195 | |
---|
| 196 | if ( (#[i]=="nofac") or (#[i]=="noFac") ) |
---|
| 197 | {noFac=1;} |
---|
| 198 | |
---|
| 199 | if ( ((#[i]=="useRing") or (#[i]=="usering")) and (ordstr(basering) != "dp("+string(nvars(basering))+"),C")) |
---|
| 200 | {useRing = 1;} |
---|
| 201 | |
---|
| 202 | if ( (#[i]=="withDelta") or (#[i]=="wd") or (#[i]=="withdelta")) |
---|
| 203 | { |
---|
| 204 | if((decomp == 0) or (decomp == 3)) |
---|
| 205 | { |
---|
| 206 | withDelta = 1; |
---|
| 207 | } |
---|
| 208 | else |
---|
| 209 | { |
---|
| 210 | decomp = 3; |
---|
| 211 | withDelta = 1; |
---|
| 212 | //Note: the delta invariants cannot be computed with an equidimensional |
---|
| 213 | //decomposition, hence we compute first the minimal primes |
---|
| 214 | } |
---|
| 215 | } |
---|
| 216 | if (#[i]=="var1") |
---|
| 217 | {denomOption = 1;} |
---|
| 218 | if (#[i]=="var2") |
---|
| 219 | {denomOption = 2;} |
---|
| 220 | } |
---|
| 221 | if(typeof(#[i]) == "list"){ |
---|
| 222 | if(size(#[i]) == 2){ |
---|
| 223 | if (#[i][1]=="inputJ"){ |
---|
| 224 | if(typeof(#[i][2]) == "ideal"){ |
---|
| 225 | inputJ = #[i][2]; |
---|
| 226 | } |
---|
| 227 | } |
---|
| 228 | } |
---|
| 229 | if (#[i][1]=="inputC"){ |
---|
| 230 | if(size(#[i]) == 2){ |
---|
| 231 | if(typeof(#[i][2]) == "ideal"){ |
---|
| 232 | inputC = #[i][2]; |
---|
| 233 | } |
---|
| 234 | } |
---|
| 235 | } |
---|
| 236 | } |
---|
| 237 | } |
---|
| 238 | kill #; |
---|
| 239 | |
---|
| 240 | //------------------------ change ring if required ------------------------ |
---|
| 241 | // If the ordering is not global, we change to dp ordering for computing the |
---|
| 242 | // min ass primes. |
---|
| 243 | // If the ordering is global, but not dp, and useRing = 0, we also change to |
---|
| 244 | // dp ordering. |
---|
| 245 | |
---|
| 246 | int isGlobal = ord_test(basering); // Checks if the original ring has |
---|
| 247 | // global ordering. |
---|
| 248 | |
---|
| 249 | def origR = basering; // origR is the original ring |
---|
| 250 | // R is the ring where computations will be done |
---|
| 251 | |
---|
| 252 | if((useRing == 1) and (isGlobal == 1)) |
---|
| 253 | { |
---|
| 254 | def globR = basering; |
---|
| 255 | } |
---|
| 256 | else |
---|
| 257 | { |
---|
| 258 | // We change to dp ordering. |
---|
| 259 | list rl = ringlist(origR); |
---|
| 260 | list origOrd = rl[3]; |
---|
| 261 | list newOrd = list("dp", intvec(1:nvars(origR))), list("C", 0); |
---|
| 262 | rl[3] = newOrd; |
---|
| 263 | def globR = ring(rl); |
---|
| 264 | setring globR; |
---|
| 265 | ideal id = fetch(origR, id); |
---|
| 266 | } |
---|
| 267 | |
---|
| 268 | //------------------------ trivial checkings ------------------------ |
---|
| 269 | id = groebner(id); |
---|
| 270 | if((size(id) == 0) or (id[1] == 1)) |
---|
| 271 | { |
---|
| 272 | // The original ring R/I was normal. Nothing to do. |
---|
| 273 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
| 274 | setring origR; |
---|
| 275 | list lR = ringlist(origR); |
---|
| 276 | def ROut = ring(lR); |
---|
| 277 | setring ROut; |
---|
| 278 | ideal norid = fetch(origR, id); |
---|
| 279 | ideal normap = maxideal(1); |
---|
| 280 | export norid; |
---|
| 281 | export normap; |
---|
| 282 | setring origR; |
---|
| 283 | if(withDelta) |
---|
| 284 | { |
---|
| 285 | result = list(list(ROut), list(ideal(1)), list(intvec(0), 0)); |
---|
| 286 | } |
---|
| 287 | else |
---|
| 288 | { |
---|
| 289 | result = list(list(ROut), list(ideal(1))); |
---|
| 290 | } |
---|
| 291 | sp = 1; // number of rings in the output |
---|
| 292 | option(set, opt); |
---|
| 293 | normalOutputText(dbg, withDelta, sp); |
---|
| 294 | return(result); |
---|
| 295 | } |
---|
| 296 | //------------------------ preliminary decomposition----------------------- |
---|
| 297 | list prim; |
---|
| 298 | if(decomp == 2) |
---|
| 299 | { |
---|
| 300 | dbprint(dbg, "// Computing the equidimensional decomposition..."); |
---|
| 301 | prim = equidim(id); |
---|
| 302 | } |
---|
| 303 | if((decomp == 0) or (decomp == 1)) |
---|
| 304 | { |
---|
| 305 | prim = id; |
---|
| 306 | } |
---|
| 307 | if(decomp == 3) |
---|
| 308 | { |
---|
| 309 | dbprint(dbg, "// Computing the minimal associated primes..."); |
---|
| 310 | if( noFac ) |
---|
| 311 | { prim = minAssGTZ(id,1); } |
---|
| 312 | else |
---|
| 313 | { prim = minAssGTZ(id); } |
---|
| 314 | } |
---|
| 315 | sp = size(prim); |
---|
| 316 | if(dbg>=1) |
---|
| 317 | { |
---|
| 318 | prim; ""; |
---|
| 319 | "// number of components is", sp; |
---|
| 320 | ""; |
---|
| 321 | } |
---|
| 322 | |
---|
| 323 | |
---|
| 324 | //----------------- back to the original ring if required ------------------ |
---|
| 325 | // if ring was not global and useRing is on, we go back to the original ring |
---|
| 326 | if((useRing == 1) and (isGlobal != 1)) |
---|
| 327 | { |
---|
| 328 | setring origR; |
---|
| 329 | def R = basering; |
---|
| 330 | list prim = fetch(globR, prim); |
---|
| 331 | } |
---|
| 332 | else |
---|
| 333 | { |
---|
| 334 | def R = basering; |
---|
| 335 | ideal inputJ = fetch(origR, inputJ); |
---|
| 336 | ideal inputC = fetch(origR, inputC); |
---|
| 337 | if(useRing == 0) |
---|
| 338 | { |
---|
| 339 | ideal U; |
---|
| 340 | poly c; |
---|
| 341 | } |
---|
| 342 | } |
---|
| 343 | |
---|
| 344 | // ---------------- normalization of the components------------------------- |
---|
| 345 | // calls normalM to compute the normalization of each component. |
---|
| 346 | |
---|
| 347 | list norComp; // The normalization of each component. |
---|
| 348 | int delt; |
---|
| 349 | int deltI = 0; |
---|
| 350 | int totalComps = 0; |
---|
| 351 | |
---|
| 352 | setring origR; |
---|
| 353 | def newROrigOrd; |
---|
| 354 | list newRListO; |
---|
| 355 | setring R; |
---|
| 356 | def newR; |
---|
| 357 | list newRList; |
---|
| 358 | |
---|
| 359 | for(i=1; i<=size(prim); i++) |
---|
| 360 | { |
---|
| 361 | if(dbg>=2){pause();} |
---|
| 362 | if(dbg>=1) |
---|
| 363 | { |
---|
| 364 | "// start computation of component",i; |
---|
| 365 | " --------------------------------"; |
---|
| 366 | } |
---|
| 367 | if(groebner(prim[i])[1] != 1) |
---|
| 368 | { |
---|
| 369 | if(dbg>=2) |
---|
| 370 | { |
---|
| 371 | "We compute the normalization in the ring"; basering; |
---|
| 372 | } |
---|
| 373 | printlevel = printlevel + 1; |
---|
| 374 | norComp = normalM(prim[i], decomp, withDelta, denomOption, inputJ, inputC); |
---|
| 375 | printlevel = printlevel - 1; |
---|
| 376 | for(j = 1; j <= size(norComp); j++) |
---|
| 377 | { |
---|
| 378 | newR = norComp[j][3]; |
---|
| 379 | newRList = ringlist(newR); |
---|
| 380 | U = norComp[j][1]; |
---|
| 381 | c = norComp[j][2]; |
---|
| 382 | if(withDelta) |
---|
| 383 | { |
---|
| 384 | delt = norComp[j][4]; |
---|
| 385 | if((delt >= 0) and (deltI >= 0)) |
---|
| 386 | { |
---|
| 387 | deltI = deltI + delt; |
---|
| 388 | } |
---|
| 389 | else |
---|
| 390 | { |
---|
| 391 | deltI = -1; |
---|
| 392 | } |
---|
| 393 | } |
---|
| 394 | // -- incorporate result for this component to the list of results --- |
---|
| 395 | if(useRing == 0) |
---|
| 396 | { |
---|
| 397 | // We go back to the original ring. |
---|
| 398 | setring origR; |
---|
| 399 | U = fetch(R, U); |
---|
| 400 | c = fetch(R, c); |
---|
| 401 | newRListO = imap(R, newRList); |
---|
| 402 | // We change the ordering in the new ring. |
---|
| 403 | if(nvars(newR) > nvars(origR)) |
---|
| 404 | { |
---|
| 405 | newRListO[3]=insert(origOrd, newRListO[3][1]); |
---|
| 406 | } |
---|
| 407 | else |
---|
| 408 | { |
---|
| 409 | newRListO[3] = origOrd; |
---|
| 410 | } |
---|
| 411 | newROrigOrd = ring(newRListO); |
---|
| 412 | setring newROrigOrd; |
---|
| 413 | ideal norid = imap(newR, norid); |
---|
| 414 | ideal normap = imap(newR, normap); |
---|
| 415 | export norid; |
---|
| 416 | export normap; |
---|
| 417 | setring origR; |
---|
| 418 | totalComps++; |
---|
| 419 | result[totalComps] = list(U, c, newROrigOrd); |
---|
| 420 | if(withDelta) |
---|
| 421 | { |
---|
| 422 | result[totalComps] = insert(result[totalComps], delt, 3); |
---|
| 423 | } |
---|
| 424 | setring R; |
---|
| 425 | } |
---|
| 426 | else |
---|
| 427 | { |
---|
| 428 | setring R; |
---|
| 429 | totalComps++; |
---|
| 430 | result[totalComps] = norComp[j]; |
---|
| 431 | } |
---|
| 432 | } |
---|
| 433 | } |
---|
| 434 | } |
---|
| 435 | |
---|
| 436 | // -------------------------- delta computation ---------------------------- |
---|
| 437 | if(withDelta == 1) |
---|
| 438 | { |
---|
| 439 | // Intersection multiplicities of list prim, sp=size(prim). |
---|
| 440 | if ( dbg >= 1 ) |
---|
| 441 | { |
---|
| 442 | "// Sum of delta for all components: ", deltI; |
---|
| 443 | } |
---|
| 444 | if(size(prim) > 1) |
---|
| 445 | { |
---|
| 446 | dbprint(dbg, "// Computing the sum of the intersection multiplicities of the components..."); |
---|
| 447 | int mul = iMult(prim); |
---|
| 448 | if ( mul < 0 ) |
---|
| 449 | { |
---|
| 450 | deltI = -1; |
---|
| 451 | } |
---|
| 452 | else |
---|
| 453 | { |
---|
| 454 | deltI = deltI + mul; |
---|
| 455 | } |
---|
| 456 | if ( dbg >= 1 ) |
---|
| 457 | { |
---|
| 458 | "// Intersection multiplicity is : ", mul; |
---|
| 459 | } |
---|
| 460 | } |
---|
| 461 | } |
---|
| 462 | |
---|
| 463 | // -------------------------- prepare output ------------------------------ |
---|
| 464 | setring origR; |
---|
| 465 | |
---|
| 466 | list RL; // List of rings |
---|
| 467 | list MG; // Module generators |
---|
| 468 | intvec DV; // Vector of delta's of each component |
---|
| 469 | for(i = 1; i <= size(result); i++) |
---|
| 470 | { |
---|
| 471 | RL[i] = result[i][3]; |
---|
| 472 | MG[i] = lineUpLast(result[i][1], result[i][2]); |
---|
| 473 | if(withDelta) |
---|
| 474 | { |
---|
| 475 | DV[i] = result[i][4]; |
---|
| 476 | } |
---|
| 477 | } |
---|
| 478 | if(withDelta) |
---|
| 479 | { |
---|
| 480 | resultNew = list(RL, MG, list(DV, deltI)); |
---|
| 481 | } |
---|
| 482 | else |
---|
| 483 | { |
---|
| 484 | resultNew = list(RL, MG); |
---|
| 485 | } |
---|
| 486 | sp = size(RL); //RL = list of rings |
---|
| 487 | |
---|
| 488 | option(set, opt); |
---|
| 489 | normalOutputText(dbg, withDelta, sp); |
---|
| 490 | return(resultNew); |
---|
| 491 | } |
---|
| 492 | |
---|
| 493 | example |
---|
| 494 | { "EXAMPLE:"; |
---|
| 495 | printlevel = printlevel+1; |
---|
| 496 | echo = 2; |
---|
| 497 | ring s = 0,(x,y),dp; |
---|
| 498 | ideal i = (x2-y3)*(x2+y2)*x; |
---|
| 499 | list nor = normal(i, "withDelta", "prim"); |
---|
| 500 | nor; |
---|
| 501 | |
---|
| 502 | // 2 branches have delta = 1, and 1 branch has delta = 0 |
---|
| 503 | // the total delta invariant is 13 |
---|
| 504 | |
---|
| 505 | def R2 = nor[1][2]; setring R2; |
---|
| 506 | norid; normap; |
---|
| 507 | |
---|
| 508 | echo = 0; |
---|
| 509 | printlevel = printlevel-1; |
---|
| 510 | pause(" hit return to continue"); echo=2; |
---|
| 511 | |
---|
| 512 | ring r = 2,(x,y,z),dp; |
---|
| 513 | ideal i = z3-xy4; |
---|
| 514 | list nor = normal(i, "withDelta", "prim"); nor; |
---|
| 515 | // the delta invariant is infinite |
---|
| 516 | // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module |
---|
| 517 | // in its quotient field Quot(r/i) |
---|
| 518 | |
---|
| 519 | // the normalization as affine algebra over the ground field: |
---|
| 520 | def R = nor[1][1]; setring R; |
---|
| 521 | norid; normap; |
---|
| 522 | } |
---|
| 523 | |
---|
| 524 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 525 | // Prints the output text in proc normal. |
---|
| 526 | // |
---|
| 527 | static proc normalOutputText(int dbg, int withDelta, int sp) |
---|
| 528 | // int dbg: printlevel |
---|
| 529 | // int withDelta: output contains information about the delta invariant |
---|
| 530 | // int sp: number of output rings. |
---|
| 531 | { |
---|
| 532 | if ( dbg >= 0 ) |
---|
| 533 | { |
---|
| 534 | ""; |
---|
| 535 | if(!withDelta) |
---|
| 536 | { |
---|
| 537 | "// 'normal' created a list, say nor, of two elements."; |
---|
| 538 | } |
---|
| 539 | else |
---|
| 540 | { |
---|
| 541 | "// 'normal' created a list, say nor, of three elements."; |
---|
| 542 | } |
---|
| 543 | "// To see the list type"; |
---|
| 544 | " nor;"; |
---|
| 545 | ""; |
---|
| 546 | "// * nor[1] is a list of", sp, "ring(s)."; |
---|
| 547 | "// To access the i-th ring nor[1][i], give it a name, say Ri, and type"; |
---|
| 548 | " def R1 = nor[1][1]; setring R1; norid; normap;"; |
---|
| 549 | "// For the other rings type first (if R is the name of your base ring)"; |
---|
| 550 | " setring R;"; |
---|
| 551 | "// and then continue as for R1."; |
---|
| 552 | "// Ri/norid is the affine algebra of the normalization of R/P_i where"; |
---|
| 553 | "// P_i is the i-th component of a decomposition of the input ideal id"; |
---|
| 554 | "// and normap the normalization map from R to Ri/norid."; |
---|
| 555 | ""; |
---|
| 556 | "// * nor[2] is a list of", sp, "ideal(s). Let ci be the last generator"; |
---|
| 557 | "// of the ideal nor[2][i]. Then the integral closure of R/P_i is"; |
---|
| 558 | "// generated as R-submodule of the total ring of fractions by"; |
---|
| 559 | "// 1/ci * nor[2][i]."; |
---|
| 560 | |
---|
| 561 | if(withDelta) |
---|
| 562 | { ""; |
---|
| 563 | "// * nor[3] is a list of an intvec of size", sp, "the delta invariants "; |
---|
| 564 | "// of the components, and an integer, the total delta invariant "; |
---|
| 565 | "// of R/id (-1 means infinite, and 0 that R/P_i resp. R/id is normal)."; |
---|
| 566 | } |
---|
| 567 | } |
---|
| 568 | } |
---|
| 569 | |
---|
| 570 | |
---|
| 571 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 572 | |
---|
| 573 | proc HomJJ (list Li) |
---|
| 574 | "USAGE: HomJJ (Li); Li = list: ideal SBid, ideal id, ideal J, poly p |
---|
| 575 | ASSUME: R = P/id, P = basering, a polynomial ring, id an ideal of P, |
---|
| 576 | @* SBid = standard basis of id, |
---|
| 577 | @* J = ideal of P containing the polynomial p, |
---|
| 578 | @* p = nonzero divisor of R |
---|
| 579 | COMPUTE: Endomorphism ring End_R(J)=Hom_R(J,J) with its ring structure as |
---|
| 580 | affine ring, together with the map R --> Hom_R(J,J) of affine rings, |
---|
| 581 | where R is the quotient ring of P modulo the standard basis SBid. |
---|
| 582 | RETURN: a list l of three objects |
---|
| 583 | @format |
---|
| 584 | l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi' |
---|
| 585 | such that l[1]/endid = Hom_R(J,J) and |
---|
| 586 | endphi describes the canonical map R -> Hom_R(J,J) |
---|
| 587 | l[2] : an integer which is 1 if phi is an isomorphism, 0 if not |
---|
| 588 | l[3] : an integer, = dim_K(Hom_R(J,J)/R) (the contribution to delta) |
---|
| 589 | if the dimension is finite, -1 otherwise |
---|
| 590 | @end format |
---|
| 591 | NOTE: printlevel >=1: display comments (default: printlevel=0) |
---|
| 592 | EXAMPLE: example HomJJ; shows an example |
---|
| 593 | " |
---|
| 594 | { |
---|
| 595 | //---------- initialisation --------------------------------------------------- |
---|
| 596 | int isIso,isPr,isHy,isCo,isRe,isEq,oSAZ,ii,jj,q,y; |
---|
| 597 | intvec rw,rw1; |
---|
| 598 | list L; |
---|
| 599 | y = printlevel-voice+2; // y=printlevel (default: y=0) |
---|
| 600 | def P = basering; |
---|
| 601 | ideal SBid, id, J = Li[1], Li[2], Li[3]; |
---|
| 602 | poly p = Li[4]; |
---|
| 603 | int noRed = 0; |
---|
| 604 | if(size(Li) > 4) |
---|
| 605 | { |
---|
| 606 | if(Li[5] == 1) { noRed = 1; } |
---|
| 607 | } |
---|
| 608 | |
---|
| 609 | attrib(SBid,"isSB",1); |
---|
| 610 | int homo = homog(Li[2]); //is 1 if id is homogeneous, 0 if not |
---|
| 611 | |
---|
| 612 | //---- set attributes for special cases where algorithm can be simplified ----- |
---|
| 613 | if( homo==1 ) |
---|
| 614 | { |
---|
| 615 | rw = ringweights(P); |
---|
| 616 | } |
---|
| 617 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
| 618 | { |
---|
| 619 | if(attrib(id,"isPrim")==1) { isPr=1; } |
---|
| 620 | } |
---|
| 621 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
| 622 | { |
---|
| 623 | if(attrib(id,"onlySingularAtZero")==1){oSAZ=1; } |
---|
| 624 | } |
---|
| 625 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
| 626 | { |
---|
| 627 | if(attrib(id,"isIsolatedSingularity")==1) { isIso=1; } |
---|
| 628 | } |
---|
| 629 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
| 630 | { |
---|
| 631 | if(attrib(id,"isCohenMacaulay")==1) { isCo=1; } |
---|
| 632 | } |
---|
| 633 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
| 634 | { |
---|
| 635 | if(attrib(id,"isRegInCodim2")==1) { isRe=1; } |
---|
| 636 | } |
---|
| 637 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
| 638 | { |
---|
| 639 | if(attrib(id,"isEquidimensional")==1) { isEq=1; } |
---|
| 640 | } |
---|
| 641 | //-------------------------- go to quotient ring ------------------------------ |
---|
| 642 | qring R = SBid; |
---|
| 643 | ideal id = fetch(P,id); |
---|
| 644 | ideal J = fetch(P,J); |
---|
| 645 | poly p = fetch(P,p); |
---|
| 646 | ideal f,rf,f2; |
---|
| 647 | module syzf; |
---|
| 648 | //---------- computation of p*Hom(J,J) as R-ideal ----------------------------- |
---|
| 649 | if ( y>=1 ) |
---|
| 650 | { |
---|
| 651 | "// compute p*Hom(J,J) = p*J:J"; |
---|
| 652 | "// the ideal J:";J; |
---|
| 653 | } |
---|
| 654 | f = quotient(p*J,J); |
---|
| 655 | |
---|
| 656 | //### (neu GMG 4.10.08) divide by the greatest common divisor: |
---|
| 657 | poly gg = gcd( f[1],p ); |
---|
| 658 | for(ii=2; ii <=ncols(f); ii++) |
---|
| 659 | { |
---|
| 660 | gg=gcd(gg,f[ii]); |
---|
| 661 | } |
---|
| 662 | for(ii=1; ii<=ncols(f); ii++) |
---|
| 663 | { |
---|
| 664 | f[ii]=f[ii]/gg; |
---|
| 665 | } |
---|
| 666 | p = p/gg; |
---|
| 667 | |
---|
| 668 | if ( y>=1 ) |
---|
| 669 | { |
---|
| 670 | "// the non-zerodivisor p:"; p; |
---|
| 671 | "// the module p*Hom(J,J) = p*J:J :"; f; |
---|
| 672 | ""; |
---|
| 673 | } |
---|
| 674 | f2 = std(p); |
---|
| 675 | |
---|
| 676 | //---------- Test: Hom(J,J) == R ?, if yes, go home --------------------------- |
---|
| 677 | |
---|
| 678 | //rf = interred(reduce(f,f2)); |
---|
| 679 | //### interred hier weggelassen, unten zugefuegt |
---|
| 680 | rf = reduce(f,f2); //represents p*Hom(J,J)/p*R = Hom(J,J)/R |
---|
| 681 | if ( size(rf) == 0 ) |
---|
| 682 | { |
---|
| 683 | if ( homog(f) && find(ordstr(basering),"s")==0 ) |
---|
| 684 | { |
---|
| 685 | ring newR1 = char(P),(X(1..nvars(P))),(a(rw),dp); |
---|
| 686 | } |
---|
| 687 | else |
---|
| 688 | { |
---|
| 689 | ring newR1 = char(P),(X(1..nvars(P))),dp; |
---|
| 690 | } |
---|
| 691 | ideal endphi = maxideal(1); |
---|
| 692 | ideal endid = fetch(P,id); |
---|
| 693 | endid = simplify(endid,2); |
---|
| 694 | L = substpart(endid,endphi,homo,rw); //## hier substpart |
---|
| 695 | def lastRing = L[1]; |
---|
| 696 | setring lastRing; |
---|
| 697 | |
---|
| 698 | attrib(endid,"onlySingularAtZero",oSAZ); |
---|
| 699 | attrib(endid,"isCohenMacaulay",isCo); |
---|
| 700 | attrib(endid,"isPrim",isPr); |
---|
| 701 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
| 702 | attrib(endid,"isRegInCodim2",isRe); |
---|
| 703 | attrib(endid,"isEqudimensional",isEq); |
---|
| 704 | attrib(endid,"isHypersurface",0); |
---|
| 705 | attrib(endid,"isCompleteIntersection",0); |
---|
| 706 | attrib(endid,"isRadical",0); |
---|
| 707 | L=lastRing; |
---|
| 708 | L = insert(L,1,1); |
---|
| 709 | dbprint(y,"// case R = Hom(J,J)"); |
---|
| 710 | if(y>=1) |
---|
| 711 | { |
---|
| 712 | "// R=Hom(J,J)"; |
---|
| 713 | lastRing; |
---|
| 714 | "// the new ideal"; |
---|
| 715 | endid; |
---|
| 716 | " "; |
---|
| 717 | "// the old ring"; |
---|
| 718 | P; |
---|
| 719 | "// the old ideal"; |
---|
| 720 | setring P; |
---|
| 721 | id; |
---|
| 722 | " "; |
---|
| 723 | setring lastRing; |
---|
| 724 | "// the map to the new ring"; |
---|
| 725 | endphi; |
---|
| 726 | " "; |
---|
| 727 | pause(); |
---|
| 728 | ""; |
---|
| 729 | } |
---|
| 730 | setring P; |
---|
| 731 | L[3]=0; |
---|
| 732 | return(L); |
---|
| 733 | } |
---|
| 734 | if(y>=1) |
---|
| 735 | { |
---|
| 736 | "// R is not equal to Hom(J,J), we have to try again"; |
---|
| 737 | pause(); |
---|
| 738 | ""; |
---|
| 739 | } |
---|
| 740 | //---------- Hom(J,J) != R: create new ring and map from old ring ------------- |
---|
| 741 | // the ring newR1/SBid+syzf will be isomorphic to Hom(J,J) as R-module |
---|
| 742 | // f2=p (i.e. ideal generated by p) |
---|
| 743 | |
---|
| 744 | //f = mstd(f)[2]; //### geaendert GMG 04.10.08 |
---|
| 745 | //ideal ann = quotient(f2,f); //### f durch rf ersetzt |
---|
| 746 | rf = mstd(rf)[2]; //rf = NF(f,p), hence <p,rf> = <p,f> |
---|
| 747 | ideal ann = quotient(f2,rf); //p:f = p:rf |
---|
| 748 | |
---|
| 749 | //------------- compute the contribution to delta ---------- |
---|
| 750 | //delt=dim_K(Hom(JJ)/R (or -1 if infinite) |
---|
| 751 | |
---|
| 752 | int delt=vdim(std(modulo(f,ideal(p)))); |
---|
| 753 | |
---|
| 754 | f = p,rf; // generates pJ:J mod(p), i.e. p*Hom(J,J)/p*R as R-module |
---|
| 755 | q = size(f); |
---|
| 756 | syzf = syz(f); |
---|
| 757 | |
---|
| 758 | if ( homo==1 ) |
---|
| 759 | { |
---|
| 760 | rw1 = rw,0; |
---|
| 761 | for ( ii=2; ii<=q; ii++ ) |
---|
| 762 | { |
---|
| 763 | rw = rw, deg(f[ii])-deg(f[1]); |
---|
| 764 | rw1 = rw1, deg(f[ii])-deg(f[1]); |
---|
| 765 | } |
---|
| 766 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),(a(rw1),dp); |
---|
| 767 | } |
---|
| 768 | else |
---|
| 769 | { |
---|
| 770 | ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),dp; |
---|
| 771 | } |
---|
| 772 | |
---|
| 773 | //map psi1 = P,maxideal(1); //### psi1 durch fetch ersetzt |
---|
| 774 | //ideal SBid = psi1(SBid); |
---|
| 775 | ideal SBid = fetch(P,SBid); |
---|
| 776 | attrib(SBid,"isSB",1); |
---|
| 777 | |
---|
| 778 | qring newR = std(SBid); |
---|
| 779 | |
---|
| 780 | //map psi = R,ideal(X(1..nvars(R))); //### psi durch fetch ersetzt |
---|
| 781 | //ideal id = psi(id); |
---|
| 782 | //ideal f = psi(f); |
---|
| 783 | //module syzf = psi(syzf); |
---|
| 784 | ideal id = fetch(R,id); |
---|
| 785 | ideal f = fetch(R,f); |
---|
| 786 | module syzf = fetch(R,syzf); |
---|
| 787 | ideal pf,Lin,Quad,Q; |
---|
| 788 | matrix T,A; |
---|
| 789 | list L1; |
---|
| 790 | |
---|
| 791 | //---------- computation of Hom(J,J) as affine ring --------------------------- |
---|
| 792 | // determine kernel of: R[T1,...,Tq] -> J:J >-> R[1/p]=R[t]/(t*p-1), |
---|
| 793 | // Ti -> fi/p -> t*fi (p=f1=f[1]), to get ring structure. This is of course |
---|
| 794 | // the same as the kernel of R[T1,...,Tq] -> pJ:J >-> R, Ti -> fi. |
---|
| 795 | // It is a fact, that the kernel is generated by the linear and the quadratic |
---|
| 796 | // relations |
---|
| 797 | // f=p,rf, rf=reduce(f,p), generates pJ:J mod(p), |
---|
| 798 | // i.e. p*Hom(J,J)/p*R as R-module |
---|
| 799 | |
---|
| 800 | pf = f[1]*f; |
---|
| 801 | T = matrix(ideal(T(1..q)),1,q); |
---|
| 802 | Lin = ideal(T*syzf); |
---|
| 803 | if(y>=1) |
---|
| 804 | { |
---|
| 805 | "// the ring structure of Hom(J,J) as R-algebra"; |
---|
| 806 | "// the linear relations:"; |
---|
| 807 | Lin; |
---|
| 808 | } |
---|
| 809 | |
---|
| 810 | poly ff; |
---|
| 811 | for (ii=2; ii<=q; ii++ ) |
---|
| 812 | { |
---|
| 813 | for ( jj=2; jj<=ii; jj++ ) |
---|
| 814 | { |
---|
| 815 | ff = NF(f[ii]*f[jj],std(0)); //this makes lift much faster |
---|
| 816 | A = lift(pf,ff); //ff lin. comb. of elts of pf mod I |
---|
| 817 | Quad = Quad, ideal(T(jj)*T(ii) - T*A); //quadratic relations |
---|
| 818 | } |
---|
| 819 | } |
---|
| 820 | |
---|
| 821 | if(y>=1) |
---|
| 822 | { |
---|
| 823 | "// the quadratic relations"; |
---|
| 824 | Quad; |
---|
| 825 | pause(); |
---|
| 826 | newline; |
---|
| 827 | } |
---|
| 828 | Q = Lin,Quad; |
---|
| 829 | Q = subst(Q,T(1),1); |
---|
| 830 | //Q = mstd(Q)[2]; //### sehr aufwendig, daher weggelassen (GMG) |
---|
| 831 | //### ev das neue interred |
---|
| 832 | //mstd dient nur zum verkleinern, die SB-Eigenschaft geht spaeter verloren |
---|
| 833 | //da in neuen Ring abgebildet und mit id vereinigt |
---|
| 834 | |
---|
| 835 | //---------- reduce number of variables by substitution, if possible ---------- |
---|
| 836 | if (homo==1) |
---|
| 837 | { |
---|
| 838 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),(a(rw),dp); |
---|
| 839 | } |
---|
| 840 | else |
---|
| 841 | { |
---|
| 842 | ring newRing = char(R),(X(1..nvars(R)),T(2..q)),dp; |
---|
| 843 | } |
---|
| 844 | |
---|
| 845 | ideal endid = imap(newR,id),imap(newR,Q); |
---|
| 846 | //hier wird Q weiterverwendet, die SB-Eigenschaft wird nicht verwendet. |
---|
| 847 | endid = simplify(endid,2); |
---|
| 848 | ideal endphi = ideal(X(1..nvars(R))); |
---|
| 849 | |
---|
| 850 | |
---|
| 851 | if(noRed == 0) |
---|
| 852 | { |
---|
| 853 | L = substpart(endid,endphi,homo,rw); |
---|
| 854 | def lastRing=L[1]; |
---|
| 855 | setring lastRing; |
---|
| 856 | //return(lastRing); |
---|
| 857 | } |
---|
| 858 | else |
---|
| 859 | { |
---|
| 860 | list RL = ringlist(newRing); |
---|
| 861 | def lastRing = ring(RL); |
---|
| 862 | setring lastRing; |
---|
| 863 | ideal endid = fetch(newRing, endid); |
---|
| 864 | ideal endphi = fetch(newRing, endphi); |
---|
| 865 | export(endid); |
---|
| 866 | export(endphi); |
---|
| 867 | //def lastRing = newRing; |
---|
| 868 | //setring R; |
---|
| 869 | //return(newR); |
---|
| 870 | } |
---|
| 871 | |
---|
| 872 | |
---|
| 873 | // L = substpart(endid,endphi,homo,rw); |
---|
| 874 | |
---|
| 875 | // def lastRing=L[1]; |
---|
| 876 | // setring lastRing; |
---|
| 877 | |
---|
| 878 | attrib(endid,"onlySingularAtZero",0); |
---|
| 879 | map sigma=R,endphi; |
---|
| 880 | ideal an=sigma(ann); |
---|
| 881 | export(an); //noetig? |
---|
| 882 | //ideal te=an,endid; |
---|
| 883 | //if(isIso && (size(reduce(te,std(maxideal(1))))==0)) //#### ok??? |
---|
| 884 | // { |
---|
| 885 | // attrib(endid,"onlySingularAtZero",oSAZ); |
---|
| 886 | // } |
---|
| 887 | //kill te; |
---|
| 888 | attrib(endid,"isCohenMacaulay",isCo); //#### ok??? |
---|
| 889 | attrib(endid,"isPrim",isPr); |
---|
| 890 | attrib(endid,"isIsolatedSingularity",isIso); |
---|
| 891 | attrib(endid,"isRegInCodim2",isRe); |
---|
| 892 | attrib(endid,"isEquidimensional",isEq); |
---|
| 893 | attrib(endid,"isHypersurface",0); |
---|
| 894 | attrib(endid,"isCompleteIntersection",0); |
---|
| 895 | attrib(endid,"isRadical",0); |
---|
| 896 | if(y>=1) |
---|
| 897 | { |
---|
| 898 | "// the new ring after reduction of the number of variables"; |
---|
| 899 | lastRing; |
---|
| 900 | "// the new ideal"; |
---|
| 901 | endid; ""; |
---|
| 902 | "// the old ring"; |
---|
| 903 | P; |
---|
| 904 | "// the old ideal"; |
---|
| 905 | setring P; |
---|
| 906 | id; |
---|
| 907 | " "; |
---|
| 908 | setring lastRing; |
---|
| 909 | "// the map to the new ring"; |
---|
| 910 | endphi; |
---|
| 911 | " "; |
---|
| 912 | pause(); |
---|
| 913 | ""; |
---|
| 914 | } |
---|
| 915 | L = lastRing; |
---|
| 916 | L = insert(L,0,1); |
---|
| 917 | L[3] = delt; |
---|
| 918 | return(L); |
---|
| 919 | } |
---|
| 920 | example |
---|
| 921 | {"EXAMPLE:"; echo = 2; |
---|
| 922 | ring r = 0,(x,y),wp(2,3); |
---|
| 923 | ideal id = y^2-x^3; |
---|
| 924 | ideal J = x,y; |
---|
| 925 | poly p = x; |
---|
| 926 | list Li = std(id),id,J,p; |
---|
| 927 | list L = HomJJ(Li); |
---|
| 928 | def end = L[1]; // defines ring L[1], containing ideals endid, endphi |
---|
| 929 | setring end; // makes end the basering |
---|
| 930 | end; |
---|
| 931 | endid; // end/endid is isomorphic to End(r/id) as ring |
---|
| 932 | map psi = r,endphi;// defines the canonical map r/id -> End(r/id) |
---|
| 933 | psi; |
---|
| 934 | L[3]; // contribution to delta |
---|
| 935 | } |
---|
| 936 | |
---|
| 937 | |
---|
| 938 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 939 | //compute intersection multiplicities as needed for delta(I) in |
---|
| 940 | //normalizationPrimes and normalP: |
---|
| 941 | |
---|
| 942 | proc iMult (list prim) |
---|
| 943 | "USAGE: iMult(L); L a list of ideals |
---|
| 944 | RETURN: int, the intersection multiplicity of the ideals of L; |
---|
| 945 | if iMult(L) is infinite, -1 is returned. |
---|
| 946 | THEORY: If r=size(L)=2 then iMult(L) = vdim(std(L[1]+L[2])) and in general |
---|
| 947 | iMult(L) = sum{ iMult(L[j],Lj) | j=1..r-1 } with Lj the intersection |
---|
| 948 | of L[j+1],...,L[r]. If I is the intersection of all ideals in L then |
---|
| 949 | we have delta(I) = delta(L[1])+...+delta(L[r]) + iMult(L) where |
---|
| 950 | delta(I) = vdim (normalisation(R/I)/(R/I)), R the basering. |
---|
| 951 | EXAMPLE: example iMult; shows an example |
---|
| 952 | " |
---|
| 953 | { int i,mul,mu; |
---|
| 954 | int sp = size(prim); |
---|
| 955 | int y = printlevel-voice+2; |
---|
| 956 | if ( sp > 1 ) |
---|
| 957 | { |
---|
| 958 | ideal I(sp-1) = prim[sp]; |
---|
| 959 | mu = vdim(std(I(sp-1)+prim[sp-1])); |
---|
| 960 | mul = mu; |
---|
| 961 | if ( y>=1 ) |
---|
| 962 | { |
---|
| 963 | "// intersection multiplicity of component",sp,"with",sp-1,":"; mu; |
---|
| 964 | } |
---|
| 965 | if ( mu >= 0 ) |
---|
| 966 | { |
---|
| 967 | for (i=sp-2; i>=1 ; i--) |
---|
| 968 | { |
---|
| 969 | ideal I(i) = intersect(I(i+1),prim[i+1]); |
---|
| 970 | mu = vdim(std(I(i)+prim[i])); |
---|
| 971 | if ( mu < 0 ) |
---|
| 972 | { |
---|
| 973 | break; |
---|
| 974 | } |
---|
| 975 | mul = mul + mu; |
---|
| 976 | if ( y>=1 ) |
---|
| 977 | { |
---|
| 978 | "// intersection multiplicity of components",sp,"...",i+1,"with",i; mu; |
---|
| 979 | } |
---|
| 980 | } |
---|
| 981 | } |
---|
| 982 | } |
---|
| 983 | return(mul); |
---|
| 984 | } |
---|
| 985 | example |
---|
| 986 | { "EXAMPLE:"; echo = 2; |
---|
| 987 | ring s = 23,(x,y),dp; |
---|
| 988 | list L = (x-y),(x3+y2); |
---|
| 989 | iMult(L); |
---|
| 990 | L = (x-y),(x3+y2),(x3-y4); |
---|
| 991 | iMult(L); |
---|
| 992 | } |
---|
| 993 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 994 | //check if I has a singularity only at zero, as needed in normalizationPrimes |
---|
| 995 | |
---|
| 996 | proc locAtZero (ideal I) |
---|
| 997 | "USAGE: locAtZero(I); I = ideal |
---|
| 998 | RETURN: int, 1 if I has only one point which is located at zero, 0 otherwise |
---|
| 999 | ASSUME: I is given as a standard bases in the basering |
---|
| 1000 | NOTE: only useful in affine rings, in local rings vdim does the check |
---|
| 1001 | EXAMPLE: example locAtZero; shows an example |
---|
| 1002 | " |
---|
| 1003 | { |
---|
| 1004 | int ii,jj, caz; //caz: conzentrated at zero |
---|
| 1005 | int dbp = printlevel-voice+2; |
---|
| 1006 | int nva = nvars(basering); |
---|
| 1007 | int vdi = vdim(I); |
---|
| 1008 | if ( vdi < 0 ) |
---|
| 1009 | { |
---|
| 1010 | if (dbp >=1) |
---|
| 1011 | { "// non-isolated singularitiy";""; } |
---|
| 1012 | return(caz); |
---|
| 1013 | } |
---|
| 1014 | |
---|
| 1015 | //Now the ideal is 0-dim |
---|
| 1016 | //First an easy test |
---|
| 1017 | //If I is homogenous and not constant it is concentrated at 0 |
---|
| 1018 | if( homog(I)==1 && size(jet(I,0))==0) |
---|
| 1019 | { |
---|
| 1020 | caz=1; |
---|
| 1021 | if (dbp >=1) |
---|
| 1022 | { "// isolated singularity and homogeneous";""; } |
---|
| 1023 | return(caz); |
---|
| 1024 | } |
---|
| 1025 | |
---|
| 1026 | //Now the general case with I 0-dim. Choose an appropriate power pot, |
---|
| 1027 | //and check each variable x whether x^pot is in I. |
---|
| 1028 | int mi1 = mindeg1(lead(I)); |
---|
| 1029 | int pot = vdi; |
---|
| 1030 | if ( (mi1+(mi1==1))^2 < vdi ) |
---|
| 1031 | { |
---|
| 1032 | pot = (mi1+(mi1==1))^2; //### alternativ: pot = vdi lassen |
---|
| 1033 | } |
---|
| 1034 | |
---|
| 1035 | while ( 1 ) |
---|
| 1036 | { |
---|
| 1037 | caz = 1; |
---|
| 1038 | for ( ii=1; ii<= nva; ii++ ) |
---|
| 1039 | { |
---|
| 1040 | if ( NF(var(ii)^pot,I) != 0 ) |
---|
| 1041 | { |
---|
| 1042 | caz = 0; break; |
---|
| 1043 | } |
---|
| 1044 | } |
---|
| 1045 | if ( caz == 1 || pot >= vdi ) |
---|
| 1046 | { |
---|
| 1047 | if (dbp >=1) |
---|
| 1048 | { |
---|
| 1049 | "// mindeg, exponent, vdim used in 'locAtZero':", mi1,pot,vdi; ""; |
---|
| 1050 | } |
---|
| 1051 | return(caz); |
---|
| 1052 | } |
---|
| 1053 | else |
---|
| 1054 | { |
---|
| 1055 | if ( pot^2 < vdi ) |
---|
| 1056 | { pot = pot^2; } |
---|
| 1057 | else |
---|
| 1058 | { pot = vdi; } |
---|
| 1059 | } |
---|
| 1060 | } |
---|
| 1061 | } |
---|
| 1062 | example |
---|
| 1063 | { "EXAMPLE:"; echo = 2; |
---|
| 1064 | ring r = 0,(x,y,z),dp; |
---|
| 1065 | poly f = z5+y4+x3+xyz; |
---|
| 1066 | ideal i = jacob(f),f; |
---|
| 1067 | i=std(i); |
---|
| 1068 | locAtZero(i); |
---|
| 1069 | i= std(i*ideal(x-1,y,z)); |
---|
| 1070 | locAtZero(i); |
---|
| 1071 | } |
---|
| 1072 | |
---|
| 1073 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1074 | |
---|
| 1075 | //The next procedure normalizationPrimes computes the normalization of an |
---|
| 1076 | //irreducible or an equidimensional ideal i. |
---|
| 1077 | //- If i is irreducuble, then the returned list, say nor, has size 2 |
---|
| 1078 | //with nor[1] the normalization ring and nor[2] the delta invariant. |
---|
| 1079 | //- If i is equidimensional, than the "splitting tools" can create a |
---|
| 1080 | //decomposition of i and nor can have more than 1 ring. |
---|
| 1081 | |
---|
| 1082 | static proc normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #) |
---|
| 1083 | "USAGE: normalizationPrimes(i,ihp,delt[,si]); i = equidimensional ideal, |
---|
| 1084 | ihp = map (partial normalization), delt = partial delta-invariant, |
---|
| 1085 | si = ideal s.t. V(si) contains singular locus (optional) |
---|
| 1086 | RETURN: a list of rings, say nor, and an integer, the delta-invariant |
---|
| 1087 | at the end of the list. |
---|
| 1088 | each ring nor[j], j = 1..size(nor)-1, contains two ideals |
---|
| 1089 | with given names norid and normap such that |
---|
| 1090 | - the direct sum of the rings nor[j]/norid is |
---|
| 1091 | the normalization of basering/i; |
---|
| 1092 | - normap gives the normalization map from basering/id |
---|
| 1093 | to nor[j]/norid (for each j) |
---|
| 1094 | nor[size(nor)] = dim_K(normalisation(P/i) / (P/i)) is the |
---|
| 1095 | delta-invariant, where P is the basering. |
---|
| 1096 | EXAMPLE: example normalizationPrimes; shows an example |
---|
| 1097 | " |
---|
| 1098 | { |
---|
| 1099 | //Note: this procedure calls itself as long as the test for |
---|
| 1100 | //normality, i.e if R==Hom(J,J), is negative. |
---|
| 1101 | |
---|
| 1102 | int printlev = printlevel; //store printlevel in order to reset it later |
---|
| 1103 | int y = printlevel-voice+2; // y=printlevel (default: y=0) |
---|
| 1104 | if(y>=1) |
---|
| 1105 | { |
---|
| 1106 | ""; |
---|
| 1107 | "// START a normalization loop with the ideal"; |
---|
| 1108 | i; ""; |
---|
| 1109 | "// in the ring:"; |
---|
| 1110 | basering; ""; |
---|
| 1111 | pause(); |
---|
| 1112 | ""; |
---|
| 1113 | } |
---|
| 1114 | |
---|
| 1115 | def BAS=basering; |
---|
| 1116 | list result,keepresult1,keepresult2,JM,gnirlist; |
---|
| 1117 | ideal J,SB,MB; |
---|
| 1118 | int depth,lauf,prdim,osaz; |
---|
| 1119 | int ti=timer; |
---|
| 1120 | |
---|
| 1121 | gnirlist = ringlist(BAS); |
---|
| 1122 | |
---|
| 1123 | //----------- the trivial case of a zero ideal as input, RETURN ------------ |
---|
| 1124 | if(size(i)==0) |
---|
| 1125 | { |
---|
| 1126 | if(y>=1) |
---|
| 1127 | { |
---|
| 1128 | "// the ideal was the zero-ideal"; |
---|
| 1129 | } |
---|
| 1130 | // execute("ring newR7="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
| 1131 | // +ordstr(basering)+");"); |
---|
| 1132 | def newR7 = ring(gnirlist); |
---|
| 1133 | setring newR7; |
---|
| 1134 | ideal norid=ideal(0); |
---|
| 1135 | ideal normap=fetch(BAS,ihp); |
---|
| 1136 | export norid; |
---|
| 1137 | export normap; |
---|
| 1138 | result=newR7; |
---|
| 1139 | result[size(result)+1]=list(delt,delti); |
---|
| 1140 | setring BAS; |
---|
| 1141 | return(result); |
---|
| 1142 | } |
---|
| 1143 | |
---|
| 1144 | //--------------- General NOTATION, compute SB of input ----------------- |
---|
| 1145 | // SM is a list, the result of mstd(i) |
---|
| 1146 | // SM[1] = SB of input ideal i, |
---|
| 1147 | // SM[2] = (minimal) generators for i. |
---|
| 1148 | // We work with SM and will copy the attributes from i to SM[2] |
---|
| 1149 | // JM will be a list, either JM[1]=maxideal(1),JM[2]=maxideal(1) |
---|
| 1150 | // in case i has onlySingularAtZero, or JM = mstd(si) where si = #[1], |
---|
| 1151 | // or JM = mstd(J) where J is the ideal of the singular locus |
---|
| 1152 | // JM[2] must be (made) radical |
---|
| 1153 | |
---|
| 1154 | if(y>=1) |
---|
| 1155 | { |
---|
| 1156 | "// SB-computation of the ideal"; |
---|
| 1157 | } |
---|
| 1158 | |
---|
| 1159 | list SM = mstd(i); //Now the work starts |
---|
| 1160 | int dimSM = dim(SM[1]); //dimension of variety to normalize |
---|
| 1161 | if(y>=1) |
---|
| 1162 | { |
---|
| 1163 | "// the dimension is:"; dimSM; |
---|
| 1164 | } |
---|
| 1165 | //----------------- the general case, set attributes ---------------- |
---|
| 1166 | //Note: onlySingularAtZero is NOT preserved under the ring extension |
---|
| 1167 | //basering --> Hom(J,J) (in contrast to isIsolatedSingularity), |
---|
| 1168 | //therefore we reset it: |
---|
| 1169 | |
---|
| 1170 | attrib(i,"onlySingularAtZero",0); |
---|
| 1171 | |
---|
| 1172 | if(attrib(i,"isPrim")==1) |
---|
| 1173 | { |
---|
| 1174 | attrib(SM[2],"isPrim",1); |
---|
| 1175 | } |
---|
| 1176 | else |
---|
| 1177 | { |
---|
| 1178 | attrib(SM[2],"isPrim",0); |
---|
| 1179 | } |
---|
| 1180 | if(attrib(i,"isIsolatedSingularity")==1) |
---|
| 1181 | { |
---|
| 1182 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
| 1183 | } |
---|
| 1184 | else |
---|
| 1185 | { |
---|
| 1186 | attrib(SM[2],"isIsolatedSingularity",0); |
---|
| 1187 | } |
---|
| 1188 | if(attrib(i,"isCohenMacaulay")==1) |
---|
| 1189 | { |
---|
| 1190 | attrib(SM[2],"isCohenMacaulay",1); |
---|
| 1191 | } |
---|
| 1192 | else |
---|
| 1193 | { |
---|
| 1194 | attrib(SM[2],"isCohenMacaulay",0); |
---|
| 1195 | } |
---|
| 1196 | if(attrib(i,"isRegInCodim2")==1) |
---|
| 1197 | { |
---|
| 1198 | attrib(SM[2],"isRegInCodim2",1); |
---|
| 1199 | } |
---|
| 1200 | else |
---|
| 1201 | { |
---|
| 1202 | attrib(SM[2],"isRegInCodim2",0); |
---|
| 1203 | } |
---|
| 1204 | if(attrib(i,"isEquidimensional")==1) |
---|
| 1205 | { |
---|
| 1206 | attrib(SM[2],"isEquidimensional",1); |
---|
| 1207 | } |
---|
| 1208 | else |
---|
| 1209 | { |
---|
| 1210 | attrib(SM[2],"isEquidimensional",0); |
---|
| 1211 | } |
---|
| 1212 | if(attrib(i,"isCompleteIntersection")==1) |
---|
| 1213 | { |
---|
| 1214 | attrib(SM[2],"isCompleteIntersection",1); |
---|
| 1215 | } |
---|
| 1216 | else |
---|
| 1217 | { |
---|
| 1218 | attrib(SM[2],"isCompleteIntersection",0); |
---|
| 1219 | } |
---|
| 1220 | if(attrib(i,"isHypersurface")==1) |
---|
| 1221 | { |
---|
| 1222 | attrib(SM[2],"isHypersurface",1); |
---|
| 1223 | } |
---|
| 1224 | else |
---|
| 1225 | { |
---|
| 1226 | attrib(SM[2],"isHypersurface",0); |
---|
| 1227 | } |
---|
| 1228 | |
---|
| 1229 | if(attrib(i,"onlySingularAtZero")==1) |
---|
| 1230 | { |
---|
| 1231 | attrib(SM[2],"onlySingularAtZero",1); |
---|
| 1232 | } |
---|
| 1233 | else |
---|
| 1234 | { |
---|
| 1235 | attrib(SM[2],"onlySingularAtZero",0); |
---|
| 1236 | } |
---|
| 1237 | |
---|
| 1238 | //------- an easy and cheap test for onlySingularAtZero --------- |
---|
| 1239 | if( (attrib(SM[2],"isIsolatedSingularity")==1) && (homog(SM[2])==1) ) |
---|
| 1240 | { |
---|
| 1241 | attrib(SM[2],"onlySingularAtZero",1); |
---|
| 1242 | } |
---|
| 1243 | |
---|
| 1244 | //-------------------- Trivial cases, in each case RETURN ------------------ |
---|
| 1245 | // input ideal is the ideal of a partial normalization |
---|
| 1246 | |
---|
| 1247 | // ------------ Trivial case: input ideal contains a unit --------------- |
---|
| 1248 | if( dimSM == -1) |
---|
| 1249 | { ""; |
---|
| 1250 | " // A unit ideal was found."; |
---|
| 1251 | " // Stop with partial result computed so far";""; |
---|
| 1252 | |
---|
| 1253 | MB=SM[2]; |
---|
| 1254 | intvec rw; |
---|
| 1255 | list LL=substpart(MB,ihp,0,rw); |
---|
| 1256 | def newR6=LL[1]; |
---|
| 1257 | setring newR6; |
---|
| 1258 | ideal norid=endid; |
---|
| 1259 | ideal normap=endphi; |
---|
| 1260 | kill endid,endphi; |
---|
| 1261 | export norid; |
---|
| 1262 | export normap; |
---|
| 1263 | result=newR6; |
---|
| 1264 | result[size(result)+1]=list(delt,delti); |
---|
| 1265 | setring BAS; |
---|
| 1266 | return(result); |
---|
| 1267 | } |
---|
| 1268 | |
---|
| 1269 | // --- Trivial case: input ideal is zero-dimensional and homog --- |
---|
| 1270 | if( (dim(SM[1])==0) && (homog(SM[2])==1) ) |
---|
| 1271 | { |
---|
| 1272 | if(y>=1) |
---|
| 1273 | { |
---|
| 1274 | "// the ideal was zero-dimensional and homogeneous"; |
---|
| 1275 | } |
---|
| 1276 | MB=maxideal(1); |
---|
| 1277 | intvec rw; |
---|
| 1278 | list LL=substpart(MB,ihp,0,rw); |
---|
| 1279 | def newR5=LL[1]; |
---|
| 1280 | setring newR5; |
---|
| 1281 | ideal norid=endid; |
---|
| 1282 | ideal normap=endphi; |
---|
| 1283 | kill endid,endphi; |
---|
| 1284 | export norid; |
---|
| 1285 | export normap; |
---|
| 1286 | result=newR5; |
---|
| 1287 | result[size(result)+1]=list(delt,delti); |
---|
| 1288 | setring BAS; |
---|
| 1289 | return(result); |
---|
| 1290 | } |
---|
| 1291 | |
---|
| 1292 | // --- Trivial case: input ideal defines a line --- |
---|
| 1293 | //the one-dimensional, homogeneous case and degree 1 case |
---|
| 1294 | if( (dim(SM[1])==1) && (maxdeg1(SM[2])==1) && (homog(SM[2])==1) ) |
---|
| 1295 | { |
---|
| 1296 | if(y>=1) |
---|
| 1297 | { |
---|
| 1298 | "// the ideal defines a line"; |
---|
| 1299 | } |
---|
| 1300 | MB=SM[2]; |
---|
| 1301 | intvec rw; |
---|
| 1302 | list LL=substpart(MB,ihp,0,rw); |
---|
| 1303 | def newR4=LL[1]; |
---|
| 1304 | setring newR4; |
---|
| 1305 | ideal norid=endid; |
---|
| 1306 | ideal normap=endphi; |
---|
| 1307 | kill endid,endphi; |
---|
| 1308 | export norid; |
---|
| 1309 | export normap; |
---|
| 1310 | result=newR4; |
---|
| 1311 | result[size(result)+1]=list(delt,delti); |
---|
| 1312 | setring BAS; |
---|
| 1313 | return(result); |
---|
| 1314 | } |
---|
| 1315 | |
---|
| 1316 | //---------------------- The non-trivial cases start ------------------- |
---|
| 1317 | //the higher dimensional case |
---|
| 1318 | //we test first hypersurface, CohenMacaulay and complete intersection |
---|
| 1319 | |
---|
| 1320 | if( ((size(SM[2])+dim(SM[1])) == nvars(basering)) ) |
---|
| 1321 | { |
---|
| 1322 | //the test for complete intersection |
---|
| 1323 | attrib(SM[2],"isCohenMacaulay",1); |
---|
| 1324 | attrib(SM[2],"isCompleteIntersection",1); |
---|
| 1325 | attrib(SM[2],"isEquidimensional",1); |
---|
| 1326 | if(y>=1) |
---|
| 1327 | { |
---|
| 1328 | "// the ideal is a complete intersection"; |
---|
| 1329 | } |
---|
| 1330 | } |
---|
| 1331 | if( size(SM[2]) == 1 ) |
---|
| 1332 | { |
---|
| 1333 | attrib(SM[2],"isHypersurface",1); |
---|
| 1334 | if(y>=1) |
---|
| 1335 | { |
---|
| 1336 | "// the ideal is a hypersurface"; |
---|
| 1337 | } |
---|
| 1338 | } |
---|
| 1339 | |
---|
| 1340 | //------------------- compute the singular locus ------------------- |
---|
| 1341 | // Computation if singular locus is critical |
---|
| 1342 | // Notation: J ideal of singular locus or (if given) containing it |
---|
| 1343 | // JM = mstd(J) or maxideal(1),maxideal(1) |
---|
| 1344 | // JM[1] SB of singular locus, JM[2] minbasis, dimJ = dim(JM[1]) |
---|
| 1345 | // SM[1] SB of the input ideal i, SM[2] minbasis |
---|
| 1346 | // Computation if singular locus is critical, because it determines the |
---|
| 1347 | // size of the ring Hom_R(J,J). We only need a test ideal contained in J. |
---|
| 1348 | |
---|
| 1349 | //----------------------- onlySingularAtZero ------------------------- |
---|
| 1350 | if( attrib(SM[2],"onlySingularAtZero") ) |
---|
| 1351 | { |
---|
| 1352 | JM = maxideal(1),maxideal(1); |
---|
| 1353 | attrib(JM[1],"isSB",1); |
---|
| 1354 | attrib(JM[2],"isRadical",1); |
---|
| 1355 | if( dim(SM[1]) >=2 ) |
---|
| 1356 | { |
---|
| 1357 | attrib(SM[2],"isRegInCodim2",1); |
---|
| 1358 | } |
---|
| 1359 | } |
---|
| 1360 | |
---|
| 1361 | //-------------------- not onlySingularAtZero ------------------------- |
---|
| 1362 | if( attrib(SM[2],"onlySingularAtZero") == 0 ) |
---|
| 1363 | { |
---|
| 1364 | //--- the case where an ideal #[1] is given: |
---|
| 1365 | if( size(#)>0 ) |
---|
| 1366 | { |
---|
| 1367 | J = #[1],SM[2]; |
---|
| 1368 | JM = mstd(J); |
---|
| 1369 | if( typeof(attrib(#[1],"isRadical"))!="int" ) |
---|
| 1370 | { |
---|
| 1371 | attrib(JM[2],"isRadical",0); |
---|
| 1372 | } |
---|
| 1373 | } |
---|
| 1374 | |
---|
| 1375 | //--- the case where an ideal #[1] is not given: |
---|
| 1376 | if( (size(#)==0) ) |
---|
| 1377 | { |
---|
| 1378 | if(y >=1 ) |
---|
| 1379 | { |
---|
| 1380 | "// singular locus will be computed"; |
---|
| 1381 | } |
---|
| 1382 | |
---|
| 1383 | J = SM[1],minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]); |
---|
| 1384 | if( y >=1 ) |
---|
| 1385 | { |
---|
| 1386 | "// SB of singular locus will be computed"; |
---|
| 1387 | } |
---|
| 1388 | JM = mstd(J); |
---|
| 1389 | } |
---|
| 1390 | |
---|
| 1391 | int dimJ = dim(JM[1]); |
---|
| 1392 | attrib(JM[1],"isSB",1); |
---|
| 1393 | if( y>=1 ) |
---|
| 1394 | { |
---|
| 1395 | "// the dimension of the singular locus is"; dimJ ; ""; |
---|
| 1396 | } |
---|
| 1397 | |
---|
| 1398 | if(dim(JM[1]) <= dim(SM[1])-2) |
---|
| 1399 | { |
---|
| 1400 | attrib(SM[2],"isRegInCodim2",1); |
---|
| 1401 | } |
---|
| 1402 | |
---|
| 1403 | //------------------ the smooth case, RETURN ------------------- |
---|
| 1404 | if( dimJ == -1 ) |
---|
| 1405 | { |
---|
| 1406 | if(y>=1) |
---|
| 1407 | { |
---|
| 1408 | "// the ideal is smooth"; |
---|
| 1409 | } |
---|
| 1410 | MB=SM[2]; |
---|
| 1411 | intvec rw; |
---|
| 1412 | list LL=substpart(MB,ihp,0,rw); |
---|
| 1413 | def newR3=LL[1]; |
---|
| 1414 | setring newR3; |
---|
| 1415 | ideal norid=endid; |
---|
| 1416 | ideal normap=endphi; |
---|
| 1417 | kill endid,endphi; |
---|
| 1418 | export norid; |
---|
| 1419 | export normap; |
---|
| 1420 | result=newR3; |
---|
| 1421 | result[size(result)+1]=list(delt,delti); |
---|
| 1422 | setring BAS; |
---|
| 1423 | return(result); |
---|
| 1424 | } |
---|
| 1425 | |
---|
| 1426 | //------- extra check for onlySingularAtZero, relatively cheap ---------- |
---|
| 1427 | //it uses the procedure 'locAtZero' from for testing |
---|
| 1428 | //if an ideal is concentrated at 0 |
---|
| 1429 | if(y>=1) |
---|
| 1430 | { |
---|
| 1431 | "// extra test for onlySingularAtZero:"; |
---|
| 1432 | } |
---|
[152996] | 1433 | if ( locAtZero(JM[1]) ) |
---|
| 1434 | { |
---|
| 1435 | attrib(SM[2],"onlySingularAtZero",1); |
---|
| 1436 | JM = maxideal(1),maxideal(1); |
---|
| 1437 | attrib(JM[1],"isSB",1); |
---|
| 1438 | attrib(JM[2],"isRadical",1); |
---|
| 1439 | } |
---|
| 1440 | else |
---|
| 1441 | { |
---|
| 1442 | attrib(SM[2],"onlySingularAtZero",0); |
---|
| 1443 | } |
---|
[1598658] | 1444 | } |
---|
| 1445 | |
---|
| 1446 | //displaying the attributes: |
---|
| 1447 | if(y>=2) |
---|
| 1448 | { |
---|
| 1449 | "// the attributes of the ideal are:"; |
---|
| 1450 | "// isCohenMacaulay:", attrib(SM[2],"isCohenMacaulay"); |
---|
| 1451 | "// isCompleteIntersection:", attrib(SM[2],"isCompleteIntersection"); |
---|
| 1452 | "// isHypersurface:", attrib(SM[2],"isHypersurface"); |
---|
| 1453 | "// isEquidimensional:", attrib(SM[2],"isEquidimensional"); |
---|
| 1454 | "// isPrim:", attrib(SM[2],"isPrim"); |
---|
| 1455 | "// isRegInCodim2:", attrib(SM[2],"isRegInCodim2"); |
---|
| 1456 | "// isIsolatedSingularity:", attrib(SM[2],"isIsolatedSingularity"); |
---|
| 1457 | "// onlySingularAtZero:", attrib(SM[2],"onlySingularAtZero"); |
---|
| 1458 | "// isRad:", attrib(SM[2],"isRad");""; |
---|
| 1459 | } |
---|
| 1460 | |
---|
| 1461 | //------------- case: CohenMacaulay in codim 2, RETURN --------------- |
---|
| 1462 | if( (attrib(SM[2],"isRegInCodim2")==1) && |
---|
| 1463 | (attrib(SM[2],"isCohenMacaulay")==1) ) |
---|
| 1464 | { |
---|
| 1465 | if(y>=1) |
---|
| 1466 | { |
---|
| 1467 | "// the ideal was CohenMacaulay and regular in codim 2, hence normal"; |
---|
| 1468 | } |
---|
| 1469 | MB=SM[2]; |
---|
| 1470 | intvec rw; |
---|
| 1471 | list LL=substpart(MB,ihp,0,rw); |
---|
| 1472 | def newR6=LL[1]; |
---|
| 1473 | setring newR6; |
---|
| 1474 | ideal norid=endid; |
---|
| 1475 | ideal normap=endphi; |
---|
| 1476 | kill endid,endphi; |
---|
| 1477 | export norid; |
---|
| 1478 | export normap; |
---|
| 1479 | result=newR6; |
---|
| 1480 | result[size(result)+1]=list(delt,delti); |
---|
| 1481 | setring BAS; |
---|
| 1482 | return(result); |
---|
| 1483 | } |
---|
| 1484 | |
---|
| 1485 | //---------- case: isolated singularity only at 0, RETURN ------------ |
---|
| 1486 | // In this case things are easier, we can use the maximal ideal as radical |
---|
| 1487 | // of the singular locus; |
---|
| 1488 | // JM mstd of ideal of singular locus, SM mstd of input ideal |
---|
| 1489 | |
---|
| 1490 | if( attrib(SM[2],"onlySingularAtZero") ) |
---|
| 1491 | { |
---|
| 1492 | //------ check variables for being a non zero-divizor ------ |
---|
| 1493 | // SL = ideal of vars not contained in ideal SM[1]: |
---|
| 1494 | |
---|
| 1495 | attrib(SM[2],"isIsolatedSingularity",1); |
---|
| 1496 | ideal SL = simplify(reduce(maxideal(1),SM[1]),2); |
---|
| 1497 | ideal Ann = quotient(SM[2],SL[1]); |
---|
| 1498 | ideal qAnn = simplify(reduce(Ann,SM[1]),2); |
---|
| 1499 | //NOTE: qAnn=0 if and only if first var (=SL[1]) not in SM is a nzd of R/SM |
---|
| 1500 | |
---|
| 1501 | //------------- We found a non-zerodivisor of R/SM ----------------------- |
---|
| 1502 | // here the enlarging of the ring via Hom_R(J,J) starts |
---|
| 1503 | |
---|
| 1504 | if( size(qAnn)==0 ) |
---|
| 1505 | { |
---|
| 1506 | if(y>=1) |
---|
| 1507 | { |
---|
| 1508 | ""; |
---|
| 1509 | "// the ideal rad(J):"; maxideal(1); |
---|
| 1510 | ""; |
---|
| 1511 | } |
---|
| 1512 | |
---|
| 1513 | // ------------- test for normality, compute Hom_R(J,J) ------------- |
---|
| 1514 | // Note: |
---|
| 1515 | // HomJJ (ideal SBid, ideal id, ideal J, poly p) with |
---|
| 1516 | // SBid = SB of id, J = radical ideal of basering P with: |
---|
| 1517 | // nonNormal(R) is in V(J), J contains the nonzero divisor p |
---|
| 1518 | // of R = P/id (J = test ideal) |
---|
| 1519 | // returns a list l of three objects |
---|
| 1520 | // l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi' |
---|
| 1521 | // s.t. l[1]/endid = Hom_R(J,J) and endphi= map R -> Hom_R(J,J) |
---|
| 1522 | // l[2] : an integer which is 1 if phi is an isomorphism, 0 if not |
---|
| 1523 | // l[3] : an integer, = dim_K(Hom_R(J,J)/R) if finite, -1 otherwise |
---|
| 1524 | |
---|
| 1525 | list RR; |
---|
| 1526 | RR = SM[1],SM[2],maxideal(1),SL[1]; |
---|
| 1527 | RR = HomJJ(RR,y); |
---|
| 1528 | // --------------------- non-normal case ------------------ |
---|
| 1529 | //RR[2]==0 means that the test for normality is negative |
---|
| 1530 | if( RR[2]==0 ) |
---|
| 1531 | { |
---|
| 1532 | def newR=RR[1]; |
---|
| 1533 | setring newR; |
---|
| 1534 | map psi=BAS,endphi; |
---|
| 1535 | list JM = psi(JM); //### |
---|
| 1536 | ideal J = JM[2]; |
---|
| 1537 | if ( delt>=0 && RR[3]>=0 ) |
---|
| 1538 | { |
---|
| 1539 | delt = delt+RR[3]; |
---|
| 1540 | } |
---|
| 1541 | else |
---|
| 1542 | { delt = -1; } |
---|
| 1543 | delti[size(delti)]=delt; |
---|
| 1544 | |
---|
| 1545 | // ---------- recursive call of normalizationPrimes ----------- |
---|
| 1546 | //normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #) |
---|
| 1547 | //ihp = (partial) normalisation map from basering |
---|
| 1548 | //#[1] ideal s.t. V(#[1]) contains singular locus of i (test ideal) |
---|
| 1549 | |
---|
| 1550 | if ( y>=1 ) |
---|
| 1551 | { |
---|
| 1552 | "// case: onlySingularAtZero, non-zerodivisor found"; |
---|
| 1553 | "// contribution of delta in ringextension R -> Hom_R(J,J):"; delt; |
---|
| 1554 | } |
---|
| 1555 | |
---|
| 1556 | //intvec atr=getAttrib(endid); |
---|
| 1557 | //"//### case: isolated singularity only at 0, recursive"; |
---|
| 1558 | //"size endid:", size(endid), size(string(endid)); |
---|
| 1559 | //"interred:"; |
---|
| 1560 | //endid = interred(endid); |
---|
| 1561 | //endid = setAttrib(endid,atr); |
---|
| 1562 | //"size endid:", size(endid), size(string(endid)); |
---|
| 1563 | |
---|
| 1564 | printlevel=printlevel+1; |
---|
| 1565 | list tluser = |
---|
| 1566 | normalizationPrimes(endid,psi(ihp),delt,delti); |
---|
| 1567 | //list tluser = |
---|
| 1568 | // normalizationPrimes(endid,psi(ihp),delt,delti,J); |
---|
| 1569 | //#### ??? improvement: give also the old ideal of sing locus??? |
---|
| 1570 | |
---|
| 1571 | printlevel = printlev; //reset printlevel |
---|
| 1572 | setring BAS; |
---|
| 1573 | return(tluser); |
---|
| 1574 | } |
---|
| 1575 | |
---|
| 1576 | // ------------------ the normal case, RETURN ----------------- |
---|
| 1577 | // Now RR[2] must be 1, hence the test for normality was positive |
---|
| 1578 | MB=SM[2]; |
---|
| 1579 | //execute("ring newR7="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
| 1580 | // +ordstr(basering)+");"); |
---|
| 1581 | def newR7 = ring(gnirlist); |
---|
| 1582 | setring newR7; |
---|
| 1583 | ideal norid=fetch(BAS,MB); |
---|
| 1584 | ideal normap=fetch(BAS,ihp); |
---|
| 1585 | if ( delt>=0 && RR[3]>=0 ) |
---|
| 1586 | { |
---|
| 1587 | delt = delt+RR[3]; |
---|
| 1588 | } |
---|
| 1589 | else |
---|
| 1590 | { delt = -1; } |
---|
| 1591 | delti[size(delti)]=delt; |
---|
| 1592 | |
---|
| 1593 | intvec atr = getAttrib(norid); |
---|
| 1594 | |
---|
| 1595 | //"//### case: isolated singularity only at 0, final"; |
---|
| 1596 | //"size norid:", size(norid), size(string(norid)); |
---|
| 1597 | //"interred:"; |
---|
| 1598 | //norid = interred(norid); |
---|
| 1599 | //norid = setAttrib(norid,atr); |
---|
| 1600 | //"size norid:", size(norid), size(string(norid)); |
---|
| 1601 | |
---|
| 1602 | export norid; |
---|
| 1603 | export normap; |
---|
| 1604 | result=newR7; |
---|
| 1605 | result[size(result)+1]=list(delt,delti); |
---|
| 1606 | setring BAS; |
---|
| 1607 | return(result); |
---|
| 1608 | } |
---|
| 1609 | |
---|
| 1610 | //------ zerodivisor of R/SM was found, gives a splitting ------------ |
---|
| 1611 | //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM |
---|
| 1612 | //and we have found a splitting: id and id1 |
---|
| 1613 | //id = Ann defines components of R/SM in the complement of V(SL[1]) |
---|
| 1614 | //id1 defines components of R/SM in the complement of V(id) |
---|
| 1615 | |
---|
| 1616 | else |
---|
| 1617 | { |
---|
| 1618 | ideal id = Ann; |
---|
| 1619 | attrib(id,"isCohenMacaulay",0); |
---|
| 1620 | attrib(id,"isPrim",0); |
---|
| 1621 | attrib(id,"isIsolatedSingularity",1); |
---|
| 1622 | attrib(id,"isRegInCodim2",0); |
---|
| 1623 | attrib(id,"isHypersurface",0); |
---|
| 1624 | attrib(id,"isCompleteIntersection",0); |
---|
| 1625 | attrib(id,"isEquidimensional",0); |
---|
| 1626 | attrib(id,"onlySingularAtZero",1); |
---|
| 1627 | |
---|
| 1628 | ideal id1 = quotient(SM[2],Ann); |
---|
| 1629 | attrib(id1,"isCohenMacaulay",0); |
---|
| 1630 | attrib(id1,"isPrim",0); |
---|
| 1631 | attrib(id1,"isIsolatedSingularity",1); |
---|
| 1632 | attrib(id1,"isRegInCodim2",0); |
---|
| 1633 | attrib(id1,"isHypersurface",0); |
---|
| 1634 | attrib(id1,"isCompleteIntersection",0); |
---|
| 1635 | attrib(id1,"isEquidimensional",0); |
---|
| 1636 | attrib(id1,"onlySingularAtZero",1); |
---|
| 1637 | |
---|
| 1638 | // ---------- recursive call of normalizationPrimes ----------- |
---|
| 1639 | if ( y>=1 ) |
---|
| 1640 | { |
---|
| 1641 | "// case: onlySingularAtZero, zerodivisor found, splitting:"; |
---|
| 1642 | "// total delta before splitting:", delt; |
---|
| 1643 | "// splitting in two components:"; |
---|
| 1644 | } |
---|
| 1645 | |
---|
| 1646 | printlevel = printlevel+1; //to see comments in normalizationPrimes |
---|
| 1647 | keepresult1 = normalizationPrimes(id,ihp,0,0); //1st split factor |
---|
| 1648 | keepresult2 = normalizationPrimes(id1,ihp,0,0); //2nd split factor |
---|
| 1649 | printlevel = printlev; //reset printlevel |
---|
| 1650 | |
---|
| 1651 | int delt1 = keepresult1[size(keepresult1)][1]; |
---|
| 1652 | int delt2 = keepresult2[size(keepresult2)][1]; |
---|
| 1653 | intvec delti1 = keepresult1[size(keepresult1)][2]; |
---|
| 1654 | intvec delti2 = keepresult2[size(keepresult2)][2]; |
---|
| 1655 | |
---|
| 1656 | if( delt>=0 && delt1>=0 && delt2>=0 ) |
---|
| 1657 | { ideal idid1=id,id1; |
---|
| 1658 | int mul = vdim(std(idid1)); |
---|
| 1659 | if ( mul>=0 ) |
---|
| 1660 | { |
---|
| 1661 | delt = delt+mul+delt1+delt2; |
---|
| 1662 | } |
---|
| 1663 | else |
---|
| 1664 | { |
---|
| 1665 | delt = -1; |
---|
| 1666 | } |
---|
| 1667 | } |
---|
| 1668 | if ( y>=1 ) |
---|
| 1669 | { |
---|
| 1670 | "// delta of first component:", delt1; |
---|
| 1671 | "// delta of second componenet:", delt2; |
---|
| 1672 | "// intersection multiplicity of both components:", mul; |
---|
| 1673 | "// total delta after splitting:", delt; |
---|
| 1674 | } |
---|
| 1675 | |
---|
| 1676 | else |
---|
| 1677 | { |
---|
| 1678 | delt = -1; |
---|
| 1679 | } |
---|
| 1680 | for(lauf=1;lauf<=size(keepresult2)-1;lauf++) |
---|
| 1681 | { |
---|
| 1682 | keepresult1=insert(keepresult1,keepresult2[lauf]); |
---|
| 1683 | } |
---|
| 1684 | keepresult1[size(keepresult1)]=list(delt,delti); |
---|
| 1685 | |
---|
| 1686 | return(keepresult1); |
---|
| 1687 | } |
---|
| 1688 | } |
---|
| 1689 | // Case "onlySingularAtZero" has finished and returned result |
---|
| 1690 | |
---|
| 1691 | //-------------- General case, not onlySingularAtZero, RETURN --------------- |
---|
| 1692 | //test for non-normality, i.e. if Hom(I,I)<>R |
---|
| 1693 | //we can use Hom(I,I) to continue |
---|
| 1694 | |
---|
| 1695 | //------ check variables for being a non zero-divizor ------ |
---|
| 1696 | // SL = ideal of vars not contained in ideal SM[1]: |
---|
| 1697 | |
---|
| 1698 | ideal SL = simplify(reduce(JM[2],SM[1]),2); |
---|
| 1699 | ideal Ann = quotient(SM[2],SL[1]); |
---|
| 1700 | ideal qAnn = simplify(reduce(Ann,SM[1]),2); |
---|
| 1701 | //NOTE: qAnn=0 <==> first var (=SL[1]) not contained in SM is a nzd of R/SM |
---|
| 1702 | |
---|
| 1703 | //------------- We found a non-zerodivisor of R/SM ----------------------- |
---|
| 1704 | //SM = mstd of ideal of variety, JM = mstd of ideal of singular locus |
---|
| 1705 | |
---|
| 1706 | if( size(qAnn)==0 ) |
---|
| 1707 | { |
---|
| 1708 | list RR; |
---|
| 1709 | list RS; |
---|
| 1710 | // ----------------- Computation of the radical ----------------- |
---|
| 1711 | if(y>=1) |
---|
| 1712 | { |
---|
| 1713 | "// radical computation of singular locus"; |
---|
| 1714 | } |
---|
| 1715 | J = radical(JM[2]); //the radical of singular locus |
---|
| 1716 | JM = mstd(J); |
---|
| 1717 | |
---|
| 1718 | if(y>=1) |
---|
| 1719 | { |
---|
| 1720 | "// radical is equal to:";""; JM[2]; |
---|
| 1721 | ""; |
---|
| 1722 | } |
---|
| 1723 | // ------------ choose non-zerodivisor of smaller degree ---------- |
---|
| 1724 | //### evtl. fuer SL[1] anderen Nichtnullteiler aus J waehlen ? |
---|
| 1725 | if( deg(SL[1]) > deg(J[1]) ) |
---|
| 1726 | { |
---|
| 1727 | Ann=quotient(SM[2],J[1]); |
---|
| 1728 | qAnn=simplify(reduce(Ann,SM[1]),2); |
---|
| 1729 | if(size(qAnn)==0) |
---|
| 1730 | { |
---|
| 1731 | SL[1]=J[1]; |
---|
| 1732 | } |
---|
| 1733 | } |
---|
| 1734 | |
---|
| 1735 | // --------------- computation of Hom(rad(J),rad(J)) -------------- |
---|
| 1736 | RR=SM[1],SM[2],JM[2],SL[1]; |
---|
| 1737 | |
---|
| 1738 | if(y>=1) |
---|
| 1739 | { |
---|
| 1740 | "// compute Hom(rad(J),rad(J))"; |
---|
| 1741 | } |
---|
| 1742 | |
---|
| 1743 | RS=HomJJ(RR,y); //most important subprocedure |
---|
| 1744 | |
---|
| 1745 | // ------------------ the normal case, RETURN ----------------- |
---|
| 1746 | // RS[2]==1 means that the test for normality was positive |
---|
| 1747 | if(RS[2]==1) |
---|
| 1748 | { |
---|
| 1749 | def lastR=RS[1]; |
---|
| 1750 | setring lastR; |
---|
| 1751 | map psi1=BAS,endphi; |
---|
| 1752 | ideal norid=endid; |
---|
| 1753 | ideal normap=psi1(ihp); |
---|
| 1754 | kill endid,endphi; |
---|
| 1755 | |
---|
| 1756 | intvec atr=getAttrib(norid); |
---|
| 1757 | |
---|
| 1758 | //"//### general case: not isolated singularity only at 0, final"; |
---|
| 1759 | //"size norid:", size(norid), size(string(norid)); |
---|
| 1760 | //"interred:"; |
---|
| 1761 | //norid = interred(norid); |
---|
| 1762 | //norid = setAttrib(norid,atr); |
---|
| 1763 | //"size norid:", size(norid), size(string(norid)); |
---|
| 1764 | |
---|
| 1765 | export norid; |
---|
| 1766 | export normap; |
---|
| 1767 | result=lastR; |
---|
| 1768 | if ( y>=1 ) |
---|
| 1769 | { |
---|
| 1770 | "// case: not onlySingularAtZero, last ring Hom_R(J,J) computed"; |
---|
| 1771 | "// delta before last ring:", delt; |
---|
| 1772 | } |
---|
| 1773 | |
---|
| 1774 | if ( delt>=0 && RS[3]>=0 ) |
---|
| 1775 | { |
---|
| 1776 | delt = delt+RS[3]; |
---|
| 1777 | } |
---|
| 1778 | else |
---|
| 1779 | { delt = -1; } |
---|
| 1780 | |
---|
| 1781 | // delti = delti,delt; |
---|
| 1782 | delti[size(delti)]=delt; |
---|
| 1783 | |
---|
| 1784 | if ( y>=1 ) |
---|
| 1785 | { |
---|
| 1786 | "// delta of last ring:", delt; |
---|
| 1787 | } |
---|
| 1788 | |
---|
| 1789 | result[size(result)+1]=list(delt,delti); |
---|
| 1790 | setring BAS; |
---|
| 1791 | return(result); |
---|
| 1792 | } |
---|
| 1793 | |
---|
| 1794 | // ----- the non-normal case, recursive call of normalizationPrimes ------- |
---|
| 1795 | // RS=HomJJ(RR,y) was computed above, RS[1] contains endid and endphi |
---|
| 1796 | // RS[1] = new ring Hom_R(J,J), RS[2]= 0 or 1, RS[2]=contribution to delta |
---|
| 1797 | // now RS[2]must be 0, i.e. the test for normality was negative |
---|
| 1798 | |
---|
| 1799 | int n = nvars(basering); |
---|
| 1800 | ideal MJ = JM[2]; |
---|
| 1801 | |
---|
| 1802 | def newR=RS[1]; |
---|
| 1803 | setring newR; |
---|
| 1804 | map psi=BAS,endphi; |
---|
| 1805 | if ( y>=1 ) |
---|
| 1806 | { |
---|
| 1807 | "// case: not onlySingularAtZero, compute new ring = Hom_R(J,J)"; |
---|
| 1808 | "// delta of old ring:", delt; |
---|
| 1809 | } |
---|
| 1810 | if ( delt>=0 && RS[3]>=0 ) |
---|
| 1811 | { |
---|
| 1812 | delt = delt+RS[3]; |
---|
| 1813 | } |
---|
| 1814 | else |
---|
| 1815 | { delt = -1; } |
---|
| 1816 | if ( y>=1 ) |
---|
| 1817 | { |
---|
| 1818 | "// delta of new ring:", delt; |
---|
| 1819 | } |
---|
| 1820 | |
---|
| 1821 | delti[size(delti)]=delt; |
---|
| 1822 | intvec atr=getAttrib(endid); |
---|
| 1823 | |
---|
| 1824 | //"//### general case: not isolated singularity only at 0, recursive"; |
---|
| 1825 | //"size endid:", size(endid), size(string(endid)); |
---|
| 1826 | //"interred:"; |
---|
| 1827 | //endid = interred(endid); |
---|
| 1828 | //endid = setAttrib(endid,atr); |
---|
| 1829 | //"size endid:", size(endid), size(string(endid)); |
---|
| 1830 | |
---|
| 1831 | printlevel = printlevel+1; |
---|
| 1832 | list tluser= |
---|
| 1833 | normalizationPrimes(endid,psi(ihp),delt,delti,psi(MJ)); |
---|
| 1834 | printlevel = printlev; //reset printlevel |
---|
| 1835 | setring BAS; |
---|
| 1836 | return(tluser); |
---|
| 1837 | } |
---|
| 1838 | |
---|
| 1839 | //---- A whole singular component was found, RETURN ----- |
---|
| 1840 | if( Ann == 1) |
---|
| 1841 | { |
---|
| 1842 | "// Input appeared not to be a radical ideal!"; |
---|
| 1843 | "// A (everywhere singular) component with ideal"; |
---|
| 1844 | "// equal to its Jacobian ideal was found"; |
---|
| 1845 | "// Procedure will stop with partial result computed so far";""; |
---|
| 1846 | |
---|
| 1847 | MB=SM[2]; |
---|
| 1848 | intvec rw; |
---|
| 1849 | list LL=substpart(MB,ihp,0,rw); |
---|
| 1850 | def newR6=LL[1]; |
---|
| 1851 | setring newR6; |
---|
| 1852 | ideal norid=endid; |
---|
| 1853 | ideal normap=endphi; |
---|
| 1854 | kill endid,endphi; |
---|
| 1855 | export norid; |
---|
| 1856 | export normap; |
---|
| 1857 | result=newR6; |
---|
| 1858 | result[size(result)+1]=lst(delt,delti); |
---|
| 1859 | setring BAS; |
---|
| 1860 | return(result); |
---|
| 1861 | } |
---|
| 1862 | |
---|
| 1863 | //------ zerodivisor of R/SM was found, gives a splitting ------------ |
---|
| 1864 | //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM |
---|
| 1865 | //and we have found a splitting: new1 and new2 |
---|
| 1866 | //id = Ann defines components of R/SM in the complement of V(SL[1]) |
---|
| 1867 | //id1 defines components of R/SM in the complement of V(id) |
---|
| 1868 | |
---|
| 1869 | else |
---|
| 1870 | { |
---|
| 1871 | if(y>=1) |
---|
| 1872 | { |
---|
| 1873 | "// zero-divisor found"; |
---|
| 1874 | } |
---|
| 1875 | int equi = attrib(SM[2],"isEquidimensional"); |
---|
| 1876 | int oSAZ = attrib(SM[2],"onlySingularAtZero"); |
---|
| 1877 | int isIs = attrib(SM[2],"isIsolatedSingularity"); |
---|
| 1878 | |
---|
| 1879 | ideal new1 = Ann; |
---|
| 1880 | ideal new2 = quotient(SM[2],Ann); |
---|
| 1881 | //ideal new2=SL[1],SM[2]; |
---|
| 1882 | |
---|
| 1883 | //execute("ring newR1="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
| 1884 | // +ordstr(basering)+");"); |
---|
| 1885 | def newR1 = ring(gnirlist); |
---|
| 1886 | setring newR1; |
---|
| 1887 | |
---|
| 1888 | ideal vid = fetch(BAS,new1); |
---|
| 1889 | ideal ihp = fetch(BAS,ihp); |
---|
| 1890 | attrib(vid,"isCohenMacaulay",0); |
---|
| 1891 | attrib(vid,"isPrim",0); |
---|
| 1892 | attrib(vid,"isIsolatedSingularity",isIs); |
---|
| 1893 | attrib(vid,"isRegInCodim2",0); |
---|
| 1894 | attrib(vid,"onlySingularAtZero",oSAZ); |
---|
| 1895 | attrib(vid,"isEquidimensional",equi); |
---|
| 1896 | attrib(vid,"isHypersurface",0); |
---|
| 1897 | attrib(vid,"isCompleteIntersection",0); |
---|
| 1898 | |
---|
| 1899 | // ---------- recursive call of normalizationPrimes ----------- |
---|
| 1900 | if ( y>=1 ) |
---|
| 1901 | { |
---|
| 1902 | "// total delta before splitting:", delt; |
---|
| 1903 | "// splitting in two components:"; |
---|
| 1904 | } |
---|
| 1905 | printlevel = printlevel+1; |
---|
| 1906 | keepresult1 = |
---|
| 1907 | normalizationPrimes(vid,ihp,0,0); //1st split factor |
---|
| 1908 | |
---|
| 1909 | list delta1 = keepresult1[size(keepresult1)]; |
---|
| 1910 | |
---|
| 1911 | setring BAS; |
---|
| 1912 | //execute("ring newR2="+charstr(basering)+",("+varstr(basering)+"),(" |
---|
| 1913 | // +ordstr(basering)+");"); |
---|
| 1914 | def newR2 = ring(gnirlist); |
---|
| 1915 | setring newR2; |
---|
| 1916 | |
---|
| 1917 | ideal vid = fetch(BAS,new2); |
---|
| 1918 | ideal ihp = fetch(BAS,ihp); |
---|
| 1919 | attrib(vid,"isCohenMacaulay",0); |
---|
| 1920 | attrib(vid,"isPrim",0); |
---|
| 1921 | attrib(vid,"isIsolatedSingularity",isIs); |
---|
| 1922 | attrib(vid,"isRegInCodim2",0); |
---|
| 1923 | attrib(vid,"isEquidimensional",equi); |
---|
| 1924 | attrib(vid,"isHypersurface",0); |
---|
| 1925 | attrib(vid,"isCompleteIntersection",0); |
---|
| 1926 | attrib(vid,"onlySingularAtZero",oSAZ); |
---|
| 1927 | |
---|
| 1928 | keepresult2 = |
---|
| 1929 | normalizationPrimes(vid,ihp,0,0); |
---|
| 1930 | list delta2 = keepresult2[size(keepresult2)]; //2nd split factor |
---|
| 1931 | printlevel = printlev; //reset printlevel |
---|
| 1932 | |
---|
| 1933 | setring BAS; |
---|
| 1934 | |
---|
| 1935 | //compute intersection multiplicity of both components: |
---|
| 1936 | new1 = new1,new2; |
---|
| 1937 | int mul=vdim(std(new1)); |
---|
| 1938 | |
---|
| 1939 | // ----- normalizationPrimes finished, add up results, RETURN -------- |
---|
| 1940 | for(lauf=1;lauf<=size(keepresult2)-1;lauf++) |
---|
| 1941 | { |
---|
| 1942 | keepresult1 = insert(keepresult1,keepresult2[lauf]); |
---|
| 1943 | } |
---|
| 1944 | if ( delt >=0 && delta1[1] >=0 && delta2[1] >=0 && mul >=0 ) |
---|
| 1945 | { |
---|
| 1946 | delt = delt+mul+delta1[1]+delta2[1]; |
---|
| 1947 | } |
---|
| 1948 | else |
---|
| 1949 | { delt = -1; } |
---|
| 1950 | delti = -2; |
---|
| 1951 | |
---|
| 1952 | if ( y>=1 ) |
---|
| 1953 | { |
---|
| 1954 | "// zero divisor produced a splitting into two components"; |
---|
| 1955 | "// delta of first component:", delta1; |
---|
| 1956 | "// delta of second componenet:", delta2; |
---|
| 1957 | "// intersection multiplicity of both components:", mul; |
---|
| 1958 | "// total delta after splitting:", delt; |
---|
| 1959 | } |
---|
| 1960 | keepresult1[size(keepresult1)] = list(delt,delti); |
---|
| 1961 | return(keepresult1); |
---|
| 1962 | } |
---|
| 1963 | } |
---|
| 1964 | example |
---|
| 1965 | { "EXAMPLE:";echo = 2; |
---|
| 1966 | // Huneke |
---|
| 1967 | ring qr=31991,(a,b,c,d,e),dp; |
---|
| 1968 | ideal i= |
---|
| 1969 | 5abcde-a5-b5-c5-d5-e5, |
---|
| 1970 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
| 1971 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
| 1972 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
| 1973 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
| 1974 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
| 1975 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
| 1976 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
| 1977 | |
---|
| 1978 | list pr=normalizationPrimes(i); |
---|
| 1979 | def r1 = pr[1]; |
---|
| 1980 | setring r1; |
---|
| 1981 | norid; |
---|
| 1982 | normap; |
---|
| 1983 | } |
---|
| 1984 | |
---|
| 1985 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1986 | static proc substpart(ideal endid, ideal endphi, int homo, intvec rw) |
---|
| 1987 | |
---|
| 1988 | "//Repeated application of elimpart to endid, until no variables can be |
---|
| 1989 | //directy substituded. homo=1 if input is homogeneous, rw contains |
---|
| 1990 | //original weights, endphi (partial) normalization map"; |
---|
| 1991 | |
---|
| 1992 | //NOTE concerning iteration of maps: Let phi: x->f(y,z), y->g(x,z) then |
---|
| 1993 | //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 |
---|
| 1994 | //and so on: none of the x or y will be eliminated |
---|
| 1995 | //Now subst: first x and then y: x+y+z->f(g(x,z),z)+g(x,z)+z eliminates y |
---|
| 1996 | //further subst replaces x by y, makes no sense (objects more compicated). |
---|
| 1997 | //Subst first y and then x eliminates x |
---|
| 1998 | //In our situation we have triangular form: x->f(y,z), y->g(z). |
---|
| 1999 | //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 |
---|
| 2000 | //subst x,y: x+y+z->f(g(z),z)+g(z)+z, eliminates x,y |
---|
| 2001 | //subst y,x: x+y+z->f(y,z)+g(z)+z eliminates only x |
---|
| 2002 | //HENCE: substitute vars depending on most other vars first |
---|
| 2003 | //However, if the sytem xi-fi is reduced then xi does not appear in any of the |
---|
| 2004 | //fj and hence the order does'nt matter when substitutinp xi by fi |
---|
| 2005 | |
---|
| 2006 | { |
---|
| 2007 | def newRing = basering; |
---|
| 2008 | int ii,jj; |
---|
| 2009 | map phi = newRing,maxideal(1); //identity map |
---|
| 2010 | list Le = elimpart(endid); |
---|
| 2011 | //this proc and the next loop try to substitute as many variables as |
---|
| 2012 | //possible indices of substituted variables |
---|
| 2013 | |
---|
| 2014 | int q = size(Le[2]); //q vars, stored in Le[2], have been substitutet |
---|
| 2015 | intvec rw1 = 0; //will become indices of substituted variables |
---|
| 2016 | rw1[nvars(basering)] = 0; |
---|
| 2017 | rw1 = rw1+1; //rw1=1,..,1 (as many 1 as nvars(basering)) |
---|
| 2018 | |
---|
| 2019 | while( size(Le[2]) != 0 ) |
---|
| 2020 | { |
---|
| 2021 | endid = Le[1]; |
---|
| 2022 | if ( defined(ps) ) |
---|
| 2023 | { kill ps; } |
---|
| 2024 | map ps = newRing,Le[5]; |
---|
| 2025 | phi = ps(phi); |
---|
| 2026 | for(ii=1;ii<=size(Le[2]);ii++) |
---|
| 2027 | { |
---|
| 2028 | phi=phi(phi); |
---|
| 2029 | } |
---|
| 2030 | //eingefuegt wegen x2-y2z2+z3 |
---|
| 2031 | |
---|
| 2032 | for( ii=1; ii<=size(rw1); ii++ ) |
---|
| 2033 | { |
---|
| 2034 | if( Le[4][ii]==0 ) //ii = index of var which was substituted |
---|
| 2035 | { |
---|
| 2036 | rw1[ii]=0; //substituted vars have entry 0 in rw1 |
---|
| 2037 | } |
---|
| 2038 | } |
---|
| 2039 | Le=elimpart(endid); //repeated application of elimpart |
---|
| 2040 | q = q + size(Le[2]); |
---|
| 2041 | } |
---|
| 2042 | endphi = phi(endphi); |
---|
| 2043 | //---------- return ----------------------------------------------------------- |
---|
| 2044 | // first the trivial case, where all variable have been eliminated |
---|
| 2045 | if( nvars(newRing) == q ) |
---|
| 2046 | { |
---|
| 2047 | ring lastRing = char(basering),T(1),dp; |
---|
| 2048 | ideal endid = T(1); |
---|
| 2049 | ideal endphi = T(1); |
---|
| 2050 | for(ii=2; ii<=q; ii++ ) |
---|
| 2051 | { |
---|
| 2052 | endphi[ii] = 0; |
---|
| 2053 | } |
---|
| 2054 | export(endid,endphi); |
---|
| 2055 | list L = lastRing; |
---|
| 2056 | setring newRing; |
---|
| 2057 | return(L); |
---|
| 2058 | } |
---|
| 2059 | |
---|
| 2060 | // in the homogeneous case put weights for the remaining vars correctly, i.e. |
---|
| 2061 | // delete from rw those weights for which the corresponding entry of rw1 is 0 |
---|
| 2062 | |
---|
| 2063 | if (homo==1 && nvars(newRing)-q >1 && size(endid) >0 ) |
---|
| 2064 | { |
---|
| 2065 | jj=1; |
---|
| 2066 | for( ii=2; ii<size(rw1); ii++) |
---|
| 2067 | { |
---|
| 2068 | jj++; |
---|
| 2069 | if( rw1[ii]==0 ) |
---|
| 2070 | { |
---|
| 2071 | rw=rw[1..jj-1],rw[jj+1..size(rw)]; |
---|
| 2072 | jj=jj-1; |
---|
| 2073 | } |
---|
| 2074 | } |
---|
| 2075 | if( rw1[1]==0 ) { rw=rw[2..size(rw)]; } |
---|
| 2076 | if( rw1[size(rw1)]==0 ){ rw=rw[1..size(rw)-1]; } |
---|
| 2077 | |
---|
| 2078 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),(a(rw),dp); |
---|
| 2079 | } |
---|
| 2080 | else |
---|
| 2081 | { |
---|
| 2082 | ring lastRing = char(basering),(T(1..nvars(newRing)-q)),dp; |
---|
| 2083 | } |
---|
| 2084 | ideal lastmap; |
---|
| 2085 | jj = 1; |
---|
| 2086 | |
---|
| 2087 | for(ii=1; ii<=size(rw1); ii++ ) |
---|
| 2088 | { |
---|
| 2089 | if ( rw1[ii]==1 ) { lastmap[ii] = T(jj); jj=jj+1; } |
---|
| 2090 | if ( rw1[ii]==0 ) { lastmap[ii] = 0; } |
---|
| 2091 | } |
---|
| 2092 | map phi1 = newRing,lastmap; |
---|
| 2093 | ideal endid = phi1(endid); //### bottelneck |
---|
| 2094 | ideal endphi = phi1(endphi); |
---|
| 2095 | |
---|
| 2096 | /* |
---|
| 2097 | Versuch: subst statt phi |
---|
| 2098 | for(ii=1; ii<=size(rw1); ii++ ) |
---|
| 2099 | { |
---|
| 2100 | if ( rw1[ii]==1 ) { endid = subst(endid,var(ii),T(jj)); } |
---|
| 2101 | if ( rw1[ii]==0 ) { endid = subst(endid,var(ii),0); } |
---|
| 2102 | } |
---|
| 2103 | */ |
---|
| 2104 | export(endid); |
---|
| 2105 | export(endphi); |
---|
| 2106 | list L = lastRing; |
---|
| 2107 | setring newRing; |
---|
| 2108 | return(L); |
---|
| 2109 | } |
---|
| 2110 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2111 | static proc deltaP(ideal I) |
---|
| 2112 | { |
---|
| 2113 | def R=basering; |
---|
| 2114 | int c,d,i; |
---|
| 2115 | int n=nvars(R); |
---|
| 2116 | list nor; |
---|
| 2117 | if(size(I)>1){ERROR("no hypersurface");} |
---|
| 2118 | ideal J=std(slocus(I)); |
---|
| 2119 | if(dim(J)<=0){return(0);} |
---|
| 2120 | poly h; |
---|
| 2121 | d=1; |
---|
| 2122 | while((d)&&(i<n)) |
---|
| 2123 | { |
---|
| 2124 | i++; |
---|
| 2125 | h=var(i); |
---|
| 2126 | d=dim(std(J+ideal(h))); |
---|
| 2127 | } |
---|
| 2128 | i=0; |
---|
| 2129 | while(d) |
---|
| 2130 | { |
---|
| 2131 | i++; |
---|
| 2132 | if(i>10){ERROR("delta not found, please inform the authors")}; |
---|
| 2133 | h=randomLast(100)[n]; |
---|
| 2134 | d=dim(std(J+ideal(h))); |
---|
| 2135 | } |
---|
| 2136 | I=I,h-1; |
---|
| 2137 | if(char(R)<=19) |
---|
| 2138 | { |
---|
| 2139 | nor=normalP(I); |
---|
| 2140 | } |
---|
| 2141 | else |
---|
| 2142 | { |
---|
| 2143 | nor=normal(I); |
---|
| 2144 | } |
---|
| 2145 | return(nor[2][2]); |
---|
| 2146 | } |
---|
| 2147 | |
---|
| 2148 | proc genus(ideal I,list #) |
---|
| 2149 | "USAGE: genus(i) or genus(i,1); I a 1-dimensional ideal |
---|
| 2150 | RETURN: an integer, the geometric genus p_g = p_a - delta of the projective |
---|
| 2151 | curve defined by i, where p_a is the arithmetic genus. |
---|
| 2152 | NOTE: delta is the sum of all local delta-invariants of the singularities, |
---|
| 2153 | i.e. dim(R'/R), R' the normalization of the local ring R of the |
---|
| 2154 | singularity. @* |
---|
| 2155 | genus(i,1) uses the normalization to compute delta. Usually genus(i,1) |
---|
| 2156 | is slower than genus(i) but sometimes not. |
---|
| 2157 | EXAMPLE: example genus; shows an example |
---|
| 2158 | " |
---|
| 2159 | { |
---|
| 2160 | int w = printlevel-voice+2; // w=printlevel (default: w=0) |
---|
| 2161 | |
---|
| 2162 | def R0=basering; |
---|
| 2163 | if(char(basering)>0) |
---|
| 2164 | { |
---|
| 2165 | def R1=changeord("dp"); |
---|
| 2166 | setring R1; |
---|
| 2167 | ideal I=imap(R0,I); |
---|
| 2168 | I=radical(I); |
---|
| 2169 | I=std(I); |
---|
| 2170 | if(dim(I)!=1) |
---|
| 2171 | { |
---|
| 2172 | if(((homog(I))&&(dim(I)!=2))||(!homog(I))) |
---|
| 2173 | { |
---|
| 2174 | ERROR("This is not a curve"); |
---|
| 2175 | } |
---|
| 2176 | } |
---|
| 2177 | if(homog(I)&&(dim(I)==2)) |
---|
| 2178 | { |
---|
| 2179 | def S=R0; |
---|
| 2180 | setring S; |
---|
| 2181 | ideal J=I; |
---|
| 2182 | } |
---|
| 2183 | else |
---|
| 2184 | { |
---|
| 2185 | def S=changevar(varstr(R0)+",@t"); |
---|
| 2186 | setring S; |
---|
| 2187 | ideal J=imap(R1,I); |
---|
| 2188 | J=homog(J,@t); |
---|
| 2189 | J=std(J); |
---|
| 2190 | } |
---|
| 2191 | int pa=1-hilbPoly(J)[1]; |
---|
| 2192 | pa=pa-deltaP(J); |
---|
| 2193 | setring R0; |
---|
| 2194 | return(pa); |
---|
| 2195 | } |
---|
| 2196 | I=std(I); |
---|
| 2197 | if(dim(I)!=1) |
---|
| 2198 | { |
---|
| 2199 | if(((homog(I))&&(dim(I)!=2))||(!homog(I))) |
---|
| 2200 | { |
---|
| 2201 | // ERROR("This is not a curve"); |
---|
| 2202 | if(w==1){"** WARNING: Input does not define a curve **"; "";} |
---|
| 2203 | } |
---|
| 2204 | } |
---|
| 2205 | list L=elimpart(I); |
---|
| 2206 | if(size(L[2])!=0) |
---|
| 2207 | { |
---|
| 2208 | map psi=R0,L[5]; |
---|
| 2209 | I=std(psi(I)); |
---|
| 2210 | } |
---|
| 2211 | if(size(I)==0) |
---|
| 2212 | { |
---|
| 2213 | return(0); |
---|
| 2214 | } |
---|
| 2215 | list N=findvars(I,0); |
---|
| 2216 | if(size(N[1])==1) |
---|
| 2217 | { |
---|
| 2218 | |
---|
| 2219 | poly p=I[1]; |
---|
| 2220 | // if(deg(squarefree(p))<deg(p)){ERROR("Curve is not reduced");} |
---|
| 2221 | return(-deg(p)+1); |
---|
| 2222 | } |
---|
| 2223 | if(size(N[1]) < nvars(R0)) |
---|
| 2224 | { |
---|
| 2225 | string newvar=string(N[1]); |
---|
| 2226 | execute("ring R=("+charstr(R0)+"),("+newvar+"),dp;"); |
---|
| 2227 | ideal I =imap(R0,I); |
---|
| 2228 | attrib(I,"isSB",1); |
---|
| 2229 | } |
---|
| 2230 | else |
---|
| 2231 | { |
---|
| 2232 | def R=basering; |
---|
| 2233 | } |
---|
| 2234 | if(dim(I)==2) |
---|
| 2235 | { |
---|
| 2236 | def newR=basering; |
---|
| 2237 | } |
---|
| 2238 | else |
---|
| 2239 | { |
---|
| 2240 | if(dim(I)==0) |
---|
| 2241 | { |
---|
| 2242 | execute("ring Rhelp=("+charstr(R0)+"),(@s,@t),dp;"); |
---|
| 2243 | } |
---|
| 2244 | else |
---|
| 2245 | { |
---|
| 2246 | execute("ring Rhelp=("+charstr(R0)+"),(@s),dp;"); |
---|
| 2247 | } |
---|
| 2248 | def newR=R+Rhelp; |
---|
| 2249 | setring newR; |
---|
| 2250 | ideal I=imap(R,I); |
---|
| 2251 | I=homog(I,@s); |
---|
| 2252 | attrib(I,"isSB",1); |
---|
| 2253 | } |
---|
| 2254 | |
---|
| 2255 | if((nvars(basering)<=3)&&(size(I)>1)) |
---|
| 2256 | { |
---|
| 2257 | ERROR("This is not equidimensional"); |
---|
| 2258 | } |
---|
| 2259 | |
---|
| 2260 | intvec hp=hilbPoly(I); |
---|
| 2261 | int p_a=1-hp[1]; |
---|
| 2262 | int d=hp[2]; |
---|
| 2263 | |
---|
| 2264 | if(w>=1) |
---|
| 2265 | { |
---|
| 2266 | "";"The ideal of the projective curve:";"";I;""; |
---|
| 2267 | "The coefficients of the Hilbert polynomial";hp; |
---|
| 2268 | "arithmetic genus:";p_a; |
---|
| 2269 | "degree:";d;""; |
---|
| 2270 | } |
---|
| 2271 | |
---|
| 2272 | intvec v = hilb(I,1); |
---|
| 2273 | int i,o; |
---|
| 2274 | if(nvars(basering)>3) |
---|
| 2275 | { |
---|
| 2276 | map phi=newR,maxideal(1); |
---|
| 2277 | int de; |
---|
| 2278 | ideal K,L1; |
---|
| 2279 | matrix M; |
---|
| 2280 | poly m=var(4); |
---|
| 2281 | poly he; |
---|
| 2282 | for(i=5;i<=nvars(basering);i++){m=m*var(i);} |
---|
| 2283 | K=eliminate(I,m,v); |
---|
| 2284 | if(size(K)==1){de=deg(K[1]);} |
---|
| 2285 | m=var(1); |
---|
| 2286 | for(i=2;i<=nvars(basering)-3;i++){m=m*var(i);} |
---|
| 2287 | i=0; |
---|
| 2288 | while(d!=de) |
---|
| 2289 | { |
---|
| 2290 | o=1; |
---|
| 2291 | i++; |
---|
| 2292 | K=phi(I); |
---|
| 2293 | K=eliminate(K,m,v); |
---|
| 2294 | if(size(K)==1){de=deg(K[1]);} |
---|
| 2295 | if((i==5)&&(d!=de)) |
---|
| 2296 | { |
---|
| 2297 | K=reduce(equidimMax(I),I); |
---|
| 2298 | if(size(K)!=0){ERROR("This is not equidimensional");} |
---|
| 2299 | } |
---|
| 2300 | if(i==10) |
---|
| 2301 | { |
---|
| 2302 | J;K; |
---|
| 2303 | ERROR("genus: did not find a good projection for to |
---|
| 2304 | the plain"); |
---|
| 2305 | } |
---|
| 2306 | if(i<5) |
---|
| 2307 | { |
---|
| 2308 | M=sparsetriag(nvars(newR),nvars(newR),80-5*i,i); |
---|
| 2309 | } |
---|
| 2310 | else |
---|
| 2311 | { |
---|
| 2312 | if(i<8) |
---|
| 2313 | { |
---|
| 2314 | M=transpose(sparsetriag(nvars(newR),nvars(newR),80-5*i,i)); |
---|
| 2315 | } |
---|
| 2316 | else |
---|
| 2317 | { |
---|
| 2318 | he=0; |
---|
| 2319 | while(he==0) |
---|
| 2320 | { |
---|
| 2321 | M=randommat(nvars(newR),nvars(newR),ideal(1),20); |
---|
| 2322 | he=det(M); |
---|
| 2323 | } |
---|
| 2324 | } |
---|
| 2325 | } |
---|
| 2326 | L1=M*transpose(maxideal(1)); |
---|
| 2327 | phi=newR,L1; |
---|
| 2328 | } |
---|
| 2329 | I=K; |
---|
| 2330 | } |
---|
| 2331 | poly p=I[1]; |
---|
| 2332 | |
---|
| 2333 | execute("ring S=("+charstr(R)+"),(x,y,t),dp;"); |
---|
| 2334 | ideal L=maxideal(1); |
---|
| 2335 | execute("ring C=("+charstr(R)+"),(x,y),ds;"); |
---|
| 2336 | ideal I; |
---|
| 2337 | execute("ring A=("+charstr(R)+"),(x,t),dp;"); |
---|
| 2338 | map phi=S,1,x,t; |
---|
| 2339 | map psi=S,x,1,t; |
---|
| 2340 | poly g,h; |
---|
| 2341 | ideal I,I1; |
---|
| 2342 | execute("ring B=("+charstr(R)+"),(x,t),ds;"); |
---|
| 2343 | |
---|
| 2344 | setring S; |
---|
| 2345 | if(o) |
---|
| 2346 | { |
---|
| 2347 | for(i=1;i<=nvars(newR)-3;i++){L[i]=0;} |
---|
| 2348 | L=L,maxideal(1); |
---|
| 2349 | } |
---|
| 2350 | map sigma=newR,L; |
---|
| 2351 | poly F=sigma(p); |
---|
| 2352 | if(w>=1){"the projected curve:";"";F;"";} |
---|
| 2353 | |
---|
| 2354 | kill newR; |
---|
| 2355 | |
---|
| 2356 | int genus=(d-1)*(d-2)/2; |
---|
| 2357 | if(w>=1){"the arithmetic genus of the plane curve:";genus;pause();} |
---|
| 2358 | |
---|
| 2359 | int delt,deltaloc,deltainf,tau,tauinf,cusps,iloc,iglob,l,nsing, |
---|
| 2360 | tauloc,tausing,k,rat,nbranchinf,nbranch,nodes,cuspsinf,nodesinf; |
---|
| 2361 | list inv; |
---|
| 2362 | |
---|
| 2363 | if(w>=1) |
---|
| 2364 | {"";"analyse the singularities at oo";"";"singular locus at (1,x,0):";"";} |
---|
| 2365 | setring A; |
---|
| 2366 | g=phi(F); |
---|
| 2367 | h=psi(F); |
---|
| 2368 | I=g,jacob(g),var(2); |
---|
| 2369 | I=std(I); |
---|
| 2370 | if(deg(I[1])>0) |
---|
| 2371 | { |
---|
| 2372 | list qr=minAssGTZ(I); |
---|
| 2373 | if(w>=1){qr;"";} |
---|
| 2374 | |
---|
| 2375 | for(k=1;k<=size(qr);k++) |
---|
| 2376 | { |
---|
| 2377 | if(w>=1){ nsing=nsing+vdim(std(qr[k]));} |
---|
| 2378 | inv=deltaLoc(g,qr[k]); |
---|
| 2379 | deltainf=deltainf+inv[1]; |
---|
| 2380 | tauinf=tauinf+inv[2]; |
---|
| 2381 | l=vdim(std(qr[k])); |
---|
| 2382 | if(inv[2]==l){nodesinf=nodesinf+l;} |
---|
| 2383 | if(inv[2]==2*l){cuspsinf=cuspsinf+l;} |
---|
| 2384 | nbranchinf=nbranchinf+inv[3]; |
---|
| 2385 | } |
---|
| 2386 | } |
---|
| 2387 | else |
---|
| 2388 | { |
---|
| 2389 | if(w>=1){" the curve is smooth at (1,x,0)";"";} |
---|
| 2390 | } |
---|
| 2391 | if(w>=1){"singular locus at (0,1,0):";"";} |
---|
| 2392 | inv=deltaLoc(h,maxideal(1)); |
---|
| 2393 | if((w>=1)&&(inv[2]!=0)){ nsing++;} |
---|
| 2394 | deltainf=deltainf+inv[1]; |
---|
| 2395 | tauinf=tauinf+inv[2]; |
---|
| 2396 | if(inv[2]==1){nodesinf++;} |
---|
| 2397 | if(inv[2]==2){cuspsinf++;} |
---|
| 2398 | |
---|
| 2399 | if((w>=1)&&(inv[2]==0)){" the curve is smooth at (0,1,0)";"";} |
---|
| 2400 | if(inv[2]>0){nbranchinf=nbranchinf+inv[3];} |
---|
| 2401 | |
---|
| 2402 | if(w>=1) |
---|
| 2403 | { |
---|
| 2404 | if(tauinf==0) |
---|
| 2405 | { |
---|
| 2406 | " the curve is smooth at oo";""; |
---|
| 2407 | } |
---|
| 2408 | else |
---|
| 2409 | { |
---|
| 2410 | "number of singularities at oo:";nsing; |
---|
| 2411 | "nodes at oo:";nodesinf; |
---|
| 2412 | "cusps at oo:";cuspsinf; |
---|
| 2413 | "branches at oo:";nbranchinf; |
---|
| 2414 | "Tjurina number at oo:";tauinf; |
---|
| 2415 | "delta at oo:";deltainf; |
---|
| 2416 | "Milnor number at oo:";2*deltainf-nbranchinf+nsing; |
---|
| 2417 | pause(); |
---|
| 2418 | } |
---|
| 2419 | "singularities at (x,y,1):";""; |
---|
| 2420 | } |
---|
| 2421 | execute("ring newR=("+charstr(R)+"),(x,y),dp;"); |
---|
| 2422 | //the singularities at the affine part |
---|
| 2423 | map sigma=S,var(1),var(2),1; |
---|
| 2424 | ideal I=sigma(F); |
---|
| 2425 | |
---|
| 2426 | if(size(#)!=0) |
---|
| 2427 | { //uses the normalization to compute delta |
---|
| 2428 | list nor=normal(I); |
---|
| 2429 | delt=nor[size(nor)][2]; |
---|
| 2430 | genus=genus-delt-deltainf; |
---|
| 2431 | setring R0; |
---|
| 2432 | return(genus); |
---|
| 2433 | } |
---|
| 2434 | |
---|
| 2435 | ideal I1=jacob(I); |
---|
| 2436 | matrix Hess[2][2]=jacob(I1); |
---|
| 2437 | ideal ID=I+I1+ideal(det(Hess));//singular locus of I+I1 |
---|
| 2438 | |
---|
| 2439 | ideal radID=std(radical(ID));//the non-nodal locus |
---|
| 2440 | if(w>=1){"the non-nodal locus:";"";radID;pause();"";} |
---|
| 2441 | if(deg(radID[1])==0) |
---|
| 2442 | { |
---|
| 2443 | ideal IDsing=1; |
---|
| 2444 | } |
---|
| 2445 | else |
---|
| 2446 | { |
---|
| 2447 | ideal IDsing=minor(jacob(ID),2)+radID;//singular locus of ID |
---|
| 2448 | } |
---|
| 2449 | |
---|
| 2450 | iglob=vdim(std(IDsing)); |
---|
| 2451 | |
---|
| 2452 | if(iglob!=0)//computation of the radical of IDsing |
---|
| 2453 | { |
---|
| 2454 | ideal radIDsing=reduce(IDsing,radID); |
---|
| 2455 | if(size(radIDsing)==0) |
---|
| 2456 | { |
---|
| 2457 | radIDsing=radID; |
---|
| 2458 | attrib(radIDsing,"isSB",1); |
---|
| 2459 | } |
---|
| 2460 | else |
---|
| 2461 | { |
---|
| 2462 | radIDsing=std(radical(IDsing)); |
---|
| 2463 | } |
---|
| 2464 | iglob=vdim(radIDsing); |
---|
| 2465 | if((w>=1)&&(iglob)) |
---|
| 2466 | {"the non-nodal-cuspidal locus:";radIDsing;pause();"";} |
---|
| 2467 | } |
---|
| 2468 | cusps=vdim(radID)-iglob; |
---|
| 2469 | nsing=nsing+cusps; |
---|
| 2470 | |
---|
| 2471 | if(iglob==0) |
---|
| 2472 | { |
---|
| 2473 | if(w>=1){" there are only cusps and nodes";"";} |
---|
| 2474 | tau=vdim(std(I+jacob(I))); |
---|
| 2475 | tauinf=tauinf+tau; |
---|
| 2476 | nodes=tau-2*cusps; |
---|
| 2477 | delt=nodes+cusps; |
---|
| 2478 | nbranch=2*tau-3*cusps; |
---|
| 2479 | nsing=nsing+nodes; |
---|
| 2480 | } |
---|
| 2481 | else |
---|
| 2482 | { |
---|
| 2483 | if(w>=1){"the non-nodal-cuspidal singularities";"";} |
---|
| 2484 | setring C; |
---|
| 2485 | ideal I1=imap(newR,IDsing); |
---|
| 2486 | iloc=vdim(std(I1)); |
---|
| 2487 | if(iglob==iloc) |
---|
| 2488 | { |
---|
| 2489 | if(w>=1){"only cusps and nodes outside (0,0,1)";} |
---|
| 2490 | setring newR; |
---|
| 2491 | tau=vdim(std(I+jacob(I))); |
---|
| 2492 | tauinf=tauinf+tau; |
---|
| 2493 | inv=deltaLoc(I[1],maxideal(1)); |
---|
| 2494 | delt=inv[1]; |
---|
| 2495 | tauloc=inv[2]; |
---|
| 2496 | nodes=tau-tauloc-2*cusps; |
---|
| 2497 | nsing=nsing+nodes; |
---|
| 2498 | nbranch=inv[3]+ 2*nodes+cusps; |
---|
| 2499 | delt=delt+nodes+cusps; |
---|
| 2500 | if((w>=1)&&(inv[2]==0)){"smooth at (0,0,1)";} |
---|
| 2501 | } |
---|
| 2502 | else |
---|
| 2503 | { |
---|
| 2504 | setring newR; |
---|
| 2505 | list pr=minAssGTZ(IDsing); |
---|
| 2506 | if(w>=1){pr;} |
---|
| 2507 | |
---|
| 2508 | for(k=1;k<=size(pr);k++) |
---|
| 2509 | { |
---|
| 2510 | if(w>=1){nsing=nsing+vdim(std(pr[k]));} |
---|
| 2511 | inv=deltaLoc(I[1],pr[k]); |
---|
| 2512 | delt=delt+inv[1]; |
---|
| 2513 | tausing=tausing+inv[2]; |
---|
| 2514 | nbranch=nbranch+inv[3]; |
---|
| 2515 | } |
---|
| 2516 | tau=vdim(std(I+jacob(I))); |
---|
| 2517 | tauinf=tauinf+tau; |
---|
| 2518 | nodes=tau-tausing-2*cusps; |
---|
| 2519 | nsing=nsing+nodes; |
---|
| 2520 | delt=delt+nodes+cusps; |
---|
| 2521 | nbranch=nbranch+2*nodes+cusps; |
---|
| 2522 | } |
---|
| 2523 | } |
---|
| 2524 | genus=genus-delt-deltainf; |
---|
| 2525 | if(w>=1) |
---|
| 2526 | { |
---|
| 2527 | "The projected plane curve has locally:";""; |
---|
| 2528 | "singularities:";nsing; |
---|
| 2529 | "branches:";nbranch+nbranchinf; |
---|
| 2530 | "nodes:"; nodes+nodesinf; |
---|
| 2531 | "cusps:";cusps+cuspsinf; |
---|
| 2532 | "Tjurina number:";tauinf; |
---|
| 2533 | "Milnor number:";2*(delt+deltainf)-nbranch-nbranchinf+nsing; |
---|
| 2534 | "delta of the projected curve:";delt+deltainf; |
---|
| 2535 | "delta of the curve:";p_a-genus; |
---|
| 2536 | "genus:";genus; |
---|
| 2537 | "===================================================="; |
---|
| 2538 | ""; |
---|
| 2539 | } |
---|
| 2540 | setring R0; |
---|
| 2541 | return(genus); |
---|
| 2542 | } |
---|
| 2543 | example |
---|
| 2544 | { "EXAMPLE:"; echo = 2; |
---|
| 2545 | ring r=0,(x,y),dp; |
---|
| 2546 | ideal i=y^9 - x^2*(x - 1)^9; |
---|
| 2547 | genus(i); |
---|
| 2548 | ring r7=7,(x,y),dp; |
---|
| 2549 | ideal i=y^9 - x^2*(x - 1)^9; |
---|
| 2550 | genus(i); |
---|
| 2551 | } |
---|
| 2552 | |
---|
| 2553 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2554 | proc deltaLoc(poly f,ideal singL) |
---|
| 2555 | "USAGE: deltaLoc(f,J); f poly, J ideal |
---|
| 2556 | ASSUME: f is reduced bivariate polynomial; basering has exactly two variables; |
---|
| 2557 | J is irreducible prime component of the singular locus of f (e.g., one |
---|
| 2558 | entry of the output of @code{minAssGTZ(I);}, I = <f,jacob(f)>). |
---|
| 2559 | RETURN: list L: |
---|
| 2560 | @texinfo |
---|
| 2561 | @table @asis |
---|
| 2562 | @item @code{L[1]}; int: |
---|
| 2563 | the sum of (local) delta invariants of f at the (conjugated) singular |
---|
| 2564 | points given by J. |
---|
| 2565 | @item @code{L[2]}; int: |
---|
| 2566 | the sum of (local) Tjurina numbers of f at the (conjugated) singular |
---|
| 2567 | points given by J. |
---|
| 2568 | @item @code{L[3]}; int: |
---|
| 2569 | the sum of (local) number of branches of f at the (conjugated) |
---|
| 2570 | singular points given by J. |
---|
| 2571 | @end table |
---|
| 2572 | @end texinfo |
---|
| 2573 | NOTE: procedure makes use of @code{execute}; increasing printlevel displays |
---|
| 2574 | more comments (default: printlevel=0). |
---|
| 2575 | SEE ALSO: delta, tjurina |
---|
| 2576 | KEYWORDS: delta invariant; Tjurina number |
---|
| 2577 | EXAMPLE: example deltaLoc; shows an example |
---|
| 2578 | " |
---|
| 2579 | { |
---|
| 2580 | option(redSB); |
---|
| 2581 | def R=basering; |
---|
| 2582 | execute("ring S=("+charstr(R)+"),(x,y),lp;"); |
---|
| 2583 | map phi=R,x,y; |
---|
| 2584 | ideal singL=phi(singL); |
---|
| 2585 | singL=simplify(std(singL),1); |
---|
| 2586 | attrib(singL,"isSB",1); |
---|
| 2587 | int d=vdim(singL); |
---|
| 2588 | poly f=phi(f); |
---|
| 2589 | int i; |
---|
| 2590 | int w = printlevel-voice+2; // w=printlevel (default: w=0) |
---|
| 2591 | if(d==1) |
---|
| 2592 | { |
---|
| 2593 | map alpha=S,var(1)-singL[2][2],var(2)-singL[1][2]; |
---|
| 2594 | f=alpha(f); |
---|
| 2595 | execute("ring C=("+charstr(S)+"),("+varstr(S)+"),ds;"); |
---|
| 2596 | poly f=imap(S,f); |
---|
| 2597 | ideal singL=imap(S,singL); |
---|
| 2598 | if((w>=1)&&(ord(f)>=2)) |
---|
| 2599 | { |
---|
| 2600 | "local analysis of the singularities";""; |
---|
| 2601 | basering; |
---|
| 2602 | singL; |
---|
| 2603 | f; |
---|
| 2604 | pause(); |
---|
| 2605 | } |
---|
| 2606 | } |
---|
| 2607 | else |
---|
| 2608 | { |
---|
| 2609 | poly p; |
---|
| 2610 | poly c; |
---|
| 2611 | map psi; |
---|
| 2612 | number co; |
---|
| 2613 | |
---|
| 2614 | while((deg(lead(singL[1]))>1)&&(deg(lead(singL[2]))>1)) |
---|
| 2615 | { |
---|
| 2616 | psi=S,x,y+random(-100,100)*x; |
---|
| 2617 | singL=psi(singL); |
---|
| 2618 | singL=std(singL); |
---|
| 2619 | f=psi(f); |
---|
| 2620 | } |
---|
| 2621 | |
---|
| 2622 | if(deg(lead(singL[2]))==1) |
---|
| 2623 | { |
---|
| 2624 | p=singL[1]; |
---|
| 2625 | c=singL[2]-lead(singL[2]); |
---|
| 2626 | co=leadcoef(singL[2]); |
---|
| 2627 | } |
---|
| 2628 | if(deg(lead(singL[1]))==1) |
---|
| 2629 | { |
---|
| 2630 | psi=S,y,x; |
---|
| 2631 | f=psi(f); |
---|
| 2632 | singL=psi(singL); |
---|
| 2633 | p=singL[2]; |
---|
| 2634 | c=singL[1]-lead(singL[1]); |
---|
| 2635 | co=leadcoef(singL[1]); |
---|
| 2636 | } |
---|
| 2637 | |
---|
| 2638 | execute("ring B=("+charstr(S)+"),a,dp;"); |
---|
| 2639 | map beta=S,a,a; |
---|
| 2640 | poly p=beta(p); |
---|
| 2641 | |
---|
| 2642 | execute("ring C=("+charstr(S)+",a),("+varstr(S)+"),ds;"); |
---|
| 2643 | number p=number(imap(B,p)); |
---|
| 2644 | |
---|
| 2645 | minpoly=p; |
---|
| 2646 | map iota=S,a,a; |
---|
| 2647 | number c=number(iota(c)); |
---|
| 2648 | number co=iota(co); |
---|
| 2649 | |
---|
| 2650 | map alpha=S,x-c/co,y+a; |
---|
| 2651 | poly f=alpha(f); |
---|
| 2652 | f=cleardenom(f); |
---|
| 2653 | if((w>=1)&&(ord(f)>=2)) |
---|
| 2654 | { |
---|
| 2655 | "local analysis of the singularities";""; |
---|
| 2656 | basering; |
---|
| 2657 | alpha; |
---|
| 2658 | f; |
---|
| 2659 | pause(); |
---|
| 2660 | ""; |
---|
| 2661 | } |
---|
| 2662 | } |
---|
| 2663 | option(noredSB); |
---|
| 2664 | ideal fstd=std(ideal(f)+jacob(f)); |
---|
| 2665 | poly hc=highcorner(fstd); |
---|
| 2666 | int tau=vdim(fstd); |
---|
| 2667 | int o=ord(f); |
---|
| 2668 | int delt,nb; |
---|
| 2669 | |
---|
| 2670 | if(tau==0) //smooth case |
---|
| 2671 | { |
---|
| 2672 | setring R; |
---|
| 2673 | return(list(0,0,1)); |
---|
| 2674 | } |
---|
| 2675 | if((char(basering)>=181)||(char(basering)==0)) |
---|
| 2676 | { |
---|
| 2677 | if(o==2) //A_k-singularity |
---|
| 2678 | { |
---|
| 2679 | if(w>=1){"A_k-singularity";"";} |
---|
| 2680 | setring R; |
---|
| 2681 | delt=(tau+1)/2; |
---|
| 2682 | return(list(d*delt,d*tau,d*(2*delt-tau+1))); |
---|
| 2683 | } |
---|
| 2684 | if((lead(f)==var(1)*var(2)^2)||(lead(f)==var(1)^2*var(2))) |
---|
| 2685 | { |
---|
| 2686 | if(w>=1){"D_k- singularity";"";} |
---|
| 2687 | |
---|
| 2688 | setring R; |
---|
| 2689 | delt=(tau+2)/2; |
---|
| 2690 | return(list(d*delt,d*tau,d*(2*delt-tau+1))); |
---|
| 2691 | } |
---|
| 2692 | |
---|
| 2693 | int mu=vdim(std(jacob(f))); |
---|
| 2694 | poly g=f+var(1)^mu+var(2)^mu; //to obtain a convenient Newton-polygon |
---|
| 2695 | |
---|
| 2696 | list NP=newtonpoly(g); |
---|
| 2697 | if(w>=1){"Newton-Polygon:";NP;"";} |
---|
| 2698 | int s=size(NP); |
---|
| 2699 | |
---|
| 2700 | if(is_NND(f,mu,NP)) |
---|
| 2701 | { // the Newton-polygon is non-degenerate |
---|
| 2702 | // compute nb, the number of branches |
---|
| 2703 | for(i=1;i<=s-1;i++) |
---|
| 2704 | { |
---|
| 2705 | nb=nb+gcd(NP[i][2]-NP[i+1][2],NP[i][1]-NP[i+1][1]); |
---|
| 2706 | } |
---|
| 2707 | if(w>=1){"Newton-Polygon is non-degenerated";"";} |
---|
| 2708 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
| 2709 | } |
---|
| 2710 | |
---|
| 2711 | if(w>=1){"Newton-Polygon is degenerated";"";} |
---|
| 2712 | |
---|
| 2713 | // the following can certainly be made more efficient when replacing |
---|
| 2714 | // 'hnexpansion' (used only for computing number of branches) by |
---|
| 2715 | // successive blowing-up + test if Newton polygon degenerate: |
---|
| 2716 | if(s>2) // splitting of f |
---|
| 2717 | { |
---|
| 2718 | if(w>=1){"Newton polygon can be used for splitting";"";} |
---|
| 2719 | intvec v=NP[1][2]-NP[2][2],NP[2][1]; |
---|
| 2720 | int de=w_deg(g,v); |
---|
| 2721 | int st=w_deg(hc,v)+v[1]+v[2]; |
---|
| 2722 | poly f1=var(2)^NP[2][2]; |
---|
| 2723 | poly f2=jet(g,de,v)/var(2)^NP[2][2]; |
---|
| 2724 | poly h=g-f1*f2; |
---|
| 2725 | de=w_deg(h,v); |
---|
| 2726 | poly k; |
---|
| 2727 | ideal wi=var(2)^NP[2][2],f2; |
---|
| 2728 | matrix li; |
---|
| 2729 | while(de<st) |
---|
| 2730 | { |
---|
| 2731 | k=jet(h,de,v); |
---|
| 2732 | li=lift(wi,k); |
---|
| 2733 | f1=f1+li[2,1]; |
---|
| 2734 | f2=f2+li[1,1]; |
---|
| 2735 | h=g-f1*f2; |
---|
| 2736 | de=w_deg(h,v); |
---|
| 2737 | } |
---|
| 2738 | nb=deltaLoc(f1,maxideal(1))[3]+deltaLoc(f2,maxideal(1))[3]; |
---|
| 2739 | setring R; |
---|
| 2740 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
| 2741 | } |
---|
| 2742 | |
---|
| 2743 | f=jet(f,deg(hc)+2); |
---|
| 2744 | if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";} |
---|
| 2745 | ideal fac=factorize(f,1); |
---|
| 2746 | if(size(fac)>1) |
---|
| 2747 | { |
---|
| 2748 | nb=0; |
---|
| 2749 | for(i=1;i<=size(fac);i++) |
---|
| 2750 | { |
---|
| 2751 | nb=nb+deltaLoc(fac[i],maxideal(1))[3]; |
---|
| 2752 | } |
---|
| 2753 | setring R; |
---|
| 2754 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
| 2755 | } |
---|
| 2756 | list HNEXP=hnexpansion(f); |
---|
| 2757 | if (typeof(HNEXP[1])=="ring") { |
---|
| 2758 | def altring = basering; |
---|
| 2759 | def HNEring = HNEXP[1]; setring HNEring; |
---|
| 2760 | nb=size(hne); |
---|
| 2761 | setring R; |
---|
| 2762 | kill HNEring; |
---|
| 2763 | } |
---|
| 2764 | else |
---|
| 2765 | { |
---|
| 2766 | nb=size(HNEXP); |
---|
| 2767 | } |
---|
| 2768 | return(list(d*(mu+nb-1)/2,d*tau,d*nb)); |
---|
| 2769 | } |
---|
| 2770 | else //the case of small characteristic |
---|
| 2771 | { |
---|
| 2772 | f=jet(f,deg(hc)+2); |
---|
| 2773 | if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";} |
---|
| 2774 | delt=delta(f); |
---|
| 2775 | return(list(d*delt,d*tau,d)); |
---|
| 2776 | } |
---|
| 2777 | } |
---|
| 2778 | example |
---|
| 2779 | { "EXAMPLE:"; echo = 2; |
---|
| 2780 | ring r=0,(x,y),dp; |
---|
| 2781 | poly f=(x2+y^2-1)^3 +27x2y2; |
---|
| 2782 | ideal I=f,jacob(f); |
---|
| 2783 | I=std(I); |
---|
| 2784 | list qr=minAssGTZ(I); |
---|
| 2785 | size(qr); |
---|
| 2786 | // each component of the singular locus either describes a cusp or a pair |
---|
| 2787 | // of conjugated nodes: |
---|
| 2788 | deltaLoc(f,qr[1]); |
---|
| 2789 | deltaLoc(f,qr[2]); |
---|
| 2790 | deltaLoc(f,qr[3]); |
---|
| 2791 | deltaLoc(f,qr[4]); |
---|
| 2792 | deltaLoc(f,qr[5]); |
---|
| 2793 | deltaLoc(f,qr[6]); |
---|
| 2794 | } |
---|
| 2795 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2796 | // compute the weighted degree of p |
---|
| 2797 | static proc w_deg(poly p, intvec v) |
---|
| 2798 | { |
---|
| 2799 | if(p==0){return(-1);} |
---|
| 2800 | int d=0; |
---|
| 2801 | while(jet(p,d,v)==0){d++;} |
---|
| 2802 | d=(transpose(leadexp(jet(p,d,v)))*v)[1]; |
---|
| 2803 | return(d); |
---|
| 2804 | } |
---|
| 2805 | |
---|
| 2806 | //proc hilbPoly(ideal J) |
---|
| 2807 | //{ |
---|
| 2808 | // poly hp; |
---|
| 2809 | // int i; |
---|
| 2810 | // if(!attrib(J,"isSB")){J=std(J);} |
---|
| 2811 | // intvec v = hilb(J,2); |
---|
| 2812 | // for(i=1; i<=size(v); i++){ hp=hp+v[i]*(var(1)-i+2);} |
---|
| 2813 | // return(hp); |
---|
| 2814 | //} |
---|
| 2815 | |
---|
| 2816 | |
---|
| 2817 | ////////////////////////////////////////////////////////////////////////////// |
---|
| 2818 | |
---|
| 2819 | proc primeClosure (list L, list #) |
---|
| 2820 | "USAGE: primeClosure(L [,c]); L a list of a ring containing a prime ideal |
---|
| 2821 | ker, c an optional integer |
---|
| 2822 | RETURN: a list L (of size n+1) consisting of rings L[1],...,L[n] such that |
---|
| 2823 | - L[1] is a copy of (not a reference to!) the input ring L[1] |
---|
| 2824 | - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi |
---|
| 2825 | such that |
---|
| 2826 | L[1]/ker --> ... --> L[n]/ker |
---|
| 2827 | are injections given by the corresponding ideals phi, and L[n]/ker |
---|
| 2828 | is the integral closure of L[1]/ker in its quotient field. |
---|
| 2829 | - all rings L[i] contain a polynomial nzd such that elements of |
---|
| 2830 | L[i]/ker are quotients of elements of L[i-1]/ker with denominator |
---|
| 2831 | nzd via the injection phi. |
---|
| 2832 | L[n+1] is the delta invariant |
---|
| 2833 | NOTE: - L is constructed by recursive calls of primeClosure itself. |
---|
| 2834 | - c determines the choice of nzd: |
---|
| 2835 | - c not given or equal to 0: first generator of the ideal SL, |
---|
| 2836 | the singular locus of Spec(L[i]/ker) |
---|
| 2837 | - c<>0: the generator of SL with least number of monomials. |
---|
| 2838 | EXAMPLE: example primeClosure; shows an example |
---|
| 2839 | " |
---|
| 2840 | { |
---|
| 2841 | //---- Start with a consistency check: |
---|
| 2842 | |
---|
| 2843 | if (!(typeof(L[1])=="ring")) |
---|
| 2844 | { |
---|
| 2845 | "// Parameter must be a ring or a list containing a ring!"; |
---|
| 2846 | return(-1); |
---|
| 2847 | } |
---|
| 2848 | |
---|
| 2849 | int dblvl = printlevel-voice+2; |
---|
| 2850 | list gnirlist = ringlist(basering); |
---|
| 2851 | |
---|
| 2852 | //---- Some auxiliary variables: |
---|
| 2853 | int delt; //finally the delta invariant |
---|
| 2854 | if ( size(L) == 1 ) |
---|
| 2855 | { |
---|
| 2856 | L[2] = delt; //set delta to 0 |
---|
| 2857 | } |
---|
| 2858 | int n = size(L)-1; //L without delta invariant |
---|
| 2859 | |
---|
| 2860 | //---- How to choose the non-zerodivisor later on? |
---|
| 2861 | |
---|
| 2862 | int nzdoption=0; |
---|
| 2863 | if (size(#)>0) |
---|
| 2864 | { |
---|
| 2865 | nzdoption=#[1]; |
---|
| 2866 | } |
---|
| 2867 | |
---|
| 2868 | // R0 below is the ring to work with, if we are in step one, make a copy of the |
---|
| 2869 | // input ring, so that all objects are created in the copy, not in the original |
---|
| 2870 | // ring (therefore a copy, not a reference is defined). |
---|
| 2871 | |
---|
| 2872 | if (n==1) |
---|
| 2873 | { |
---|
| 2874 | def R = L[1]; |
---|
| 2875 | list Rlist = ringlist(R); |
---|
| 2876 | def BAS = basering; |
---|
| 2877 | setring R; |
---|
| 2878 | if (!(typeof(ker)=="ideal")) |
---|
| 2879 | { |
---|
| 2880 | "// No ideal ker in the input ring!"; |
---|
| 2881 | return (-1); |
---|
| 2882 | } |
---|
| 2883 | ker=simplify(interred(ker),15); |
---|
| 2884 | //execute ("ring R0="+charstr(R)+",("+varstr(R)+"),("+ordstr(R)+");"); |
---|
| 2885 | // Rlist may be not defined in this new ring, so we define it again. |
---|
| 2886 | list Rlist2 = ringlist(R); |
---|
| 2887 | def R0 = ring(Rlist2); |
---|
| 2888 | setring R0; |
---|
| 2889 | ideal ker=fetch(R,ker); |
---|
| 2890 | // check whether we compute the normalization of the blow up of |
---|
| 2891 | // an isolated singularity at the origin (checked in normalI) |
---|
| 2892 | |
---|
| 2893 | if (typeof(attrib(L[1],"iso_sing_Rees"))=="int") |
---|
| 2894 | { |
---|
| 2895 | attrib(R0,"iso_sing_Rees",attrib(L[1],"iso_sing_Rees")); |
---|
| 2896 | } |
---|
| 2897 | L[1]=R0; |
---|
| 2898 | } |
---|
| 2899 | else |
---|
| 2900 | { |
---|
| 2901 | def R0 = L[n]; |
---|
| 2902 | setring R0; |
---|
| 2903 | } |
---|
| 2904 | |
---|
| 2905 | // In order to apply HomJJ from normal.lib, we need the radical of the singular |
---|
| 2906 | // locus of ker, J:=rad(ker): |
---|
| 2907 | |
---|
| 2908 | list SM=mstd(ker); |
---|
| 2909 | |
---|
| 2910 | // In the first iteration, we have to compute the singular locus "from |
---|
| 2911 | // scratch". |
---|
| 2912 | // In further iterations, we can fetch it from the previous one but |
---|
| 2913 | // have to compute its radical |
---|
| 2914 | // the next rings R1 contain already the (fetched) ideal |
---|
| 2915 | |
---|
| 2916 | if (n==1) //we are in R0=L[1] |
---|
| 2917 | { |
---|
| 2918 | if (typeof(attrib(R0,"iso_sing_Rees"))=="int") |
---|
| 2919 | { |
---|
| 2920 | ideal J; |
---|
| 2921 | for (int s=1;s<=attrib(R0,"iso_sing_Rees");s++) |
---|
| 2922 | { |
---|
| 2923 | J=J,var(s); |
---|
| 2924 | } |
---|
| 2925 | J = J,SM[2]; |
---|
| 2926 | list JM = mstd(J); |
---|
| 2927 | } |
---|
| 2928 | else |
---|
| 2929 | { |
---|
| 2930 | if ( dblvl >= 1 ) |
---|
| 2931 | {""; |
---|
| 2932 | "// compute the singular locus"; |
---|
| 2933 | } |
---|
| 2934 | //### Berechnung des singulaeren Orts geaendert (ist so schneller) |
---|
| 2935 | ideal J = minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]); |
---|
| 2936 | J = J,SM[2]; |
---|
| 2937 | list JM = mstd(J); |
---|
| 2938 | } |
---|
| 2939 | |
---|
| 2940 | if ( dblvl >= 1 ) |
---|
| 2941 | {""; |
---|
| 2942 | "// dimension of singular locus is", dim(JM[1]); |
---|
| 2943 | if ( dblvl >= 2 ) |
---|
| 2944 | {""; |
---|
| 2945 | "// the singular locus is:"; JM[2]; |
---|
| 2946 | } |
---|
| 2947 | } |
---|
| 2948 | |
---|
| 2949 | if ( dblvl >= 1 ) |
---|
| 2950 | {""; |
---|
| 2951 | "// compute radical of singular locus"; |
---|
| 2952 | } |
---|
| 2953 | |
---|
| 2954 | J = simplify(radical(JM[2]),2); |
---|
| 2955 | if ( dblvl >= 1 ) |
---|
| 2956 | {""; |
---|
| 2957 | "// radical of singular locus is:"; J; |
---|
| 2958 | pause(); |
---|
| 2959 | } |
---|
| 2960 | } |
---|
| 2961 | else |
---|
| 2962 | { |
---|
| 2963 | if ( dblvl >= 1 ) |
---|
| 2964 | {""; |
---|
| 2965 | "// compute radical of test ideal in ideal of singular locus"; |
---|
| 2966 | } |
---|
| 2967 | J = simplify(radical(J),2); |
---|
| 2968 | if ( dblvl >= 1 ) |
---|
| 2969 | {""; |
---|
| 2970 | "// radical of test ideal is:"; J; |
---|
| 2971 | pause(); |
---|
| 2972 | } |
---|
| 2973 | } |
---|
| 2974 | |
---|
| 2975 | // having computed the radical J of/in the ideal of the singular locus, |
---|
| 2976 | // we now need to pick an element nzd of J; |
---|
| 2977 | // NOTE: nzd must be a non-zero divisor mod ker, i.e. not contained in ker |
---|
| 2978 | |
---|
| 2979 | poly nzd = J[1]; |
---|
| 2980 | poly nzd1 = NF(nzd,SM[1]); |
---|
| 2981 | if (nzd1 != 0) |
---|
| 2982 | { |
---|
| 2983 | if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) ) |
---|
| 2984 | { |
---|
| 2985 | nzd = nzd1; |
---|
| 2986 | } |
---|
| 2987 | } |
---|
| 2988 | |
---|
| 2989 | if (nzdoption || nzd1==0) |
---|
| 2990 | { |
---|
| 2991 | for (int ii=2;ii<=ncols(J);ii++) |
---|
| 2992 | { |
---|
| 2993 | nzd1 = NF(J[ii],SM[1]); |
---|
| 2994 | if ( nzd1 != 0 ) |
---|
| 2995 | { |
---|
| 2996 | if ( (deg(nzd)>=deg(J[ii])) && (size(nzd)>size(J[ii])) ) |
---|
| 2997 | { |
---|
| 2998 | nzd=J[ii]; |
---|
| 2999 | } |
---|
| 3000 | if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) ) |
---|
| 3001 | { |
---|
| 3002 | nzd = nzd1; |
---|
| 3003 | } |
---|
| 3004 | } |
---|
| 3005 | } |
---|
| 3006 | } |
---|
| 3007 | |
---|
| 3008 | export nzd; |
---|
| 3009 | // In this case we do not eliminate variables, so that the maps |
---|
| 3010 | // are well defined. |
---|
| 3011 | list RR = SM[1],SM[2],J,nzd,1; |
---|
| 3012 | |
---|
| 3013 | if ( dblvl >= 1 ) |
---|
| 3014 | {""; |
---|
| 3015 | "// compute the first ring extension:"; |
---|
| 3016 | "RR: "; |
---|
| 3017 | RR; |
---|
| 3018 | } |
---|
| 3019 | |
---|
| 3020 | list RS = HomJJ(RR); |
---|
| 3021 | //NOTE: HomJJ creates new ring with variables X(i) and T(j) |
---|
| 3022 | //------------------------------------------------------------------------- |
---|
| 3023 | // If we've reached the integral closure (as determined by the result of |
---|
| 3024 | // HomJJ), then we are done, otherwise we have to prepare the next iteration. |
---|
| 3025 | |
---|
| 3026 | if (RS[2]==1) // we've reached the integral closure, we are still in R0 |
---|
| 3027 | { |
---|
| 3028 | kill J; |
---|
| 3029 | if ( n== 1) |
---|
| 3030 | { |
---|
| 3031 | def R1 = RS[1]; |
---|
| 3032 | setring R1; |
---|
| 3033 | ideal norid, normap = endid, endphi; |
---|
| 3034 | kill endid, endphi; |
---|
| 3035 | |
---|
| 3036 | //"//### case: primeClosure, final"; |
---|
| 3037 | //"size norid:", size(norid), size(string(norid)); |
---|
| 3038 | //"interred:"; |
---|
| 3039 | //norid = interred(norid); |
---|
| 3040 | //"size norid:", size(norid), size(string(norid)); |
---|
| 3041 | |
---|
| 3042 | export (norid, normap); |
---|
| 3043 | L[1] = R1; |
---|
| 3044 | } |
---|
| 3045 | return(L); |
---|
| 3046 | } |
---|
| 3047 | else // prepare the next iteration |
---|
| 3048 | { |
---|
| 3049 | if (n==1) // In the first iteration: keep only the data |
---|
| 3050 | { // needed later on. |
---|
| 3051 | kill RR,SM; |
---|
| 3052 | export(ker); |
---|
| 3053 | } |
---|
| 3054 | if ( dblvl >= 1 ) |
---|
| 3055 | {""; |
---|
| 3056 | "// computing the next ring extension, we are in loop"; n+1; |
---|
| 3057 | } |
---|
| 3058 | |
---|
| 3059 | def R1 = RS[1]; // The data of the next ring R1: |
---|
| 3060 | delt = RS[3]; // the delta invariant of the ring extension |
---|
| 3061 | setring R1; // keep only what is necessary and kill |
---|
| 3062 | ideal ker=endid; // everything else. |
---|
| 3063 | export(ker); |
---|
| 3064 | ideal norid=endid; |
---|
| 3065 | |
---|
| 3066 | //"//### case: primeClosure, loop", n+1; |
---|
| 3067 | //"size norid:", size(norid), size(string(norid)); |
---|
| 3068 | //"interred:"; |
---|
| 3069 | //norid = interred(norid); //???? |
---|
| 3070 | //"size norid:", size(norid), size(string(norid)); |
---|
| 3071 | |
---|
| 3072 | export(norid); |
---|
| 3073 | kill endid; |
---|
| 3074 | |
---|
| 3075 | map phi = R0,endphi; // fetch the singular locus |
---|
| 3076 | ideal J = mstd(simplify(phi(J)+ker,4))[2]; // ideal J in R1 |
---|
| 3077 | export(J); |
---|
| 3078 | if(n>1) |
---|
| 3079 | { |
---|
| 3080 | ideal normap=phi(normap); |
---|
| 3081 | } |
---|
| 3082 | else |
---|
| 3083 | { |
---|
| 3084 | ideal normap=endphi; |
---|
| 3085 | } |
---|
| 3086 | export(normap); |
---|
| 3087 | kill phi; // we save phi as ideal, not as map, so that |
---|
| 3088 | ideal phi=endphi; // we have more flexibility in the ring names |
---|
| 3089 | kill endphi; // later on. |
---|
| 3090 | export(phi); |
---|
| 3091 | L=insert(L,R1,n); // Add the new ring R1 and go on with the |
---|
| 3092 | // next iteration |
---|
| 3093 | if ( L[size(L)] >= 0 && delt >= 0 ) |
---|
| 3094 | { |
---|
| 3095 | delt = L[size(L)] + delt; |
---|
| 3096 | } |
---|
| 3097 | else |
---|
| 3098 | { |
---|
| 3099 | delt = -1; |
---|
| 3100 | } |
---|
| 3101 | L[size(L)] = delt; |
---|
| 3102 | |
---|
| 3103 | if (size(#)>0) |
---|
| 3104 | { |
---|
| 3105 | return (primeClosure(L,#)); |
---|
| 3106 | } |
---|
| 3107 | else |
---|
| 3108 | { |
---|
| 3109 | return(primeClosure(L)); // next iteration. |
---|
| 3110 | } |
---|
| 3111 | } |
---|
| 3112 | } |
---|
| 3113 | example |
---|
| 3114 | { |
---|
| 3115 | "EXAMPLE:"; echo=2; |
---|
| 3116 | ring R=0,(x,y),dp; |
---|
| 3117 | ideal I=x4,y4; |
---|
| 3118 | def K=ReesAlgebra(I)[1]; // K contains ker such that K/ker=R[It] |
---|
| 3119 | list L=primeClosure(K); |
---|
| 3120 | def R(1)=L[1]; // L[4] contains ker, L[4]/ker is the |
---|
| 3121 | def R(4)=L[4]; // integral closure of L[1]/ker |
---|
| 3122 | setring R(1); |
---|
| 3123 | R(1); |
---|
| 3124 | ker; |
---|
| 3125 | setring R(4); |
---|
| 3126 | R(4); |
---|
| 3127 | ker; |
---|
| 3128 | } |
---|
| 3129 | |
---|
| 3130 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 3131 | |
---|
| 3132 | proc closureFrac(list L) |
---|
| 3133 | "USAGE: closureFrac (L); L a list of size n+1 as in the result of |
---|
| 3134 | primeClosure, L[n] contains an additional polynomial f |
---|
| 3135 | CREATE: a list fraction of two elements of L[1], such that |
---|
| 3136 | f=fraction[1]/fraction[2] via the injections phi L[i]-->L[i+1]. |
---|
| 3137 | EXAMPLE: example closureFrac; shows an example |
---|
| 3138 | " |
---|
| 3139 | { |
---|
| 3140 | // Define some auxiliary variables: |
---|
| 3141 | |
---|
| 3142 | int n=size(L)-1; |
---|
| 3143 | int i,j,k,l,n2,n3; |
---|
| 3144 | intvec V; |
---|
| 3145 | string mapstr; |
---|
| 3146 | for (i=1; i<=n; i++) { def R(i) = L[i]; } |
---|
| 3147 | |
---|
| 3148 | // The quotient representing f is computed as in 'closureGenerators' with |
---|
| 3149 | // the differences that |
---|
| 3150 | // - the loop is done twice: for the numerator and for the denominator; |
---|
| 3151 | // - the result is stored in the list fraction and |
---|
| 3152 | // - we have to make sure that no more objects of the rings R(i) survive. |
---|
| 3153 | |
---|
| 3154 | for (j=1; j<=2; j++) |
---|
| 3155 | { |
---|
| 3156 | setring R(n); |
---|
| 3157 | if (j==1) |
---|
| 3158 | { |
---|
| 3159 | poly p=f; |
---|
| 3160 | } |
---|
| 3161 | else |
---|
| 3162 | { |
---|
| 3163 | p=1; |
---|
| 3164 | } |
---|
| 3165 | |
---|
| 3166 | for (k=n; k>1; k--) |
---|
| 3167 | { |
---|
| 3168 | if (j==1) |
---|
| 3169 | { |
---|
| 3170 | map phimap=R(k-1),phi; |
---|
| 3171 | } |
---|
| 3172 | |
---|
| 3173 | p=p*phimap(nzd); |
---|
| 3174 | |
---|
| 3175 | if (j==2) |
---|
| 3176 | { |
---|
| 3177 | kill phimap; |
---|
| 3178 | } |
---|
| 3179 | |
---|
| 3180 | if (j==1) |
---|
| 3181 | { |
---|
| 3182 | //### noch abfragen ob Z(i) definiert ist |
---|
| 3183 | list gnirlist = ringlist(R(k)); |
---|
| 3184 | n2 = size(gnirlist[2]); |
---|
| 3185 | n3 = size(gnirlist[3]); |
---|
| 3186 | for( i=1; i<=ncols(phi); i++) |
---|
| 3187 | { |
---|
| 3188 | gnirlist[2][n2+i] = "Z("+string(i)+")"; |
---|
| 3189 | } |
---|
| 3190 | V=0; |
---|
| 3191 | V[ncols(phi)]=0; V=V+1; |
---|
| 3192 | gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1); |
---|
| 3193 | def S(k) = ring(gnirlist); |
---|
| 3194 | setring S(k); |
---|
| 3195 | |
---|
| 3196 | //execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+", |
---|
| 3197 | // Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k))) |
---|
| 3198 | // +"),dp("+string(ncols(phi))+"));"); |
---|
| 3199 | |
---|
| 3200 | ideal phi = imap(R(k),phi); |
---|
| 3201 | ideal J = imap (R(k),ker); |
---|
| 3202 | for (l=1;l<=ncols(phi);l++) |
---|
| 3203 | { |
---|
| 3204 | J=J+(Z(l)-phi[l]); |
---|
| 3205 | } |
---|
| 3206 | J=groebner(J); |
---|
| 3207 | poly h=NF(imap(R(k),p),J); |
---|
| 3208 | } |
---|
| 3209 | else |
---|
| 3210 | { |
---|
| 3211 | setring S(k); |
---|
| 3212 | h=NF(imap(R(k),p),J); |
---|
| 3213 | setring R(k); |
---|
| 3214 | kill p; |
---|
| 3215 | } |
---|
| 3216 | |
---|
| 3217 | setring R(k-1); |
---|
| 3218 | |
---|
| 3219 | if (j==1) |
---|
| 3220 | { |
---|
| 3221 | ideal maxi; |
---|
| 3222 | maxi[nvars(R(k))] = 0; |
---|
| 3223 | maxi = maxi,maxideal(1); |
---|
| 3224 | map backmap = S(k),maxi; |
---|
| 3225 | |
---|
| 3226 | //mapstr=" map backmap = S(k),"; |
---|
| 3227 | //for (l=1;l<=nvars(R(k));l++) |
---|
| 3228 | //{ |
---|
| 3229 | // mapstr=mapstr+"0,"; |
---|
| 3230 | //} |
---|
| 3231 | //execute (mapstr+"maxideal(1);"); |
---|
| 3232 | poly p; |
---|
| 3233 | } |
---|
| 3234 | p=NF(backmap(h),std(ker)); |
---|
| 3235 | if (j==2) |
---|
| 3236 | { |
---|
| 3237 | kill backmap; |
---|
| 3238 | } |
---|
| 3239 | } |
---|
| 3240 | |
---|
| 3241 | if (j==1) |
---|
| 3242 | { |
---|
| 3243 | if (defined(fraction)) |
---|
| 3244 | { |
---|
| 3245 | kill fraction; |
---|
| 3246 | list fraction=p; |
---|
| 3247 | } |
---|
| 3248 | else |
---|
| 3249 | { |
---|
| 3250 | list fraction=p; |
---|
| 3251 | } |
---|
| 3252 | } |
---|
| 3253 | else |
---|
| 3254 | { |
---|
| 3255 | fraction=insert(fraction,p,1); |
---|
| 3256 | } |
---|
| 3257 | } |
---|
| 3258 | export(fraction); |
---|
| 3259 | return (); |
---|
| 3260 | } |
---|
| 3261 | example |
---|
| 3262 | { |
---|
| 3263 | "EXAMPLE:"; echo=2; |
---|
| 3264 | ring R=0,(x,y),dp; |
---|
| 3265 | ideal ker=x2+y2; |
---|
| 3266 | export ker; |
---|
| 3267 | list L=primeClosure(R); // We normalize R/ker |
---|
| 3268 | for (int i=1;i<=size(L);i++) { def R(i)=L[i]; } |
---|
| 3269 | setring R(2); |
---|
| 3270 | kill R; |
---|
| 3271 | phi; // The map R(1)-->R(2) |
---|
| 3272 | poly f=T(2); // We will get a representation of f |
---|
| 3273 | export f; |
---|
| 3274 | L[2]=R(2); |
---|
| 3275 | closureFrac(L); |
---|
| 3276 | setring R(1); |
---|
| 3277 | kill R(2); |
---|
| 3278 | fraction; // f=fraction[1]/fraction[2] via phi |
---|
| 3279 | kill R(1); |
---|
| 3280 | } |
---|
| 3281 | |
---|
| 3282 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 3283 | // closureGenerators is called inside proc normal (option "withGens" ) |
---|
| 3284 | // |
---|
| 3285 | |
---|
| 3286 | // INPUT is the output of proc primeClosure (except for the last element, the |
---|
| 3287 | // delta invariant) : hence input is a list L consisting of rings |
---|
| 3288 | // L[1],...,L[n] (denoted R(1)...R(n) below) such that |
---|
| 3289 | // - L[1] is a copy of (not a reference to!) the input ring L[1] |
---|
| 3290 | // - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi |
---|
| 3291 | // such that |
---|
| 3292 | // L[1]/ker --> ... --> L[n]/ker |
---|
| 3293 | // are injections given by the corresponding ideals phi, and L[n]/ker |
---|
| 3294 | // is the integral closure of L[1]/ker in its quotient field. |
---|
| 3295 | // - all rings L[i] contain a polynomial nzd such that elements of |
---|
| 3296 | // L[i]/ker are quotients of elements of L[i-1]/ker with denominator |
---|
| 3297 | // nzd via the injection phi. |
---|
| 3298 | |
---|
| 3299 | // COMPUTE: In the list L of rings R(1),...,R(n), compute representations of |
---|
| 3300 | // the ring variables of the last ring R(n) as fractions of elements of R(1): |
---|
| 3301 | // The proc returns an ideal preim s.t. preim[i]/preim[size(preim)] expresses |
---|
| 3302 | // the ith variable of R(n) as fraction of elements of the basering R(1) |
---|
| 3303 | // preim[size(preim)] is a non-zero divisor of basering/i. |
---|
| 3304 | |
---|
| 3305 | proc closureGenerators(list L); |
---|
| 3306 | { |
---|
| 3307 | def Rees=basering; // when called inside normalI (in reesclos.lib) |
---|
| 3308 | // the Rees Algebra is the current basering |
---|
| 3309 | |
---|
| 3310 | // ------- First of all we need some variable declarations ----------- |
---|
| 3311 | int n = size(L); // the number of rings R(1)-->...-->R(n) |
---|
| 3312 | int length = nvars(L[n]); // the number of variables of the last ring |
---|
| 3313 | int j,k,l,n2,n3; |
---|
| 3314 | intvec V; |
---|
| 3315 | string mapstr; |
---|
| 3316 | list preimages; |
---|
| 3317 | //Note: the empty list belongs to no ring, hence preimages can be used |
---|
| 3318 | //later in R(1) |
---|
| 3319 | //this is not possible for ideals (belong always to some ring) |
---|
| 3320 | |
---|
| 3321 | for (int i=1; i<=n; i++) |
---|
| 3322 | { |
---|
| 3323 | def R(i)=L[i]; //give the rings from L a name |
---|
| 3324 | } |
---|
| 3325 | |
---|
| 3326 | // For each variable (counter j) and for each intermediate ring (counter k): |
---|
| 3327 | // Find a preimage of var_j*phi(nzd(k-1)) in R(k-1). |
---|
| 3328 | // Finally, do the same for nzd. |
---|
| 3329 | |
---|
| 3330 | for (j=1; j <= length+1; j++ ) |
---|
| 3331 | { |
---|
| 3332 | setring R(n); |
---|
| 3333 | if (j==1) |
---|
| 3334 | { |
---|
| 3335 | poly p; |
---|
| 3336 | } |
---|
| 3337 | if (j <= length ) |
---|
| 3338 | { |
---|
| 3339 | p=var(j); |
---|
| 3340 | } |
---|
| 3341 | else |
---|
| 3342 | { |
---|
| 3343 | p=1; |
---|
| 3344 | } |
---|
| 3345 | //i.e. p=j-th var of R(n) for j<=length and p=1 for j=length+1 |
---|
| 3346 | |
---|
| 3347 | for (k=n; k>1; k--) |
---|
| 3348 | { |
---|
| 3349 | |
---|
| 3350 | if (j==1) |
---|
| 3351 | { |
---|
| 3352 | map phimap=R(k-1),phi; //phimap:R(k-1)-->R(n), k=2..n, is the map |
---|
| 3353 | //belonging to phi in R(n) |
---|
| 3354 | } |
---|
| 3355 | |
---|
| 3356 | p = p*phimap(nzd); |
---|
| 3357 | |
---|
| 3358 | // Compute the preimage of [p mod ker(k)] under phi in R(k-1): |
---|
| 3359 | // As p is an element of Image(phi), there is a polynomial h such |
---|
| 3360 | // that h is mapped to [p mod ker(k)], and h can be computed as the |
---|
| 3361 | // normal form of p w.r.t. a Groebner basis of |
---|
| 3362 | // J(k) := <ker(k),Z(l)-phi(k)(l)> in R(k)[Z]=:S(k) |
---|
| 3363 | |
---|
| 3364 | if (j==1) // In the first iteration: Create S(k), fetch phi and |
---|
| 3365 | // ker(k) and construct the ideal J(k). |
---|
| 3366 | { |
---|
| 3367 | //### noch abfragen ob Z(i) definiert ist |
---|
| 3368 | list gnirlist = ringlist(R(k)); |
---|
| 3369 | n2 = size(gnirlist[2]); |
---|
| 3370 | n3 = size(gnirlist[3]); |
---|
| 3371 | for( i=1; i<=ncols(phi); i++) |
---|
| 3372 | { |
---|
| 3373 | gnirlist[2][n2+i] = "Z("+string(i)+")"; |
---|
| 3374 | } |
---|
| 3375 | V=0; |
---|
| 3376 | V[ncols(phi)]=0; |
---|
| 3377 | V=V+1; |
---|
| 3378 | gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1); |
---|
| 3379 | def S(k) = ring(gnirlist); |
---|
| 3380 | setring S(k); |
---|
| 3381 | |
---|
| 3382 | // execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+", |
---|
| 3383 | // Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k))) |
---|
| 3384 | // +"),dp("+string(ncols(phi))+"));"); |
---|
| 3385 | |
---|
| 3386 | ideal phi = imap(R(k),phi); |
---|
| 3387 | ideal J = imap (R(k),ker); |
---|
| 3388 | for ( l=1; l<=ncols(phi); l++ ) |
---|
| 3389 | { |
---|
| 3390 | J=J+(Z(l)-phi[l]); |
---|
| 3391 | } |
---|
| 3392 | J = groebner(J); |
---|
| 3393 | poly h = NF(imap(R(k),p),J); |
---|
| 3394 | } |
---|
| 3395 | else |
---|
| 3396 | { |
---|
| 3397 | setring S(k); |
---|
| 3398 | h = NF(imap(R(k),p),J); |
---|
| 3399 | } |
---|
| 3400 | |
---|
| 3401 | setring R(k-1); |
---|
| 3402 | |
---|
| 3403 | if (j==1) // In the first iteration: Compute backmap:S(k)-->R(k-1) |
---|
| 3404 | { |
---|
| 3405 | ideal maxi; |
---|
| 3406 | maxi[nvars(R(k))] = 0; |
---|
| 3407 | maxi = maxi,maxideal(1); |
---|
| 3408 | map backmap = S(k),maxi; |
---|
| 3409 | |
---|
| 3410 | //mapstr=" map backmap = S(k),"; |
---|
| 3411 | //for (l=1;l<=nvars(R(k));l++) |
---|
| 3412 | //{ |
---|
| 3413 | // mapstr=mapstr+"0,"; |
---|
| 3414 | //} |
---|
| 3415 | //execute (mapstr+"maxideal(1);"); |
---|
| 3416 | |
---|
| 3417 | poly p; |
---|
| 3418 | } |
---|
| 3419 | p = NF(backmap(h),std(ker)); |
---|
| 3420 | } |
---|
| 3421 | // Whe are down to R(1), store here the result in the list preimages |
---|
| 3422 | preimages = insert(preimages,p,j-1); |
---|
| 3423 | } |
---|
| 3424 | ideal preim; //make the list preimages to an ideal preim |
---|
| 3425 | for ( i=1; i<=size(preimages); i++ ) |
---|
| 3426 | { |
---|
| 3427 | preim[i] = preimages[i]; |
---|
| 3428 | } |
---|
| 3429 | // R(1) was a copy of Rees, so we have to get back to the basering Rees from |
---|
| 3430 | // the beginning and fetch the result (the ideal preim) to this ring. |
---|
| 3431 | setring Rees; |
---|
| 3432 | return (fetch(R(1),preim)); |
---|
| 3433 | } |
---|
| 3434 | |
---|
| 3435 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 3436 | // From here: procedures for char p with Frobenius |
---|
| 3437 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 3438 | |
---|
| 3439 | proc normalP(ideal id,list #) |
---|
| 3440 | "USAGE: normalP(id [,choose]); id = radical ideal, choose = optional list of |
---|
| 3441 | strings. |
---|
| 3442 | Optional parameters in list choose (can be entered in any order):@* |
---|
| 3443 | \"withRing\", \"isPrim\", \"noFac\", \"noRed\", where@* |
---|
| 3444 | - \"noFac\" -> factorization is avoided during the computation |
---|
| 3445 | of the minimal associated primes.@* |
---|
| 3446 | - \"isPrim\" -> assumes that the ideal is prime. If the assumption |
---|
| 3447 | does not hold, output might be wrong.@* |
---|
| 3448 | - \"withRing\" -> the ring structure of the normalization is |
---|
| 3449 | computed. The number of variables in the new ring is reduced as much |
---|
| 3450 | as possible.@* |
---|
| 3451 | - \"noRed\" -> when computing the ring structure, no reduction on the |
---|
| 3452 | number of variables is done, it creates one new variable for every |
---|
| 3453 | new module generator of the integral closure in the quotient field.@* |
---|
| 3454 | ASSUME: The characteristic of the ground field must be positive. If the |
---|
| 3455 | option \"isPrim\" is not set, the minimal associated primes of id |
---|
| 3456 | are computed first and hence normalP computes the normalization of |
---|
| 3457 | the radical of id. If option \"isPrim\" is set, the ideal must be |
---|
| 3458 | a prime ideal otherwise the result may be wrong. |
---|
| 3459 | RETURN: a list, say 'nor' of size 2 (resp. 3 if \"withRing\" is set).@* |
---|
| 3460 | ** If option \"withRing\" is not set: @* |
---|
| 3461 | Only the module structure is computed: @* |
---|
| 3462 | * nor[1] is a list of ideals Ii, i=1..r, in the basering R where r |
---|
| 3463 | is the number of minimal associated prime ideals P_i of the input |
---|
| 3464 | ideal id, describing the module structure:@* |
---|
| 3465 | If Ii is given by polynomials g_1,...,g_k in R, then c:=g_k is |
---|
| 3466 | non-zero in the ring R/P_i and g_1/c,...,g_k/c generate the integral |
---|
| 3467 | closure of R/P_i as R-module in the quotient field of R/P_i.@* |
---|
| 3468 | * nor[2] shows the delta invariants: it is a list of an intvec |
---|
| 3469 | of size r, the delta invariants of the r components, and an integer, |
---|
| 3470 | the total delta invariant of R/id |
---|
| 3471 | (-1 means infinite, and 0 that R/P_i resp. R/id is normal). @* |
---|
| 3472 | ** If option \"withRing\" is set: @* |
---|
| 3473 | The ring structure is also computed, and in this case:@* |
---|
| 3474 | * nor[1] is a list of r rings.@* |
---|
| 3475 | Each ring Ri = nor[1][i], i=1..r, contains two ideals with given |
---|
| 3476 | names @code{norid} and @code{normap} such that @* |
---|
| 3477 | - Ri/norid is the normalization of R/P_i, i.e. isomorphic as |
---|
| 3478 | K-algebra (K the ground field) to the integral closure of R/P_i in |
---|
| 3479 | the field of fractions of R/P_i; @* |
---|
| 3480 | - the direct sum of the rings Ri/norid is the normalization |
---|
| 3481 | of R/id; @* |
---|
| 3482 | - @code{normap} gives the normalization map from R to Ri/norid.@* |
---|
| 3483 | * nor[2] gives the module generators of the normalization of R/P_i, |
---|
| 3484 | it is the same as nor[1] if \"withRing\" is not set.@* |
---|
| 3485 | * nor[3] shows the delta invariants, it is the same as nor[2] if |
---|
| 3486 | \"withRing\" is not set. |
---|
| 3487 | THEORY: normalP uses the Leonard-Pellikaan-Singh-Swanson algorithm (using the |
---|
| 3488 | Frobenius) cf. [A. K. Singh, I. Swanson: An algorithm for computing |
---|
| 3489 | the integral closure, arXiv:0901.0871]. |
---|
| 3490 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
| 3491 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
| 3492 | id. The procedure returns the delta invariants of the components P_i |
---|
| 3493 | and of id. |
---|
| 3494 | NOTE: To use the i-th ring type: @code{def R=nor[1][i]; setring R;}. |
---|
| 3495 | @* Increasing/decreasing printlevel displays more/less comments |
---|
| 3496 | (default: printlevel = 0). |
---|
| 3497 | @* Not implemented for local or mixed orderings or quotient rings. |
---|
| 3498 | For local or mixed orderings use proc 'normal'. |
---|
| 3499 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
| 3500 | be used (qhweight(id); computes weights). |
---|
| 3501 | @* Works only in characteristic p > 0; use proc normal in char 0. |
---|
| 3502 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
| 3503 | SEE ALSO: normal, normalC |
---|
| 3504 | EXAMPLE: example normalP; shows an example |
---|
| 3505 | " |
---|
| 3506 | { |
---|
| 3507 | int i,j,y, sr, del, co; |
---|
| 3508 | intvec deli; |
---|
| 3509 | list resu, Resu, prim, Gens, mstdid; |
---|
| 3510 | ideal gens; |
---|
| 3511 | |
---|
| 3512 | // Default options |
---|
| 3513 | int wring = 0; // The ring structure is not computed. |
---|
| 3514 | int noRed = 0; // No reduction is done in the ring structure |
---|
| 3515 | int isPrim = 0; // Ideal is not assumed to be prime |
---|
| 3516 | int noFac = 0; // Use facstd when computing the decomposition |
---|
| 3517 | |
---|
| 3518 | |
---|
| 3519 | y = printlevel-voice+2; |
---|
| 3520 | |
---|
| 3521 | if ( ord_test(basering) != 1) |
---|
| 3522 | { |
---|
| 3523 | ""; |
---|
| 3524 | "// Not implemented for this ordering,"; |
---|
| 3525 | "// please change to global ordering!"; |
---|
| 3526 | return(resu); |
---|
| 3527 | } |
---|
| 3528 | if ( char(basering) <= 0) |
---|
| 3529 | { |
---|
| 3530 | ""; |
---|
| 3531 | "// Algorithm works only in positive characteristic,"; |
---|
| 3532 | "// use procedure 'normal' if the characteristic is 0"; |
---|
| 3533 | return(resu); |
---|
| 3534 | } |
---|
| 3535 | |
---|
| 3536 | //--------------------------- define the method --------------------------- |
---|
| 3537 | string method; //make all options one string in order to use |
---|
| 3538 | //all combinations of options simultaneously |
---|
| 3539 | for ( i=1; i<= size(#); i++ ) |
---|
| 3540 | { |
---|
| 3541 | if ( typeof(#[i]) == "string" ) |
---|
| 3542 | { |
---|
| 3543 | method = method + #[i]; |
---|
| 3544 | } |
---|
| 3545 | } |
---|
| 3546 | |
---|
| 3547 | if ( find(method,"withring") or find(method,"withRing") ) |
---|
| 3548 | { |
---|
| 3549 | wring=1; |
---|
| 3550 | } |
---|
| 3551 | if ( find(method,"noRed") or find(method,"nored") ) |
---|
| 3552 | { |
---|
| 3553 | noRed=1; |
---|
| 3554 | } |
---|
| 3555 | if ( find(method,"isPrim") or find(method,"isprim") ) |
---|
| 3556 | { |
---|
| 3557 | isPrim=1; |
---|
| 3558 | } |
---|
| 3559 | if ( find(method,"noFac") or find(method,"nofac")) |
---|
| 3560 | { |
---|
| 3561 | noFac=1; |
---|
| 3562 | } |
---|
| 3563 | |
---|
| 3564 | kill #; |
---|
| 3565 | list #; |
---|
| 3566 | //--------------------------- start computation --------------------------- |
---|
| 3567 | ideal II,K1,K2; |
---|
| 3568 | |
---|
| 3569 | //----------- check first (or ignore) if input id is prime ------------- |
---|
| 3570 | |
---|
| 3571 | if ( isPrim ) |
---|
| 3572 | { |
---|
| 3573 | prim[1] = id; |
---|
| 3574 | if( y >= 0 ) |
---|
| 3575 | { ""; |
---|
| 3576 | "// ** WARNING: result is correct if ideal is prime (not checked) **"; |
---|
| 3577 | "// disable option \"isPrim\" to decompose ideal into prime components";""; |
---|
| 3578 | } |
---|
| 3579 | } |
---|
| 3580 | else |
---|
| 3581 | { |
---|
| 3582 | if(y>=1) |
---|
| 3583 | { "// compute minimal associated primes"; } |
---|
| 3584 | |
---|
| 3585 | if( noFac ) |
---|
| 3586 | { prim = minAssGTZ(id,1); } |
---|
| 3587 | else |
---|
| 3588 | { prim = minAssGTZ(id); } |
---|
| 3589 | |
---|
| 3590 | if(y>=1) |
---|
| 3591 | { |
---|
| 3592 | prim;""; |
---|
| 3593 | "// number of irreducible components is", size(prim); |
---|
| 3594 | } |
---|
| 3595 | } |
---|
| 3596 | |
---|
| 3597 | //----------- compute integral closure for every component ------------- |
---|
| 3598 | |
---|
| 3599 | for(i=1; i<=size(prim); i++) |
---|
| 3600 | { |
---|
| 3601 | if(y>=1) |
---|
| 3602 | { |
---|
| 3603 | ""; pause(); ""; |
---|
| 3604 | "// start computation of component",i; |
---|
| 3605 | " --------------------------------"; |
---|
| 3606 | } |
---|
| 3607 | if(y>=1) |
---|
| 3608 | { "// compute SB of ideal"; |
---|
| 3609 | } |
---|
| 3610 | mstdid = mstd(prim[i]); |
---|
| 3611 | if(y>=1) |
---|
| 3612 | { "// dimension of component is", dim(mstdid[1]);"";} |
---|
| 3613 | |
---|
| 3614 | //------- 1-st main subprocedure: compute module generators ---------- |
---|
| 3615 | printlevel = printlevel+1; |
---|
| 3616 | II = normalityTest(mstdid); |
---|
| 3617 | |
---|
| 3618 | //------ compute also the ringstructure if "withRing" is given ------- |
---|
| 3619 | if ( wring ) |
---|
| 3620 | { |
---|
| 3621 | //------ 2-nd main subprocedure: compute ring structure ----------- |
---|
| 3622 | if(noRed == 0){ |
---|
| 3623 | resu = list(computeRing(II,prim[i])) + resu; |
---|
| 3624 | } |
---|
| 3625 | else |
---|
| 3626 | { |
---|
| 3627 | resu = list(computeRing(II,prim[i], "noRed")) + resu; |
---|
| 3628 | } |
---|
| 3629 | } |
---|
| 3630 | printlevel = printlevel-1; |
---|
| 3631 | |
---|
| 3632 | //----- rearrange module generators s.t. denominator comes last ------ |
---|
| 3633 | gens=0; |
---|
| 3634 | for( j=2; j<=size(II); j++ ) |
---|
| 3635 | { |
---|
| 3636 | gens[j-1]=II[j]; |
---|
| 3637 | } |
---|
| 3638 | gens[size(gens)+1]=II[1]; |
---|
| 3639 | Gens = list(gens) + Gens; |
---|
| 3640 | //------------------------------ compute delta ----------------------- |
---|
| 3641 | K1 = mstdid[1]+II; |
---|
| 3642 | K1 = std(K1); |
---|
| 3643 | K2 = mstdid[1]+II[1]; |
---|
| 3644 | K2 = std(K2); |
---|
| 3645 | // K1 = std(mstdid[1],II); //### besser |
---|
| 3646 | // K2 = std(mstdid[1],II[1]); //### besser: Hannes, fixen! |
---|
| 3647 | co = codim(K1,K2); |
---|
| 3648 | deli = co,deli; |
---|
| 3649 | if ( co >= 0 && del >= 0 ) |
---|
| 3650 | { |
---|
| 3651 | del = del + co; |
---|
| 3652 | } |
---|
| 3653 | else |
---|
| 3654 | { del = -1; } |
---|
| 3655 | } |
---|
| 3656 | |
---|
| 3657 | if ( del >= 0 ) |
---|
| 3658 | { |
---|
| 3659 | int mul = iMult(prim); |
---|
| 3660 | del = del + mul; |
---|
| 3661 | } |
---|
| 3662 | else |
---|
| 3663 | { del = -1; } |
---|
| 3664 | |
---|
| 3665 | deli = deli[1..size(deli)-1]; |
---|
| 3666 | if ( wring ) |
---|
| 3667 | { Resu = resu,Gens,list(deli,del); } |
---|
| 3668 | else |
---|
| 3669 | { Resu = Gens,list(deli,del); } |
---|
| 3670 | |
---|
| 3671 | sr = size(prim); |
---|
| 3672 | |
---|
| 3673 | //-------------------- Finally print comments and return -------------------- |
---|
| 3674 | if(y >= 0) |
---|
| 3675 | {""; |
---|
| 3676 | if ( wring ) |
---|
| 3677 | { |
---|
| 3678 | "// 'normalP' created a list, say nor, of three lists: |
---|
| 3679 | // To see the result, type |
---|
| 3680 | nor; |
---|
| 3681 | |
---|
| 3682 | // * nor[1] is a list of",sr,"ring(s): |
---|
| 3683 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
| 3684 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
| 3685 | // for the other rings type first setring R; (if R is the name of your |
---|
| 3686 | // original basering) and then continue as for R1; |
---|
| 3687 | // Ri/norid is the affine algebra of the normalization of the i-th |
---|
| 3688 | // component R/P_i (where P_i is a min. associated prime of the input ideal) |
---|
| 3689 | // and normap the normalization map from R to Ri/norid; |
---|
| 3690 | |
---|
| 3691 | // * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of |
---|
| 3692 | // elements g1..gk of r such that the gj/gk generate the integral |
---|
| 3693 | // closure of R/P_i as R-module in the quotient field of R/P_i. |
---|
| 3694 | |
---|
| 3695 | // * nor[3] shows the delta-invariant of each component and of the input |
---|
| 3696 | // ideal (-1 means infinite, and 0 that r/P_i is normal)."; |
---|
| 3697 | } |
---|
| 3698 | else |
---|
| 3699 | { |
---|
| 3700 | "// 'normalP' computed a list, say nor, of two lists: |
---|
| 3701 | // To see the result, type |
---|
| 3702 | nor; |
---|
| 3703 | |
---|
| 3704 | // * nor[1] is a list of",sr,"ideal(s), where each ideal nor[1][i] consists |
---|
| 3705 | // of elements g1..gk of the basering R such that gj/gk generate the integral |
---|
| 3706 | // closure of R/P_i (where P_i is a min. associated prime of the input ideal) |
---|
| 3707 | // as R-module in the quotient field of R/P_i; |
---|
| 3708 | |
---|
| 3709 | // * nor[2] shows the delta-invariant of each component and of the input ideal |
---|
| 3710 | // (-1 means infinite, and 0 that R/P_i is normal)."; |
---|
| 3711 | } |
---|
| 3712 | } |
---|
| 3713 | |
---|
| 3714 | return(Resu); |
---|
| 3715 | } |
---|
| 3716 | example |
---|
| 3717 | { "EXAMPLE:"; echo = 2; |
---|
| 3718 | ring r = 11,(x,y,z),wp(2,1,2); |
---|
| 3719 | ideal i = x*(z3 - xy4 + x2); |
---|
| 3720 | list nor= normalP(i); nor; |
---|
| 3721 | //the result says that both components of i are normal, but i itself |
---|
| 3722 | //has infinite delta |
---|
| 3723 | pause("hit return to continue"); |
---|
| 3724 | |
---|
| 3725 | ring s = 2,(x,y),dp; |
---|
| 3726 | ideal i = y*((x-y^2)^2 - x^3); |
---|
| 3727 | list nor = normalP(i,"withRing"); nor; |
---|
| 3728 | |
---|
| 3729 | def R2 = nor[1][2]; setring R2; |
---|
| 3730 | norid; normap; |
---|
| 3731 | } |
---|
| 3732 | |
---|
| 3733 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 3734 | // Assume: mstdid is the result of mstd(prim[i]), prim[i] a prime component of |
---|
| 3735 | // the input ideal id of normalP. |
---|
| 3736 | // Output is an ideal U s.t. U[i]/U[1] are module generators. |
---|
| 3737 | |
---|
| 3738 | static proc normalityTest(list mstdid) |
---|
| 3739 | { |
---|
| 3740 | int y = printlevel-voice+2; |
---|
| 3741 | intvec op = option(get); |
---|
| 3742 | option(redSB); |
---|
| 3743 | def R = basering; |
---|
| 3744 | int n, p = nvars(R), char(R); |
---|
| 3745 | int ii; |
---|
| 3746 | |
---|
| 3747 | ideal J = mstdid[1]; //J is the SB of I |
---|
| 3748 | ideal I = mstdid[2]; |
---|
| 3749 | int h = n-dim(J); //codimension of V(I), I is a prime ideal |
---|
| 3750 | |
---|
| 3751 | //-------------------------- compute singular locus ---------------------- |
---|
| 3752 | qring Q = J; //pass to quotient ring |
---|
| 3753 | ideal I = imap(R,I); |
---|
| 3754 | ideal J = imap(R,J); |
---|
| 3755 | attrib(J,"isSB",1); |
---|
| 3756 | if ( y >= 1) |
---|
| 3757 | { "start normality test"; "compute singular locus";} |
---|
| 3758 | |
---|
| 3759 | ideal M = minor(jacob(I),h,J); //use the command minor modulo J (hence J=0) |
---|
| 3760 | M = std(M); //this makes M much smaller |
---|
| 3761 | //keep only minors which are not 0 mod I (!) this is important since we |
---|
| 3762 | //need a nzd mod I |
---|
| 3763 | |
---|
| 3764 | //---------------- choose nzd from ideal of singular locus -------------- |
---|
| 3765 | ideal D = M[1]; |
---|
| 3766 | for( ii=2; ii<=size(M); ii++ ) //look for the shortest one |
---|
| 3767 | { |
---|
| 3768 | if( size(M[ii]) < size(D[1]) ) |
---|
| 3769 | { |
---|
| 3770 | D = M[ii]; |
---|
| 3771 | } |
---|
| 3772 | } |
---|
| 3773 | |
---|
| 3774 | //--------------- start p-th power algorithm and return ---------------- |
---|
| 3775 | ideal F = var(1)^p; |
---|
| 3776 | for(ii=2; ii<=n; ii++) |
---|
| 3777 | { |
---|
| 3778 | F=F,var(ii)^p; |
---|
| 3779 | } |
---|
| 3780 | |
---|
| 3781 | ideal Dp=D^(p-1); |
---|
| 3782 | ideal U=1; |
---|
| 3783 | ideal K,L; |
---|
| 3784 | map phi=Q,F; |
---|
| 3785 | if ( y >= 1) |
---|
| 3786 | { "compute module generators of integral closure"; |
---|
| 3787 | "denominator D is:"; D; |
---|
| 3788 | pause(); |
---|
| 3789 | } |
---|
| 3790 | |
---|
| 3791 | ii=0; |
---|
| 3792 | list LK; |
---|
| 3793 | while(1) |
---|
| 3794 | { |
---|
| 3795 | ii=ii+1; |
---|
| 3796 | if ( y >= 1) |
---|
| 3797 | { "iteration", ii; } |
---|
| 3798 | L = U*Dp + I; |
---|
| 3799 | //### L=interred(L) oder mstd(L)[2]? |
---|
| 3800 | //Wird dadurch kleiner aber string(L) wird groesser |
---|
| 3801 | K = preimage(Q,phi,L); //### Improvement by block ordering? |
---|
| 3802 | option(returnSB); |
---|
| 3803 | K = intersect(U,K); //K is the new U, it is a SB |
---|
| 3804 | LK = mstd(K); |
---|
| 3805 | K = LK[2]; |
---|
| 3806 | |
---|
| 3807 | //---------------------------- simplify output -------------------------- |
---|
| 3808 | if(size(reduce(U,LK[1]))==0) //previous U coincides with new U |
---|
| 3809 | { //i.e. we reached the integral closure |
---|
| 3810 | U=simplify(reduce(U,groebner(D)),2); |
---|
| 3811 | U = D,U; |
---|
| 3812 | poly gg = gcd(U[1],U[size(U)]); |
---|
| 3813 | for(ii=2; ii<=size(U)-1 ;ii++) |
---|
| 3814 | { |
---|
| 3815 | gg = gcd(gg,U[ii]); |
---|
| 3816 | } |
---|
| 3817 | for(ii=1; ii<=size(U); ii++) |
---|
| 3818 | { |
---|
| 3819 | U[ii]=U[ii]/gg; |
---|
| 3820 | } |
---|
| 3821 | U = simplify(U,6); |
---|
| 3822 | //if ( y >= 1) |
---|
| 3823 | //{ "module generators are U[i]/U[1], with U:"; U; |
---|
| 3824 | // ""; pause(); } |
---|
| 3825 | option(set,op); |
---|
| 3826 | setring R; |
---|
| 3827 | ideal U = imap(Q,U); |
---|
| 3828 | return(U); |
---|
| 3829 | } |
---|
| 3830 | U=K; |
---|
| 3831 | } |
---|
| 3832 | } |
---|
| 3833 | |
---|
| 3834 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 3835 | |
---|
| 3836 | static proc substpartSpecial(ideal endid, ideal endphi) |
---|
| 3837 | { |
---|
| 3838 | //Note: newRing is of the form (R the original basering): |
---|
| 3839 | //char(R),(T(1..N),X(1..nvars(R))),(dp(N),...); |
---|
| 3840 | |
---|
| 3841 | int ii,jj,kk; |
---|
| 3842 | def BAS = basering; |
---|
| 3843 | int n = nvars(basering); |
---|
| 3844 | |
---|
| 3845 | list Le = elimpart(endid); |
---|
| 3846 | int q = size(Le[2]); //q variables have been substituted |
---|
| 3847 | //Le;""; |
---|
| 3848 | if ( q == 0 ) |
---|
| 3849 | { |
---|
| 3850 | ideal normap = endphi; |
---|
| 3851 | ideal norid = endid; |
---|
| 3852 | export(norid); |
---|
| 3853 | export(normap); |
---|
| 3854 | list L = BAS; |
---|
| 3855 | return(L); |
---|
| 3856 | } |
---|
| 3857 | |
---|
| 3858 | list gnirlist = ringlist(basering); |
---|
| 3859 | endid = Le[1]; |
---|
| 3860 | //endphi;""; |
---|
| 3861 | for( ii=1; ii<=n; ii++) |
---|
| 3862 | { |
---|
| 3863 | if( Le[4][ii] == 0 ) //ii=index of substituted var |
---|
| 3864 | { |
---|
| 3865 | endphi = subst(endphi,var(ii),Le[5][ii]); |
---|
| 3866 | } |
---|
| 3867 | } |
---|
| 3868 | //endphi;""; |
---|
| 3869 | list g2 = gnirlist[2]; //the varlist |
---|
| 3870 | list g3 = gnirlist[3]; //contains blocks of orderings |
---|
| 3871 | int n3 = size(g3); |
---|
| 3872 | |
---|
| 3873 | //----------------- first identify module ordering ------------------ |
---|
| 3874 | if ( g3[n3][1]== "c" or g3[n3][1] == "C" ) |
---|
| 3875 | { |
---|
| 3876 | list gm = g3[n3]; //last blockis module ordering |
---|
| 3877 | g3 = delete(g3,n3); |
---|
| 3878 | int m = 0; |
---|
| 3879 | } |
---|
| 3880 | else |
---|
| 3881 | { |
---|
| 3882 | list gm = g3[1]; //first block is module ordering |
---|
| 3883 | g3 = delete(g3,1); |
---|
| 3884 | int m = 1; |
---|
| 3885 | } |
---|
| 3886 | //---- delete variables which were substituted and weights -------- |
---|
| 3887 | intvec V; |
---|
| 3888 | int n(0); |
---|
| 3889 | list newg2; |
---|
| 3890 | list newg3; |
---|
| 3891 | for ( ii=1; ii<=n3-1; ii++ ) |
---|
| 3892 | { |
---|
| 3893 | // If order is a matrix ordering, it is replaced by dp ordering. |
---|
| 3894 | // TODO: replace it only when some of the original |
---|
| 3895 | // variables are eliminated. |
---|
| 3896 | if(g3[ii][1] == "M"){ |
---|
| 3897 | g3[ii][1] = "dp"; |
---|
| 3898 | g3[ii][2] = (1..sqroot(size(g3[ii][2])))*0+1; |
---|
| 3899 | } |
---|
| 3900 | V = V,g3[ii][2]; //copy weights for ordering in each block |
---|
| 3901 | if ( ii==1 ) //into one intvector |
---|
| 3902 | { |
---|
| 3903 | V = V[2..size(V)]; |
---|
| 3904 | } |
---|
| 3905 | // int n(ii) = size(g3[ii][2]); |
---|
| 3906 | int n(ii) = size(V); |
---|
| 3907 | intvec V(ii); |
---|
| 3908 | |
---|
| 3909 | for ( jj = n(ii-1)+1; jj<=n(ii); jj++) |
---|
| 3910 | { |
---|
| 3911 | if( Le[4][jj] !=0 ) //jj=index of var which was not substituted |
---|
| 3912 | { |
---|
| 3913 | kk=kk+1; |
---|
| 3914 | newg2[kk] = g2[jj]; //not substituted var from varlist |
---|
| 3915 | V(ii)=V(ii),V[jj]; //weight of not substituted variable |
---|
| 3916 | } |
---|
| 3917 | } |
---|
| 3918 | if ( size(V(ii)) >= 2 ) |
---|
| 3919 | { |
---|
| 3920 | V(ii) = V(ii)[2..size(V(ii))]; |
---|
| 3921 | list g3(ii)=g3[ii][1],V(ii); |
---|
| 3922 | newg3 = insert(newg3,g3(ii),size(newg3)); |
---|
| 3923 | //"newg3"; newg3; |
---|
| 3924 | } |
---|
| 3925 | } |
---|
| 3926 | //"newg3"; newg3; |
---|
| 3927 | //newg3 = delete(newg3,1); //delete empty list |
---|
| 3928 | |
---|
| 3929 | /* |
---|
| 3930 | //### neue Ordnung, 1 Block fuer alle vars, aber Gewichte erhalten; |
---|
| 3931 | //vorerst nicht realisiert, da bei leonhard1 alte Version (neue Variable T(i) |
---|
| 3932 | //ein neuer Block) ein kuerzeres Ergebnis liefert |
---|
| 3933 | kill g3; |
---|
| 3934 | list g3; |
---|
| 3935 | V=0; |
---|
| 3936 | for ( ii= 1; ii<=n3-1; ii++ ) |
---|
| 3937 | { |
---|
| 3938 | V=V,V(ii); |
---|
| 3939 | } |
---|
| 3940 | V = V[2..size(V)]; |
---|
| 3941 | |
---|
| 3942 | if ( V==1 ) |
---|
| 3943 | { |
---|
| 3944 | g3[1] = list("dp",V); |
---|
| 3945 | } |
---|
| 3946 | else |
---|
| 3947 | { |
---|
| 3948 | g3[1] = lis("wp",V); |
---|
| 3949 | } |
---|
| 3950 | newg3 = g3; |
---|
| 3951 | |
---|
| 3952 | //"newg3";newg3;""; |
---|
| 3953 | //### Ende neue Ordnung |
---|
| 3954 | */ |
---|
| 3955 | |
---|
| 3956 | if ( m == 0 ) |
---|
| 3957 | { |
---|
| 3958 | newg3 = insert(newg3,gm,size(newg3)); |
---|
| 3959 | } |
---|
| 3960 | else |
---|
| 3961 | { |
---|
| 3962 | newg3 = insert(newg3,gm); |
---|
| 3963 | } |
---|
| 3964 | gnirlist[2] = newg2; |
---|
| 3965 | gnirlist[3] = newg3; |
---|
| 3966 | |
---|
| 3967 | //gnirlist; |
---|
| 3968 | def newBAS = ring(gnirlist); //change of ring to less vars |
---|
| 3969 | setring newBAS; |
---|
| 3970 | ideal normap = imap(BAS,endphi); |
---|
| 3971 | //normap = simplify(normap,2); |
---|
| 3972 | ideal norid = imap(BAS,endid); |
---|
| 3973 | export(norid); |
---|
| 3974 | export(normap); |
---|
| 3975 | list L = newBAS; |
---|
| 3976 | return(L); |
---|
| 3977 | |
---|
| 3978 | //Hier scheint interred gut zu sein, da es Ergebnis relativ schnell |
---|
| 3979 | //verkleinert. Hier wird z.B. bei leonard1 size(norid) verkleinert aber |
---|
| 3980 | //size(string(norid)) stark vergroessert, aber es hat keine Auswirkungen |
---|
| 3981 | //da keine map mehr folgt. |
---|
| 3982 | //### Bei Leonard2 haengt interred (BUG) |
---|
| 3983 | //mstd[2] verkleinert norid nocheinmal um die Haelfte, dauert aber 3.71 sec |
---|
| 3984 | //### Ev. Hinweis auf mstd in der Hilfe? |
---|
| 3985 | |
---|
| 3986 | } |
---|
| 3987 | |
---|
| 3988 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 3989 | // Computes the ring structure of a ring given by module generators. |
---|
| 3990 | // Assume: J[i]/J[1] are the module generators in the quotient field |
---|
| 3991 | // with J[1] as universal denominator. |
---|
| 3992 | // If option "noRed" is not given, a reduction in the number of variables is |
---|
| 3993 | // attempted. |
---|
| 3994 | static proc computeRing(ideal J, ideal I, list #) |
---|
| 3995 | { |
---|
| 3996 | int i, ii,jj; |
---|
| 3997 | intvec V; // to be used for variable weights |
---|
| 3998 | int y = printlevel-voice+2; |
---|
| 3999 | def R = basering; |
---|
| 4000 | poly c = J[1]; // the denominator |
---|
| 4001 | list gnirlist = ringlist(basering); |
---|
| 4002 | string svars = varstr(basering); |
---|
| 4003 | int nva = nvars(basering); |
---|
| 4004 | string svar; |
---|
| 4005 | ideal maxid = maxideal(1); |
---|
| 4006 | |
---|
| 4007 | int noRed = 0; // By default, we try to reduce the number of generators. |
---|
| 4008 | if(size(#) > 0){ |
---|
| 4009 | if ( typeof(#[1]) == "string" ) |
---|
| 4010 | { |
---|
| 4011 | if (#[1] == "noRed"){noRed = 1;} |
---|
| 4012 | } |
---|
| 4013 | } |
---|
| 4014 | |
---|
| 4015 | if ( y >= 1){"// computing the ring structure...";} |
---|
| 4016 | |
---|
| 4017 | if(c==1) |
---|
| 4018 | { |
---|
| 4019 | /* if( defined(norid) ) { kill norid; } |
---|
| 4020 | if( defined(normap) ) { kill normap; } |
---|
| 4021 | ideal norid = I; |
---|
| 4022 | ideal normap = maxid; */ |
---|
| 4023 | |
---|
| 4024 | list gnirlist = ringlist(R); |
---|
| 4025 | def R1 = ring(gnirlist); |
---|
| 4026 | setring R1; |
---|
| 4027 | ideal norid = imap(R, I); |
---|
| 4028 | ideal normap = imap(R, maxid); |
---|
| 4029 | export norid; |
---|
| 4030 | export normap; |
---|
| 4031 | |
---|
| 4032 | if(noRed == 1){ |
---|
| 4033 | setring R; |
---|
| 4034 | return(R1); |
---|
| 4035 | } |
---|
| 4036 | else |
---|
| 4037 | { |
---|
| 4038 | list L = substpartSpecial(norid,normap); |
---|
| 4039 | def lastRing = L[1]; |
---|
| 4040 | setring R; |
---|
| 4041 | return(lastRing); |
---|
| 4042 | } |
---|
| 4043 | } |
---|
| 4044 | |
---|
| 4045 | |
---|
| 4046 | //-------------- Enlarge ring by creating new variables ------------------ |
---|
| 4047 | //check first whether variables T(i) and then whether Z(i),...,A(i) exist |
---|
| 4048 | //old variable names are not touched |
---|
| 4049 | |
---|
| 4050 | if ( find(svars,"T(") == 0 ) |
---|
| 4051 | { |
---|
| 4052 | svar = "T"; |
---|
| 4053 | } |
---|
| 4054 | else |
---|
| 4055 | { |
---|
| 4056 | for (ii=90; ii>=65; ii--) |
---|
| 4057 | { |
---|
| 4058 | if ( find(svars,ASCII(ii)+"(") == 0 ) |
---|
| 4059 | { |
---|
| 4060 | svar = ASCII(ii); break; |
---|
| 4061 | } |
---|
| 4062 | } |
---|
| 4063 | } |
---|
| 4064 | |
---|
| 4065 | int q = size(J)-1; |
---|
| 4066 | if ( size(svar) != 0 ) |
---|
| 4067 | { |
---|
| 4068 | for ( ii=q; ii>=1; ii-- ) |
---|
| 4069 | { |
---|
| 4070 | gnirlist[2] = insert(gnirlist[2],svar+"("+string(ii)+")"); |
---|
| 4071 | } |
---|
| 4072 | } |
---|
| 4073 | else |
---|
| 4074 | { |
---|
| 4075 | for ( ii=q; ii>=1; ii-- ) |
---|
| 4076 | { |
---|
| 4077 | gnirlist[2] = insert(gnirlist[2],"T("+string(100*nva+ii)+")"); |
---|
| 4078 | } |
---|
| 4079 | } |
---|
| 4080 | |
---|
| 4081 | V[q]=0; //create intvec of variable weights |
---|
| 4082 | V=V+1; |
---|
| 4083 | gnirlist[3] = insert(gnirlist[3],list("dp",V)); |
---|
| 4084 | |
---|
| 4085 | //this is a block ordering with one dp-block (1st block) for new vars |
---|
| 4086 | //the remaining weights and blocks for old vars are kept |
---|
| 4087 | //### perhaps better to make only one block, keeping weights ? |
---|
| 4088 | //this might effect syz below |
---|
| 4089 | //alt: ring newR = char(R),(X(1..nvars(R)),T(1..q)),dp; |
---|
| 4090 | //Reihenfolge geaendert:neue Variablen kommen zuerst, Namen ev. nicht T(i) |
---|
| 4091 | |
---|
| 4092 | def newR = ring(gnirlist); |
---|
| 4093 | setring newR; //new extended ring |
---|
| 4094 | ideal I = imap(R,I); |
---|
| 4095 | |
---|
| 4096 | //------------- Compute linear and quadratic relations --------------- |
---|
| 4097 | if(y>=1) |
---|
| 4098 | { |
---|
| 4099 | "// compute linear relations:"; |
---|
| 4100 | } |
---|
| 4101 | qring newQ = std(I); |
---|
| 4102 | |
---|
| 4103 | ideal f = imap(R,J); |
---|
| 4104 | module syzf = syz(f); |
---|
| 4105 | ideal pf = f[1]*f; |
---|
| 4106 | //f[1] is the denominator D from normalityTest, a non zero divisor of R/I |
---|
| 4107 | |
---|
| 4108 | ideal newT = maxideal(1); |
---|
| 4109 | newT = 1,newT[1..q]; |
---|
| 4110 | //matrix T = matrix(ideal(1,T(1..q)),1,q+1); //alt |
---|
| 4111 | matrix T = matrix(newT,1,q+1); |
---|
| 4112 | ideal Lin = ideal(T*syzf); |
---|
| 4113 | //Lin=interred(Lin); |
---|
| 4114 | //### interred reduziert ev size aber size(string(LIN)) wird groesser |
---|
| 4115 | |
---|
| 4116 | if(y>=1) |
---|
| 4117 | { |
---|
| 4118 | if(y>=3) |
---|
| 4119 | { |
---|
| 4120 | "// the linear relations:"; Lin; pause();""; |
---|
| 4121 | } |
---|
| 4122 | "// the ring structure of the normalization as affine algebra"; |
---|
| 4123 | "// number of linear relations:", size(Lin); |
---|
| 4124 | } |
---|
| 4125 | |
---|
| 4126 | if(y>=1) |
---|
| 4127 | { |
---|
| 4128 | "// compute quadratic relations:"; |
---|
| 4129 | } |
---|
| 4130 | matrix A; |
---|
| 4131 | ideal Quad; |
---|
| 4132 | poly ff; |
---|
| 4133 | newT = newT[2..size(newT)]; |
---|
| 4134 | matrix u; // The units for non-global orderings. |
---|
| 4135 | |
---|
| 4136 | // Quadratic relations |
---|
| 4137 | for (ii=2; ii<=q+1; ii++ ) |
---|
| 4138 | { |
---|
| 4139 | for ( jj=2; jj<=ii; jj++ ) |
---|
| 4140 | { |
---|
| 4141 | ff = NF(f[ii]*f[jj],std(0)); // this makes lift much faster |
---|
| 4142 | // For non-global orderings, we have to take care of the units. |
---|
| 4143 | if(ord_test(basering) != 1){ |
---|
| 4144 | A = lift(pf, ff, u); |
---|
| 4145 | Quad = Quad,ideal(newT[jj-1]*newT[ii-1] * u[1, 1]- T*A); |
---|
| 4146 | } |
---|
| 4147 | else |
---|
| 4148 | { |
---|
| 4149 | A = lift(pf,ff); // ff lin. comb. of elts of pf mod I |
---|
| 4150 | Quad = Quad,ideal(newT[jj-1]*newT[ii-1] - T*A); |
---|
| 4151 | } |
---|
| 4152 | //A = lift(pf, f[ii]*f[jj]); |
---|
| 4153 | //Quad = Quad, ideal(T(jj-1)*T(ii-1) - T*A); |
---|
| 4154 | } |
---|
| 4155 | } |
---|
| 4156 | Quad = Quad[2..ncols(Quad)]; |
---|
| 4157 | |
---|
| 4158 | if(y>=1) |
---|
| 4159 | { |
---|
| 4160 | if(y>=3) |
---|
| 4161 | { |
---|
| 4162 | "// the quadratic relations"; Quad; pause();""; |
---|
| 4163 | } |
---|
| 4164 | "// number of quadratic relations:", size(Quad); |
---|
| 4165 | } |
---|
| 4166 | ideal Q1 = Lin,Quad; //elements of Q1 are in NF w.r.t. I |
---|
| 4167 | |
---|
| 4168 | //Q1 = mstd(Q1)[2]; |
---|
| 4169 | //### weglassen, ist sehr zeitaufwendig. |
---|
| 4170 | //Ebenso interred, z.B. bei Leonard1 (1. Komponente von Leonard): |
---|
| 4171 | //"size Q1:", size(Q1), size(string(Q1)); //75 60083 |
---|
| 4172 | //Q1 = interred(Q1); |
---|
| 4173 | //"size Q1:", size(Q1), size(string(Q1)); //73 231956 (!) |
---|
| 4174 | //### Speicherueberlauf bei substpartSpecial bei 'ideal norid = phi1(endid)' |
---|
| 4175 | //Beispiel fuer Hans um map zu testen! |
---|
| 4176 | |
---|
| 4177 | setring newR; |
---|
| 4178 | ideal endid = imap(newQ,Q1),I; |
---|
| 4179 | ideal endphi = imap(R,maxid); |
---|
| 4180 | |
---|
| 4181 | if(noRed == 0){ |
---|
| 4182 | list L=substpartSpecial(endid,endphi); |
---|
| 4183 | def lastRing=L[1]; |
---|
| 4184 | if(y>=1) |
---|
| 4185 | { |
---|
| 4186 | "// number of substituted variables:", nvars(newR)-nvars(lastRing); |
---|
| 4187 | pause();""; |
---|
| 4188 | } |
---|
| 4189 | return(lastRing); |
---|
| 4190 | } |
---|
| 4191 | else |
---|
| 4192 | { |
---|
| 4193 | ideal norid = endid; |
---|
| 4194 | ideal normap = endphi; |
---|
| 4195 | export(norid); |
---|
| 4196 | export(normap); |
---|
| 4197 | setring R; |
---|
| 4198 | return(newR); |
---|
| 4199 | } |
---|
| 4200 | } |
---|
| 4201 | |
---|
| 4202 | // Up to here: procedures for char p with Frobenius |
---|
| 4203 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4204 | |
---|
| 4205 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4206 | // From here: subprocedures for normal |
---|
| 4207 | |
---|
| 4208 | // inputJ is used in parametrization of rational curves algorithms, to specify |
---|
| 4209 | // a different test ideal. |
---|
| 4210 | |
---|
| 4211 | static proc normalM(ideal I, int decomp, int withDelta, int denomOption, ideal inputJ, ideal inputC){ |
---|
| 4212 | // Computes the normalization of a ring R / I using the module structure as far |
---|
| 4213 | // as possible. |
---|
| 4214 | // The ring R is the basering. |
---|
| 4215 | // Input: ideal I |
---|
| 4216 | // Output: a list of 3 elements (resp 4 if withDelta = 1), say nor. |
---|
| 4217 | // - nor[1] = U, an ideal of R. |
---|
| 4218 | // - nor[2] = c, an element of R. |
---|
| 4219 | // U and c satisfy that 1/c * U is the normalization of R / I in the |
---|
| 4220 | // quotient field Q(R/I). |
---|
| 4221 | // - nor[3] = ring say T, containing two ideals norid and normap such that |
---|
| 4222 | // normap gives the normalization map from R / I to T / norid. |
---|
| 4223 | // - nor[4] = the delta invariant, if withDelta = 1. |
---|
| 4224 | |
---|
| 4225 | // Details: |
---|
| 4226 | // -------- |
---|
| 4227 | // Computes the ideal of the minors in the first step and then reuses it in all |
---|
| 4228 | // steps. |
---|
| 4229 | // In step s, the denominator is D^s, where D is a nzd of the original quotient |
---|
| 4230 | // ring, contained in the radical of the singular locus. |
---|
| 4231 | // This denominator is used except when the degree of D^i is greater than the |
---|
| 4232 | // degree of a universal denominator. |
---|
| 4233 | // The nzd is taken as the smallest degree polynomial in the radical of the |
---|
| 4234 | // singular locus. |
---|
| 4235 | |
---|
| 4236 | // It assumes that the ideal I is equidimensional radical. This is not checked |
---|
| 4237 | // in the procedure! |
---|
| 4238 | // If decomp = 0 or decomp = 3 it assumes further that I is prime. Therefore |
---|
| 4239 | // any non-zero element in the jacobian ideal is assumed to be a |
---|
| 4240 | // non-zerodivisor. |
---|
| 4241 | |
---|
| 4242 | // It works over the given basering. |
---|
| 4243 | // If it has a non-global ordering, it changes it to dp global only for |
---|
| 4244 | // computing radical. |
---|
| 4245 | |
---|
| 4246 | // The delta invariant is only computed if withDelta = 1, and decomp = 0 or |
---|
| 4247 | // decomp = 3 (meaning that the ideal is prime). |
---|
| 4248 | |
---|
| 4249 | // denomOption = 0 -> Uses the smallest degree polynomial |
---|
| 4250 | // denomOption = i > 0 -> Uses a polynomial in the i-th variable |
---|
| 4251 | |
---|
| 4252 | option("redSB"); |
---|
| 4253 | option("returnSB"); |
---|
| 4254 | int step = 0; // Number of steps. (for debugging) |
---|
| 4255 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
| 4256 | int i; // counter |
---|
| 4257 | int isGlobal = ord_test(basering); |
---|
| 4258 | |
---|
| 4259 | poly c; // The common denominator. |
---|
| 4260 | |
---|
| 4261 | def R = basering; |
---|
| 4262 | |
---|
| 4263 | //------------------------ Groebner bases and dimension of I----------------- |
---|
| 4264 | if(isGlobal == 1){ |
---|
| 4265 | list IM = mstd(I); |
---|
| 4266 | I = IM[1]; |
---|
| 4267 | ideal IMin = IM[2]; // A minimal set of generators in the groebner basis. |
---|
| 4268 | } |
---|
| 4269 | else |
---|
| 4270 | { |
---|
| 4271 | // The minimal set of generators is not computed by mstd for |
---|
| 4272 | // non-global orderings. |
---|
| 4273 | I = groebner(I); |
---|
| 4274 | ideal IMin = I; |
---|
| 4275 | } |
---|
| 4276 | int d = dim(I); |
---|
| 4277 | |
---|
| 4278 | // ---------------- computation of the singular locus --------------------- |
---|
| 4279 | // We compute the radical of the ideal of minors modulo the original ideal. |
---|
| 4280 | // This is done only in the first step. |
---|
| 4281 | qring Q = I; // We work in the quotient by the groebner base of the ideal I |
---|
| 4282 | option("redSB"); |
---|
| 4283 | option("returnSB"); |
---|
| 4284 | |
---|
| 4285 | // If a conductor ideal was given as input, we use it instead of the |
---|
| 4286 | // singular locus. If a test ideal was given as input, we do not compute the |
---|
| 4287 | // singular locus. |
---|
| 4288 | ideal inputC = fetch(R, inputC); |
---|
| 4289 | ideal inputJ = fetch(R, inputJ); |
---|
| 4290 | if((inputC == 0) && (inputJ == 0)){ |
---|
| 4291 | // We compute the radical of the ideal of minors modulo the original ideal. |
---|
| 4292 | // This is done only in the first step. |
---|
| 4293 | ideal I = fetch(R, I); |
---|
| 4294 | attrib(I, "isSB", 1); |
---|
| 4295 | ideal IMin = fetch(R, IMin); |
---|
| 4296 | |
---|
| 4297 | dbprint(dbg, "Computing the jacobian ideal..."); |
---|
| 4298 | |
---|
| 4299 | // If a given conductor ideal is given, we use it. |
---|
| 4300 | // If a given test ideal is given, we don't need to compute the jacobian |
---|
| 4301 | ideal J = minor(jacob(IMin), nvars(basering) - d, I); |
---|
| 4302 | J = groebner(J); |
---|
| 4303 | } else { |
---|
| 4304 | ideal J = fetch(R, inputC); |
---|
| 4305 | J = groebner(J); |
---|
| 4306 | } |
---|
| 4307 | |
---|
| 4308 | //------------------ We check if the singular locus is empty ------------- |
---|
| 4309 | if(J[1] == 1){ |
---|
| 4310 | // The original ring R/I was normal. Nothing to do. |
---|
| 4311 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
| 4312 | setring R; |
---|
| 4313 | list lR = ringlist(R); |
---|
| 4314 | def ROut = ring(lR); |
---|
| 4315 | setring ROut; |
---|
| 4316 | ideal norid = fetch(R, I); |
---|
| 4317 | ideal normap = maxideal(1); |
---|
| 4318 | export norid; |
---|
| 4319 | export normap; |
---|
| 4320 | setring R; |
---|
| 4321 | if(withDelta){ |
---|
| 4322 | list output = ideal(1), poly(1), ROut, 0; |
---|
| 4323 | } |
---|
| 4324 | else |
---|
| 4325 | { |
---|
| 4326 | list output = ideal(1), poly(1), ROut; |
---|
| 4327 | } |
---|
| 4328 | return(list(output)); |
---|
| 4329 | } |
---|
| 4330 | |
---|
| 4331 | |
---|
| 4332 | // -------------------- election of the universal denominator---------------- |
---|
| 4333 | // We first check if a conductor ideal was computed. If not, we don't |
---|
| 4334 | // compute a universal denominator. |
---|
| 4335 | ideal Id1; |
---|
| 4336 | if(J != 0){ |
---|
| 4337 | if(denomOption == 0){ |
---|
| 4338 | poly condu = getSmallest(J); // Choses the polynomial of smallest degree |
---|
| 4339 | // of J as universal denominator. |
---|
| 4340 | } else { |
---|
| 4341 | poly condu = getOneVar(J, denomOption); |
---|
| 4342 | } |
---|
| 4343 | if(dbg >= 1){ |
---|
| 4344 | ""; |
---|
| 4345 | "The universal denominator is ", condu; |
---|
| 4346 | } |
---|
| 4347 | |
---|
| 4348 | // ----- splitting the ideal by the universal denominator (if possible) ----- |
---|
| 4349 | // If the ideal is equidimensional, but not necessarily prime, we check if |
---|
| 4350 | // the universal denominator is a non-zerodivisor of R/I. |
---|
| 4351 | // If not, we split I. |
---|
| 4352 | if((decomp == 1) or (decomp == 2)){ |
---|
| 4353 | Id1 = quotient(0, condu); |
---|
| 4354 | if(size(Id1) > 0){ |
---|
| 4355 | // We have to split. |
---|
| 4356 | if(dbg >= 1){ |
---|
| 4357 | "A zerodivisor was found. We split the ideal. The zerodivisor is ", condu; |
---|
| 4358 | } |
---|
| 4359 | setring R; |
---|
| 4360 | ideal Id1 = fetch(Q, Id1), I; |
---|
| 4361 | Id1 = groebner(Id1); |
---|
| 4362 | ideal Id2 = quotient(I, Id1); |
---|
| 4363 | // I = I1 \cap I2 |
---|
| 4364 | printlevel = printlevel + 1; |
---|
| 4365 | ideal JDefault = 0; // Now it uses the default J; |
---|
| 4366 | list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault)[1]; |
---|
| 4367 | list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault)[1]; |
---|
| 4368 | printlevel = printlevel - 1; |
---|
| 4369 | return(list(nor1, nor2)); |
---|
| 4370 | } |
---|
| 4371 | } |
---|
| 4372 | } else { |
---|
| 4373 | poly condu = 0; |
---|
| 4374 | } |
---|
| 4375 | |
---|
| 4376 | // --------------- computation of the first test ideal --------------------- |
---|
| 4377 | // To compute the radical we go back to the original ring. |
---|
| 4378 | // If we are using a non-global ordering, we must change to the global |
---|
| 4379 | // ordering. |
---|
| 4380 | setring R; |
---|
| 4381 | // If a test ideal is given at the input, we use it. |
---|
| 4382 | if(inputJ == 0){ |
---|
| 4383 | if(isGlobal == 1){ |
---|
| 4384 | ideal J = fetch(Q, J); |
---|
| 4385 | J = J, I; |
---|
| 4386 | if(dbg >= 1){ |
---|
| 4387 | "The original singular locus is"; |
---|
| 4388 | groebner(J); |
---|
| 4389 | if(dbg >= 2){pause();} |
---|
| 4390 | ""; |
---|
| 4391 | } |
---|
| 4392 | // We check if the only singular point is the origin. |
---|
| 4393 | // If so, the radical is the maximal ideal at the origin. |
---|
| 4394 | J = groebner(J); |
---|
| 4395 | if(locAtZero(J)){ |
---|
| 4396 | J = maxideal(1); |
---|
| 4397 | } else { |
---|
| 4398 | J = radical(J); |
---|
| 4399 | } |
---|
| 4400 | } else { |
---|
| 4401 | // We change to global dp ordering. |
---|
| 4402 | list rl = ringlist(R); |
---|
| 4403 | list origOrd = rl[3]; |
---|
| 4404 | list newOrd = list("dp", intvec(1:nvars(R))), list("C", 0); |
---|
| 4405 | rl[3] = newOrd; |
---|
| 4406 | def globR = ring(rl); |
---|
| 4407 | setring globR; |
---|
| 4408 | ideal J = fetch(Q, J); |
---|
| 4409 | ideal I = fetch(R, I); |
---|
| 4410 | J = J, I; |
---|
| 4411 | if(dbg >= 1){ |
---|
| 4412 | "The original singular locus is"; |
---|
| 4413 | groebner(J); |
---|
| 4414 | if(dbg>=2){pause();} |
---|
| 4415 | ""; |
---|
| 4416 | } |
---|
| 4417 | J = radical(J); |
---|
| 4418 | setring R; |
---|
| 4419 | ideal J = fetch(globR, J); |
---|
| 4420 | } |
---|
| 4421 | } else { |
---|
| 4422 | ideal J = inputJ; |
---|
| 4423 | } |
---|
| 4424 | |
---|
| 4425 | if(dbg >= 1){ |
---|
| 4426 | "The radical of the original singular locus is"; |
---|
| 4427 | J; |
---|
| 4428 | if(dbg>=2){pause();} |
---|
| 4429 | } |
---|
| 4430 | |
---|
| 4431 | // ---------------- election of the non zero divisor --------------------- |
---|
| 4432 | setring Q; |
---|
| 4433 | J = fetch(R, J); |
---|
| 4434 | J = interred(J); |
---|
| 4435 | if(denomOption == 0){ |
---|
| 4436 | poly D = getSmallest(J); // Chooses the polynomial of smallest degree as |
---|
| 4437 | // non-zerodivisor. |
---|
| 4438 | } else { |
---|
| 4439 | poly D = getOneVar(J, denomOption); |
---|
| 4440 | } |
---|
| 4441 | if(dbg >= 1){ |
---|
| 4442 | "The non zero divisor is ", D; |
---|
| 4443 | ""; |
---|
| 4444 | } |
---|
| 4445 | |
---|
| 4446 | // ------- splitting the ideal by the non-zerodivisor (if possible) -------- |
---|
| 4447 | // If the ideal is equidimensional, but not necessarily prime, we check if D |
---|
| 4448 | // is actually a non-zerodivisor of R/I. |
---|
| 4449 | // If not, we split I. |
---|
| 4450 | if((decomp == 1) or (decomp == 2)){ |
---|
| 4451 | // We check if D is actually a non-zerodivisor of R/I. |
---|
| 4452 | // If not, we split I. |
---|
| 4453 | Id1 = quotient(0, D); |
---|
| 4454 | if(size(Id1) > 0){ |
---|
| 4455 | // We have to split. |
---|
| 4456 | if(dbg >= 1){ |
---|
| 4457 | "A zerodivisor was found. We split the ideal. The zerodivisor is ", D; |
---|
| 4458 | } |
---|
| 4459 | setring R; |
---|
| 4460 | ideal Id1 = fetch(Q, Id1), I; |
---|
| 4461 | Id1 = groebner(Id1); |
---|
| 4462 | ideal Id2 = quotient(I, Id1); |
---|
| 4463 | // I = Id1 \cap Id2 |
---|
| 4464 | printlevel = printlevel + 1; |
---|
| 4465 | |
---|
| 4466 | ideal JDefault = 0; // Now it uses the default J; |
---|
| 4467 | list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault)[1]; |
---|
| 4468 | list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault)[1]; |
---|
| 4469 | printlevel = printlevel - 1; |
---|
| 4470 | return(list(nor1, nor2)); |
---|
| 4471 | } |
---|
| 4472 | } |
---|
| 4473 | |
---|
| 4474 | // --------------------- normalization ------------------------------------ |
---|
| 4475 | // We call normalMEqui to compute the normalization. |
---|
| 4476 | setring R; |
---|
| 4477 | poly D = fetch(Q, D); |
---|
| 4478 | poly condu = fetch(Q, condu); |
---|
| 4479 | J = fetch(Q, J); |
---|
| 4480 | printlevel = printlevel + 1; |
---|
| 4481 | list result = normalMEqui(I, J, condu, D, withDelta, denomOption); |
---|
| 4482 | printlevel = printlevel - 1; |
---|
| 4483 | return(list(result)); |
---|
| 4484 | } |
---|
| 4485 | |
---|
| 4486 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4487 | |
---|
| 4488 | static proc normalMEqui(ideal I, ideal origJ, poly condu, poly D, int withDelta) |
---|
| 4489 | // Here is where the normalization is actually computed. |
---|
| 4490 | |
---|
| 4491 | // Computes the normalization of R/I. (basering is R) |
---|
| 4492 | // I is assumed to be radical and equidimensional. |
---|
| 4493 | // origJ is the first test ideal. |
---|
| 4494 | // D is a non-zerodivisor of R/I. |
---|
| 4495 | // condu is a non-zerodivisor in the conductor or 0 if it was not computed. |
---|
| 4496 | // If withDelta = 1, computes the delta invariant. |
---|
| 4497 | { |
---|
| 4498 | int step = 0; // Number of steps. (for debugging) |
---|
| 4499 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
| 4500 | int i; // counter |
---|
| 4501 | int isNormal = 0; // check for exiting the loop |
---|
| 4502 | int isGlobal = ord_test(basering); |
---|
| 4503 | int delt; |
---|
| 4504 | |
---|
| 4505 | def R = basering; |
---|
| 4506 | poly c = D; |
---|
| 4507 | ideal U; |
---|
| 4508 | ideal cJ; |
---|
| 4509 | list testOut; // Output of proc testIdeal |
---|
| 4510 | // (the test ideal and the ring structure) |
---|
| 4511 | |
---|
| 4512 | qring Q = groebner(I); |
---|
| 4513 | option("redSB"); |
---|
| 4514 | option("returnSB"); |
---|
| 4515 | ideal J = imap(R, origJ); |
---|
| 4516 | poly c = imap(R, c); |
---|
| 4517 | poly D = imap(R, D); |
---|
| 4518 | poly condu = imap(R, condu); |
---|
| 4519 | ideal cJ; |
---|
| 4520 | ideal cJMod; |
---|
| 4521 | |
---|
| 4522 | dbprint(dbg, "Preliminar step begins."); |
---|
| 4523 | |
---|
| 4524 | // --------------------- computation of A1 ------------------------------- |
---|
| 4525 | dbprint(dbg, "Computing the quotient (DJ : J)..."); |
---|
| 4526 | ideal U = groebner(quotient(D*J, J)); |
---|
| 4527 | ideal oldU = 1; |
---|
| 4528 | |
---|
| 4529 | if(dbg >= 2) { "The quotient is"; U; } |
---|
| 4530 | |
---|
| 4531 | // ----------------- Grauer-Remmert criterion check ----------------------- |
---|
| 4532 | // We check if the equality in Grauert - Remmert criterion is satisfied. |
---|
| 4533 | isNormal = checkInclusions(D*oldU, U); |
---|
| 4534 | if(isNormal == 0) |
---|
| 4535 | { |
---|
| 4536 | if(dbg >= 1) |
---|
| 4537 | { |
---|
| 4538 | "In this step, we have the ring 1/c * U, with c =", c; |
---|
| 4539 | "and U = "; U; |
---|
| 4540 | } |
---|
| 4541 | } |
---|
| 4542 | else |
---|
| 4543 | { |
---|
| 4544 | // The original ring R/I was normal. Nothing to do. |
---|
| 4545 | // We define anyway a new ring, equal to R, to be able to return it. |
---|
| 4546 | setring R; |
---|
| 4547 | list lR = ringlist(R); |
---|
| 4548 | def ROut = ring(lR); |
---|
| 4549 | setring ROut; |
---|
| 4550 | ideal norid = fetch(R, I); |
---|
| 4551 | ideal normap = maxideal(1); |
---|
| 4552 | export norid; |
---|
| 4553 | export normap; |
---|
| 4554 | setring R; |
---|
| 4555 | if(withDelta) |
---|
| 4556 | { |
---|
| 4557 | list output = ideal(1), poly(1), ROut, 0; |
---|
| 4558 | } |
---|
| 4559 | else |
---|
| 4560 | { |
---|
| 4561 | list output = ideal(1), poly(1), ROut; |
---|
| 4562 | } |
---|
| 4563 | return(output); |
---|
| 4564 | } |
---|
| 4565 | |
---|
| 4566 | // ----- computation of the chain of ideals A1 c A2 c ... c An ------------ |
---|
| 4567 | while(isNormal == 0) |
---|
| 4568 | { |
---|
| 4569 | step++; |
---|
| 4570 | if(dbg >= 1) { ""; "Step ", step, " begins."; } |
---|
| 4571 | dbprint(dbg, "Computing the test ideal..."); |
---|
| 4572 | |
---|
| 4573 | // --------------- computation of the test ideal ------------------------ |
---|
| 4574 | // Computes a test ideal for the new ring. |
---|
| 4575 | // The test ideal will be the radical in the new ring of the original |
---|
| 4576 | // test ideal. |
---|
| 4577 | setring R; |
---|
| 4578 | U = imap(Q, U); |
---|
| 4579 | c = imap(Q, c); |
---|
| 4580 | testOut = testIdeal(I, U, origJ, c, D); |
---|
| 4581 | cJ = testOut[1]; |
---|
| 4582 | |
---|
| 4583 | setring Q; |
---|
| 4584 | cJ = imap(R, cJ); |
---|
| 4585 | cJ = groebner(cJ); |
---|
| 4586 | |
---|
| 4587 | // cJ / c is now the ideal mapped back. |
---|
| 4588 | // We have the generators as an ideal in the new ring, |
---|
| 4589 | // but we want the generators as an ideal in the original ring. |
---|
| 4590 | cJMod = getGenerators(cJ, U, c); |
---|
| 4591 | |
---|
| 4592 | if(dbg >= 2) { "The test ideal in this step is "; cJMod; } |
---|
| 4593 | |
---|
| 4594 | cJ = cJMod; |
---|
| 4595 | |
---|
| 4596 | // ------------- computation of the quotient (DJ : J)-------------------- |
---|
| 4597 | oldU = U; |
---|
| 4598 | dbprint(dbg, "Computing the quotient (c*D*cJ : cJ)..."); |
---|
| 4599 | U = quotient(c*D*cJ, cJ); |
---|
| 4600 | if(dbg >= 2){"The quotient is "; U;} |
---|
| 4601 | |
---|
| 4602 | // ------------- Grauert - Remmert criterion check ---------------------- |
---|
| 4603 | // We check if the equality in Grauert - Remmert criterion is satisfied. |
---|
| 4604 | isNormal = checkInclusions(D*oldU, U); |
---|
| 4605 | |
---|
| 4606 | if(isNormal == 1) |
---|
| 4607 | { |
---|
| 4608 | // We go one step back. In the last step we didnt get antyhing new, |
---|
| 4609 | // we just verified that the ring was already normal. |
---|
| 4610 | dbprint(dbg, "The ring in the previous step was already normal."); |
---|
| 4611 | dbprint(dbg, ""); |
---|
| 4612 | U = oldU; |
---|
| 4613 | } |
---|
| 4614 | else |
---|
| 4615 | { |
---|
| 4616 | // ------------- preparation for next iteration ---------------------- |
---|
| 4617 | // We have to go on. |
---|
| 4618 | // The new denominator is chosen. |
---|
| 4619 | c = D * c; |
---|
| 4620 | |
---|
| 4621 | // If we have a universal denominator of smaller degree than c, |
---|
| 4622 | // we replace c by it. |
---|
| 4623 | if(condu != 0){ |
---|
| 4624 | if(deg(c) > deg(condu)) |
---|
| 4625 | { |
---|
| 4626 | U = changeDenominatorQ(U, c, condu); |
---|
| 4627 | c = condu; |
---|
| 4628 | } |
---|
| 4629 | } |
---|
| 4630 | if(dbg >= 1) |
---|
| 4631 | { |
---|
| 4632 | "In this step, we have the ring 1/c * U, with c =", c; |
---|
| 4633 | "and U = "; |
---|
| 4634 | U; |
---|
| 4635 | if(dbg>=2){pause();} |
---|
| 4636 | } |
---|
| 4637 | } |
---|
| 4638 | } |
---|
| 4639 | |
---|
| 4640 | // ------------------------- delta computation ---------------------------- |
---|
| 4641 | if(withDelta) |
---|
| 4642 | { |
---|
| 4643 | ideal UD = groebner(U); |
---|
| 4644 | delt = vdim(std(modulo(UD, c))); |
---|
| 4645 | } |
---|
| 4646 | |
---|
| 4647 | // -------------------------- prepare output ----------------------------- |
---|
| 4648 | setring R; |
---|
| 4649 | U = fetch(Q, U); |
---|
| 4650 | c = fetch(Q, c); |
---|
| 4651 | |
---|
| 4652 | // Ring structure of the new ring |
---|
| 4653 | def ere = testOut[2]; |
---|
| 4654 | if(withDelta) |
---|
| 4655 | { |
---|
| 4656 | list output = U, c, ere, delt; |
---|
| 4657 | } |
---|
| 4658 | else |
---|
| 4659 | { |
---|
| 4660 | list output = U, c, ere; |
---|
| 4661 | } |
---|
| 4662 | return(output); |
---|
| 4663 | } |
---|
| 4664 | |
---|
| 4665 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4666 | |
---|
| 4667 | static proc lineUpLast(ideal U, poly c) |
---|
| 4668 | // Sets c as the last generator of U. |
---|
| 4669 | { |
---|
| 4670 | int i; |
---|
| 4671 | ideal newU; |
---|
| 4672 | for (i = 1; i <= ncols(U); i++) |
---|
| 4673 | { |
---|
| 4674 | if(U[i] != c) |
---|
| 4675 | { |
---|
| 4676 | if(size(newU) == 0) |
---|
| 4677 | { newU = U[i]; } |
---|
| 4678 | else |
---|
| 4679 | { newU = newU, U[i]; } |
---|
| 4680 | } |
---|
| 4681 | } |
---|
| 4682 | if(size(newU) == 0) |
---|
| 4683 | { newU = c; } |
---|
| 4684 | else |
---|
| 4685 | { newU = newU, c; } |
---|
| 4686 | return(newU); |
---|
| 4687 | } |
---|
| 4688 | |
---|
| 4689 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4690 | |
---|
| 4691 | static proc lineUp(ideal U, poly c) |
---|
| 4692 | // Sets c as the first generator of U. |
---|
| 4693 | { |
---|
| 4694 | int i; |
---|
| 4695 | ideal newU = c; |
---|
| 4696 | for (i = 1; i <= ncols(U); i++) |
---|
| 4697 | { |
---|
| 4698 | if(U[i] != c) |
---|
| 4699 | { |
---|
| 4700 | newU = newU, U[i]; |
---|
| 4701 | } |
---|
| 4702 | } |
---|
| 4703 | return(newU); |
---|
| 4704 | } |
---|
| 4705 | |
---|
| 4706 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4707 | |
---|
| 4708 | //WARNING - elim is not working here!! Check!! |
---|
| 4709 | //It is now replaced by computing an eliminating groebner basis. |
---|
| 4710 | proc getOneVar(ideal J, int vari) |
---|
| 4711 | "USAGE: getOneVar(J, vari); J is a 0-dimensional ideal, vari is an integer. |
---|
| 4712 | RETURN: a polynomial of J in the variable indicated by vari of smallest |
---|
| 4713 | degree.@* |
---|
| 4714 | NOTE: Works only over rings of two variables.@* |
---|
| 4715 | It is intended mainly as an auxiliary procedure for computing |
---|
| 4716 | integral bases. @* |
---|
| 4717 | EXAMPLE: example getOneVar; shows an example |
---|
| 4718 | " |
---|
| 4719 | { |
---|
| 4720 | def R = basering; |
---|
| 4721 | ring RR = 0, (var(3-vari), var(vari)), lp; |
---|
| 4722 | ideal J = imap(R, J); |
---|
| 4723 | J = groebner(J); |
---|
| 4724 | poly g = J[1]; |
---|
| 4725 | setring R; |
---|
| 4726 | poly g = imap(RR, g); |
---|
| 4727 | return(g); |
---|
| 4728 | } |
---|
| 4729 | example |
---|
| 4730 | { "EXAMPLE:"; |
---|
| 4731 | printlevel = printlevel+1; |
---|
| 4732 | echo = 2; |
---|
| 4733 | ring s = 0,(x,y),dp; |
---|
| 4734 | ideal J = x3-y, y3; |
---|
| 4735 | getOneVar(J, 1); |
---|
| 4736 | |
---|
| 4737 | echo = 0; |
---|
| 4738 | printlevel = printlevel-1; |
---|
| 4739 | } |
---|
| 4740 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4741 | |
---|
| 4742 | proc getSmallest(ideal J) |
---|
| 4743 | "USAGE: getSmallest(J); J is an ideal. |
---|
| 4744 | RETURN: the generator of J of smallest degree. If there are more than one, it |
---|
| 4745 | chooses the one with smallest number of monomials.@* |
---|
| 4746 | NOTE: It looks only at the generator of J, not at all the polynomials in |
---|
| 4747 | the ideal.@* |
---|
| 4748 | It is intended maninly to compute a good universal denominator in the |
---|
| 4749 | normalization algorithms.@* |
---|
| 4750 | EXAMPLE: example getSmallest; shows an example |
---|
| 4751 | " |
---|
| 4752 | { |
---|
| 4753 | // Computes the polynomial of smallest degree of J. |
---|
| 4754 | // |
---|
| 4755 | int i; |
---|
| 4756 | poly p = J[1]; |
---|
| 4757 | int d = deg(p); |
---|
| 4758 | int di; |
---|
| 4759 | for(i = 2; i <= ncols(J); i++) |
---|
| 4760 | { |
---|
| 4761 | if(J[i] != 0) |
---|
| 4762 | { |
---|
| 4763 | di = deg(J[i]); |
---|
| 4764 | if(di < d) |
---|
| 4765 | { |
---|
| 4766 | p = J[i]; |
---|
| 4767 | d = di; |
---|
| 4768 | } |
---|
| 4769 | else |
---|
| 4770 | { |
---|
| 4771 | if(di == d) |
---|
| 4772 | { |
---|
| 4773 | if(size(J[i]) < size(p)) |
---|
| 4774 | { |
---|
| 4775 | p = J[i]; |
---|
| 4776 | } |
---|
| 4777 | } |
---|
| 4778 | } |
---|
| 4779 | } |
---|
| 4780 | } |
---|
| 4781 | return(p); |
---|
| 4782 | } |
---|
| 4783 | example |
---|
| 4784 | { "EXAMPLE:"; |
---|
| 4785 | printlevel = printlevel+1; |
---|
| 4786 | echo = 2; |
---|
| 4787 | ring s = 0,(x,y),dp; |
---|
| 4788 | ideal J = x3-y, y5, x2-y2+1; |
---|
| 4789 | getSmallest(J); |
---|
| 4790 | |
---|
| 4791 | echo = 0; |
---|
| 4792 | printlevel = printlevel-1; |
---|
| 4793 | } |
---|
| 4794 | |
---|
| 4795 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4796 | |
---|
| 4797 | static proc getGenerators(ideal J, ideal U, poly c) |
---|
| 4798 | { |
---|
| 4799 | // Computes the generators of J as an ideal in the original ring, |
---|
| 4800 | // where J is given by generators in the new ring. |
---|
| 4801 | |
---|
| 4802 | // The new ring is given by 1/c * U in the total ring of fractions. |
---|
| 4803 | |
---|
| 4804 | int i, j; // counters; |
---|
| 4805 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
| 4806 | poly p; // The lifted polynomial |
---|
| 4807 | ideal JGr = groebner(J); // Groebner base of J |
---|
| 4808 | |
---|
| 4809 | if(dbg>1){"Checking for new generators...";} |
---|
| 4810 | for(i = 1; i <= ncols(J); i++) |
---|
| 4811 | { |
---|
| 4812 | for(j = 1; j <= ncols(U); j++) |
---|
| 4813 | { |
---|
| 4814 | p = lift(c, J[i]*U[j])[1,1]; |
---|
| 4815 | p = reduce(p, JGr); |
---|
| 4816 | if(p != 0) |
---|
| 4817 | { |
---|
| 4818 | if(dbg>1) |
---|
| 4819 | { |
---|
| 4820 | "New polynoial added:", p; |
---|
| 4821 | if(dbg>4) {pause();} |
---|
| 4822 | } |
---|
| 4823 | JGr = JGr, p; |
---|
| 4824 | JGr = groebner(JGr); |
---|
| 4825 | J = J, p; |
---|
| 4826 | } |
---|
| 4827 | } |
---|
| 4828 | } |
---|
| 4829 | return(J); |
---|
| 4830 | } |
---|
| 4831 | |
---|
| 4832 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4833 | |
---|
| 4834 | static proc testIdeal(ideal I, ideal U, ideal origJ, poly c, poly D) |
---|
| 4835 | { |
---|
| 4836 | // Internal procedure, used in normalM. |
---|
| 4837 | // Computes the test ideal in the new ring. |
---|
| 4838 | // It takes the original test ideal and computes the radical of it in the |
---|
| 4839 | // new ring. |
---|
| 4840 | |
---|
| 4841 | // The new ring is 1/c * U. |
---|
| 4842 | // The original test ideal is origJ. |
---|
| 4843 | // The original ring is R / I, where R is the basering. |
---|
| 4844 | int i; // counter |
---|
| 4845 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
| 4846 | def R = basering; // We dont work in the quo |
---|
| 4847 | ideal J = origJ; |
---|
| 4848 | |
---|
| 4849 | // ---------- computation of the ring structure of 1/c * U ---------------- |
---|
| 4850 | U = lineUp(U, c); |
---|
| 4851 | |
---|
| 4852 | if(dbg > 1){"Computing the new ring structure...";} |
---|
| 4853 | list ele = computeRing(U, I, "noRed"); |
---|
| 4854 | |
---|
| 4855 | def origEre = ele[1]; |
---|
| 4856 | setring origEre; |
---|
| 4857 | if(dbg > 1){"The relations are"; norid;} |
---|
| 4858 | |
---|
| 4859 | // ---------------- setting the ring to work in -------------------------- |
---|
| 4860 | int isGlobal = ord_test(origEre); // Checks if the original ring has |
---|
| 4861 | // global ordering. |
---|
| 4862 | if(isGlobal != 1) |
---|
| 4863 | { |
---|
| 4864 | list rl = ringlist(origEre); |
---|
| 4865 | list origOrd = rl[3]; |
---|
| 4866 | list newOrd = list("dp", intvec(1:nvars(origEre))), list("C", 0); |
---|
| 4867 | rl[3] = newOrd; |
---|
| 4868 | def ere = ring(rl); // globR is the original ring but |
---|
| 4869 | // with a global ordering. |
---|
| 4870 | setring ere; |
---|
| 4871 | ideal norid = imap(origEre, norid); |
---|
| 4872 | } |
---|
| 4873 | else |
---|
| 4874 | { |
---|
| 4875 | def ere = origEre; |
---|
| 4876 | } |
---|
| 4877 | |
---|
| 4878 | ideal I = imap(R, I); |
---|
| 4879 | ideal J = imap(R, J); |
---|
| 4880 | J = J, norid, I; |
---|
| 4881 | |
---|
| 4882 | |
---|
| 4883 | // ----- computation of the test ideal using the ring structure of Ai ----- |
---|
| 4884 | option("redSB"); |
---|
| 4885 | option("returnSB"); |
---|
| 4886 | |
---|
| 4887 | if(dbg > 1){"Computing the radical of J...";} |
---|
| 4888 | J = radical(J); |
---|
| 4889 | if(dbg > 1){"Computing the interreduction of the radical...";} |
---|
| 4890 | J = groebner(J); |
---|
| 4891 | //J = interred(J); |
---|
| 4892 | if(dbg > 1) |
---|
| 4893 | { |
---|
| 4894 | "The radical in the generated ring is"; |
---|
| 4895 | J; |
---|
| 4896 | if(dbg>4){pause();} |
---|
| 4897 | } |
---|
| 4898 | |
---|
| 4899 | setring ere; |
---|
| 4900 | |
---|
| 4901 | // -------------- map from Ai to the total ring of fractions --------------- |
---|
| 4902 | // Now we must map back this ideal J to U_i / c in the total ring of |
---|
| 4903 | // fractions. |
---|
| 4904 | // The map sends T_j -> u_j / c. |
---|
| 4905 | // The map is built by the following steps: |
---|
| 4906 | // 1) We compute the degree of the generators of J with respect to the |
---|
| 4907 | // new variables T_j. |
---|
| 4908 | // 2) For each generator, we multiply each term by a power of c, as if |
---|
| 4909 | // taking c^n as a common denominator (considering the new variables as |
---|
| 4910 | // a polynomial in the old variables divided by c). |
---|
| 4911 | // 3) We replace the new variables T_j by the corresponding numerator u_j. |
---|
| 4912 | // 4) We lift the resulting polynomial to change the denominator |
---|
| 4913 | // from c^n to c. |
---|
| 4914 | int nNewVars = nvars(ere) - nvars(R); // Number of new variables |
---|
| 4915 | poly c = imap(R, c); |
---|
| 4916 | intvec @v = 1..nNewVars; // Vector of the new variables. |
---|
| 4917 | // They must be the first ones. |
---|
| 4918 | if(dbg > 1){"The indices of the new variables are", @v;} |
---|
| 4919 | |
---|
| 4920 | // ---------------------- step 1 of the mapping --------------------------- |
---|
| 4921 | intvec degs; |
---|
| 4922 | for(i = 1; i<=ncols(J); i++) |
---|
| 4923 | { |
---|
| 4924 | degs[i] = degSubring(J[i], @v); |
---|
| 4925 | } |
---|
| 4926 | if(dbg > 1) |
---|
| 4927 | { |
---|
| 4928 | "The degrees with respect to the new variables are"; |
---|
| 4929 | degs; |
---|
| 4930 | } |
---|
| 4931 | |
---|
| 4932 | // ---------------------- step 2 of the mapping --------------------------- |
---|
| 4933 | ideal mapJ = mapBackIdeal(J, c, @v); |
---|
| 4934 | |
---|
| 4935 | setring R; |
---|
| 4936 | |
---|
| 4937 | // ---------------------- step 3 of the mapping --------------------------- |
---|
| 4938 | ideal z; // The variables of the original ring in order. |
---|
| 4939 | for(i = 1; i<=nvars(R); i++) |
---|
| 4940 | { |
---|
| 4941 | z[i] = var(i); |
---|
| 4942 | } |
---|
| 4943 | |
---|
| 4944 | map f = ere, U[2..ncols(U)], z[1..ncols(z)]; // The map to the original ring. |
---|
| 4945 | if(dbg > 1) |
---|
| 4946 | { |
---|
| 4947 | "The map is "; |
---|
| 4948 | f; |
---|
| 4949 | if(dbg>4){pause();} |
---|
| 4950 | } |
---|
| 4951 | |
---|
| 4952 | if(dbg > 1){ "Computing the map..."; } |
---|
| 4953 | |
---|
| 4954 | J = f(mapJ); |
---|
| 4955 | if(dbg > 1) |
---|
| 4956 | { |
---|
| 4957 | "The ideal J mapped back (before lifting) is"; |
---|
| 4958 | J; |
---|
| 4959 | if(dbg>4){pause();} |
---|
| 4960 | } |
---|
| 4961 | |
---|
| 4962 | // ---------------------- step 4 of the mapping --------------------------- |
---|
| 4963 | qring Q = groebner(I); |
---|
| 4964 | ideal J = imap(R, J); |
---|
| 4965 | poly c = imap(R, c); |
---|
| 4966 | for(i = 1; i<=ncols(J); i++) |
---|
| 4967 | { |
---|
| 4968 | if(degs[i]>1) |
---|
| 4969 | { |
---|
| 4970 | J[i] = lift(c^(degs[i]-1), J[i])[1,1]; |
---|
| 4971 | } |
---|
| 4972 | else |
---|
| 4973 | { |
---|
| 4974 | if(degs[i]==0) { J[i] = c*J[i]; } |
---|
| 4975 | } |
---|
| 4976 | } |
---|
| 4977 | |
---|
| 4978 | if(dbg > 1) |
---|
| 4979 | { |
---|
| 4980 | "The ideal J lifted is"; |
---|
| 4981 | J; |
---|
| 4982 | if(dbg>4){pause();} |
---|
| 4983 | } |
---|
| 4984 | |
---|
| 4985 | // --------------------------- prepare output ---------------------------- |
---|
| 4986 | J = groebner(J); |
---|
| 4987 | |
---|
| 4988 | setring R; |
---|
| 4989 | J = imap(Q, J); |
---|
| 4990 | |
---|
| 4991 | return(list(J, ele[1])); |
---|
| 4992 | } |
---|
| 4993 | |
---|
| 4994 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4995 | |
---|
| 4996 | proc changeDenominator(ideal U1, poly c1, poly c2, ideal I) |
---|
| 4997 | "USAGE: changeDenominator(U1, c1, c2, I); U1 and I ideals, c1 and c2 |
---|
| 4998 | polynomials.@* |
---|
| 4999 | RETURN: an ideal U2 such that the A-modules 1/c1 * U1 and 1/c2 * U2 are equal, |
---|
| 5000 | where A = R/I and R is the basering.@* |
---|
| 5001 | NOTE: It assumes that such U2 exists. It is intended maninly as an auxiliary |
---|
| 5002 | procedure in the normalization algorithms.@* |
---|
| 5003 | EXAMPLE: example changeDenominator; shows an example |
---|
| 5004 | " |
---|
| 5005 | { |
---|
| 5006 | // Let A = R / I. Given an A-module in the form 1/c1 * U1 (U1 ideal of A), it |
---|
| 5007 | // computes a new ideal U2 such that the the A-module is 1/c2 * U2. |
---|
| 5008 | // The base ring is R, but the computations are to be done in R / I. |
---|
| 5009 | int a; // counter |
---|
| 5010 | def R = basering; |
---|
| 5011 | qring Q = I; |
---|
| 5012 | ideal U1 = fetch(R, U1); |
---|
| 5013 | poly c1 = fetch(R, c1); |
---|
| 5014 | poly c2 = fetch(R, c2); |
---|
| 5015 | ideal U2 = changeDenominatorQ(U1, c1, c2); |
---|
| 5016 | setring R; |
---|
| 5017 | ideal U2 = fetch(Q, U2); |
---|
| 5018 | return(U2); |
---|
| 5019 | } |
---|
| 5020 | example |
---|
| 5021 | { |
---|
| 5022 | "EXAMPLE:"; |
---|
| 5023 | echo = 2; |
---|
| 5024 | ring s = 0,(x,y),dp; |
---|
| 5025 | ideal I = y5-y4x+4y2x2-x4; |
---|
| 5026 | ideal U1 = normal(I)[2][1]; |
---|
| 5027 | poly c1 = U1[4]; |
---|
| 5028 | U1;c1; |
---|
| 5029 | // 1/c1 * U1 is the normalization of I. |
---|
| 5030 | ideal U2 = changeDenominator(U1, c1, x3, I); |
---|
| 5031 | U2; |
---|
| 5032 | // 1/x3 * U2 is also the normalization of I, but with a different denominator. |
---|
| 5033 | echo = 0; |
---|
| 5034 | } |
---|
| 5035 | |
---|
| 5036 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5037 | |
---|
| 5038 | static proc changeDenominatorQ(ideal U1, poly c1, poly c2) |
---|
| 5039 | { |
---|
| 5040 | // Given a ring in the form 1/c1 * U, it computes a new U2 st the ring |
---|
| 5041 | // is 1/c2 * U2. |
---|
| 5042 | // The base ring is already a quotient ring R / I. |
---|
| 5043 | int a; // counter |
---|
| 5044 | ideal U2; |
---|
| 5045 | poly p; |
---|
| 5046 | for(a = 1; a <= ncols(U1); a++) |
---|
| 5047 | { |
---|
| 5048 | p = lift(c1, c2*U1[a])[1,1]; |
---|
| 5049 | U2[a] = p; |
---|
| 5050 | } |
---|
| 5051 | return(U2); |
---|
| 5052 | } |
---|
| 5053 | |
---|
| 5054 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5055 | |
---|
| 5056 | static proc checkInclusions(ideal U1, ideal U2) |
---|
| 5057 | { |
---|
| 5058 | // Checks if the identity A = Hom(J, J) of Grauert-Remmert criterion is |
---|
| 5059 | // satisfied. |
---|
| 5060 | int dbg = printlevel - voice + 2; // dbg = printlevel (default: dbg = 0) |
---|
| 5061 | list reduction1; |
---|
| 5062 | list reduction2; |
---|
| 5063 | |
---|
| 5064 | // ---------------------- inclusion Hom(J, J) c A ------------------------- |
---|
| 5065 | if(dbg > 1){"Checking the inclusion Hom(J, J) c A:";} |
---|
| 5066 | // This interred is used only because a bug in groebner! |
---|
| 5067 | U1 = groebner(U1); |
---|
| 5068 | reduction1 = reduce(U2, U1); |
---|
| 5069 | if(dbg > 1){reduction1[1];} |
---|
| 5070 | |
---|
| 5071 | // ---------------------- inclusion A c Hom(J, J) ------------------------- |
---|
| 5072 | // The following check should always be satisfied. |
---|
| 5073 | // This is only used for debugging. |
---|
| 5074 | if(dbg > 1) |
---|
| 5075 | { |
---|
| 5076 | "and the inclusion A c Hom(J, J): (this should always be satisfied)"; |
---|
| 5077 | // This interred is used only because a bug in groebner! |
---|
| 5078 | U2 = groebner(U2); |
---|
| 5079 | reduction2 = reduce(U1, groebner(U2)); |
---|
| 5080 | reduction2[1]; |
---|
| 5081 | if(size(reduction2[1]) > 0) |
---|
| 5082 | { |
---|
| 5083 | "Something went wrong... (this inclusion should always be satisfied)"; |
---|
| 5084 | ~; |
---|
| 5085 | } |
---|
| 5086 | else |
---|
| 5087 | { |
---|
| 5088 | if(dbg>4){pause();} |
---|
| 5089 | } |
---|
| 5090 | } |
---|
| 5091 | |
---|
| 5092 | if(size(reduction1[1]) == 0) |
---|
| 5093 | { |
---|
| 5094 | // We are done! The ring computed in the last step was normal. |
---|
| 5095 | return(1); |
---|
| 5096 | } |
---|
| 5097 | else |
---|
| 5098 | { |
---|
| 5099 | return(0); |
---|
| 5100 | } |
---|
| 5101 | } |
---|
| 5102 | |
---|
| 5103 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5104 | |
---|
| 5105 | static proc degSubring(poly p, intvec @v) |
---|
| 5106 | { |
---|
| 5107 | // Computes the degree of a polynomial taking only some variables as variables |
---|
| 5108 | // and the others as parameters. |
---|
| 5109 | |
---|
| 5110 | // The degree is taken w.r.t. the variables indicated in v. |
---|
| 5111 | int i; // Counter |
---|
| 5112 | int d = 0; // The degree |
---|
| 5113 | int e; // Degree (auxiliar variable) |
---|
| 5114 | for(i = 1; i <= size(p); i++) |
---|
| 5115 | { |
---|
| 5116 | e = sum(leadexp(p[i]), @v); |
---|
| 5117 | if(e > d){d = e;} |
---|
| 5118 | } |
---|
| 5119 | return(d); |
---|
| 5120 | } |
---|
| 5121 | |
---|
| 5122 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5123 | |
---|
| 5124 | static proc mapBackIdeal(ideal I, poly c, intvec @v) |
---|
| 5125 | { |
---|
| 5126 | // Modifies all polynomials in I so that a map x(i) -> y(i)/c can be |
---|
| 5127 | // carried out. |
---|
| 5128 | |
---|
| 5129 | // v indicates wicih variables x(i) of the ring will be mapped to y(i)/c. |
---|
| 5130 | |
---|
| 5131 | int i; // counter |
---|
| 5132 | for(i = 1; i <= ncols(I); i++) |
---|
| 5133 | { |
---|
| 5134 | I[i] = mapBackPoly(I[i], c, @v); |
---|
| 5135 | } |
---|
| 5136 | return(I); |
---|
| 5137 | } |
---|
| 5138 | |
---|
| 5139 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5140 | |
---|
| 5141 | static proc mapBackPoly(poly p, poly c, intvec @v) |
---|
| 5142 | { |
---|
| 5143 | // Multiplies each monomial of p by a power of c so that a map x(i) -> y(i)/c |
---|
| 5144 | // can be carried out. |
---|
| 5145 | |
---|
| 5146 | // v indicates wicih variables x(i) of the ring will be mapped to y(i)/c. |
---|
| 5147 | int i; // counter |
---|
| 5148 | int e; // exponent |
---|
| 5149 | int d = degSubring(p, @v); |
---|
| 5150 | poly g = 0; |
---|
| 5151 | int size_p=size(p); |
---|
| 5152 | for(i = 1; i <= size_p; i++) |
---|
| 5153 | { |
---|
| 5154 | e = sum(leadexp(p[i]), @v); |
---|
| 5155 | g = g + p[i] * c^(d-e); |
---|
| 5156 | } |
---|
| 5157 | return(g); |
---|
| 5158 | } |
---|
| 5159 | |
---|
| 5160 | // End procedures for normal |
---|
| 5161 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5162 | |
---|
| 5163 | |
---|
| 5164 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5165 | // Begin procedures for normalC |
---|
| 5166 | |
---|
| 5167 | // We first define resp. copy some attributes to be used in proc normal and |
---|
| 5168 | // static proc normalizationPrimes, and ..., to speed up computation in |
---|
| 5169 | // special cases |
---|
| 5170 | //NOTE: We use the following attributes: |
---|
| 5171 | // 1 attrib(id,"isCohenMacaulay"); //--- Cohen Macaulay |
---|
| 5172 | // 2 attrib(id,"isCompleteIntersection"); //--- complete intersection |
---|
| 5173 | // 3 attrib(id,"isHypersurface"); //--- hypersurface |
---|
| 5174 | // 4 attrib(id,"isEquidimensional"); //--- equidimensional ideal |
---|
| 5175 | // 5 attrib(id,"isPrim"); //--- prime ideal |
---|
| 5176 | // 6 attrib(id,"isRegInCodim2"); //--- regular in codimension 2 |
---|
| 5177 | // 7 attrib(id,"isIsolatedSingularity"); //--- isolated singularities |
---|
| 5178 | // 8 attrib(id,"onlySingularAtZero"); //--- only singular at 0 |
---|
| 5179 | // 9 attrib(id,"isRadical"); //--- radical ideal |
---|
| 5180 | //Recall: (attrib(id,"xy"),1) sets attrib xy to TRUE and |
---|
| 5181 | // (attrib(id,"xy"),0) to FALSE |
---|
| 5182 | |
---|
| 5183 | static proc getAttrib (ideal id) |
---|
| 5184 | "USAGE: getAttrib(id); id=ideal |
---|
| 5185 | COMPUTE: check attributes for id. If the attributes above are defined, |
---|
| 5186 | take its value, otherwise define it and set it to 0 |
---|
| 5187 | RETURN: intvec of size 9, with entries 0 or 1, values of attributes defined |
---|
| 5188 | above (in this order) |
---|
| 5189 | EXAMPLE: no example |
---|
| 5190 | " |
---|
| 5191 | { |
---|
| 5192 | int isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad; |
---|
| 5193 | |
---|
| 5194 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
| 5195 | { |
---|
| 5196 | if( attrib(id,"isCohenMacaulay")==1 ) |
---|
| 5197 | { isCoM=1; isEq=1; } |
---|
| 5198 | } |
---|
| 5199 | |
---|
| 5200 | if( typeof(attrib(id,"isCompleteIntersection"))=="int" ) |
---|
| 5201 | { |
---|
| 5202 | if(attrib(id,"isCompleteIntersection")==1) |
---|
| 5203 | { isCoI=1; isCoM=1; isEq=1; } |
---|
| 5204 | } |
---|
| 5205 | |
---|
| 5206 | if( typeof(attrib(id,"isHypersurface"))=="int" ) |
---|
| 5207 | { |
---|
| 5208 | if(attrib(id,"isHypersurface")==1) |
---|
| 5209 | { isHy=1; isCoI=1; isCoM=1; isEq=1; } |
---|
| 5210 | } |
---|
| 5211 | |
---|
| 5212 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
| 5213 | { |
---|
| 5214 | if(attrib(id,"isEquidimensional")==1) |
---|
| 5215 | { isEq=1; } |
---|
| 5216 | } |
---|
| 5217 | |
---|
| 5218 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
| 5219 | { |
---|
| 5220 | if(attrib(id,"isPrim")==1) |
---|
| 5221 | { isPr=1; } |
---|
| 5222 | } |
---|
| 5223 | |
---|
| 5224 | if( typeof(attrib(id,"isRegInCodim2"))=="int" ) |
---|
| 5225 | { |
---|
| 5226 | if(attrib(id,"isRegInCodim2")==1) |
---|
| 5227 | { isReg=1; } |
---|
| 5228 | } |
---|
| 5229 | |
---|
| 5230 | if( typeof(attrib(id,"isIsolatedSingularity"))=="int" ) |
---|
| 5231 | { |
---|
| 5232 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
| 5233 | { isIso=1; } |
---|
| 5234 | } |
---|
| 5235 | |
---|
| 5236 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
| 5237 | { |
---|
| 5238 | if(attrib(id,"onlySingularAtZero")==1) |
---|
| 5239 | { oSAZ=1; } |
---|
| 5240 | } |
---|
| 5241 | |
---|
| 5242 | if( typeof(attrib(id,"isRad"))=="int" ) |
---|
| 5243 | { |
---|
| 5244 | if(attrib(id,"isRad")==1) |
---|
| 5245 | { isRad=1; } |
---|
| 5246 | } |
---|
| 5247 | |
---|
| 5248 | intvec atr = isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad; |
---|
| 5249 | return(atr); |
---|
| 5250 | } |
---|
| 5251 | |
---|
| 5252 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5253 | |
---|
| 5254 | static proc setAttrib (ideal id, intvec atr) |
---|
| 5255 | "USAGE: setAttrib(id,atr); id ideal, atr intvec |
---|
| 5256 | COMPUTE: set attributes to id specified by atr |
---|
| 5257 | RETURN: id, with assigned attributes from atr |
---|
| 5258 | EXAMPLE: no example |
---|
| 5259 | " |
---|
| 5260 | { |
---|
| 5261 | attrib(id,"isCohenMacaulay",atr[1]); //--- Cohen Macaulay |
---|
| 5262 | attrib(id,"isCompleteIntersection",atr[2]); //--- complete intersection |
---|
| 5263 | attrib(id,"isHypersurface",atr[3]); //--- hypersurface |
---|
| 5264 | attrib(id,"isEquidimensional",atr[4]); //--- equidimensional ideal |
---|
| 5265 | attrib(id,"isPrim",atr[5]); //--- prime ideal |
---|
| 5266 | attrib(id,"isRegInCodim2",atr[6]); //--- regular in codimension 2 |
---|
| 5267 | attrib(id,"isIsolatedSingularity",atr[7]); //--- isolated singularities |
---|
| 5268 | attrib(id,"onlySingularAtZero",atr[8]); //--- only singular at 0 |
---|
| 5269 | attrib(id,"isRadical",atr[9]); //--- radical ideal |
---|
| 5270 | |
---|
| 5271 | return(id); |
---|
| 5272 | } |
---|
| 5273 | |
---|
| 5274 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5275 | // copyAttribs is not used anywhere so far |
---|
| 5276 | |
---|
| 5277 | static proc copyAttribs (ideal id1, ideal id) |
---|
| 5278 | "USAGE: copyAttribs(id1,id); id1, id ideals |
---|
| 5279 | COMPUTE: copy attributes from id1 to id |
---|
| 5280 | RETURN: id, with assigned attributes from id1 |
---|
| 5281 | EXAMPLE: no example |
---|
| 5282 | " |
---|
| 5283 | { |
---|
| 5284 | if( typeof(attrib(id1,"isCohenMacaulay"))=="int" ) |
---|
| 5285 | { |
---|
| 5286 | if( attrib(id1,"isCohenMacaulay")==1 ) |
---|
| 5287 | { |
---|
| 5288 | attrib(id,"isEquidimensional",1); |
---|
| 5289 | } |
---|
| 5290 | } |
---|
| 5291 | else |
---|
| 5292 | { |
---|
| 5293 | attrib(id,"isCohenMacaulay",0); |
---|
| 5294 | } |
---|
| 5295 | |
---|
| 5296 | if( typeof(attrib(id1,"isCompleteIntersection"))=="int" ) |
---|
| 5297 | { |
---|
| 5298 | if(attrib(id1,"isCompleteIntersection")==1) |
---|
| 5299 | { |
---|
| 5300 | attrib(id,"isCohenMacaulay",1); |
---|
| 5301 | attrib(id,"isEquidimensional",1); |
---|
| 5302 | } |
---|
| 5303 | } |
---|
| 5304 | else |
---|
| 5305 | { |
---|
| 5306 | attrib(id,"isCompleteIntersection",0); |
---|
| 5307 | } |
---|
| 5308 | |
---|
| 5309 | if( typeof(attrib(id1,"isHypersurface"))=="int" ) |
---|
| 5310 | { |
---|
| 5311 | if(attrib(id1,"isHypersurface")==1) |
---|
| 5312 | { |
---|
| 5313 | attrib(id,"isCompleteIntersection",1); |
---|
| 5314 | attrib(id,"isCohenMacaulay",1); |
---|
| 5315 | attrib(id,"isEquidimensional",1); |
---|
| 5316 | } |
---|
| 5317 | } |
---|
| 5318 | else |
---|
| 5319 | { |
---|
| 5320 | attrib(id,"isHypersurface",0); |
---|
| 5321 | } |
---|
| 5322 | |
---|
| 5323 | if( (typeof(attrib(id1,"isEquidimensional"))=="int") ) |
---|
| 5324 | { |
---|
| 5325 | if(attrib(id1,"isEquidimensional")==1) |
---|
| 5326 | { |
---|
| 5327 | attrib(id,"isEquidimensional",1); |
---|
| 5328 | } |
---|
| 5329 | } |
---|
| 5330 | else |
---|
| 5331 | { |
---|
| 5332 | attrib(id,"isEquidimensional",0); |
---|
| 5333 | } |
---|
| 5334 | |
---|
| 5335 | if( typeof(attrib(id1,"isPrim"))=="int" ) |
---|
| 5336 | { |
---|
| 5337 | if(attrib(id1,"isPrim")==1) |
---|
| 5338 | { |
---|
| 5339 | attrib(id,"isEquidimensional",1); |
---|
| 5340 | } |
---|
| 5341 | } |
---|
| 5342 | else |
---|
| 5343 | { |
---|
| 5344 | attrib(id,"isPrim",0); |
---|
| 5345 | } |
---|
| 5346 | |
---|
| 5347 | if( (typeof(attrib(id1,"isRegInCodim2"))=="int") ) |
---|
| 5348 | { |
---|
| 5349 | if(attrib(id1,"isRegInCodim2")==1) |
---|
| 5350 | { |
---|
| 5351 | attrib(id,"isRegInCodim2",1); |
---|
| 5352 | } |
---|
| 5353 | } |
---|
| 5354 | else |
---|
| 5355 | { |
---|
| 5356 | attrib(id,"isRegInCodim2",0); |
---|
| 5357 | } |
---|
| 5358 | |
---|
| 5359 | if( (typeof(attrib(id1,"isIsolatedSingularity"))=="int") ) |
---|
| 5360 | { |
---|
| 5361 | if(attrib(id1,"isIsolatedSingularity")==1) |
---|
| 5362 | { |
---|
| 5363 | attrib(id,"isIsolatedSingularity",1); |
---|
| 5364 | } |
---|
| 5365 | } |
---|
| 5366 | else |
---|
| 5367 | { |
---|
| 5368 | attrib(id,"isIsolatedSingularity",0); |
---|
| 5369 | } |
---|
| 5370 | |
---|
| 5371 | if( typeof(attrib(id1,"onlySingularAtZero"))=="int" ) |
---|
| 5372 | { |
---|
| 5373 | if(attrib(id1,"onlySingularAtZero")==1) |
---|
| 5374 | { |
---|
| 5375 | attrib(id,"isIsolatedSingularity",1); |
---|
| 5376 | } |
---|
| 5377 | } |
---|
| 5378 | else |
---|
| 5379 | { |
---|
| 5380 | attrib(id,"onlySingularAtZero",0); |
---|
| 5381 | } |
---|
| 5382 | |
---|
| 5383 | if( typeof(attrib(id1,"isRad"))=="int" ) |
---|
| 5384 | { |
---|
| 5385 | if(attrib(id1,"isRad")==1) |
---|
| 5386 | { |
---|
| 5387 | attrib(id,"isRad",1); |
---|
| 5388 | } |
---|
| 5389 | } |
---|
| 5390 | else |
---|
| 5391 | { |
---|
| 5392 | attrib(id,"isRad",0); |
---|
| 5393 | } |
---|
| 5394 | return(id); |
---|
| 5395 | } |
---|
| 5396 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 5397 | |
---|
| 5398 | proc normalC(ideal id, list #) |
---|
| 5399 | "USAGE: normalC(id [,choose]); id = radical ideal, choose = optional list |
---|
| 5400 | of string. |
---|
| 5401 | Optional parameters in list choose (can be entered in any order):@* |
---|
| 5402 | Decomposition:@* |
---|
| 5403 | - \"equidim\" -> computes first an equidimensional decomposition, |
---|
| 5404 | and then the normalization of each component (default).@* |
---|
| 5405 | - \"prim\" -> computes first the minimal associated primes, and then |
---|
| 5406 | the normalization of each prime. @* |
---|
| 5407 | - \"noDeco\" -> no preliminary decomposition is done. If the ideal is |
---|
| 5408 | not equidimensional radical, output might be wrong.@* |
---|
| 5409 | - \"isPrim\" -> assumes that the ideal is prime. If the assumption does |
---|
| 5410 | not hold, output might be wrong.@* |
---|
| 5411 | - \"noFac\" -> factorization is avoided in the computation of the |
---|
| 5412 | minimal associated primes; |
---|
| 5413 | Other:@* |
---|
| 5414 | - \"withGens\" -> the minimal associated primes P_i of id are |
---|
| 5415 | computed and for each P_i, algebra generators of the integral closure |
---|
| 5416 | of basering/P_i are computed as elements of its quotient field;@* |
---|
| 5417 | If choose is not given or empty, the default options are used.@* |
---|
| 5418 | ASSUME: The ideal must be radical, for non-radical ideals the output may |
---|
| 5419 | be wrong (id=radical(id); makes id radical). However, if option |
---|
| 5420 | \"prim\" is set the minimal associated primes are computed first |
---|
| 5421 | and hence normalC computes the normalization of the radical of id. |
---|
| 5422 | \"isPrim\" should only be used if id is known to be irreducible. |
---|
| 5423 | RETURN: a list, say nor, of size 2 (resp. 3 if option \"withGens\" is set).@* |
---|
| 5424 | * nor[1] is always a of r rings, where r is the number of associated |
---|
| 5425 | primes with option \"prim\" (resp. >= no of equidimenensional |
---|
| 5426 | components with option \"equidim\").@* |
---|
| 5427 | Each ring Ri=nor[1][i], i=1..r, contains two ideals with given |
---|
| 5428 | names @code{norid} and @code{normap} such that @* |
---|
| 5429 | - Ri/norid is the normalization of the i-th component, i.e. the |
---|
| 5430 | integral closure in its field of fractions as affine ring, i.e. Ri is |
---|
| 5431 | given in the form K[X(1..p),T(1..q)], where K is the ground field; |
---|
| 5432 | - normap gives the normalization map from basering/id to |
---|
| 5433 | Ri/norid for each i (the j-th element of normap is mapped to the |
---|
| 5434 | j-th variable of R).@* |
---|
| 5435 | - the direct sum of the rings Ri/norid is the normalization |
---|
| 5436 | of basering/id; @* |
---|
| 5437 | ** If option \"withGens\" is not set: @* |
---|
| 5438 | * nor[2] shows the delta invariants: nor[2] is a list of an intvec of |
---|
| 5439 | size r, the delta invariants of the r components, and an integer, the |
---|
| 5440 | delta invariant of basering/id. (-1 means infinite, 0 that basering/P_i |
---|
| 5441 | resp. basering/input is normal, -2 means that delta resp. delta of one |
---|
| 5442 | of the components is not computed (which may happen if \"equidim\" is |
---|
| 5443 | given). @* |
---|
| 5444 | ** If option \"withGens\" is set: |
---|
| 5445 | * nor[2] is a list of ideals Ii=nor[2][i], i=1..r, in the basering, |
---|
| 5446 | generating the integral closure of basering/P_i in its quotient field |
---|
| 5447 | as K-algebra (K the ground field):@* |
---|
| 5448 | If Ii is given by polynomials g_1,...,g_k, then c:=g_k is a non-zero |
---|
| 5449 | divisor and the j-th variables of the ring Ri satisfies var(j)=g_j/c, |
---|
| 5450 | j=1..k-1, as element in the quotient field of basering/P_i. The |
---|
| 5451 | g_j/g_k+1 are K-algebra generators of the integral closure of |
---|
| 5452 | basering/P_i.@* |
---|
| 5453 | * nor[3] shows the delta invariant as above. |
---|
| 5454 | THEORY: We use the Grauert-Remmert-de Jong algorithm [c.f. G.-M. Greuel, |
---|
| 5455 | G. Pfister: A SINGULAR Introduction to Commutative Algebra, 2nd Edition. |
---|
| 5456 | Springer Verlag (2007)]. |
---|
| 5457 | The procedure computes the algebra structure and the delta invariant of |
---|
| 5458 | the normalization of R/id:@* |
---|
| 5459 | The normalization is an affine algebra over the ground field K |
---|
| 5460 | and nor[1] presents it as such: Ri = K[X(1..p),T(1..q)] and Ri/norid |
---|
| 5461 | is the integral closure of R/P_i; if option \"withGens\" is set the |
---|
| 5462 | X(j) and T(j) are expressed as quotients in the total ring of |
---|
| 5463 | fractions. Note that the X(j) and T(j) generate the integral closure |
---|
| 5464 | as K-algebra, but not necessarily as R-module (since relations of the |
---|
| 5465 | form X(1)=T(1)*T(2) may have been eliminated). Geometrically the |
---|
| 5466 | algebra structure is relevant since the variety of the ideal norid in |
---|
| 5467 | Ri is the normalization of the variety of the ideal P_i in R.@* |
---|
| 5468 | The delta invariant of a reduced ring A is dim_K(normalization(A)/A). |
---|
| 5469 | For A=K[x1,...,xn]/id we call this number also the delta invariant of |
---|
| 5470 | id. nor[3] returns the delta invariants of the components P_i and of |
---|
| 5471 | id. |
---|
| 5472 | NOTE: To use the i-th ring type: @code{def R=nor[1][i]; setring R;}. |
---|
| 5473 | @* Increasing/decreasing printlevel displays more/less comments |
---|
| 5474 | (default: printlevel=0). |
---|
| 5475 | @* Not implemented for local or mixed orderings or quotient rings. |
---|
| 5476 | For local or mixed orderings use proc 'normal'. |
---|
| 5477 | @* If the input ideal id is weighted homogeneous a weighted ordering may |
---|
| 5478 | be used (qhweight(id); computes weights). |
---|
| 5479 | KEYWORDS: normalization; integral closure; delta invariant. |
---|
| 5480 | SEE ALSO: normal, normalP. |
---|
| 5481 | EXAMPLE: example normalC; shows an example |
---|
| 5482 | " |
---|
| 5483 | { |
---|
| 5484 | int i,j; |
---|
| 5485 | int withGens, withEqui, withPrim, isPrim, noFac; |
---|
| 5486 | int dbg = printlevel-voice+2; |
---|
| 5487 | int nvar = nvars(basering); |
---|
| 5488 | int chara = char(basering); |
---|
| 5489 | list result, prim, keepresult; |
---|
| 5490 | |
---|
| 5491 | int decomp; // Preliminar decomposition: |
---|
| 5492 | // 0 -> no decomposition (id is assumed to be prime) |
---|
| 5493 | // 1 -> no decomposition |
---|
| 5494 | // (id is assumed to be equidimensional radical) |
---|
| 5495 | // 2 -> equidimensional decomposition |
---|
| 5496 | // 3 -> minimal associated primes |
---|
| 5497 | |
---|
| 5498 | // Default methods: |
---|
| 5499 | noFac = 0; // Use facstd when computing minimal associated primes |
---|
| 5500 | decomp = 2; // Equidimensional decomposition for nvar > 2 |
---|
| 5501 | if (nvar <= 2) |
---|
| 5502 | { decomp = 3; } // Compute minimal associated primes if nvar <= 2 |
---|
| 5503 | |
---|
| 5504 | if ( ord_test(basering) != 1 ) |
---|
| 5505 | { |
---|
| 5506 | ""; |
---|
| 5507 | "// Not implemented for this ordering,"; |
---|
| 5508 | "// please change to global ordering or use proc normal"; |
---|
| 5509 | return(result); |
---|
| 5510 | } |
---|
| 5511 | |
---|
| 5512 | //--------------------------- define the method --------------------------- |
---|
| 5513 | string method; //make all options one string in order to use |
---|
| 5514 | //all combinations of options simultaneously |
---|
| 5515 | for ( i=1; i <= size(#); i++ ) |
---|
| 5516 | { |
---|
| 5517 | if ( typeof(#[i]) == "string" ) |
---|
| 5518 | { |
---|
| 5519 | method = method + #[i]; |
---|
| 5520 | } |
---|
| 5521 | } |
---|
| 5522 | |
---|
| 5523 | //--------------------------- choosen methods ----------------------- |
---|
| 5524 | // "withGens": computes algebra generators for each irreducible component |
---|
| 5525 | // ### the extra code for withGens should be incorporated in the general case |
---|
| 5526 | |
---|
| 5527 | if ( find(method,"withgens") or find(method,"withGens")) |
---|
| 5528 | { |
---|
| 5529 | withGens = 1; |
---|
| 5530 | } |
---|
| 5531 | |
---|
| 5532 | // the general case: either equidim or minAssGTZ or no decomposition |
---|
| 5533 | |
---|
| 5534 | if ( find(method,"isprim") or find(method,"isPrim") ) |
---|
| 5535 | {decomp = 0; isPrim=1;} |
---|
| 5536 | |
---|
| 5537 | if ( find(method,"nodeco") or find(method,"noDeco") ) |
---|
| 5538 | {decomp = 1;} |
---|
| 5539 | |
---|
| 5540 | if ( find(method,"equidim") ) |
---|
| 5541 | { decomp = 2; } |
---|
| 5542 | |
---|
| 5543 | if ( find(method,"prim") ) |
---|
| 5544 | { decomp = 3; } |
---|
| 5545 | |
---|
| 5546 | if ( find(method,"nofac") or find(method,"noFac") ) |
---|
| 5547 | { noFac = 1; } |
---|
| 5548 | |
---|
| 5549 | kill #; |
---|
| 5550 | list #; |
---|
| 5551 | |
---|
| 5552 | //------- Special algorithm with computation of the generators, RETURN ------- |
---|
| 5553 | //--------------------- method "withGens" ---------------------------------- |
---|
| 5554 | //the integral closure is computed in proc primeClosure. In the general case |
---|
| 5555 | //it is computed in normalizationPrimes. The main difference is that in |
---|
| 5556 | //primeClosure the singular locus is only computed in the first iteration, |
---|
| 5557 | //that no attributes are used, and that the generators are computed. |
---|
| 5558 | //In primeClosure the (algebra) generators for each irreducible component |
---|
| 5559 | //are computed in the static proc closureGenerators |
---|
| 5560 | |
---|
| 5561 | if( withGens ) |
---|
| 5562 | { |
---|
| 5563 | if( dbg >= 1 ) |
---|
| 5564 | { ""; |
---|
| 5565 | "// We use method 'withGens'"; |
---|
| 5566 | } |
---|
| 5567 | if ( decomp == 0 or decomp == 1 ) |
---|
| 5568 | { |
---|
| 5569 | prim[1] = id; |
---|
| 5570 | if( dbg >= 0 ) |
---|
| 5571 | { |
---|
| 5572 | ""; |
---|
| 5573 | "// ** WARNING: result is correct if ideal is prime (not checked) **"; |
---|
| 5574 | "// if procedure is called with string \"prim\", primality is checked"; |
---|
| 5575 | } |
---|
| 5576 | } |
---|
| 5577 | else |
---|
| 5578 | { |
---|
| 5579 | if(dbg >= 1) |
---|
| 5580 | { "// Computing minimal associated primes..."; } |
---|
| 5581 | |
---|
| 5582 | if( noFac ) |
---|
| 5583 | { prim = minAssGTZ(id,1); } |
---|
| 5584 | else |
---|
| 5585 | { prim = minAssGTZ(id); } |
---|
| 5586 | |
---|
| 5587 | if(dbg >= 2) |
---|
| 5588 | { prim;""; } |
---|
| 5589 | if(dbg >= 1) |
---|
| 5590 | { |
---|
| 5591 | "// number of irreducible components is", size(prim); |
---|
| 5592 | } |
---|
| 5593 | } |
---|
| 5594 | //----------- compute integral closure for every component ------------- |
---|
| 5595 | int del; |
---|
| 5596 | intvec deli; |
---|
| 5597 | list Gens,l,resu,Resu; |
---|
| 5598 | ideal gens; |
---|
| 5599 | def R = basering; |
---|
| 5600 | poly gg; |
---|
| 5601 | |
---|
| 5602 | for(i=1; i<=size(prim); i++) |
---|
| 5603 | { |
---|
| 5604 | if(dbg>=1) |
---|
| 5605 | { |
---|
| 5606 | ""; pause(); ""; |
---|
| 5607 | "// Computing normalization of component",i; |
---|
| 5608 | " ---------------------------------------"; |
---|
| 5609 | } |
---|
| 5610 | |
---|
| 5611 | if( defined(ker) ) { kill ker; } |
---|
| 5612 | ideal ker = prim[i]; |
---|
| 5613 | export(ker); |
---|
| 5614 | l = R; |
---|
| 5615 | l = primeClosure(l,1); //here the work is done |
---|
| 5616 | // primeClosure is called with list l consisting of the basering |
---|
| 5617 | //### ausprobieren ob primeClosure(l,1) schneller als primeClosure(l) |
---|
| 5618 | // 1 bedeutet: kuerzester nzd |
---|
| 5619 | // l[size(l)] is the delta invariant |
---|
| 5620 | |
---|
| 5621 | if ( l[size(l)] >= 0 && del >= 0 ) |
---|
| 5622 | { |
---|
| 5623 | del = del + l[size(l)]; |
---|
| 5624 | } |
---|
| 5625 | else |
---|
| 5626 | { del = -1; } |
---|
| 5627 | deli = l[size(l)],deli; |
---|
| 5628 | |
---|
| 5629 | l = l[1..size(l)-1]; |
---|
| 5630 | resu = list(l[size(l)]) + resu; |
---|
| 5631 | gens = closureGenerators(l); //computes algebra(!) generators |
---|
| 5632 | |
---|
| 5633 | //NOTE: gens[i]/gens[size(gens)] expresses the ith variable of resu[1] |
---|
| 5634 | //(the normalization) as fraction of elements of the basering; |
---|
| 5635 | //the variables of resu[1] are algebra generators. |
---|
| 5636 | //gens[size(gens)] is a non-zero divisor of basering/i |
---|
| 5637 | |
---|
| 5638 | //divide by the greatest common divisor: |
---|
| 5639 | gg = gcd( gens[1],gens[size(gens)] ); |
---|
| 5640 | for(j=2; j<=size(gens)-1; j++) |
---|
| 5641 | { |
---|
| 5642 | gg=gcd(gg,gens[j]); |
---|
| 5643 | } |
---|
| 5644 | for(j=1; j<=size(gens); j++) |
---|
| 5645 | { |
---|
| 5646 | gens[j]=gens[j]/gg; |
---|
| 5647 | } |
---|
| 5648 | Gens = list(gens) + Gens; |
---|
| 5649 | |
---|
| 5650 | /* ### Da die gens Algebra-Erzeuger sind, ist reduce nach Bestimmung |
---|
| 5651 | der Algebra-Variablen T(i) nicht zulaessig! |
---|
| 5652 | for(i=1;i<=size(gens)-1;i++) |
---|
| 5653 | { |
---|
| 5654 | gens[i]= reduce(gens[i],std(gens[size(gens)])); |
---|
| 5655 | } |
---|
| 5656 | for(i=size(gens)-1; i>=1; i--) |
---|
| 5657 | { |
---|
| 5658 | if(gens[i]==0) |
---|
| 5659 | { gens = delete(gens,i); } |
---|
| 5660 | } |
---|
| 5661 | */ |
---|
| 5662 | if( defined(ker) ) { kill ker; } |
---|
| 5663 | } |
---|
| 5664 | |
---|
| 5665 | if ( del >= 0 ) |
---|
| 5666 | { |
---|
| 5667 | int mul = iMult(prim); |
---|
| 5668 | del = del + mul; |
---|
| 5669 | } |
---|
| 5670 | else |
---|
| 5671 | { del = -1; } |
---|
| 5672 | deli = deli[1..size(deli)-1]; |
---|
| 5673 | Resu = resu,Gens,list(deli,del); |
---|
| 5674 | int sr = size(resu); |
---|
| 5675 | |
---|
| 5676 | if ( dbg >= 0 ) |
---|
| 5677 | {""; |
---|
| 5678 | "// 'normalC' created a list, say nor, of three lists: |
---|
| 5679 | // To see the list type |
---|
| 5680 | nor; |
---|
| 5681 | |
---|
| 5682 | // * nor[1] is a list of",sr,"ring(s) |
---|
| 5683 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
| 5684 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
| 5685 | // For the other rings type first (if R is the name of your original basering) |
---|
| 5686 | setring R; |
---|
| 5687 | // and then continue as for R1. |
---|
| 5688 | // Ri/norid is the affine algebra of the normalization of the i-th |
---|
| 5689 | // component R/P_i (where P_i is an associated prime of the input ideal id) |
---|
| 5690 | // and normap the normalization map from R to Ri/norid. |
---|
| 5691 | |
---|
| 5692 | // * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of |
---|
| 5693 | // elements g1..gk of R such that the gj/gk generate the integral |
---|
| 5694 | // closure of R/P_i as sub-algebra in the quotient field of R/P_i, with |
---|
| 5695 | // gj/gk being mapped by normap to the j-th variable of Ri; |
---|
| 5696 | |
---|
| 5697 | // * nor[3] shows the delta-invariant of each component and of id |
---|
| 5698 | // (-1 means infinite, and 0 that R/P_i resp. R/id is normal)."; |
---|
| 5699 | } |
---|
| 5700 | return(Resu); |
---|
| 5701 | } |
---|
| 5702 | //----------------- end method "withGens" -------------------------------- |
---|
| 5703 | |
---|
| 5704 | //-------- The general case without computation of the generators ----------- |
---|
| 5705 | // (attrib(id,"xy"),1) sets attrib xy to TRUE and (attrib(id,"xy"),0) to FALSE |
---|
| 5706 | // We use the following attributes: |
---|
| 5707 | // attrib(id,"isCohenMacaulay"); //--- Cohen Macaulay |
---|
| 5708 | // attrib(id,"isCompleteIntersection"); //--- complete intersection |
---|
| 5709 | // attrib(id,"isHypersurface"); //--- hypersurface |
---|
| 5710 | // attrib(id,"isEquidimensional",-1); //--- equidimensional ideal |
---|
| 5711 | // attrib(id,"isPrim"); //--- prime ideal |
---|
| 5712 | // attrib(id,"isRegInCodim2"); //--- regular in codimension 2 |
---|
| 5713 | // attrib(id,"isIsolatedSingularity"; //--- isolated singularities |
---|
| 5714 | // attrib(id,"onlySingularAtZero"); //--- only singular at 0 |
---|
| 5715 | |
---|
| 5716 | //------------------- first set the attributes ---------------------- |
---|
| 5717 | if( typeof(attrib(id,"isCohenMacaulay"))=="int" ) |
---|
| 5718 | { |
---|
| 5719 | if( attrib(id,"isCohenMacaulay")==1 ) |
---|
| 5720 | { |
---|
| 5721 | attrib(id,"isEquidimensional",1); |
---|
| 5722 | } |
---|
| 5723 | } |
---|
| 5724 | else |
---|
| 5725 | { |
---|
| 5726 | attrib(id,"isCohenMacaulay",0); |
---|
| 5727 | } |
---|
| 5728 | |
---|
| 5729 | if( typeof(attrib(id,"isCompleteIntersection"))=="int" ) |
---|
| 5730 | { |
---|
| 5731 | if(attrib(id,"isCompleteIntersection")==1) |
---|
| 5732 | { |
---|
| 5733 | attrib(id,"isCohenMacaulay",1); |
---|
| 5734 | attrib(id,"isEquidimensional",1); |
---|
| 5735 | } |
---|
| 5736 | } |
---|
| 5737 | else |
---|
| 5738 | { |
---|
| 5739 | attrib(id,"isCompleteIntersection",0); |
---|
| 5740 | } |
---|
| 5741 | |
---|
| 5742 | if( typeof(attrib(id,"isHypersurface"))=="int" ) |
---|
| 5743 | { |
---|
| 5744 | if(attrib(id,"isHypersurface")==1) |
---|
| 5745 | { |
---|
| 5746 | attrib(id,"isCompleteIntersection",1); |
---|
| 5747 | attrib(id,"isCohenMacaulay",1); |
---|
| 5748 | attrib(id,"isEquidimensional",1); |
---|
| 5749 | } |
---|
| 5750 | } |
---|
| 5751 | else |
---|
| 5752 | { |
---|
| 5753 | attrib(id,"isHypersurface",0); |
---|
| 5754 | } |
---|
| 5755 | |
---|
| 5756 | if( ! (typeof(attrib(id,"isEquidimensional"))=="int") ) |
---|
| 5757 | { |
---|
| 5758 | attrib(id,"isEquidimensional",0); |
---|
| 5759 | } |
---|
| 5760 | |
---|
| 5761 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
| 5762 | { |
---|
| 5763 | if(attrib(id,"isPrim")==1) |
---|
| 5764 | { |
---|
| 5765 | attrib(id,"isEquidimensional",1); |
---|
| 5766 | } |
---|
| 5767 | } |
---|
| 5768 | else |
---|
| 5769 | { |
---|
| 5770 | attrib(id,"isPrim",0); |
---|
| 5771 | } |
---|
| 5772 | |
---|
| 5773 | if( ! (typeof(attrib(id,"isRegInCodim2"))=="int") ) |
---|
| 5774 | { |
---|
| 5775 | attrib(id,"isRegInCodim2",0); |
---|
| 5776 | } |
---|
| 5777 | |
---|
| 5778 | if( ! (typeof(attrib(id,"isIsolatedSingularity"))=="int") ) |
---|
| 5779 | { |
---|
| 5780 | attrib(id,"isIsolatedSingularity",0); |
---|
| 5781 | } |
---|
| 5782 | |
---|
| 5783 | if( typeof(attrib(id,"onlySingularAtZero"))=="int" ) |
---|
| 5784 | { |
---|
| 5785 | if(attrib(id,"onlySingularAtZero")==1) |
---|
| 5786 | { |
---|
| 5787 | attrib(id,"isIsolatedSingularity",1); |
---|
| 5788 | } |
---|
| 5789 | } |
---|
| 5790 | else |
---|
| 5791 | { |
---|
| 5792 | attrib(id,"onlySingularAtZero",0); |
---|
| 5793 | } |
---|
| 5794 | |
---|
| 5795 | //-------------- compute equidimensional decomposition -------------------- |
---|
| 5796 | //If the method "equidim" is given, compute the equidim decomposition |
---|
| 5797 | //and goto the next step (no normalization |
---|
| 5798 | //ACHTUNG: equidim berechnet bei nicht reduzierten id die eingebetteten |
---|
| 5799 | //Komponenten als niederdim Komponenten, waehrend diese bei primdecGTZ |
---|
| 5800 | //nicht auftauchen: ideal(x,y)*xy |
---|
| 5801 | //this is default for nvars > 2 |
---|
| 5802 | |
---|
| 5803 | if( decomp == 2 ) |
---|
| 5804 | { |
---|
| 5805 | withPrim = 0; //this is used to check later that prim |
---|
| 5806 | //contains equidim but not prime components |
---|
| 5807 | if( dbg >= 1 ) |
---|
| 5808 | { |
---|
| 5809 | "// We use method 'equidim'"; |
---|
| 5810 | } |
---|
| 5811 | if( typeof(attrib(id,"isEquidimensional"))=="int" ) |
---|
| 5812 | { |
---|
| 5813 | if(attrib(id,"isEquidimensional")==1) |
---|
| 5814 | { |
---|
| 5815 | prim[1] = id; |
---|
| 5816 | } |
---|
| 5817 | else |
---|
| 5818 | { |
---|
| 5819 | prim = equidim(id); |
---|
| 5820 | } |
---|
| 5821 | } |
---|
| 5822 | else |
---|
| 5823 | { |
---|
| 5824 | prim = equidim(id); |
---|
| 5825 | } |
---|
| 5826 | if(dbg>=1) |
---|
| 5827 | { ""; |
---|
| 5828 | "// number of equidimensional components:", size(prim); |
---|
| 5829 | } |
---|
| 5830 | if ( !noFac ) |
---|
| 5831 | { |
---|
| 5832 | intvec opt = option(get); |
---|
| 5833 | option(redSB); |
---|
| 5834 | for(j=1; j<=size(prim); j++) |
---|
| 5835 | { |
---|
| 5836 | keepresult = keepresult+facstd(prim[j]); |
---|
| 5837 | } |
---|
| 5838 | prim = keepresult; |
---|
| 5839 | if ( size(prim) == 0 ) |
---|
| 5840 | { |
---|
| 5841 | prim=ideal(0); //Bug in facstd, liefert leere Liste bei 0-Ideal |
---|
| 5842 | } |
---|
| 5843 | |
---|
| 5844 | if(dbg>=1) |
---|
| 5845 | { ""; |
---|
| 5846 | "// number of components after application of facstd:", size(prim); |
---|
| 5847 | } |
---|
| 5848 | option(set,opt); |
---|
| 5849 | } |
---|
| 5850 | } |
---|
| 5851 | |
---|
| 5852 | //------------------- compute associated primes ------------------------- |
---|
| 5853 | //the case where withEqui = 0, here the min. ass. primes are computed |
---|
| 5854 | //start with the computation of the minimal associated primes: |
---|
| 5855 | |
---|
| 5856 | else |
---|
| 5857 | { |
---|
| 5858 | if( isPrim ) |
---|
| 5859 | { |
---|
| 5860 | if( dbg >= 0 ) |
---|
| 5861 | { |
---|
| 5862 | "// ** WARNING: result is correct if ideal is prime"; |
---|
| 5863 | "// or equidimensional (not checked) **"; |
---|
| 5864 | "// disable option \"isPrim\" to decompose ideal into prime"; |
---|
| 5865 | "// or equidimensional components";""; |
---|
| 5866 | } |
---|
| 5867 | if( dbg >= 1 ) |
---|
| 5868 | { |
---|
| 5869 | "// We use method 'isPrim'";""; |
---|
| 5870 | } |
---|
| 5871 | prim[1]=id; |
---|
| 5872 | } |
---|
| 5873 | else |
---|
| 5874 | { |
---|
| 5875 | withPrim = 1; //this is used to check later that prim |
---|
| 5876 | //contains prime but not equidim components |
---|
| 5877 | if( dbg >= 1 ) |
---|
| 5878 | { |
---|
| 5879 | "// We use method 'prim'"; |
---|
| 5880 | } |
---|
| 5881 | |
---|
| 5882 | if( typeof(attrib(id,"isPrim"))=="int" ) |
---|
| 5883 | { |
---|
| 5884 | if(attrib(id,"isPrim")==1) |
---|
| 5885 | { |
---|
| 5886 | prim[1]=id; |
---|
| 5887 | } |
---|
| 5888 | else |
---|
| 5889 | { |
---|
| 5890 | if( noFac ) |
---|
| 5891 | { prim=minAssGTZ(id,1); } //does not use factorizing groebner |
---|
| 5892 | else |
---|
| 5893 | { prim=minAssGTZ(id); } //uses factorizing groebner |
---|
| 5894 | } |
---|
| 5895 | } |
---|
| 5896 | else |
---|
| 5897 | { |
---|
| 5898 | if( noFac ) |
---|
| 5899 | { prim=minAssGTZ(id,1); } |
---|
| 5900 | else |
---|
| 5901 | { prim=minAssGTZ(id); } |
---|
| 5902 | } |
---|
| 5903 | if(dbg>=1) |
---|
| 5904 | { ""; |
---|
| 5905 | "// number of irreducible components:", size(prim); |
---|
| 5906 | } |
---|
| 5907 | } |
---|
| 5908 | } |
---|
| 5909 | |
---|
| 5910 | //----- for each component (equidim or irred) compute normalization ----- |
---|
| 5911 | int sr, skr, del; |
---|
| 5912 | intvec deli; |
---|
| 5913 | int sp = size(prim); //size of list prim (# irred or equidim comp) |
---|
| 5914 | |
---|
| 5915 | for(i=1; i<=sp; i++) |
---|
| 5916 | { |
---|
| 5917 | if(dbg>=1) |
---|
| 5918 | { ""; |
---|
| 5919 | "// computing the normalization of component",i; |
---|
| 5920 | " ----------------------------------------"; |
---|
| 5921 | } |
---|
| 5922 | //-------------- first set attributes for components ------------------ |
---|
| 5923 | attrib(prim[i],"isEquidimensional",1); |
---|
| 5924 | if( withPrim ) |
---|
| 5925 | { |
---|
| 5926 | attrib(prim[i],"isPrim",1); |
---|
| 5927 | } |
---|
| 5928 | else |
---|
| 5929 | { attrib(prim[i],"isPrim",0); } |
---|
| 5930 | |
---|
| 5931 | if(attrib(id,"onlySingularAtZero")==1) |
---|
| 5932 | { attrib(prim[i],"onlySingularAtZero",1); } |
---|
| 5933 | else |
---|
| 5934 | { attrib(prim[i],"onlySingularAtZero",0); } |
---|
| 5935 | |
---|
| 5936 | if(attrib(id,"isIsolatedSingularity")==1) |
---|
| 5937 | { attrib(prim[i],"isIsolatedSingularity",1); } |
---|
| 5938 | else |
---|
| 5939 | { attrib(prim[i],"isIsolatedSingularity",0); } |
---|
| 5940 | |
---|
| 5941 | if( attrib(id,"isHypersurface")==1 ) |
---|
| 5942 | { |
---|
| 5943 | attrib(prim[i],"isHypersurface",1); |
---|
| 5944 | attrib(prim[i],"isCompleteIntersection",1); |
---|
| 5945 | attrib(prim[i],"isCohenMacaulay",1); |
---|
| 5946 | } |
---|
| 5947 | else |
---|
| 5948 | { attrib(prim[i],"isHypersurface",0); } |
---|
| 5949 | |
---|
| 5950 | if ( sp == 1) //the case of one component: copy attribs from id |
---|
| 5951 | { |
---|
| 5952 | if(attrib(id,"isRegInCodim2")==1) |
---|
| 5953 | {attrib(prim[i],"isRegInCodim2",1); } |
---|
| 5954 | else |
---|
| 5955 | {attrib(prim[i],"isRegInCodim2",0); } |
---|
| 5956 | |
---|
| 5957 | if(attrib(id,"isCohenMacaulay")==1) |
---|
| 5958 | {attrib(prim[i],"isCohenMacaulay",1); } |
---|
| 5959 | else |
---|
| 5960 | {attrib(prim[i],"isCohenMacaulay",0); } |
---|
| 5961 | |
---|
| 5962 | if(attrib(id,"isCompleteIntersection")==1) |
---|
| 5963 | {attrib(prim[i],"isCompleteIntersection",1); } |
---|
| 5964 | else |
---|
| 5965 | {attrib(prim[i],"isCompleteIntersection",0); } |
---|
| 5966 | } |
---|
| 5967 | else |
---|
| 5968 | { |
---|
| 5969 | attrib(prim[i],"isRegInCodim2",0); |
---|
| 5970 | attrib(prim[i],"isCohenMacaulay",0); |
---|
| 5971 | attrib(prim[i],"isCompleteIntersection",0); |
---|
| 5972 | } |
---|
| 5973 | |
---|
| 5974 | //------ Now compute the normalization of each component --------- |
---|
| 5975 | //note: for equidimensional components the "splitting tools" can |
---|
| 5976 | //create further decomposition |
---|
| 5977 | //We now start normalizationPrimes with |
---|
| 5978 | //ihp = partial normalisation map = identity map = maxideal(1) |
---|
| 5979 | //del = partial delta invariant = 0 |
---|
| 5980 | //deli= intvec of partial delta invariants of components |
---|
| 5981 | //in normalizationPrimes all the work is done: |
---|
| 5982 | |
---|
| 5983 | keepresult = normalizationPrimes(prim[i],maxideal(1),0,0); |
---|
| 5984 | |
---|
| 5985 | for(j=1; j<=size(keepresult)-1; j++) |
---|
| 5986 | { |
---|
| 5987 | result=insert(result,keepresult[j]); |
---|
| 5988 | } |
---|
| 5989 | skr = size(keepresult); |
---|
| 5990 | |
---|
| 5991 | //compute delta: |
---|
| 5992 | if( del >= 0 && keepresult[skr][1] >=0 ) |
---|
| 5993 | { |
---|
| 5994 | del = del + keepresult[skr][1]; |
---|
| 5995 | } |
---|
| 5996 | else |
---|
| 5997 | { |
---|
| 5998 | del = -1; |
---|
| 5999 | } |
---|
| 6000 | deli = keepresult[skr][2],deli; |
---|
| 6001 | |
---|
| 6002 | if ( dbg>=1 ) |
---|
| 6003 | { |
---|
| 6004 | "// delta of component",i; keepresult[skr][1]; |
---|
| 6005 | } |
---|
| 6006 | } |
---|
| 6007 | sr = size(result); |
---|
| 6008 | |
---|
| 6009 | // -------------- Now compute intersection multiplicities ------------- |
---|
| 6010 | //intersection multiplicities of list prim, sp=size(prim). |
---|
| 6011 | if ( dbg>=1 ) |
---|
| 6012 | { |
---|
| 6013 | "// Sum of delta for all components"; del; |
---|
| 6014 | if ( sp>1 ) |
---|
| 6015 | { |
---|
| 6016 | "// Compute intersection multiplicities of the components"; |
---|
| 6017 | } |
---|
| 6018 | } |
---|
| 6019 | |
---|
| 6020 | if ( sp > 1 ) |
---|
| 6021 | { |
---|
| 6022 | int mul = iMult(prim); |
---|
| 6023 | if ( mul < 0 ) |
---|
| 6024 | { |
---|
| 6025 | del = -1; |
---|
| 6026 | } |
---|
| 6027 | else |
---|
| 6028 | { |
---|
| 6029 | del = del + mul; |
---|
| 6030 | } |
---|
| 6031 | } |
---|
| 6032 | deli = deli[1..size(deli)-1]; |
---|
| 6033 | result = result,list(deli,del); |
---|
| 6034 | |
---|
| 6035 | //--------------- Finally print comments and return ------------------ |
---|
| 6036 | if ( dbg >= 0) |
---|
| 6037 | {""; |
---|
| 6038 | "// 'normalC' created a list, say nor, of two lists: |
---|
| 6039 | // To see the result, type |
---|
| 6040 | nor; |
---|
| 6041 | |
---|
| 6042 | // * nor[1] is a list of",sr,"ring(s). |
---|
| 6043 | // To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g. |
---|
| 6044 | def R1 = nor[1][1]; setring R1; norid; normap; |
---|
| 6045 | // and similair for the other rings nor[1][i]; |
---|
| 6046 | // Ri/norid is the affine algebra of the normalization of r/P_i (where P_i |
---|
| 6047 | // is an associated prime or an equidimensional part of the input ideal id) |
---|
| 6048 | // and normap the normalization map from the basering to Ri/norid; |
---|
| 6049 | |
---|
| 6050 | // * nor[2] shows the delta-invariant of each component and of id |
---|
| 6051 | // (-1 means infinite, 0 that r/P_i resp. r/id is normal, and -2 that delta |
---|
| 6052 | // of a component was not computed)."; |
---|
| 6053 | } |
---|
| 6054 | return(result); |
---|
| 6055 | } |
---|
| 6056 | |
---|
| 6057 | example |
---|
| 6058 | { "EXAMPLE:"; |
---|
| 6059 | printlevel = printlevel+1; |
---|
| 6060 | echo = 2; |
---|
| 6061 | ring s = 0,(x,y),dp; |
---|
| 6062 | ideal i = (x2-y3)*(x2+y2)*x; |
---|
| 6063 | |
---|
| 6064 | list nor = normalC(i); |
---|
| 6065 | |
---|
| 6066 | nor; |
---|
| 6067 | // 2 branches have delta = 1, and 1 branch has delta = 0 |
---|
| 6068 | // the total delta invariant is 13 |
---|
| 6069 | |
---|
| 6070 | def R2 = nor[1][2]; setring R2; |
---|
| 6071 | norid; normap; |
---|
| 6072 | |
---|
| 6073 | echo = 0; |
---|
| 6074 | printlevel = printlevel-1; |
---|
| 6075 | pause(" hit return to continue"); echo=2; |
---|
| 6076 | |
---|
| 6077 | ring r = 2,(x,y,z),dp; |
---|
| 6078 | ideal i = z3-xy4; |
---|
| 6079 | nor = normalC(i); nor; |
---|
| 6080 | // the delta invariant is infinite |
---|
| 6081 | // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module |
---|
| 6082 | // in its quotient field Quot(r/i) |
---|
| 6083 | |
---|
| 6084 | // the normalization as affine algebra over the ground field: |
---|
| 6085 | def R = nor[1][1]; setring R; |
---|
| 6086 | norid; normap; |
---|
| 6087 | |
---|
| 6088 | echo = 0; |
---|
| 6089 | pause(" hit return to continue");echo = 2; |
---|
| 6090 | |
---|
| 6091 | setring r; |
---|
| 6092 | nor = normalC(i, "withGens", "prim"); // a different algorithm |
---|
| 6093 | nor; |
---|
| 6094 | } |
---|
| 6095 | |
---|
| 6096 | ////////////////////////////////////////////////////////////////////////////// |
---|
| 6097 | //closureRingtower seems not to be used anywhere |
---|
| 6098 | static proc closureRingtower(list L) |
---|
| 6099 | "USAGE: closureRingtower(list L); L a list of rings |
---|
| 6100 | CREATE: rings R(1),...,R(n) such that R(i)=L[i] for all i |
---|
| 6101 | EXAMPLE: example closureRingtower; shows an example |
---|
| 6102 | " |
---|
| 6103 | { |
---|
| 6104 | int n=size(L); |
---|
| 6105 | for (int i=1;i<=n;i++) |
---|
| 6106 | { |
---|
| 6107 | if (defined(R(i))) |
---|
| 6108 | { |
---|
| 6109 | string s="Fixed name R("+string(i)+") leads to conflict with existing " |
---|
| 6110 | +"object having this name"; |
---|
| 6111 | ERROR(s); |
---|
| 6112 | } |
---|
| 6113 | def R(i)=L[i]; |
---|
| 6114 | export R(i); |
---|
| 6115 | } |
---|
| 6116 | |
---|
| 6117 | return(); |
---|
| 6118 | } |
---|
| 6119 | example |
---|
| 6120 | { |
---|
| 6121 | "EXAMPLE:"; echo=2; |
---|
| 6122 | ring R=0,(x,y),dp; |
---|
| 6123 | ideal I=x4,y4; |
---|
| 6124 | list L=primeClosure(ReesAlgebra(I)[1]); |
---|
| 6125 | L=delete(L,size(L)); |
---|
| 6126 | L; |
---|
| 6127 | closureRingtower(L); |
---|
| 6128 | R(1); |
---|
| 6129 | R(4); |
---|
| 6130 | kill R(1),R(2),R(3),R(4); |
---|
| 6131 | } |
---|
| 6132 | |
---|
| 6133 | // Up to here: procedures for normalC |
---|
| 6134 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 6135 | |
---|
| 6136 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 6137 | // From here: miscellaneous procedures |
---|
| 6138 | |
---|
| 6139 | // Used for timing and comparing the different normalization procedures. |
---|
| 6140 | // Option (can be entered in any order) |
---|
| 6141 | // "normal" -> uses the new algortihm (normal) |
---|
| 6142 | // "normalP" -> uses normalP |
---|
| 6143 | // "normalC" -> uses normalC, without "withGens" option |
---|
| 6144 | // "primCl" -> uses normalC, with option "withGens". |
---|
| 6145 | // "111" -> checks the output of normalM using norTest. |
---|
| 6146 | // "p" -> compares the output of norM with the output of normalP |
---|
| 6147 | // ("normalP" option must also be set). |
---|
| 6148 | // "pc" -> compares the output of norM with the output of normalC with |
---|
| 6149 | // option "withGens" |
---|
| 6150 | // ("primCl" option must also be set). |
---|
| 6151 | |
---|
| 6152 | proc timeNormal(ideal I, list #) |
---|
| 6153 | { |
---|
| 6154 | def r = basering; |
---|
| 6155 | |
---|
| 6156 | //--------------------------- define the method --------------------------- |
---|
| 6157 | int isPrim, useRing; |
---|
| 6158 | int decomp = -1; |
---|
| 6159 | int norM, norC, norP, primCl; |
---|
| 6160 | int checkP, check111, checkPC; |
---|
| 6161 | int i; |
---|
| 6162 | ideal U1, U2, W; |
---|
| 6163 | poly c1, c2; |
---|
| 6164 | int ch; |
---|
| 6165 | string check; |
---|
| 6166 | string method; //make all options one string in order to use |
---|
| 6167 | //all combinations of options simultaneously |
---|
| 6168 | for ( i=1; i <= size(#); i++ ) |
---|
| 6169 | { |
---|
| 6170 | if ( typeof(#[i]) == "string" ) |
---|
| 6171 | { |
---|
| 6172 | method = method + #[i]; |
---|
| 6173 | } |
---|
| 6174 | } |
---|
| 6175 | if ( find(method, "normal")) |
---|
| 6176 | {norM = 1;} |
---|
| 6177 | if ( find(method, "normalP") and (char(basering) > 0)) |
---|
| 6178 | {norP = 1;} |
---|
| 6179 | if ( find(method, "normalC")) |
---|
| 6180 | {norC = 1;} |
---|
| 6181 | if ( find(method, "primCl")) |
---|
| 6182 | {primCl = 1;} |
---|
| 6183 | if ( find(method, "isprim") or find(method,"isPrim") ) |
---|
| 6184 | {decomp = 0;} |
---|
| 6185 | if ( find(method, "p") ) |
---|
| 6186 | {checkP = 1;} |
---|
| 6187 | if ( find(method, "pc") ) |
---|
| 6188 | {checkPC = 1;} |
---|
| 6189 | if ( find(method, "111") ) |
---|
| 6190 | {check111 = 1;} |
---|
| 6191 | |
---|
| 6192 | int tt; |
---|
| 6193 | if(norM) |
---|
| 6194 | { |
---|
| 6195 | tt = timer; |
---|
| 6196 | if(decomp == 0) |
---|
| 6197 | { |
---|
| 6198 | "Running normal(useRing, isPrim)..."; |
---|
| 6199 | list a1 = normal(I, "useRing", "isPrim"); |
---|
| 6200 | "Time normal(useRing, isPrim): ", timer - tt; |
---|
| 6201 | } |
---|
| 6202 | else |
---|
| 6203 | { |
---|
| 6204 | "Running normal(useRing)..."; |
---|
| 6205 | list a1 = normal(I, "useRing"); |
---|
| 6206 | "Time normal(useRing): ", timer - tt; |
---|
| 6207 | } |
---|
| 6208 | ""; |
---|
| 6209 | } |
---|
| 6210 | if(norP) |
---|
| 6211 | { |
---|
| 6212 | tt = timer; |
---|
| 6213 | if(decomp == 0) |
---|
| 6214 | { |
---|
| 6215 | "Running normalP(isPrim)..."; |
---|
| 6216 | list a2 = normalP(I, "isPrim"); |
---|
| 6217 | "Time normalP(isPrim): ", timer - tt; |
---|
| 6218 | } |
---|
| 6219 | else |
---|
| 6220 | { |
---|
| 6221 | "Running normalP()..."; |
---|
| 6222 | list a2 = normalP(I); |
---|
| 6223 | "Time normalP(): ", timer - tt; |
---|
| 6224 | } |
---|
| 6225 | ""; |
---|
| 6226 | } |
---|
| 6227 | |
---|
| 6228 | if(norC) |
---|
| 6229 | { |
---|
| 6230 | tt = timer; |
---|
| 6231 | if(decomp == 0) |
---|
| 6232 | { |
---|
| 6233 | "Running normalC(isPrim)..."; |
---|
| 6234 | list a3 = normalC(I, "isPrim"); |
---|
| 6235 | "Time normalC(isPrim): ", timer - tt; |
---|
| 6236 | } |
---|
| 6237 | else |
---|
| 6238 | { |
---|
| 6239 | "Running normalC()..."; |
---|
| 6240 | list a3 = normalC(I); |
---|
| 6241 | "Time normalC(): ", timer - tt; |
---|
| 6242 | } |
---|
| 6243 | ""; |
---|
| 6244 | } |
---|
| 6245 | |
---|
| 6246 | if(primCl) |
---|
| 6247 | { |
---|
| 6248 | tt = timer; |
---|
| 6249 | if(decomp == 0) |
---|
| 6250 | { |
---|
| 6251 | "Running normalC(withGens, isPrim)..."; |
---|
| 6252 | list a4 = normalC(I, "isPrim", "withGens"); |
---|
| 6253 | "Time normalC(withGens, isPrim): ", timer - tt; |
---|
| 6254 | } |
---|
| 6255 | else |
---|
| 6256 | { |
---|
| 6257 | "Running normalC(withGens)..."; |
---|
| 6258 | list a4 = normalC(I, "withGens"); |
---|
| 6259 | "Time normalC(withGens): ", timer - tt; |
---|
| 6260 | } |
---|
| 6261 | ""; |
---|
| 6262 | } |
---|
| 6263 | |
---|
| 6264 | if(check111 and norM) |
---|
| 6265 | { |
---|
| 6266 | "Checking output with norTest..."; |
---|
| 6267 | "WARNING: this checking only works if the original ideal was prime."; |
---|
| 6268 | norTest(I, a1); |
---|
| 6269 | ""; |
---|
| 6270 | } |
---|
| 6271 | |
---|
| 6272 | if(checkP and norP and norM) |
---|
| 6273 | { |
---|
| 6274 | "Comparing with normalP output..."; |
---|
| 6275 | if(size(a2) > 0) |
---|
| 6276 | { |
---|
| 6277 | "WARNING: this checking only works if the original ideal was prime."; |
---|
| 6278 | U1 = a1[2][1]; |
---|
| 6279 | c1 = U1[size(U1)]; |
---|
| 6280 | U2 = a2[1][1]; |
---|
| 6281 | c2 = a2[1][1][size(a2[1][1])]; |
---|
| 6282 | W = changeDenominator(U1, c1, c2, groebner(I)); |
---|
| 6283 | qring q = groebner(I); |
---|
| 6284 | ideal U2 = fetch(r, U2); |
---|
| 6285 | ideal W = fetch(r, W); |
---|
| 6286 | ch = 0; |
---|
| 6287 | if(size(reduce(U2, groebner(W))) == 0) |
---|
| 6288 | { |
---|
| 6289 | "U2 c U1"; |
---|
| 6290 | ch = 1; |
---|
| 6291 | } |
---|
| 6292 | if(size(reduce(W, groebner(U2))) == 0) |
---|
| 6293 | { |
---|
| 6294 | "U1 c U2"; |
---|
| 6295 | ch = ch + 1; |
---|
| 6296 | } |
---|
| 6297 | if(ch == 2) |
---|
| 6298 | { |
---|
| 6299 | "Output of normalP is equal."; |
---|
| 6300 | } |
---|
| 6301 | else |
---|
| 6302 | { |
---|
| 6303 | "ERROR: Output of normalP is different."; |
---|
| 6304 | } |
---|
| 6305 | setring r; |
---|
| 6306 | kill q; |
---|
| 6307 | } |
---|
| 6308 | else |
---|
| 6309 | { |
---|
| 6310 | "normalP returned no output. Comparison is not possible."; |
---|
| 6311 | } |
---|
| 6312 | ""; |
---|
| 6313 | } |
---|
| 6314 | |
---|
| 6315 | if(checkPC and norM and primCl) |
---|
| 6316 | { |
---|
| 6317 | "Comparing with primeClosure output..."; |
---|
| 6318 | if(size(a4) > 0) |
---|
| 6319 | { |
---|
| 6320 | "WARNING: this checking only works if the original ideal was prime."; |
---|
| 6321 | // primeClosure check |
---|
| 6322 | U1 = a1[2][1]; |
---|
| 6323 | c1 = U1[size(U1)]; |
---|
| 6324 | U2 = a4[2][1]; |
---|
| 6325 | c2 = a4[2][1][size(a4[2][1])]; |
---|
| 6326 | W = changeDenominator(U1, c1, c2, groebner(I)); |
---|
| 6327 | qring q = groebner(I); |
---|
| 6328 | ideal U2 = fetch(r, U2); |
---|
| 6329 | ideal W = fetch(r, W); |
---|
| 6330 | ch = 0; |
---|
| 6331 | if(size(reduce(U2, groebner(W))) == 0) |
---|
| 6332 | { |
---|
| 6333 | "U2 c U1"; |
---|
| 6334 | ch = 1; |
---|
| 6335 | } |
---|
| 6336 | if(size(reduce(W, groebner(U2))) == 0) |
---|
| 6337 | { |
---|
| 6338 | "U1 c U2"; |
---|
| 6339 | ch = ch + 1; |
---|
| 6340 | } |
---|
| 6341 | if(ch == 2) |
---|
| 6342 | { |
---|
| 6343 | "Output of normalC(withGens) is equal."; |
---|
| 6344 | } |
---|
| 6345 | else |
---|
| 6346 | { |
---|
| 6347 | "ERROR: Output of normalC(withGens) is different."; |
---|
| 6348 | } |
---|
| 6349 | setring r; |
---|
| 6350 | kill q; |
---|
| 6351 | } |
---|
| 6352 | else |
---|
| 6353 | { |
---|
| 6354 | "normalC(withGens) returned no output. Comparison is not possible."; |
---|
| 6355 | } |
---|
| 6356 | ""; |
---|
| 6357 | } |
---|
| 6358 | } |
---|
| 6359 | |
---|
| 6360 | /////////////////////////////////////////////////////////////////////////// |
---|
| 6361 | static proc sqroot(int n); |
---|
| 6362 | { |
---|
| 6363 | int s = 1; |
---|
| 6364 | while(s*s < n) { s++; } |
---|
| 6365 | return(s); |
---|
| 6366 | } |
---|
| 6367 | |
---|
| 6368 | /////////////////////////////////////////////////////////////////////////// |
---|
| 6369 | proc norTest (ideal i, list nor, list #) |
---|
| 6370 | "USAGE: norTest(i,nor,[n]); i=prime ideal, nor=list, n=optional integer |
---|
| 6371 | ASSUME: nor is the output of normal(i) (any options) or |
---|
| 6372 | normalP(i,"withRing") or normalC(i) (any options). |
---|
| 6373 | In particular, the ring nor[1][1] contains the ideal norid |
---|
| 6374 | and the map normap: basering/i --> nor[1][1]/norid. |
---|
| 6375 | RETURN: an intvec v such that: |
---|
| 6376 | @format |
---|
| 6377 | v[1] = 1 if the normap is injective and 0 otherwise |
---|
| 6378 | v[2] = 1 if the normap is finite and 0 otherwise |
---|
| 6379 | v[3] = 1 if nor[1][1]/norid is normal and 0 otherwise |
---|
| 6380 | @end format |
---|
| 6381 | If n=1 (resp n=2) only v[1] (resp. v[2]) is computed and returned |
---|
| 6382 | THEORY: The procedure can be used to test whether the computation of the |
---|
| 6383 | normalization was correct: basering/i --> nor[1][1]/norid is the |
---|
| 6384 | normalization of basering/i if and only if v=1,1,0. |
---|
| 6385 | NOTE: For big examples it can be hard to fully test correctness; the |
---|
| 6386 | partial test norTest(i,nor,2) is usually fast |
---|
| 6387 | EXAMPLE: example norTest; shows an example |
---|
| 6388 | " |
---|
| 6389 | { |
---|
| 6390 | //### Sollte erweitert werden auf den reduziblen Fall: einen neuen affinen |
---|
| 6391 | // Ring nor[1][1]+...+nor[1][r] (direkte Summe) erzeugen, map dorthin |
---|
| 6392 | // definieren und dann testen. |
---|
| 6393 | |
---|
| 6394 | int prl = printlevel - voice + 2; |
---|
| 6395 | int a,b,d; |
---|
| 6396 | int n,ii; |
---|
| 6397 | if (size(#) > 0) { n = #[1]; } |
---|
| 6398 | |
---|
| 6399 | def BAS = basering; |
---|
| 6400 | |
---|
| 6401 | //### make a copy of nor to have a cpoy of nor[1][1] (not a reference to) |
---|
| 6402 | // in order not to override norid and normap. |
---|
| 6403 | // delete nor[2] (if it contains the module generators, which are not used) |
---|
| 6404 | // s.t. newnor does not belong to a ring. |
---|
| 6405 | |
---|
| 6406 | list newnor = nor; |
---|
| 6407 | if ( size(newnor) == 3 ) |
---|
| 6408 | { |
---|
| 6409 | newnor = delete(newnor,2); |
---|
| 6410 | } |
---|
| 6411 | def R = newnor[1][1]; |
---|
| 6412 | qring QAS = std(i); |
---|
| 6413 | |
---|
| 6414 | |
---|
| 6415 | setring R; |
---|
| 6416 | int nva = nvars(R); |
---|
| 6417 | string svars = varstr(R); |
---|
| 6418 | string svar; |
---|
| 6419 | |
---|
| 6420 | norid = interred(norid); |
---|
| 6421 | |
---|
| 6422 | //--------- create new ring with one dp block keeping weights ------------ |
---|
| 6423 | list LR = ringlist(R); |
---|
| 6424 | list g3 = LR[3]; |
---|
| 6425 | int n3 = size(g3); |
---|
| 6426 | list newg3; |
---|
| 6427 | intvec V; |
---|
| 6428 | |
---|
| 6429 | //--------- check first whether variables Z(i),...,A(i) exist ----------- |
---|
| 6430 | for (ii=90; ii>=65; ii--) |
---|
| 6431 | { |
---|
| 6432 | if ( find(svars,ASCII(ii)+"(") == 0 ) |
---|
| 6433 | { |
---|
| 6434 | svar = ASCII(ii); break; |
---|
| 6435 | } |
---|
| 6436 | } |
---|
| 6437 | if ( size(svar) != 0 ) |
---|
| 6438 | { |
---|
| 6439 | for ( ii = 1; ii <= nva; ii++ ) |
---|
| 6440 | { |
---|
| 6441 | LR[2][ii] = svar+"("+string(ii)+")"; |
---|
| 6442 | V[ii] = 1; |
---|
| 6443 | } |
---|
| 6444 | } |
---|
| 6445 | else |
---|
| 6446 | { |
---|
| 6447 | for ( ii = 1; ii <= nva; ii++ ) |
---|
| 6448 | { |
---|
| 6449 | LR[2][ii] = "Z("+string(100*nva+ii)+")"; |
---|
| 6450 | V[ii] = 1; |
---|
| 6451 | } |
---|
| 6452 | } |
---|
| 6453 | |
---|
| 6454 | if ( g3[n3][1]== "c" or g3[n3][1] == "C" ) |
---|
| 6455 | { |
---|
| 6456 | list gm = g3[n3]; //last blockis module ordering |
---|
| 6457 | newg3[1] = list("dp",V); |
---|
| 6458 | newg3 = insert(newg3,gm,size(newg3)); |
---|
| 6459 | } |
---|
| 6460 | else |
---|
| 6461 | { |
---|
| 6462 | list gm = g3[1]; //first block is module ordering |
---|
| 6463 | newg3[1] = list("dp",V); |
---|
| 6464 | newg3 = insert(newg3,gm); |
---|
| 6465 | } |
---|
| 6466 | LR[3] = newg3; |
---|
| 6467 | //LR;""; |
---|
| 6468 | def newR = ring(LR); |
---|
| 6469 | |
---|
| 6470 | setring newR; |
---|
| 6471 | ideal norid = fetch(R,norid); |
---|
| 6472 | ideal normap = fetch(R,normap); |
---|
| 6473 | if( defined(lnorid) ) { kill lnorid; } //um ** redefinig zu beheben |
---|
| 6474 | if( defined(snorid) ) { kill snorid; } //sollte nicht noetig sein |
---|
| 6475 | |
---|
| 6476 | //----------- go to quotient ring for checking injectivity ------------- |
---|
| 6477 | //"mstd"; |
---|
| 6478 | list lnorid = mstd(norid); |
---|
| 6479 | ideal snorid = lnorid[1]; |
---|
| 6480 | //"size mstdnorid:", size(snorid),size(lnorid[2]); |
---|
| 6481 | //"size string mstdnorid:", size(string(snorid)),size(string(lnorid[2])); |
---|
| 6482 | qring QR = snorid; |
---|
| 6483 | ideal qnormap = fetch(newR,normap); |
---|
| 6484 | //ideal qnormap = imap(newR,normap); |
---|
| 6485 | //ideal qnormap = imap(R,normap); |
---|
| 6486 | map Qnormap = QAS,qnormap; //r/id --> R/norid |
---|
| 6487 | |
---|
| 6488 | //------------------------ check injectivity --------------------------- |
---|
| 6489 | //"injective:"; |
---|
| 6490 | a = is_injective(Qnormap,QAS); //a. Test for injectivity of Qnormap |
---|
| 6491 | dbprint ( prl, "injective: "+string(a) ); |
---|
| 6492 | if ( n==1 ) { return (a); } |
---|
| 6493 | a; |
---|
| 6494 | |
---|
| 6495 | //------------------------ check finiteness --------------------------- |
---|
| 6496 | setring newR; |
---|
| 6497 | b = mapIsFinite(normap,BAS,lnorid[2]); //b. Test for finiteness of normap |
---|
| 6498 | dbprint ( prl, "finite: "+string(b) ); |
---|
| 6499 | if ( n==2 ) { return (intvec(a,b)); } |
---|
| 6500 | b; |
---|
| 6501 | |
---|
| 6502 | //------------------------ check normality --------------------------- |
---|
| 6503 | list testnor = normal(lnorid[2],"isPrim","noFac", "withDelta"); |
---|
| 6504 | //### Problem: bei mehrfachem Aufruf von norTest gibt es |
---|
| 6505 | // ** redefining norid & ** redefining normap |
---|
| 6506 | //Dies produziert Fehler, da alte norid und normap ueberschrieben werden |
---|
| 6507 | //norid und normap werden innnerhalb von proc computeRing ueberschrieben |
---|
| 6508 | //Die Kopie newR scheint das Problem zu loesen |
---|
| 6509 | |
---|
| 6510 | printlevel=prl; |
---|
| 6511 | |
---|
| 6512 | d = testnor[3][2]; //d = delta |
---|
| 6513 | kill testnor; //### sollte ueberfluessig sein |
---|
| 6514 | int d1 = (d==0); //d1=1 if delta=0 |
---|
| 6515 | dbprint ( prl, "delta: "+string(d) ); |
---|
| 6516 | return(intvec(a,b,d1)); |
---|
| 6517 | } |
---|
| 6518 | example |
---|
| 6519 | { "EXAMPLE:"; echo = 2; |
---|
| 6520 | int prl = printlevel; |
---|
| 6521 | printlevel = -1; |
---|
| 6522 | ring r = 0,(x,y),dp; |
---|
| 6523 | ideal i = (x-y^2)^2 - y*x^3; |
---|
| 6524 | list nor = normal(i); |
---|
| 6525 | norTest(i,nor); //1,1,1 means that normal was correct |
---|
| 6526 | |
---|
| 6527 | nor = normalC(i); |
---|
| 6528 | norTest(i,nor); //1,1,1 means that normal was correct |
---|
| 6529 | |
---|
| 6530 | ring s = 2,(x,y),dp; |
---|
| 6531 | ideal i = (x-y^2)^2 - y*x^3; |
---|
| 6532 | nor = normalP(i,"withRing"); |
---|
| 6533 | norTest(i,nor); //1,1,1 means that normalP was correct |
---|
| 6534 | printlevel = prl; |
---|
| 6535 | } |
---|
| 6536 | |
---|
| 6537 | /////////////////////////////////////////////////////////////////////////// |
---|
| 6538 | // |
---|
| 6539 | // EXAMPLES |
---|
| 6540 | // |
---|
| 6541 | /////////////////////////////////////////////////////////////////////////// |
---|
| 6542 | /* |
---|
| 6543 | //commands for computing the normalization: |
---|
| 6544 | // options for normal: "equidim", "prim" |
---|
| 6545 | // "noDeco", "isPrim", "noFac" |
---|
| 6546 | // (prim by default) |
---|
| 6547 | // options for normalP: "withRing", "isPrim" or "noFac" |
---|
| 6548 | // options for normalC: "equidim", "prim", "withGens", |
---|
| 6549 | // "noDeco", "isPrim", "noFac" |
---|
| 6550 | |
---|
| 6551 | //Commands for testing 'normal' |
---|
| 6552 | list nor = normal(i); nor; |
---|
| 6553 | list nor = normal(i,"isPrim");nor; |
---|
| 6554 | list nor = normal(i,"equidim");nor; |
---|
| 6555 | list nor = normal(i,"prim");nor; |
---|
| 6556 | list nor = normal(i,"equidim","noFac");nor; |
---|
| 6557 | list nor = normal(i,"prim","noFac");nor; |
---|
| 6558 | |
---|
| 6559 | //Commands for testing 'normalP' in positive char |
---|
| 6560 | list nor = normalP(i);nor; //withGens but no ringstructure |
---|
| 6561 | list nor = normalP(i,"withRing"); nor; //compute the ringstructure |
---|
| 6562 | list nor = normalP(i,"isPrim"); nor; //if i is known to be prime |
---|
| 6563 | |
---|
| 6564 | //Commands for testing 'normalC' |
---|
| 6565 | list nor = normal(i); nor; |
---|
| 6566 | list nor = normal(i,"withGens");nor; |
---|
| 6567 | list nor = normal(i,"isPrim");nor; |
---|
| 6568 | list nor = normal(i,"equidim");nor; |
---|
| 6569 | list nor = normal(i,"prim");nor; |
---|
| 6570 | list nor = normal(i,"equidim","noFac");nor; |
---|
| 6571 | list nor = normal(i,"prim","noFac");nor; |
---|
| 6572 | |
---|
| 6573 | //Commands for testing correctness (i must be prime): |
---|
| 6574 | list nor = normalP(i,"withRing","isPrim"); |
---|
| 6575 | list nor = normal(i,"isPrim"); |
---|
| 6576 | norTest(i,nor); //full test for not too big examples (1,1,1 => ok) |
---|
| 6577 | norTest(i,nor,2); //partial test for big examples (1,1 => ok) |
---|
| 6578 | factorize(i[1]); //checks for irreducibility |
---|
| 6579 | |
---|
| 6580 | ///////////////////////////////////////////////////////////////////////////// |
---|
| 6581 | |
---|
| 6582 | //----------------------Examples for normal (new algorithm)------------------ |
---|
| 6583 | // Timings with Computeserver Dual AMD Opteron 242 1.60GHz. |
---|
| 6584 | // Examples from "Normalization of Rings" paper. |
---|
| 6585 | |
---|
| 6586 | // Example 1 |
---|
| 6587 | // char 0 : normal = 0 secs (7 steps) - normalC = 75 secs |
---|
| 6588 | // char 2 : normal = 0 secs (7 steps) - normalP = 0 secs - normalC = 0 secs |
---|
| 6589 | // char 5 : normal = 1 secs (7 steps) - normalP = 71 - normalC = 1 secs |
---|
| 6590 | // char 11 : normal = 2 secs (7 steps) - normalP = 12 secs - normalC doesn't finish |
---|
| 6591 | // char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 1 sec |
---|
| 6592 | LIB"normal.lib"; |
---|
| 6593 | ring r = 2, (x, y), dp; |
---|
| 6594 | ideal i = (x-y)*x*(y+x^2)^3-y^3*(x^3+x*y-y^2); |
---|
| 6595 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
| 6596 | |
---|
| 6597 | // Example 2 |
---|
| 6598 | // char 0 : normal = 1 sec (7 steps) - normalC doesn't finish |
---|
| 6599 | // char 3 : normal = 1 secs (8 steps) - normalP = 0 secs - normalC = 4 secs |
---|
| 6600 | // char 13 : normal = 1 sec (7 steps) - normalP doesn't finish - normalC = 13 secs |
---|
| 6601 | // char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 10 sec |
---|
| 6602 | //Example is reducible in char 5 and 7 |
---|
| 6603 | LIB"normal.lib"; |
---|
| 6604 | ring r = 3, (x, y), dp; |
---|
| 6605 | 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; |
---|
| 6606 | timeNormal(i, "normal", "normalC", "normalP", "p", "isPrim"); |
---|
| 6607 | |
---|
| 6608 | // Example 3 |
---|
| 6609 | // char 0 : normal = 3 secs (6 steps) - normalC doesn't finish |
---|
| 6610 | // char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
| 6611 | // char 5 : normal = 0 secs (6 steps) - normalP = 8 secs - normalC doesn't finish |
---|
| 6612 | LIB"normal.lib"; |
---|
| 6613 | ring r=5,(x, y),dp; |
---|
| 6614 | ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9; |
---|
| 6615 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
| 6616 | |
---|
| 6617 | // Example 4 |
---|
| 6618 | // char 0 : normal = 0 secs (1 step) - normalC = 0 secs |
---|
| 6619 | // char 5 : normal = 0 secs (1 step) - normalP = 3 secs - normalC = 0 secs |
---|
| 6620 | // char 11 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
| 6621 | // char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
| 6622 | LIB"normal.lib"; |
---|
| 6623 | ring r=5,(x,y),dp; // genus 0 4 nodes and 6 cusps im P2 |
---|
| 6624 | ideal i=(x2+y^2-1)^3 +27x2y2; |
---|
| 6625 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
| 6626 | |
---|
| 6627 | // Example 5 |
---|
| 6628 | // char 0 : normal = 0 secs (1 step) - normalC = 0 secs |
---|
| 6629 | // char 5 : normal = 1 secs (3 step) - normalP doesn't finish - normalC doesn't finish |
---|
| 6630 | // char 11 : normal = 0 secs (1 step) - normalP 0 secs - normalC = 0 secs |
---|
| 6631 | // char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs |
---|
| 6632 | LIB"normal.lib"; |
---|
| 6633 | ring r=11,(x,y),dp; //24 sing, delta 24 |
---|
| 6634 | ideal i=-x10+x8y2-x6y4-x2y8+2y10-x8+2x6y2+x4y4-x2y6-y8+2x6-x4y2+x2y4+2x4+2x2y2-y4-x2+y2-1; |
---|
| 6635 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
| 6636 | |
---|
| 6637 | // Example 6 |
---|
| 6638 | // char 2 : normal = 5 secs (2 steps) - normalP = 25 secs - normalC = 166 secs |
---|
| 6639 | LIB"normal.lib"; |
---|
| 6640 | ring r=2,(v,u,z,y,x),dp; |
---|
| 6641 | 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; |
---|
| 6642 | timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p"); |
---|
| 6643 | |
---|
| 6644 | // Example 7 |
---|
| 6645 | // char 0 : normal = 11 secs (6 steps) - normalC = 11 secs |
---|
| 6646 | // char 2 : normal = 11 secs (6 steps) - normalP = 0 secs - normalC = 11 secs |
---|
| 6647 | // char 5 : normal = 11 secs (6 steps) - normalP = 3 secs - normalC = 11 secs |
---|
| 6648 | // char 11 : normal = 11 secs (6 steps) - normalP = 43 secs - normalC = 11 secs |
---|
| 6649 | // char 32003 : normal = 11 secs (6 steps) - normalP doesn't finish - normalC = 11 secs |
---|
| 6650 | LIB"normal.lib"; |
---|
| 6651 | ring r=11,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
| 6652 | ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3; |
---|
| 6653 | timeNormal(i, "normal", "normalC", "normalP", "isPrim"); |
---|
| 6654 | |
---|
| 6655 | //////////////////////////////////////////////////////////////////////////////// |
---|
| 6656 | |
---|
| 6657 | // Other examples with new algorithm |
---|
| 6658 | |
---|
| 6659 | // Example 1 |
---|
| 6660 | // char 0 : normal = 1 secs (13 steps) - normalC doesn't finish |
---|
| 6661 | // char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
| 6662 | // char 5 : normal = 1 secs (13 steps) - normalP = 29 secs - normalC doesn't finish |
---|
| 6663 | ring r=2,(x,y),dp; //genus 35 |
---|
| 6664 | ideal i=y30+y13x+x4y5+x3*(x+1)^2; |
---|
| 6665 | timeNormal(i, "normal", "normalC", "normalP"); |
---|
| 6666 | |
---|
| 6667 | // Example 2 |
---|
| 6668 | // char 0 : normal = 1 secs (13 steps) - normalC doesn't finish |
---|
| 6669 | // char 3 : normal = 2 secs (13 steps) - normalP = 0 secs - normalC doesn't finish |
---|
| 6670 | ring r=3,(x,y),dp; //genus 19, delta 21 |
---|
| 6671 | ideal i=y20+y13x+x4y5+x3*(x+1)^2; |
---|
| 6672 | timeNormal(i, "normal", "normalC", "normalP"); |
---|
| 6673 | |
---|
| 6674 | // Example 3 |
---|
| 6675 | // Very fast with all algorithms |
---|
| 6676 | ring r = 3, (x, y), dp; |
---|
| 6677 | ideal I = (x-y^2)^2-x*y^3; |
---|
| 6678 | timeNormal(I, "normal", "normalC", "normalP", "primCl", "111", "p", "pc"); |
---|
| 6679 | |
---|
| 6680 | |
---|
| 6681 | |
---|
| 6682 | //----------------------Test Example for charp ------------------- |
---|
| 6683 | //Zu tun: |
---|
| 6684 | //### nach minor nur std statt mstd verwenden |
---|
| 6685 | //***hat bei keinem Beisp etwas gebracht -> wieder zurueck |
---|
| 6686 | //### wenn interred ok, dann wieder einsetzen (am Schluss) |
---|
| 6687 | //### bottelnecks bei maps beheben |
---|
| 6688 | //### minor verbessern |
---|
| 6689 | //### preimage verbessern (Ist imm Kern map oder imap verwendet?) |
---|
| 6690 | //### Gleich in Ordnung dp wechseln, ringlist verwenden |
---|
| 6691 | //### interred ev nur zum Schluss |
---|
| 6692 | // (z.B. wenn nacher std; wenn nacher minor: testen ) |
---|
| 6693 | |
---|
| 6694 | //Zeiten mit normalV5.lib (mstd aktiv, interred inaktiv) |
---|
| 6695 | |
---|
| 6696 | //SWANSON EXAMPLES: (Macaulay2, icFracP=normalP, icFractions<->normal) |
---|
| 6697 | //--------------------------------------------------------------------- |
---|
| 6698 | //1. Series Fp[x,y,u,v]/(x2v-y2u) |
---|
| 6699 | //------------------------------- |
---|
| 6700 | //characteristic p 2 3 5 7 11 13 17 37 97 |
---|
| 6701 | //icFracP 0.04 0.03 0.04 0.04 0.04 0.05 0.05 0.13 0.59 Mac |
---|
| 6702 | //normalP 0 0 0 0 0 0 0 0 1 Sing |
---|
| 6703 | //icFractions 0.08 0.09 0.09 0.09 0.14 0.15 0.15 0.15 0.15 Mac |
---|
| 6704 | //normal 0 0 0 0 0 0 0 0 0 Sing |
---|
| 6705 | |
---|
| 6706 | 2. Series Fp[u, v, w, x, y, z]/u2x4+uvy4+v2z4 |
---|
| 6707 | //-------------------------------------------- |
---|
| 6708 | //characteristic p 2 3 5 7 11 |
---|
| 6709 | //icFracP 0.07 0.22 9.67 143 12543 |
---|
| 6710 | //normalP 0 0 5 42 1566 |
---|
| 6711 | //icFractions 1.16 * * * * *: > 6h |
---|
| 6712 | //normal 0 0 0 0 0 |
---|
| 6713 | |
---|
| 6714 | //3. Series Fp[u, v, w, x, y, z]/(u2xp+uvyp+v2zp) |
---|
| 6715 | //----------------------------------------------- |
---|
| 6716 | //characteristic p 2 3 5 7 11 13 17 19 23 |
---|
| 6717 | //icFracP 0.06 0.07 0.09 0.27 1.81 4.89 26 56 225 |
---|
| 6718 | //normalP 0 0 0 0 1 2 6 10 27 |
---|
| 6719 | //icFractions 0.16 1.49 75.00 4009 * * * * * |
---|
| 6720 | //normal 0 0 2 836 |
---|
| 6721 | //normal(neu) 0 0 1 2 10 155 |
---|
| 6722 | //### p=7 normal braucht 807 sec in: |
---|
| 6723 | // ideal endid = phi1(endid); //### bottelneck' |
---|
| 6724 | |
---|
| 6725 | //1. |
---|
| 6726 | int p = 2; ring r = p,(u,v,x,y,z),dp; ideal i = x2v-y2u; |
---|
| 6727 | //2. |
---|
| 6728 | int p = 7; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2x4+uvy4+v2z4; |
---|
| 6729 | //3. |
---|
| 6730 | int p=11; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2*x^p+uv*y^p+v2*z^p; |
---|
| 6731 | |
---|
| 6732 | //IRREDUCIBLE EXAMPLES: |
---|
| 6733 | //--------------------- |
---|
| 6734 | //timing for MacBookPro 2.2GHz Intel Core 2 Duo, 4GB Ram |
---|
| 6735 | //Sing. ix86Mac-darwin version 3-1-0 (3100-2008101314) Oct 13 2008 14:46:59 |
---|
| 6736 | //if no time is given: < 1 sec |
---|
| 6737 | |
---|
| 6738 | //Apply: |
---|
| 6739 | list nor = normal(i,"isPrim"); nor; |
---|
| 6740 | list nor = normalP(i,"withRing","isPrim"); nor; |
---|
| 6741 | def R=nor[1][1]; setring R; norid; normap; |
---|
| 6742 | setring r; |
---|
| 6743 | norTest(i,nor); |
---|
| 6744 | |
---|
| 6745 | int tt = timer; |
---|
| 6746 | list nor = normalP(i,"withRing","isPrim"); nor; |
---|
| 6747 | timer-tt; |
---|
| 6748 | int tt = timer; |
---|
| 6749 | list nor = normal(i,"isPrim"); |
---|
| 6750 | timer-tt; |
---|
| 6751 | |
---|
| 6752 | ring r=19,(x,y,u,v),dp; //delta -1 |
---|
| 6753 | ideal i=x2v-y2u; |
---|
| 6754 | //norTest 2 sec |
---|
| 6755 | |
---|
| 6756 | ring r=2,(y,x2,x1),lp; //delta -1 |
---|
| 6757 | ideal i=y^4+y^2*x2*x1+x2^3*x1^2+x2^2*x1^3; |
---|
| 6758 | //### norid hat 1 Element nach interred |
---|
| 6759 | |
---|
| 6760 | ring r = 11,(x,y,z),wp(2,1,2); //alles < 1 sec |
---|
| 6761 | ideal i=z3 - xy4 + x2; //not reduced, delta =0 ok |
---|
| 6762 | ideal i=y4+x5+y2x; //not reduced, delta -1 |
---|
| 6763 | //interred verkleinert norid |
---|
| 6764 | |
---|
| 6765 | ring r=3,(u,v,x,y,z),dp; //delta -1 |
---|
| 6766 | ideal i=u2x3+uvy3+v2z3; |
---|
| 6767 | |
---|
| 6768 | ring r=3,(u,v,x,y,z),dp; //delta -1 |
---|
| 6769 | ideal i=u2x4+uvy4+v2z4; |
---|
| 6770 | //norTest(i,nor); 0 sec, norTest(i,nor) haengt! |
---|
| 6771 | |
---|
| 6772 | ring r=5,(u,v,x,y,z),dp; //delta -1 |
---|
| 6773 | ideal i=u2x6+uvy6+v2z6; |
---|
| 6774 | //normalP 5sec, normalC 1sec |
---|
| 6775 | //V5: norTest(i,nor); 45 sec bei normalP, V6 12 sec |
---|
| 6776 | //28 sec bei normal |
---|
| 6777 | |
---|
| 6778 | ring r=5,(u,v,x,y,z),dp; //delta -1 |
---|
| 6779 | ideal i=u2x5+uvy5+v2z5; |
---|
| 6780 | //normalP 1sec, normalC 1 sec, |
---|
| 6781 | //norTest lange: minor(jacob(I),h,J) 193 (308)sec, haengt dann bei M = std(M); |
---|
| 6782 | //norTest(i,nor,2); verwenden! |
---|
| 6783 | //Sing 3.0-4 orig >9h! haengt bei Q = mstd(Q)[2]; |
---|
| 6784 | |
---|
| 6785 | ring r=2,(y,x),wp(12,5); //delta 3 |
---|
| 6786 | ideal i=y5+y2x4+y2x+yx2+x12; |
---|
| 6787 | //normalP 0 sec (Test 0 sec), normalC 2 sec (Test 2 sec) |
---|
| 6788 | //normalC withGens (ohne interred) 0sec |
---|
| 6789 | |
---|
| 6790 | ring r=2,(y,x),dp; //delta= 22 |
---|
| 6791 | ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9; |
---|
| 6792 | //normalP 1sec, interred verkleinert norid betraechtlich |
---|
| 6793 | //normalC haengt bei minor, ideal im loop wird zu gross ### |
---|
| 6794 | //interred bei normalC vergroeesert string um Faktor 4000! |
---|
| 6795 | //withGens haengt bei interred in loop 4 (> 10 h) oder |
---|
| 6796 | //(nach Ausschalten von interred) bei |
---|
| 6797 | //int delt=vdim(std(modulo(f,ideal(p)))); (>?h) |
---|
| 6798 | |
---|
| 6799 | //Leonard1: (1. Komponente von Leonard), delta -1 |
---|
| 6800 | ring r=2,(v,u,z,y,x),dp; |
---|
| 6801 | ideal i = z3+zyx+y3x2+y2x3, uyx+z2,uz+z+y2x+yx2, u2+u+zy+zx, |
---|
| 6802 | v3+vux+vz2+vzyx+vzx+uz3+uz2y+z3+z2yx2; |
---|
| 6803 | //normalP 5 sec (withRing 9 sec), norTest(i,nor,2); 45 sec |
---|
| 6804 | //normalC 102sec, 99sec |
---|
| 6805 | //### Zeit wird bei ideal Ann = quotient(SM[2],SL[1]); und bei |
---|
| 6806 | // f = quotient(p*J,J); verbraucht |
---|
| 6807 | //withGens (ohne interred) 131sec, norTest(i,nor,2); 2min25sec |
---|
| 6808 | //norTest(i,nor,2); 45 sec |
---|
| 6809 | |
---|
| 6810 | ring r=2,(y,x),wp(25,21); //Leonard2, delta 232 |
---|
| 6811 | ring r=2,(y,x),dp; |
---|
| 6812 | ideal i= |
---|
| 6813 | y^21+y^20*x +y^18*(x^3+x+1) +y^17*(x^3+1) +y^16*(x^4+x) |
---|
| 6814 | +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) |
---|
| 6815 | +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) |
---|
| 6816 | +y^10*(x^12+x^9+x^8+x^7+x^5+x^3+x+1) |
---|
| 6817 | +y^9*(x^14+x^13+x^10+x^9+x^8+x^7+x^6+x^3+x^2+1) |
---|
| 6818 | +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) |
---|
| 6819 | +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) |
---|
| 6820 | +y^4*(x^19+x^16+x^15+x^12+x^6+x^5+x^3+1) |
---|
| 6821 | +y^3*(x^18+x^15+x^12+x^10+x^9+x^7+x^4+x) |
---|
| 6822 | +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) |
---|
| 6823 | +y*(x^23+x^22+x^20+x^17+x^15+x^14+x^12+x^9) |
---|
| 6824 | +(x^25+x^23+x^19+x^17+x^15+x^13+x^11+x^5); |
---|
| 6825 | //normalP: dp 2sec withRing 8sec, |
---|
| 6826 | //wp 4sec, withRing:51sec Zeit in lin = subst(lin, var(ii), vip); in elimpart ), |
---|
| 6827 | //norTest(i,nor,2): haengt bei mstd(norid); |
---|
| 6828 | //### normalC: (m. interred): haengt bei endid = interred(endid); |
---|
| 6829 | //GEFIXTES INTERRED ABWARTEN. Dann interred aktivieren |
---|
| 6830 | //interred(norid) haengt u. mst(norid) zu lange |
---|
| 6831 | //(o.interred): haengt bei haengt bei list SM = mstd(i); |
---|
| 6832 | //ideal in der Mitte zu gross |
---|
| 6833 | //i = Ideal (size 118, 13 var) fuer die neue Normalisierung |
---|
| 6834 | //normal(neu) haengt bei return(std(i)) (offensichtlich in eineranderen lib) |
---|
| 6835 | |
---|
| 6836 | REDUCIBLE EXAMPLES: |
---|
| 6837 | ------------------ |
---|
| 6838 | //Apply: |
---|
| 6839 | int tt = timer; |
---|
| 6840 | list nor=normalP(i,"isPrim","withRing"); |
---|
| 6841 | timer-tt; |
---|
| 6842 | |
---|
| 6843 | list nor = normal(i); nor; |
---|
| 6844 | list nor = normalC(i); nor; |
---|
| 6845 | list nor = normalC(i, "withGens"); nor; |
---|
| 6846 | list nor = normalP(i,"withRing"); nor; |
---|
| 6847 | list nor = normalP(i); nor; |
---|
| 6848 | def R=nor[1][1]; setring R; norid; normap; |
---|
| 6849 | |
---|
| 6850 | //Leonhard 4 Komponenten, dim=2, delta: 0,0,0,-1 |
---|
| 6851 | ring r=2,(v,u,z,y,x),dp; //lp zu lange |
---|
| 6852 | ideal i=z3+zyx+y3x2+y2x3, uyx+z2, v3+vuyx+vux+vzyx+vzx+uy3x2+uy2x+zy3x+zy2x2; |
---|
| 6853 | //normalP: 19 sec, withRing: 22 sec |
---|
| 6854 | //normalC ohne (mit) interred: 112 (113)sec, equidim: 99sec |
---|
| 6855 | //normalC 1. mal 111 sec, (2.mal) 450sec!! 3.mal 172 sec |
---|
| 6856 | //(unterschiedlich lange primdec, mit Auswirkungen) |
---|
| 6857 | //char 19: normalC: 15sec , withGens: 14sec (o.interr.) |
---|
| 6858 | |
---|
| 6859 | //----------------------Test Example for special cases ------------------- |
---|
| 6860 | int tt = timer; |
---|
| 6861 | list nor=normalP(i,"withRing");nor; |
---|
| 6862 | //list nor=normalP(i,"withRing", "isPrim");nor; |
---|
| 6863 | timer-tt; |
---|
| 6864 | def R1 = nor[1][1]; setring R1; norid; normap; interred(norid); |
---|
| 6865 | setring r; |
---|
| 6866 | |
---|
| 6867 | int tt = timer; |
---|
| 6868 | list nor=normal(i,"isPrim");nor; |
---|
| 6869 | timer-tt; |
---|
| 6870 | |
---|
| 6871 | ring r = 29,(x,y,z),dp; |
---|
| 6872 | ideal i = x2y2,x2z2; //Nicht equidimensional, equidim reduziert nicht, ok |
---|
| 6873 | ideal i = xyz*(z3-xy4); //### interred(norid) verkuerzt |
---|
| 6874 | //je 0 sec |
---|
| 6875 | |
---|
| 6876 | ideal j = x,y; |
---|
| 6877 | ideal i = j*xy; |
---|
| 6878 | equidim(i); |
---|
| 6879 | //hat eingebettete Komponente, equidim rechnet wie in Beschreibung (ok) |
---|
| 6880 | |
---|
| 6881 | ring r = 19,(x,y),dp; |
---|
| 6882 | ideal i = x3-y4; //delta = 3 |
---|
| 6883 | ideal i = y*x*(x3-y4); //delta = 11; 0,0,3 |
---|
| 6884 | ideal i = (x2-y3)*(x3-y4); //delta = 13; 1,3 |
---|
| 6885 | ideal i = (x-y)*(x3+y2)*(x3-y4); //delta = 23; 0,1,3 |
---|
| 6886 | ideal i = (x-1)*(x3+y2)*(x2-y3); //delta = 16; 0,1,1 |
---|
| 6887 | ideal i = (x-y^2)^2 - y*x^3; //delta = 3 |
---|
| 6888 | //singularities at not only at 0, hier rechnet equidim falsch |
---|
| 6889 | |
---|
| 6890 | // -------------------------- General Examples ---------------------------//Huneke, irred., delta=2 (Version 3-0-4: < 1sec) |
---|
| 6891 | //Version 3-0-6 default: 1sec, mit gens 2sec, mit delta 5 sec |
---|
| 6892 | //(prim,noFac):ca 7 Min, prim:ca 10 min(wg facstd) |
---|
| 6893 | // |
---|
| 6894 | // "equidim" < 1sec irred. 5sec |
---|
| 6895 | // ring r=31991,(a,b,c,d,e),dp; |
---|
| 6896 | ring r=2,(a,b,c,d,e),dp; //delta=2 |
---|
| 6897 | ideal i= |
---|
| 6898 | 5abcde-a5-b5-c5-d5-e5, |
---|
| 6899 | ab3c+bc3d+a3be+cd3e+ade3, |
---|
| 6900 | a2bc2+b2cd2+a2d2e+ab2e2+c2de2, |
---|
| 6901 | abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5, |
---|
| 6902 | ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5, |
---|
| 6903 | a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6, |
---|
| 6904 | a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4, |
---|
| 6905 | b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5; |
---|
| 6906 | //normalC: char 2, 31991: 0 sec (isPrim); char 2, equidim: 7 sec |
---|
| 6907 | //norTest(i,nor,2); 1sec |
---|
| 6908 | //normalP char 2: 1sec (isPrim) |
---|
| 6909 | //size(norid); size(string(norid));21 1219 interred(norid): 21 1245 (0 sec) |
---|
| 6910 | |
---|
| 6911 | int tt = timer; |
---|
| 6912 | list nor=normalC(i);nor; |
---|
| 6913 | timer-tt; |
---|
| 6914 | |
---|
| 6915 | list nor = normalP(i,"isPrim"); |
---|
| 6916 | |
---|
| 6917 | //Vasconcelos irred., delta -1 (dauert laenger) |
---|
| 6918 | //auf macbook pro = 20 sec mit alter Version, |
---|
| 6919 | //Sing 3-0-6: |
---|
| 6920 | // Char 32003: "equidim" 30 sec, "noFac": 30sec |
---|
| 6921 | //gens: nach 9 min abgebr (haengt in Lin = ideal(T*syzf);) !!!! Hans zu tun |
---|
| 6922 | //Char 2: default (charp) 2 sec, normalC ca 30 sec |
---|
| 6923 | //ring r=32003,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
| 6924 | ring r=2,(x,y,z,w,t),dp; //dim 2, dim s_locus 1 |
---|
| 6925 | ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3; |
---|
| 6926 | //normalC: char 2: 22, sec (mit und ohne isPrim) |
---|
| 6927 | //normalP char 2: 0sec (isPrim) o. interred |
---|
| 6928 | //char 32003: ### haengt in ideal endid = phi1(endid); |
---|
| 6929 | |
---|
| 6930 | //------------------------------------------------------- |
---|
| 6931 | //kleine Beispiele: |
---|
| 6932 | |
---|
| 6933 | //Theo1, irred, delta=-1 |
---|
| 6934 | //normalC: 1sec, normalP: 3 sec |
---|
| 6935 | ring r=32003,(x,y,z),wp(2,3,6); //dim 2,dim slocus 1 |
---|
| 6936 | ideal i=zy2-zx3-x6; |
---|
| 6937 | //normalC: char 2,19,32003: 0 sec (isPrim) |
---|
| 6938 | //normalP (isPrim) char 2,19: 0sec, char 29: 1sec |
---|
| 6939 | |
---|
| 6940 | //Theo1a, CohenMacaulay regular in codim 2, dim slocus=1, delta=0 |
---|
| 6941 | //normalC: 0 sec, normalP: haegt in K=preimage(R,phi,L); |
---|
| 6942 | ring r=32003,(x,y,z,u),dp; |
---|
| 6943 | ideal i=zy2-zx3-x6+u2; |
---|
| 6944 | //normalC: char 2,32003: 0 sec (isPrim) |
---|
| 6945 | //normalP (isPrim) char 2: 0sec, char 19: haengt in K = preimage(Q,phi,L); |
---|
| 6946 | |
---|
| 6947 | //Theo2, irreduzibel, reduziert, < 1sec, delta -1 |
---|
| 6948 | ring r=0,(x,y,z),wp(3,4,12); |
---|
| 6949 | ideal i=z*(y3-x4)+x8; |
---|
| 6950 | //normalC: char 2,32003,0: 0 sec (isPrim) |
---|
| 6951 | //normalP (isPrim) char 2: 0 1sec, char 19: 1sec char 29: 7 sec |
---|
| 6952 | |
---|
| 6953 | //Theo2a, reduiziert, 2-dim, dim_slocus=1, alte Version 3 sec, |
---|
| 6954 | //normalP ca 30 sec, normalC ca 4sec, delta -1 |
---|
| 6955 | //ring r=32003,(T(1..4)),wp(3,4,12,17); |
---|
| 6956 | //ring r=11,(T(1..4)),dp; |
---|
| 6957 | ring r=11,(T(1..4)),wp(3,4,12,17); |
---|
| 6958 | ideal i= |
---|
| 6959 | T(1)^8-T(1)^4*T(3)+T(2)^3*T(3), |
---|
| 6960 | T(1)^4*T(2)^2-T(2)^2*T(3)+T(1)*T(4), |
---|
| 6961 | T(1)^7+T(1)^3*T(2)^3-T(1)^3*T(3)+T(2)*T(4), |
---|
| 6962 | 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; |
---|
| 6963 | //normalC: char 2,32003: 0 sec (isPrim) |
---|
| 6964 | //normalP (isPrim) char 2: 0sec, char 11 2se, char 19: 13sec |
---|
| 6965 | //norTest 48sec in char11 |
---|
| 6966 | //### interred verkuerzt |
---|
| 6967 | //char 29: haengt in K = preimage(Q,phi,L); |
---|
| 6968 | |
---|
| 6969 | //Theo3, irred, 2-dim, 1-dim sing, < 1sec |
---|
| 6970 | ring r=11,(x,y,z),wp(3,5,15); |
---|
| 6971 | ideal i=z*(y3-x5)+x10; |
---|
| 6972 | //normalC: char 2,0: 0 sec (withRing) |
---|
| 6973 | //normalP (withRing) char 2,11: 0sec, char 19: 13sec norTest 12sec(char 11) |
---|
| 6974 | |
---|
| 6975 | //Theo4 reducible, delta (0,0,0) -1 |
---|
| 6976 | ring r=29,(x,y,z),dp; |
---|
| 6977 | ideal i=(x-y)*(x-z)*(y-z); |
---|
| 6978 | //normalC: char 2,32003: 0 sec |
---|
| 6979 | //normalP char withRing 2, 29: 0sec, 6sec |
---|
| 6980 | |
---|
| 6981 | //Theo6 |
---|
| 6982 | ring r=32003,(x,y,z),dp; |
---|
| 6983 | ideal i=x2y2+x2z2+y2z2; |
---|
| 6984 | //normalC: char 2,32003: 0 sec |
---|
| 6985 | //normalP char withRing 2, 29: 0sec, 4sec |
---|
| 6986 | |
---|
| 6987 | //Sturmfels, CM, 15 componenten, alle glatt |
---|
| 6988 | ring r=0,(b,s,t,u,v,w,x,y,z),dp; |
---|
| 6989 | ideal i= bv+su, bw+tu, sw+tv, by+sx, bz+tx, sz+ty,uy+vx,uz+wx,vz+wy,bvz; |
---|
| 6990 | //normalC car 11, 0: 1sec, normalP 0 sec |
---|
| 6991 | |
---|
| 6992 | //riemenschneider, , dim 3, 5 Komp. delta (0,0,0,0,0), -1 |
---|
| 6993 | ring r=2,(p,q,s,t,u,v,w,x,y,z),wp(1,1,1,1,1,1,2,1,1,1); |
---|
| 6994 | ideal i=xz,vx,ux,su,qu,txy,stx,qtx,uv2z-uwz,uv3-uvw,puv2-puw; |
---|
| 6995 | //alles 0 sec in char 2 |
---|
| 6996 | |
---|
| 6997 | //4 Komponenten, alle glatt, 0sec |
---|
| 6998 | ring r=11,(x,y,z,t),dp; |
---|
| 6999 | ideal i=x2z+xzt,xyz,xy2-xyt,x2y+xyt; |
---|
| 7000 | |
---|
| 7001 | //dim 3, 2 Komponenten delta (-1,0), -1 |
---|
| 7002 | ring r=2,(u,v,w,x,y,z),wp(1,1,1,3,2,1); |
---|
| 7003 | ideal i=wx,wy,wz,vx,vy,vz,ux,uy,uz,y3-x2; |
---|
| 7004 | //alles 0 sec in char 2 |
---|
| 7005 | //--------------------------------------------------------- |
---|
| 7006 | int tt = timer; |
---|
| 7007 | list nor=normalP(i,"normalC","withRing");nor; |
---|
| 7008 | timer-tt; |
---|
| 7009 | |
---|
| 7010 | //St_S/Y, 3 Komponenten, 2 glatt, 1 normal |
---|
| 7011 | //charp haengt (in char 20) in K=preimage(R,phi,L); |
---|
| 7012 | //ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
| 7013 | ring r=11,(b,s,t,u,v,w,x,y,z),dp; |
---|
| 7014 | ideal i=wy-vz,vx-uy,tv-sw,su-bv,tuy-bvz; |
---|
| 7015 | //normalC: char 2,32003: 0 sec |
---|
| 7016 | //normalP char withRing 2: 1sec, char 11: 40sec |
---|
| 7017 | |
---|
| 7018 | //Horrocks: cahr 0: 17 (8 in char 11) Komponenten alle normal, delta 1 |
---|
| 7019 | //char 11: 8 Komponenten alle normal, delta -1 |
---|
| 7020 | ring r=0,(a,b,c,d,e,f),dp; |
---|
| 7021 | //ring r=11,(a,b,c,d,e,f),dp; //Charp bis p = 200 ca 3sec |
---|
| 7022 | ideal i= |
---|
| 7023 | adef-16000be2f+16001cef2, ad2f+8002bdef+8001cdf2, abdf-16000b2ef+16001bcf2, |
---|
| 7024 | a2df+8002abef+8001acf2, ad2e-8000bde2-7999cdef, acde-16000bce2+16001c2ef, |
---|
| 7025 | a2de-8000abe2-7999acef, acd2+8002bcde+8001c2df, abd2-8000b2de-7999bcdf, |
---|
| 7026 | a2d2+9603abde-10800b2e2-9601acdf+800bcef+11601c2f2, |
---|
| 7027 | abde-8000b2e2-acdf-16001bcef-8001c2f2, abcd-16000b2ce+16001bc2f, |
---|
| 7028 | a2cd+8002abce+8001ac2f, a2bd-8000ab2e-7999abcf, ab3f-3bdf3, |
---|
| 7029 | a2b2f-2adf3-16000bef3+16001cf4, a3bf+4aef3, ac3e-10668cde3, |
---|
| 7030 | a2c2e+10667ade3+16001be4+5334ce3f, a3ce+10669ae3f, bc3d+8001cd3e, |
---|
| 7031 | ac3d+8000bc3e+16001cd2e2+8001c4f, b2c2d+16001ad4+4000bd3e+12001cd3f, |
---|
| 7032 | b2c2e-10668bc3f-10667cd2ef, abc2e-cde2f, b3cd-8000bd3f, b3ce-10668b2c2f-10667bd2ef, abc2f-cdef2, a2bce-16000be3f+16001ce2f2, |
---|
| 7033 | ab3d-8000b4e-8001b3cf+16000bd2f2, ab2cf-bdef2, |
---|
| 7034 | a2bcf-16000be2f2+16001cef3, a4d-8000a3be+8001a3cf-2ae2f2; |
---|
| 7035 | //normalC: char 0: 1sec char 11: 0sec |
---|
| 7036 | //normalP: char 11: 0sec |
---|
| 7037 | |
---|
| 7038 | //2sec mit normalC, in char 2 ebenfalls (char 20 mit charp >1 min) |
---|
| 7039 | //4 Komp. in char 2, delta (0,0,0,0) -1, char 11:delta (-1,0,0,0) -1 |
---|
| 7040 | ring r=32003,(b,s,t,u,v,w,x,y,z),dp; |
---|
| 7041 | ideal i= |
---|
| 7042 | wx2y3-vx2y2z+wx2yz2+wy3z2-vx2z3-vy2z3, |
---|
| 7043 | vx3y2-ux2y3+vx3z2-ux2yz2+vxy2z2-uy3z2, |
---|
| 7044 | tvx2y2-swx2y2+tvx2z2-swx2z2+tvy2z2-swy2z2, |
---|
| 7045 | sux2y2-bvx2y2+sux2z2-bvx2z2+suy2z2-bvy2z2, |
---|
| 7046 | tux2y3-bvx2y2z+tux2yz2+tuy3z2-bvx2z3-bvy2z3; |
---|
| 7047 | //normalC: char 2,32003: 1 sec |
---|
| 7048 | //normalP char withRing 2: 1sec, char 11: 40sec |
---|
| 7049 | |
---|
| 7050 | //--------------------------------------------------------- |
---|
| 7051 | //genus: |
---|
| 7052 | int tt = timer; |
---|
| 7053 | list nor=normal(i, "noFac");nor; |
---|
| 7054 | timer-tt; |
---|
| 7055 | |
---|
| 7056 | //Yoshihiko Sakai, irred, 0sec, delta = 8 |
---|
| 7057 | ring r=0,(x,y),dp; //genus 0 4 nodes and 6 cusps im P2 |
---|
| 7058 | //ring r=7,(x,y),dp; //charp haengt in K = preimage(Q,phi,L) |
---|
| 7059 | ideal i=(x2+y^2-1)^3 +27x2y2; |
---|
| 7060 | |
---|
| 7061 | ring r=0,(x,y),dp; //genus 0 |
---|
| 7062 | ideal i=(x-y^2)^2 - y*x^3; |
---|
| 7063 | |
---|
| 7064 | ring r=0,(x,y),dp; //genus 4 |
---|
| 7065 | ideal i=y3-x6+1; |
---|
| 7066 | |
---|
| 7067 | int m=9; // q=9: genus 0 |
---|
| 7068 | int p=2; |
---|
| 7069 | int q=9;//2,...,9 |
---|
| 7070 | ring r=0,(x,y),dp; |
---|
| 7071 | ideal i=y^m - x^p*(x - 1)^q; |
---|
| 7072 | |
---|
| 7073 | ring r=0,(x,y),dp; //genus 19 |
---|
| 7074 | 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; |
---|
| 7075 | |
---|
| 7076 | ring r=23,(x,y),dp; //genus 34, delta 2 |
---|
| 7077 | ideal i=y10+(-2494x2+474)*y8+(84366+2042158x4-660492)*y6 |
---|
| 7078 | +(128361096x4-47970216x2+6697080-761328152x6)*y4 |
---|
| 7079 | +(-12024807786x4-506101284x2+15052058268x6+202172841-3212x8)*y2 |
---|
| 7080 | +34263110700x4-228715574724x6+5431439286x2+201803238 |
---|
| 7081 | -9127158539954x10-3212722859346x8; |
---|
| 7082 | //normalC, normalP 0 sec |
---|
| 7083 | |
---|
| 7084 | //Rob Koelman |
---|
| 7085 | //ring r=0,(x,y,z),dp; //dim sing = 1 (nach ca 15 min abgebrochen) |
---|
| 7086 | ring r=32003,(x,y,z),dp; |
---|
| 7087 | ideal i= |
---|
| 7088 | 761328152*x^6*z^4-5431439286*x^2*y^8+2494*x^2*z^8+228715574724*x^6*y^4+ |
---|
| 7089 | 9127158539954*x^10-15052058268*x^6*y^2*z^2+3212722859346*x^8*y^2- |
---|
| 7090 | 134266087241*x^8*z^2-202172841*y^8*z^2-34263110700*x^4*y^6-6697080*y^6*z^4- |
---|
| 7091 | 2042158*x^4*z^6-201803238*y^10+12024807786*x^4*y^4*z^2-128361096*x^4*y^2*z^4+ |
---|
| 7092 | 506101284*x^2*z^2*y^6+47970216*x^2*z^4*y^4+660492*x^2*z^6*y^2- |
---|
| 7093 | z^10-474*z^8*y^2-84366*z^6*y^4; |
---|
| 7094 | //normalC char 32003: 10 sec, char 0 : |
---|
| 7095 | |
---|
| 7096 | //ring r=0,(x,y),dp;//genus 10 with 26 cusps (nach ca 4 min abgebrochen) |
---|
| 7097 | ring r=32003,(x,y),dp; //24 sing, delta 24 |
---|
| 7098 | ideal i=9127158539954x10+3212722859346x8y2+228715574724x6y4-34263110700x4y6 |
---|
| 7099 | -5431439286x2y8-201803238y10-134266087241x8-15052058268x6y2+12024807786x4y4 |
---|
| 7100 | +506101284x2y6-202172841y8+761328152x6-128361096x4y2+47970216x2y4-6697080y6 |
---|
| 7101 | -2042158x4+660492x2y2-84366y4+2494x2-474y2-1; |
---|
| 7102 | //normalC 32003: 4 sec, char 0: abgebrochen bei pr = facstd(i); ### |
---|
| 7103 | |
---|
| 7104 | ring r=0,(x,y),dp; //irred, genus 1 with 5 cusps, delta 5 |
---|
| 7105 | ideal i=57y5+516x4y-320x4+66y4-340x2y3+73y3+128x2-84x2y2-96x2y; |
---|
| 7106 | //normalC 0 sec |
---|
| 7107 | |
---|
| 7108 | ring r=2,(x,y),dp; //genus 4, 2 Zweige, delta (13,9) 89 |
---|
| 7109 | ideal i=((x2+y3)^2+xy6)*((x3+y2)^2+x10y); |
---|
| 7110 | //normalC: char 2 : 1sec, char 0: lange |
---|
| 7111 | //normalP char 2 withRing: 0sec |
---|
| 7112 | |
---|
| 7113 | ring r=2,(y,z,w,u),dp; //2 Komp. genus -5 |
---|
| 7114 | ideal i=y2+z2+w2+u2,w4-u4; |
---|
| 7115 | //normalC: char 2 : 0sec, char 0: 1sec |
---|
| 7116 | //normalP char 2 withRing: 0sec |
---|
| 7117 | |
---|
| 7118 | ring r=0,(y,z,w,u),dp; //irred. genus 9 |
---|
| 7119 | ideal i=y2+z2+w2+u2,z4+w4+u4; |
---|
| 7120 | //char 0: 0sec |
---|
| 7121 | |
---|
| 7122 | ring r=0,(x,y,t),dp; //irred, delta -1 |
---|
| 7123 | 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; |
---|
| 7124 | //char 0: 0sec |
---|
| 7125 | |
---|
| 7126 | ring r=0,(x,y,z,w,u),dp; |
---|
| 7127 | ideal i=x2+y2+z2+w2+u2,x3+y3+z3,z4+w4+u4; |
---|
| 7128 | //char 0: 0sec |
---|
| 7129 | |
---|
| 7130 | //--------------------------------------------------------- |
---|
| 7131 | //Probleme mit normalC in char 2 und char 0 |
---|
| 7132 | |
---|
| 7133 | int tt = timer; |
---|
| 7134 | list nor=normalC(i,"withRing");nor; |
---|
| 7135 | timer-tt; |
---|
| 7136 | |
---|
| 7137 | //Mark van Hoeij |
---|
| 7138 | ring r=3,(x,y),dp; //genus 19, delta 21 |
---|
| 7139 | ideal i=y20+y13x+x4y5+x3*(x+1)^2; |
---|
| 7140 | //normalC: char 2 > 10 min bei list SM = mstd(i);### |
---|
| 7141 | //normalP char 2 withRing: 0sec, char 11: haengt bei K = preimage(Q,phi,L); |
---|
| 7142 | |
---|
| 7143 | ring r=2,(x,y),dp; //genus 35 |
---|
| 7144 | ideal i=y30+y13x+x4y5+x3*(x+1)^2; |
---|
| 7145 | //char 0 abgebrochen bei list SM = mstd(i); ### |
---|
| 7146 | //char 2 nach ca 30 min |
---|
| 7147 | //normalC: char 2: abgebr. bei list SM = mstd(i); //Now the work starts' |
---|
| 7148 | //normalC, withGens, char 2: abgebrochen bei Q=mstd(Q)[2]; |
---|
| 7149 | //normalP char 2 withRing: 0sec |
---|
| 7150 | |
---|
| 7151 | ring r=0,(x,y),dp; //irred, genus 55, delta 21 |
---|
| 7152 | ideal i=y40+y13x+x4y5+x3*(x+1)^2; |
---|
| 7153 | //normalC: char 2 lange |
---|
| 7154 | //normalP char 2 withRing: 0sec |
---|
| 7155 | |
---|
| 7156 | ring r=29,(x,y,t),dp; //char 0: genus -5, 4 Komp, delta (-1,-1,0,0), -1 |
---|
| 7157 | 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; |
---|
| 7158 | //normalC: char 29 : 0sec, char 0: 0sec //char 29 6 Komponenten |
---|
| 7159 | //normalP char 29 withRing: 1sec |
---|
| 7160 | |
---|
| 7161 | //-------------------------- problematic examples ------------------------ |
---|
| 7162 | //ring r=0,(x,y,t),dp; |
---|
| 7163 | ring r=32003,(x,y,t),dp; |
---|
| 7164 | ideal i= |
---|
| 7165 | 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; |
---|
| 7166 | //char 0: lange (es liegt an den grossen Zahlen), char 32003: 0 sec |
---|
| 7167 | |
---|
| 7168 | //dasselbe Beipiel in char 19: irred |
---|
| 7169 | ring r=0,(x,y,t),dp; |
---|
| 7170 | ideal i= |
---|
| 7171 | 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; |
---|
| 7172 | //normalP: char 2,3: 0sec, norTest 0,2 sec, char 11 haengt bei peimage |
---|
| 7173 | //normalC: char 3: 0 sec, char 0: 1sec |
---|
| 7174 | |
---|
| 7175 | //ring r=0,(x,y),dp; |
---|
| 7176 | ring r=32003,(x,y),dp; |
---|
| 7177 | ideal i= |
---|
| 7178 | x30y21+21x29y20+210x28y19+10x27y19+1330x27y18+190x26y18+5985x26y17 |
---|
| 7179 | +1710x25y17+20349x25y16+45x24y17+9690x24y16+54264x24y15+765x23y16 |
---|
| 7180 | +38760x23y15+116280x23y14+6120x22y15+116280x22y14+120x21y15 |
---|
| 7181 | +203490x22y13+30600x21y14+271320x21y13+1799x20y14+293930x21y12+107100x20y13 |
---|
| 7182 | +503880x20y12+12586x19y13+352716x20y11+278460x19y12+210x18y13+755820x19y11 |
---|
| 7183 | +54509x18y12+352716x19y10+556920x18y11+2723x17y12+923780x18y10+163436x17y11 |
---|
| 7184 | +293930x18y9+875160x17y10+16296x16y11+923780x17y9+359359x16y10+252x15y11 |
---|
| 7185 | +203490x17y8+1093950x16y9+59598x15y10+755820x16y8+598598x15y9+2751x14y10 |
---|
| 7186 | +116280x16y7+1093950x15y8+148610x14y9+503880x15y7+769197x14y8+13650x13y9 |
---|
| 7187 | +54264x15y6+875160x14y7+266805x13y8+210x12y9+271320x14y6+768768x13y7 |
---|
| 7188 | +40635x12y8+20349x14y5+556920x13y6+354816x12y7+1855x11y8+116280x13y5 |
---|
| 7189 | +597597x12y6+80640x11y7+5985x13y4+278460x12y5+353892x11y6+7280x10y7+38760x12y4 |
---|
| 7190 | +358358x11y5+112014x10y6+120x9y7+1330x12y3+107100x11y4+264726x10y5+16660x9y6 |
---|
| 7191 | +9690x11y3+162799x10y4+111132x9y5+805x8y6+210x11y2+30600x10y3+146685x9y4 |
---|
| 7192 | +24500x8y5+1710x10y2+54236x9y3+78750x8y4+2310x7y5+21x10y+6120x9y2+58520x8y3 |
---|
| 7193 | +24010x7y4+45x6y5+190x9y+12509x8y2+39060x7y3+3675x6y4+x9+765x8y+15918x7y2 |
---|
| 7194 | +15680x6y3+204x5y4+10x8+1786x7y+12915x6y2+3500x5y3+45x7+2646x6y+6580x5y2 |
---|
| 7195 | +366x4y3+119x6+2562x5y+1995x4y2+10x3y3+203x5+1610x4y+324x3y2+231x4+630x3y |
---|
| 7196 | +23x2y2+175x3+141x2y+85x2+16xy+24x+y+4; |
---|
| 7197 | list nor = normal(i); |
---|
| 7198 | //normalC: char 0: ### haengt in SB of singular locus JM = mstd(J); |
---|
| 7199 | //normalC: char 32003,"noFac","equidim": 0sec, "noFac": 1sec |
---|
| 7200 | // ev neues interred |
---|
| 7201 | genus(i); // haengt bei int mu=vdim(std(jacob(f))); |
---|
| 7202 | //### ist das noetig? |
---|
| 7203 | |
---|
| 7204 | //Singular rechnet genus richtig, auch im Fall, dass Kurve irreduzibel, |
---|
| 7205 | //aber nicht absolut irreduzibel ist: |
---|
| 7206 | ring r = 0,(x,y),dp; |
---|
| 7207 | ideal i = x2+y2; //irreduzibel /Q aber reduzibel /C (x-iy)*(x+iy) |
---|
| 7208 | factorize( x2+y2); //liefert irreduzibel |
---|
| 7209 | genus(i); //sollte 0+0-2+1= -1 sein |
---|
| 7210 | genus(i,1); //beides ist korrekt in Singular |
---|
| 7211 | |
---|
| 7212 | */ |
---|
| 7213 | |
---|