source: git/Singular/LIB/normal.lib @ 6b5e56

spielwiese
Last change on this file since 6b5e56 was 6b5e56, checked in by Hans Schoenemann <hannes@…>, 7 years ago
doc: references
  • Property mode set to 100644
File size: 223.9 KB
Line 
1//////////////////////////////////////////////////////////////////////////////
2version="version normal.lib 4.0.1.1 Dec_2014 "; // $Id$
3category="Commutative Algebra";
4info="
5LIBRARY:  normal.lib     Normalization of Affine Rings
6AUTHORS:  G.-M. Greuel,  greuel@mathematik.uni-kl.de,
7@*        S. Laplagne,   slaplagn@dm.uba.ar,
8@*        G. Pfister,    pfister@mathematik.uni-kl.de
9@*        Peter Chini,   chini@rhrk.uni-kl.de (normalConductor)
10
11
12PROCEDURES:
13 normal(I,[...]);    normalization of an affine ring
14 normalP(I,[...]);   normalization of an affine ring in positive characteristic
15 normalC(I,[...]);   normalization of an affine ring through a chain of rings
16 HomJJ(L);           presentation of End_R(J) as affine ring, J an ideal
17 genus(I);           computes the geometric genus of a projective curve
18 primeClosure(L);    integral closure of R/p, p a prime ideal
19 closureFrac(L);     writes a poly in integral closure as element of Quot(R/p)
20 iMult(L);           intersection multiplicity of the ideals of the list L
21
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 normalConductor(ideal); computation of the conductor as ideal in the basering
29
30SEE ALSO: locnormal_lib;modnormal_lib
31";
32
33LIB "general.lib";
34LIB "poly.lib";
35LIB "sing.lib";
36LIB "primdec.lib";
37LIB "elim.lib";
38LIB "presolve.lib";
39LIB "inout.lib";
40LIB "ring.lib";
41LIB "hnoether.lib";
42LIB "reesclos.lib";
43LIB "algebra.lib";
44LIB "curveInv.lib";
45
46///////////////////////////////////////////////////////////////////////////////
47
48proc normal(ideal id, list #)
49"USAGE:  normal(id [,choose]); id = radical ideal, choose = list of options. @*
50         Optional parameters in list choose (can be entered in any order):@*
51         Decomposition:@*
52         - \"equidim\" -> computes first an equidimensional decomposition of the
53         input ideal, and then the normalization of each component (default).@*
54         - \"prim\" -> computes first the minimal associated primes of the input
55         ideal, and then the normalization of each prime. (When the input ideal
56         is not prime and the minimal associated primes are easy to compute,
57         this method is usually faster than \"equidim\".)@*
58         - \"noDeco\" -> no preliminary decomposition is done. If the ideal is
59         not equidimensional radical, output might be wrong.@*
60         - \"isPrim\" -> assumes that the ideal is prime. If this assumption
61         does not hold, the output might be wrong.@*
62         - \"noFac\" -> factorization is avoided in the computation of the
63         minimal associated primes;
64         Other:@*
65         - \"useRing\" -> uses the original ring ordering.@*
66         If this option is set and if the ring ordering is not global, normal
67         will change to a global ordering only for computing radicals and prime
68         or equidimensional decompositions.@*
69         If this option is not set, normal changes to dp ordering and performs
70         all computations with respect to this ordering.@*
71         - \"withDelta\" (or \"wd\") -> returns also the delta invariants.@*
72         If the optional parameter choose is not given or empty, only
73         \"equidim\" but no other option is used.@*
74         - list(\"inputJ\", ideal inputJ) -> takes as initial test ideal the
75         ideal inputJ. This option is only for use in other procedures. Using
76         this option, the result might not be the normalization.@*
77         (Option only valid for global algorithm.)@*
78         - list(\"inputC\", ideal inputC) -> takes as initial conductor the
79         ideal inputC. This option is only for use in other procedures. Using
80         this option, the result might not be the normalization.@*
81         (Option only valid for global algorithm.)@*
82         Options used for computing integral basis (over rings of two
83         variables):@*
84         - \"var1\" -> uses a polynomial in the first variable as
85         universal denominator.@*
86         - \"var2\" -> uses a polynomial in the second variable as universal
87         denominator.@*
88         If the optional parameter choose is not given or empty, only
89         \"equidim\" but no other option is used.@*
90ASSUME:  The ideal must be radical, for non-radical ideals the output may
91         be wrong (id=radical(id); makes id radical). However, when using the
92         \"prim\" option the minimal associated primes of id are computed first
93         and hence normal computes the normalization of the radical of id.@*
94NOTE:    \"isPrim\" should only be used if id is known to be prime.
95RETURN:  a list, say nor, of size 2 (resp. 3 with option \"withDelta\").
96         Let R denote the basering and id the input ideal.
97         * nor[1] is a list of r rings, where r is the number of associated
98         primes P_i with option \"prim\" (resp. >= no of equidimenensional
99         components P_i with option \"equidim\").@*
100         Each ring Ri := nor[1][i], i=1..r, contains two ideals with given
101         names @code{norid} and @code{normap} such that: @*
102         - Ri/norid is the normalization of the i-th component, i.e. the
103          integral closure of R/P_i in its field of fractions (as affine ring);
104         - @code{normap} gives the normalization map from R/id to
105           Ri/norid for each i.@*
106         - the direct sum of the rings Ri/norid, i=1,..r, is the normalization
107           of R/id as affine algebra; @*
108         * nor[2] is a list of size r with information on the normalization of
109         the i-th component as module over the basering R:@*
110         nor[2][i] is an ideal, say U, in R such that the integral closure
111         of basering/P_i is generated as module over R by 1/c * U, with c
112         the last element U[size(U)] of U.@*
113         * nor[3] (if option \"withDelta\" is set) is a list of an intvec
114         of size r, the delta invariants of the r components, and an integer,
115         the total delta invariant of basering/id (-1 means infinite, and 0
116         that R/P_i resp. R/id is normal).
117THEORY:  We use here a general algorithm described in [G.-M.Greuel, S.Laplagne,
118         F.Seelisch: Normalization of Rings (2009)].@*
119         The procedure computes the R-module structure, the algebra structure
120         and the delta invariant of the normalization of R/id:@*
121         The normalization of R/id is the integral closure of R/id in its total
122         ring of fractions. It is a finitely generated R-module and nor[2]
123         computes R-module generators of it. More precisely: If U:=nor[2][i]
124         and c:=U[size(U)], then c is a non-zero divisor and U/c is an R-module
125         in the total ring of fractions, the integral closure of R/P_i. Since
126         U[size(U)]/c is equal to 1, R/P_i resp. R/id is contained in the
127         integral closure.@*
128         The normalization is also an affine algebra over the ground field
129         and nor[1] presents it as such. For geometric considerations nor[1] is
130         relevant since the variety of the ideal norid in Ri is the
131         normalization of the variety of the ideal P_i in R.@*
132         The delta invariant of a reduced ring A is dim_K(normalization(A)/A).
133         For A=K[x1,...,xn]/id we call this number also the delta invariant of
134         id. nor[3] returns the delta invariants of the components P_i and of
135         id.
136NOTE:    To use the i-th ring type e.g.: @code{def R=nor[1][i]; setring R;}.
137@*       Increasing/decreasing printlevel displays more/less comments
138         (default: printlevel=0).
139@*       Implementation works also for local rings.
140@*       Not implemented for quotient rings.
141@*       If the input ideal id is weighted homogeneous a weighted ordering may
142         be used together with the useRing-option (qhweight(id); computes
143         weights).
144KEYWORDS: normalization; integral closure; delta invariant.
145SEE ALSO: normalC, normalP.
146EXAMPLE: example normal; shows an example
147"
148{
149  ASSUME(0, not isQuotientRing(basering) );
150
151  intvec opt = option(get);     // Save current options
152
153  int i,j;
154  int decomp;   // Preliminary decomposition:
155                // 0 -> no decomposition (id is assumed to be prime)
156                // 1 -> no decomposition
157                //      (id is assumed to be equidimensional radical)
158                // 2 -> equidimensional decomposition
159                // 3 -> minimal associated primes
160  int noFac, useRing, withDelta;
161  int dbg = printlevel - voice + 2;
162  int nvar = nvars(basering);
163  int chara  = char(basering);
164  int denomOption;   // Method for choosing the conductor
165
166  ideal inputJ = 0;      // Test ideal given in the input (if any).
167  ideal inputC = 0;      // Conductor ideal given in the input (if any).
168
169  list result, resultNew;
170  list keepresult;
171  list ringStruc;
172  ideal U;
173  poly c;
174  int sp;            // Number of components.
175
176  // Default methods:
177  noFac = 0;         // Use facSTD when computing minimal associated primes
178  decomp = 2;        // Equidimensional decomposition
179  useRing = 0;       // Change first to dp ordering, and perform all
180                     // computations there.
181  withDelta = 0;     // Do not compute the delta invariant.
182  denomOption = 0;   // The default universal denominator is the smallest
183                     // degree polynomial.
184
185//--------------------------- define the method ---------------------------
186  for ( i=1; i <= size(#); i++ )
187  {
188    if ( typeof(#[i]) == "string" )
189    {
190//--------------------------- chosen methods -----------------------
191      if ( (#[i]=="isprim") or (#[i]=="isPrim") )
192      {decomp = 0;}
193
194      if ( (#[i]=="nodeco") or (#[i]=="noDeco") )
195      {decomp = 1;}
196
197      if (#[i]=="prim")
198      {decomp = 3;}
199
200      if (#[i]=="equidim")
201      {decomp = 2;}
202
203      if ( (#[i]=="nofac") or (#[i]=="noFac") )
204      {noFac=1;}
205
206      if ( ((#[i]=="useRing") or (#[i]=="usering")) and (ordstr(basering) != "dp("+string(nvars(basering))+"),C"))
207      {useRing = 1;}
208
209      if ( (#[i]=="withDelta") or (#[i]=="wd") or (#[i]=="withdelta"))
210      {
211        if((decomp == 0) or (decomp == 3))
212        {
213          withDelta = 1;
214        }
215        else
216        {
217          decomp = 3;
218          withDelta = 1;
219          //Note: the delta invariants cannot be computed with an equidimensional
220          //decomposition, hence we compute first the minimal primes
221        }
222      }
223      if (#[i]=="var1")
224      {denomOption = 1;}
225      if (#[i]=="var2")
226      {denomOption = 2;}
227    }
228    if(typeof(#[i]) == "list"){
229      if(size(#[i]) == 2){
230        if (#[i][1]=="inputJ"){
231          if(typeof(#[i][2]) == "ideal"){
232            inputJ = #[i][2];
233          }
234        }
235      }
236      if (#[i][1]=="inputC"){
237        if(size(#[i]) == 2){
238          if(typeof(#[i][2]) == "ideal"){
239            inputC = #[i][2];
240          }
241        }
242      }
243    }
244  }
245  kill #;
246
247//------------------------ change ring if required ------------------------
248// If the ordering is not global, we change to dp ordering for computing the
249// min ass primes.
250// If the ordering is global, but not dp, and useRing = 0, we also change to
251// dp ordering.
252
253  int isGlobal = attrib(basering,"global");// Checks if the original ring has
254                                          // global ordering.
255
256  def origR = basering;   // origR is the original ring
257                          // R is the ring where computations will be done
258
259  if((useRing  == 1) and (isGlobal == 1))
260  {
261    def globR = basering;
262  }
263  else
264  {
265    // We change to dp ordering.
266    list rl = ringlist(origR);
267    list origOrd = rl[3];
268    list newOrd = list("dp", intvec(1:nvars(origR))), list("C", 0);
269    rl[3] = newOrd;
270    def globR = ring(rl);
271    setring globR;
272    ideal id = fetch(origR, id);
273  }
274
275//------------------------ trivial checkings ------------------------
276  id = groebner(id);
277  if((size(id) == 0) or (id[1] == 1))
278  {
279    // The original ring R/I was normal. Nothing to do.
280    // We define anyway a new ring, equal to R, to be able to return it.
281    setring origR;
282    list lR = ringlist(origR);
283    def ROut = ring(lR);
284    setring ROut;
285    ideal norid = fetch(origR, id);
286    ideal normap = maxideal(1);
287    export norid;
288    export normap;
289    setring origR;
290    if(withDelta)
291    {
292      result = list(list(ROut), list(ideal(1)), list(intvec(0), 0));
293    }
294    else
295    {
296      result = list(list(ROut), list(ideal(1)));
297    }
298    sp = 1;      // number of rings in the output
299    option(set, opt);
300    normalOutputText(dbg, withDelta, sp);
301    return(result);
302  }
303//------------------------ preliminary decomposition-----------------------
304  list prim;
305  if(decomp == 2)
306  {
307    dbprint(dbg, "// Computing the equidimensional decomposition...");
308    prim = equidim(id);
309  }
310  if((decomp == 0) or (decomp == 1))
311  {
312    prim = id;
313  }
314  if(decomp == 3)
315  {
316    dbprint(dbg, "// Computing the minimal associated primes...");
317    if( noFac )
318    { prim = minAssGTZ(id,1); }
319    else
320    { prim = minAssGTZ(id); }
321  }
322  sp = size(prim);
323  if(dbg>=1)
324  {
325    prim; "";
326    "// number of components is", sp;
327    "";
328  }
329
330
331//----------------- back to the original ring if required ------------------
332// if ring was not global and useRing is on, we go back to the original ring
333  if((useRing == 1) and (isGlobal != 1))
334  {
335    setring origR;
336    def R = basering;
337    list prim = fetch(globR, prim);
338  }
339  else
340  {
341    def R = basering;
342    ideal inputJ = fetch(origR, inputJ);
343    ideal inputC = fetch(origR, inputC);
344    if(useRing == 0)
345    {
346      ideal U;
347      poly c;
348    }
349  }
350
351// ---------------- normalization of the components-------------------------
352// calls normalM to compute the normalization of each component.
353
354  list norComp;       // The normalization of each component.
355  int delt;
356  int deltI = 0;
357  int totalComps = 0;
358
359  setring origR;
360  def newROrigOrd;
361  list newRListO;
362  setring R;
363  def newR;
364  list newRList;
365
366  for(i=1; i<=size(prim); i++)
367  {
368    if(dbg>=2){pause();}
369    if(dbg>=1)
370    {
371      "// start computation of component",i;
372      "   --------------------------------";
373    }
374    if(groebner(prim[i])[1] != 1)
375    {
376      if(dbg>=2)
377      {
378        "We compute the normalization in the ring"; basering;
379      }
380      printlevel = printlevel + 1;
381      norComp = normalM(prim[i], decomp, withDelta, denomOption, inputJ, inputC);
382      printlevel = printlevel - 1;
383      for(j = 1; j <= size(norComp); j++)
384      {
385        newR = norComp[j][3];
386        if(!defined(savebasering)) { def savebasering;}
387        savebasering=basering;
388        setring newR; // must be in a compatible ring to newR
389                      // as ringlist may produce ring-dep. stuff
390        if(!defined(newRList)) { list newRList;}
391        newRList = ringlist(newR);
392        setring savebasering;
393        U = norComp[j][1];
394        c = norComp[j][2];
395        if(withDelta)
396        {
397          delt = norComp[j][4];
398          if((delt >= 0) and (deltI >= 0))
399          {
400            deltI = deltI + delt;
401          }
402          else
403          {
404            deltI = -1;
405          }
406        }
407        // -- incorporate result for this component to the list of results ---
408        if(useRing == 0)
409        {
410          // We go back to the original ring.
411          setring origR;
412          U = fetch(R, U);
413          c = fetch(R, c);
414          newRListO = imap(newR, newRList);
415          // We change the ordering in the new ring.
416          if(nvars(newR) > nvars(origR))
417          {
418            newRListO[3]=insert(origOrd, newRListO[3][1]);
419          }
420          else
421          {
422            newRListO[3] = origOrd;
423          }
424          newROrigOrd = ring(newRListO);
425          setring newROrigOrd;
426          ideal norid = imap(newR, norid);
427          ideal normap = imap(newR, normap);
428          export norid;
429          export normap;
430          setring origR;
431          totalComps++;
432          result[totalComps] = list(U, c, newROrigOrd);
433          if(withDelta)
434          {
435            result[totalComps] = insert(result[totalComps], delt, 3);
436          }
437          setring R;
438        }
439        else
440        {
441          setring R;
442          totalComps++;
443          result[totalComps] = norComp[j];
444        }
445      }
446    }
447  }
448
449// -------------------------- delta computation ----------------------------
450  if(withDelta == 1)
451  {
452    // Intersection multiplicities of list prim, sp=size(prim).
453    if ( dbg >= 1 )
454    {
455      "// Sum of delta for all components: ", deltI;
456    }
457    if(size(prim) > 1)
458    {
459      dbprint(dbg, "// Computing the sum of the intersection multiplicities of the components...");
460      int mul = iMult(prim);
461      if ( mul < 0 )
462      {
463        deltI = -1;
464      }
465      else
466      {
467        deltI = deltI + mul;
468      }
469      if ( dbg >= 1 )
470      {
471        "// Intersection multiplicity is : ", mul;
472      }
473    }
474  }
475
476// -------------------------- prepare output ------------------------------
477  setring origR;
478
479  list RL;      // List of rings
480  list MG;      // Module generators
481  intvec DV;    // Vector of delta's of each component
482  for(i = 1; i <= size(result); i++)
483  {
484    RL[i] = result[i][3];
485    MG[i] = lineUpLast(result[i][1], result[i][2]);
486    if(withDelta)
487    {
488      DV[i] = result[i][4];
489    }
490  }
491  if(withDelta)
492  {
493    resultNew = list(RL, MG, list(DV, deltI));
494  }
495  else
496  {
497    resultNew = list(RL, MG);
498  }
499  sp = size(RL);              //RL = list of rings
500
501  option(set, opt);
502  normalOutputText(dbg, withDelta, sp);
503  return(resultNew);
504}
505
506example
507{ "EXAMPLE:";
508  printlevel = printlevel+1;
509  echo = 2;
510  ring s = 0,(x,y),dp;
511  ideal i = (x2-y3)*(x2+y2)*x;
512  list nor = normal(i, "withDelta", "prim");
513  nor;
514
515  // 2 branches have delta = 1, and 1 branch has delta = 0
516  // the total delta invariant is 13
517
518  def R2 = nor[1][2];  setring R2;
519  norid; normap;
520
521  echo = 0;
522  printlevel = printlevel-1;
523  pause("   hit return to continue"); echo=2;
524
525  ring r = 2,(x,y,z),dp;
526  ideal i = z3-xy4;
527  list nor = normal(i, "withDelta", "prim");  nor;
528  // the delta invariant is infinite
529  // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module
530  // in its quotient field Quot(r/i)
531
532  // the normalization as affine algebra over the ground field:
533  def R = nor[1][1]; setring R;
534  norid; normap;
535}
536
537///////////////////////////////////////////////////////////////////////////////
538// Prints the output text in proc normal.
539//
540static proc normalOutputText(int dbg, int withDelta, int sp)
541// int dbg: printlevel
542// int withDelta: output contains information about the delta invariant
543// int sp: number of output rings.
544{
545  if ( dbg >= 0 )
546  {
547    "";
548    if(!withDelta)
549    {
550      "// 'normal' created a list, say nor, of two elements.";
551    }
552    else
553    {
554      "// 'normal' created a list, say nor, of three elements.";
555    }
556    "// To see the list type";
557    "      nor;";
558    "";
559    "// * nor[1] is a list of", sp, "ring(s).";
560    "// To access the i-th ring nor[1][i], give it a name, say Ri, and type";
561    "     def R1 = nor[1][1]; setring R1; norid; normap;";
562    "// For the other rings type first (if R is the name of your base ring)";
563    "     setring R;";
564    "// and then continue as for R1.";
565    "// Ri/norid is the affine algebra of the normalization of R/P_i where";
566    "// P_i is the i-th component of a decomposition of the input ideal id";
567    "// and normap the normalization map from R to Ri/norid.";
568    "";
569    "// * nor[2] is a list of", sp, "ideal(s). Let ci be the last generator";
570    "// of the ideal nor[2][i]. Then the integral closure of R/P_i is";
571    "// generated as R-submodule of the total ring of fractions by";
572    "// 1/ci * nor[2][i].";
573
574    if(withDelta)
575    { "";
576      "// * nor[3] is a list of an intvec of size", sp, "the delta invariants ";
577      "// of the components, and an integer, the total delta invariant ";
578      "// of R/id (-1 means infinite, and 0 that R/P_i resp. R/id is normal).";
579    }
580  }
581}
582
583
584///////////////////////////////////////////////////////////////////////////////
585
586proc HomJJ (list Li)
587"USAGE:   HomJJ (Li);  Li = list: ideal SBid, ideal id, ideal J, poly p
588ASSUME:  R    = P/id,  P = basering, a polynomial ring, id an ideal of P,
589@*       SBid = standard basis of id,
590@*       J    = ideal of P containing the polynomial p,
591@*       p    = nonzero divisor of R
592COMPUTE: Endomorphism ring End_R(J)=Hom_R(J,J) with its ring structure as
593         affine ring, together with the map R --> Hom_R(J,J) of affine rings,
594         where R is the quotient ring of P modulo the standard basis SBid.
595RETURN:  a list l of three objects
596@format
597         l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi'
598               such that l[1]/endid = Hom_R(J,J) and
599               endphi describes the canonical map R -> Hom_R(J,J)
600         l[2] : an integer which is 1 if phi is an isomorphism, 0 if not
601         l[3] : an integer, = dim_K(Hom_R(J,J)/R) (the contribution to delta)
602                if the dimension is finite, -1 otherwise
603@end format
604NOTE:    printlevel >=1: display comments (default: printlevel=0)
605EXAMPLE: example HomJJ;  shows an example
606"
607{
608   ASSUME(0, not isQuotientRing(basering) );
609
610//---------- initialisation ---------------------------------------------------
611   int isIso,isPr,isHy,isCo,isRe,isEq,oSAZ,ii,jj,q,y;
612   intvec rw,rw1;
613   list L;
614   y = printlevel-voice+2;  // y=printlevel (default: y=0)
615   def P = basering;
616   ideal SBid, id, J = Li[1], Li[2], Li[3];
617   poly p = Li[4];
618   int noRed = 0;
619   if(size(Li) > 4)
620   {
621     if(Li[5] == 1) { noRed = 1; }
622   }
623
624   attrib(SBid,"isSB",1);
625   int homo = homog(Li[2]);               //is 1 if id is homogeneous, 0 if not
626
627//---- set attributes for special cases where algorithm can be simplified -----
628   if( homo==1 )
629   {
630      rw = ringweights(P);
631   }
632   if( typeof(attrib(id,"isPrim"))=="int" )
633   {
634      if(attrib(id,"isPrim")==1)  { isPr=1; }
635   }
636   if( typeof(attrib(id,"onlySingularAtZero"))=="int" )
637   {
638      if(attrib(id,"onlySingularAtZero")==1){oSAZ=1; }
639   }
640   if( typeof(attrib(id,"isIsolatedSingularity"))=="int" )
641   {
642      if(attrib(id,"isIsolatedSingularity")==1) { isIso=1; }
643   }
644   if( typeof(attrib(id,"isCohenMacaulay"))=="int" )
645   {
646      if(attrib(id,"isCohenMacaulay")==1) { isCo=1; }
647   }
648   if( typeof(attrib(id,"isRegInCodim2"))=="int" )
649   {
650      if(attrib(id,"isRegInCodim2")==1) { isRe=1; }
651   }
652   if( typeof(attrib(id,"isEquidimensional"))=="int" )
653   {
654      if(attrib(id,"isEquidimensional")==1) { isEq=1; }
655   }
656//-------------------------- go to quotient ring ------------------------------
657   qring R  = SBid;
658   ideal id = fetch(P,id);
659   ideal J  = fetch(P,J);
660   poly p   = fetch(P,p);
661   ideal f,rf,f2;
662   module syzf;
663//---------- computation of p*Hom(J,J) as R-ideal -----------------------------
664   if ( y>=1 )
665   {
666     "// compute p*Hom(J,J) = p*J:J";
667     "//   the ideal J:";J;
668   }
669   f  = quotient(p*J,J);
670
671   //### (neu GMG 4.10.08) divide by the greatest common divisor:
672   poly gg = gcd( f[1],p );
673   for(ii=2; ii <=ncols(f); ii++)
674   {
675      gg=gcd(gg,f[ii]);
676   }
677   for(ii=1; ii<=ncols(f); ii++)
678   {
679      f[ii]=f[ii]/gg;
680   }
681   p = p/gg;
682
683   if ( y>=1 )
684   {
685      "//   the non-zerodivisor p:"; p;
686      "//   the module p*Hom(J,J) = p*J:J :"; f;
687      "";
688   }
689   f2 = std(p);
690
691//---------- Test: Hom(J,J) == R ?, if yes, go home ---------------------------
692
693   //rf = interred(reduce(f,f2));
694   //### interred hier weggelassen, unten zugefuegt
695   rf = reduce(f,f2);       //represents p*Hom(J,J)/p*R = Hom(J,J)/R
696   if ( size(rf) == 0 )
697   {
698      if ( homog(f) && find(ordstr(basering),"s")==0 )
699      {
700         ring newR1 = char(P),(X(1..nvars(P))),(a(rw),dp);
701      }
702      else
703      {
704         ring newR1 = char(P),(X(1..nvars(P))),dp;
705      }
706      ideal endphi = maxideal(1);
707      ideal endid = fetch(P,id);
708      endid = simplify(endid,2);
709      L = substpart(endid,endphi,homo,rw);   //## hier substpart
710      def lastRing = L[1];
711      setring lastRing;
712
713      attrib(endid,"onlySingularAtZero",oSAZ);
714      attrib(endid,"isCohenMacaulay",isCo);
715      attrib(endid,"isPrim",isPr);
716      attrib(endid,"isIsolatedSingularity",isIso);
717      attrib(endid,"isRegInCodim2",isRe);
718      attrib(endid,"isEqudimensional",isEq);
719      attrib(endid,"isHypersurface",0);
720      attrib(endid,"isCompleteIntersection",0);
721      attrib(endid,"isRadical",0);
722      L=lastRing;
723      L = insert(L,1,1);
724      dbprint(y,"// case R = Hom(J,J)");
725      if(y>=1)
726      {
727         "//   R=Hom(J,J)";
728         lastRing;
729         "//   the new ideal";
730         endid;
731         "   ";
732         "//   the old ring";
733         P;
734         "//   the old ideal";
735         setring P;
736         id;
737         "   ";
738         setring lastRing;
739         "//   the map to the new ring";
740         endphi;
741         "   ";
742         pause();
743         "";
744      }
745      setring P;
746      L[3]=0;
747      return(L);
748   }
749   if(y>=1)
750   {
751      "// R is not equal to Hom(J,J), we have to try again";
752      pause();
753      "";
754   }
755//---------- Hom(J,J) != R: create new ring and map from old ring -------------
756// the ring newR1/SBid+syzf will be isomorphic to Hom(J,J) as R-module
757// f2=p (i.e. ideal generated by p)
758
759   //f = mstd(f)[2];              //### geaendert GMG 04.10.08
760   //ideal ann = quotient(f2,f);  //### f durch rf ersetzt
761   rf = mstd(rf)[2];              //rf = NF(f,p), hence <p,rf> = <p,f>
762   ideal ann = quotient(f2,rf);   //p:f = p:rf
763
764   //------------- compute the contribution to delta ----------
765   //delt=dim_K(Hom(JJ)/R (or -1 if infinite)
766
767   int delt=vdim(std(modulo(f,ideal(p))));
768
769   f = p,rf;          // generates pJ:J mod(p), i.e. p*Hom(J,J)/p*R as R-module
770   q = size(f);
771   syzf = syz(f);
772
773   if ( homo==1 )
774   {
775      rw1 = rw,0;
776      for ( ii=2; ii<=q; ii++ )
777      {
778         rw  = rw, deg(f[ii])-deg(f[1]);
779         rw1 = rw1, deg(f[ii])-deg(f[1]);
780      }
781      ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),(a(rw1),dp);
782   }
783   else
784   {
785      ring newR1 = char(R),(X(1..nvars(R)),T(1..q)),dp;
786   }
787
788   //map psi1 = P,maxideal(1);          //### psi1 durch fetch ersetzt
789   //ideal SBid = psi1(SBid);
790   ideal SBid = fetch(P,SBid);
791   attrib(SBid,"isSB",1);
792
793   qring newR = std(SBid);
794
795   //map psi = R,ideal(X(1..nvars(R)));  //### psi durch fetch ersetzt
796   //ideal id = psi(id);
797   //ideal f = psi(f);
798   //module syzf = psi(syzf);
799   ideal id = fetch(R,id);
800   ideal f = fetch(R,f);
801   module syzf = fetch(R,syzf);
802   ideal pf,Lin,Quad,Q;
803   matrix T,A;
804   list L1;
805
806//---------- computation of Hom(J,J) as affine ring ---------------------------
807// determine kernel of: R[T1,...,Tq] -> J:J >-> R[1/p]=R[t]/(t*p-1),
808// Ti -> fi/p -> t*fi (p=f1=f[1]), to get ring structure. This is of course
809// the same as the kernel of R[T1,...,Tq] -> pJ:J >-> R, Ti -> fi.
810// It is a fact, that the kernel is generated by the linear and the quadratic
811// relations
812// f=p,rf, rf=reduce(f,p), generates pJ:J mod(p),
813// i.e. p*Hom(J,J)/p*R as R-module
814
815   pf = f[1]*f;
816   T = matrix(ideal(T(1..q)),1,q);
817   Lin = ideal(T*syzf);
818   if(y>=1)
819   {
820      "// the ring structure of Hom(J,J) as R-algebra";
821      "//   the linear relations:";
822      Lin;
823   }
824
825   poly ff;
826   for (ii=2; ii<=q; ii++ )
827   {
828      for ( jj=2; jj<=ii; jj++ )
829      {
830         ff = NF(f[ii]*f[jj],std(0));       //this makes lift much faster
831         A = lift(pf,ff);                   //ff lin. comb. of elts of pf mod I
832         Quad = Quad, ideal(T(jj)*T(ii) - T*A);  //quadratic relations
833      }
834   }
835
836   if(y>=1)
837   {
838      "//   the quadratic relations";
839      Quad;
840      pause();
841      newline;
842   }
843   Q = Lin,Quad;
844   Q = subst(Q,T(1),1);
845   //Q = mstd(Q)[2];            //### sehr aufwendig, daher weggelassen (GMG)
846   //### ev das neue interred
847   //mstd dient nur zum verkleinern, die SB-Eigenschaft geht spaeter verloren
848   //da in neuen Ring abgebildet und mit id vereinigt
849
850//---------- reduce number of variables by substitution, if possible ----------
851   if (homo==1)
852   {
853      ring newRing = char(R),(X(1..nvars(R)),T(2..q)),(a(rw),dp);
854   }
855   else
856   {
857      ring newRing = char(R),(X(1..nvars(R)),T(2..q)),dp;
858   }
859
860   ideal endid  = imap(newR,id),imap(newR,Q);
861   //hier wird Q weiterverwendet, die SB-Eigenschaft wird nicht verwendet.
862   endid = simplify(endid,2);
863   ideal endphi = ideal(X(1..nvars(R)));
864
865
866  if(noRed == 0)
867  {
868    L = substpart(endid,endphi,homo,rw);
869    def lastRing=L[1];
870    setring lastRing;
871    //return(lastRing);
872  }
873  else
874  {
875    list RL = ringlist(newRing);
876    def lastRing = ring(RL);
877    setring lastRing;
878    ideal endid = fetch(newRing, endid);
879    ideal endphi = fetch(newRing, endphi);
880    export(endid);
881    export(endphi);
882    //def lastRing = newRing;
883    //setring R;
884    //return(newR);
885  }
886
887
888//   L = substpart(endid,endphi,homo,rw);
889
890//   def lastRing=L[1];
891//   setring lastRing;
892
893   attrib(endid,"onlySingularAtZero",0);
894   map sigma=R,endphi;
895   ideal an=sigma(ann);
896   export(an);  //noetig?
897   //ideal te=an,endid;
898   //if(isIso && (size(reduce(te,std(maxideal(1))))==0))   //#### ok???
899   // {
900   //    attrib(endid,"onlySingularAtZero",oSAZ);
901   // }
902   //kill te;
903   attrib(endid,"isCohenMacaulay",isCo);                //#### ok???
904   attrib(endid,"isPrim",isPr);
905   attrib(endid,"isIsolatedSingularity",isIso);
906   attrib(endid,"isRegInCodim2",isRe);
907   attrib(endid,"isEquidimensional",isEq);
908   attrib(endid,"isHypersurface",0);
909   attrib(endid,"isCompleteIntersection",0);
910   attrib(endid,"isRadical",0);
911   if(y>=1)
912   {
913      "// the new ring after reduction of the number of variables";
914      lastRing;
915      "//   the new ideal";
916      endid;  "";
917      "// the old ring";
918      P;
919      "//   the old ideal";
920      setring P;
921      id;
922      "   ";
923      setring lastRing;
924      "//   the map to the new ring";
925      endphi;
926      "   ";
927      pause();
928      "";
929   }
930   L = lastRing;
931   L = insert(L,0,1);
932   L[3] = delt;
933   setring(P);
934   return(L);
935}
936example
937{"EXAMPLE:";  echo = 2;
938  ring r   = 0,(x,y),wp(2,3);
939  ideal id = y^2-x^3;
940  ideal J  = x,y;
941  poly p   = x;
942  list Li  = std(id),id,J,p;
943  list L   = HomJJ(Li);
944  def end = L[1];    // defines ring L[1], containing ideals endid, endphi
945  setring end;       // makes end the basering
946  end;
947  endid;             // end/endid is isomorphic to End(r/id) as ring
948  map psi = r,endphi;// defines the canonical map r/id -> End(r/id)
949  psi;
950  L[3];              // contribution to delta
951}
952
953
954///////////////////////////////////////////////////////////////////////////////
955//compute intersection multiplicities as needed for delta(I) in
956//normalizationPrimes and normalP:
957
958proc iMult (list prim)
959"USAGE:   iMult(L);  L a list of ideals
960RETURN:  int, the intersection multiplicity of the ideals of L;
961         if iMult(L) is infinite, -1 is returned.
962THEORY:  If r=size(L)=2 then iMult(L) = vdim(std(L[1]+L[2])) and in general
963         iMult(L) = sum{ iMult(L[j],Lj) | j=1..r-1 } with Lj the intersection
964         of L[j+1],...,L[r]. If I is the intersection of all ideals in L then
965         we have delta(I) = delta(L[1])+...+delta(L[r]) + iMult(L) where
966         delta(I) = vdim (normalisation(R/I)/(R/I)), R the basering.
967EXAMPLE: example iMult; shows an example
968"
969{
970     ASSUME(0, not isQuotientRing(basering) );
971
972     int i,mul,mu;
973     int sp = size(prim);
974     int y = printlevel-voice+2;
975     if ( sp > 1 )
976     {
977        ideal I(sp-1) = prim[sp];
978        mu = vdim(std(I(sp-1)+prim[sp-1]));
979        mul = mu;
980        if ( y>=1 )
981        {
982          "// intersection multiplicity of component",sp,"with",sp-1,":"; mu;
983        }
984        if ( mu >= 0 )
985        {
986           for (i=sp-2; i>=1 ; i--)
987           {
988              ideal I(i) = intersect(I(i+1),prim[i+1]);
989              mu = vdim(std(I(i)+prim[i]));
990              if ( mu < 0 )
991              {
992                break;
993              }
994              mul = mul + mu;
995              if ( y>=1 )
996              {
997                "// intersection multiplicity of components",sp,"...",i+1,"with",i; mu;
998              }
999           }
1000        }
1001     }
1002     return(mul);
1003}
1004example
1005{ "EXAMPLE:"; echo = 2;
1006   ring s  = 23,(x,y),dp;
1007   list L = (x-y),(x3+y2);
1008   iMult(L);
1009   L = (x-y),(x3+y2),(x3-y4);
1010   iMult(L);
1011}
1012///////////////////////////////////////////////////////////////////////////////
1013//check if I has a singularity only at zero, as needed in normalizationPrimes
1014
1015proc locAtZero (ideal I)
1016"USAGE:   locAtZero(I);  I = ideal
1017RETURN:  int, 1 if I has only one point which is located at zero, 0 otherwise
1018ASSUME:  I is given as a standard bases in the basering
1019NOTE:    only useful in affine rings, in local rings vdim does the check
1020EXAMPLE: example locAtZero; shows an example
1021"
1022{
1023   ASSUME(0, not isQuotientRing(basering) );
1024
1025   int ii,jj, caz;                   //caz: conzentrated at zero
1026   int dbp = printlevel-voice+2;
1027   int nva = nvars(basering);
1028   int vdi = vdim(I);
1029   if ( vdi < 0 )
1030   {
1031      if (dbp >=1)
1032      { "// non-isolated singularitiy";""; }
1033      return(caz);
1034   }
1035
1036   //Now the ideal is 0-dim
1037   //First an easy test
1038   //If I is homogenous and not constant it is concentrated at 0
1039   if( homog(I)==1 && size(jet(I,0))==0)
1040   {
1041      caz=1;
1042      if (dbp >=1)
1043      { "// isolated singularity and homogeneous";""; }
1044      return(caz);
1045   }
1046
1047   //Now the general case with I 0-dim. Choose an appropriate power pot,
1048   //and check each variable x whether x^pot is in I.
1049   int mi1 = mindeg1(lead(I));
1050   int pot = vdi;
1051   if ( (mi1+(mi1==1))^2 < vdi )
1052   {
1053      pot = (mi1+(mi1==1))^2;      //### alternativ: pot = vdi lassen
1054   }
1055
1056   while ( 1 )
1057   {
1058      caz = 1;
1059      for ( ii=1; ii<= nva; ii++ )
1060      {
1061        if ( NF(var(ii)^pot,I) != 0 )
1062        {
1063           caz = 0; break;
1064        }
1065      }
1066      if ( caz == 1 || pot >= vdi )
1067      {
1068        if (dbp >=1)
1069        {
1070          "// mindeg, exponent, vdim used in 'locAtZero':", mi1,pot,vdi; "";
1071        }
1072        return(caz);
1073      }
1074      else
1075      {
1076        if ( pot^2 < vdi )
1077        { pot = pot^2; }
1078        else
1079        { pot = vdi; }
1080      }
1081   }
1082}
1083example
1084{ "EXAMPLE:"; echo = 2;
1085   ring r = 0,(x,y,z),dp;
1086   poly f = z5+y4+x3+xyz;
1087   ideal i = jacob(f),f;
1088   i=std(i);
1089   locAtZero(i);
1090   i= std(i*ideal(x-1,y,z));
1091   locAtZero(i);
1092}
1093
1094///////////////////////////////////////////////////////////////////////////////
1095
1096//The next procedure normalizationPrimes computes the normalization of an
1097//irreducible or an equidimensional ideal i.
1098//- If i is irreducuble, then the returned list, say nor, has size 2
1099//with nor[1] the normalization ring and nor[2] the delta invariant.
1100//- If i is equidimensional, than the "splitting tools" can create a
1101//decomposition of i and nor can have more than 1 ring.
1102
1103static proc normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #)
1104"USAGE:   normalizationPrimes(i,ihp,delt[,si]);  i = equidimensional ideal,
1105         ihp = map (partial normalization), delt = partial delta-invariant,
1106         si = ideal s.t. V(si) contains singular locus (optional)
1107RETURN:   a list of rings, say nor, and an integer, the delta-invariant
1108          at the end of the list.
1109          each ring nor[j], j = 1..size(nor)-1, contains two ideals
1110          with given names norid and normap such that
1111           - the direct sum of the rings nor[j]/norid is
1112             the normalization of basering/i;
1113           - normap gives the normalization map from basering/id
1114             to nor[j]/norid (for each j)
1115          nor[size(nor)] = dim_K(normalisation(P/i) / (P/i)) is the
1116          delta-invariant, where P is the basering.
1117EXAMPLE: example normalizationPrimes; shows an example
1118"
1119{
1120   ASSUME(1, not isQuotientRing(basering) );
1121   //Note: this procedure calls itself as long as the test for
1122   //normality, i.e if R==Hom(J,J), is negative.
1123
1124   int printlev = printlevel;   //store printlevel in order to reset it later
1125   int y = printlevel-voice+2;  // y=printlevel (default: y=0)
1126   if(y>=1)
1127   {
1128     "";
1129     "// START a normalization loop with the ideal";
1130     i;  "";
1131     "// in the ring:";
1132     basering;  "";
1133     pause();
1134     "";
1135   }
1136
1137   def BAS=basering;
1138   list result,keepresult1,keepresult2,JM,gnirlist;
1139   ideal J,SB,MB;
1140   int depth,lauf,prdim,osaz;
1141   int ti=timer;
1142
1143   gnirlist = ringlist(BAS);
1144
1145//----------- the trivial case of a zero ideal as input, RETURN ------------
1146   if(size(i)==0)
1147   {
1148      if(y>=1)
1149      {
1150          "// the ideal was the zero-ideal";
1151      }
1152         def newR7 = ring(gnirlist);
1153         setring newR7;
1154         ideal norid=ideal(0);
1155         ideal normap=fetch(BAS,ihp);
1156         export norid;
1157         export normap;
1158         result=newR7;
1159         result[size(result)+1]=list(delt,delti);
1160         setring BAS;
1161         return(result);
1162   }
1163
1164//--------------- General NOTATION, compute SB of input -----------------
1165// SM is a list, the result of mstd(i)
1166// SM[1] = SB of input ideal i,
1167// SM[2] = (minimal) generators for i.
1168// We work with SM and will copy the attributes from i to SM[2]
1169// JM will be a list, either JM[1]=maxideal(1),JM[2]=maxideal(1)
1170// in case i has onlySingularAtZero, or JM = mstd(si) where si = #[1],
1171// or JM = mstd(J) where J is the ideal of the singular locus
1172// JM[2] must be (made) radical
1173
1174   if(y>=1)
1175   {
1176     "// SB-computation of the ideal";
1177   }
1178
1179   list SM = mstd(i);              //Now the work starts
1180   int dimSM =  dim(SM[1]);        //dimension of variety to normalize
1181   if(y>=1)
1182   {
1183      "// the dimension is:";  dimSM;
1184   }
1185//----------------- the general case, set attributes ----------------
1186   //Note: onlySingularAtZero is NOT preserved under the ring extension
1187   //basering --> Hom(J,J) (in contrast to isIsolatedSingularity),
1188   //therefore we reset it:
1189
1190   attrib(i,"onlySingularAtZero",0);
1191
1192   if(attrib(i,"isPrim")==1)
1193   {
1194      attrib(SM[2],"isPrim",1);
1195   }
1196   else
1197   {
1198      attrib(SM[2],"isPrim",0);
1199   }
1200   if(attrib(i,"isIsolatedSingularity")==1)
1201   {
1202      attrib(SM[2],"isIsolatedSingularity",1);
1203   }
1204   else
1205   {
1206      attrib(SM[2],"isIsolatedSingularity",0);
1207   }
1208   if(attrib(i,"isCohenMacaulay")==1)
1209   {
1210      attrib(SM[2],"isCohenMacaulay",1);
1211   }
1212   else
1213   {
1214      attrib(SM[2],"isCohenMacaulay",0);
1215   }
1216   if(attrib(i,"isRegInCodim2")==1)
1217   {
1218      attrib(SM[2],"isRegInCodim2",1);
1219   }
1220   else
1221   {
1222      attrib(SM[2],"isRegInCodim2",0);
1223   }
1224   if(attrib(i,"isEquidimensional")==1)
1225   {
1226      attrib(SM[2],"isEquidimensional",1);
1227   }
1228   else
1229   {
1230      attrib(SM[2],"isEquidimensional",0);
1231   }
1232   if(attrib(i,"isCompleteIntersection")==1)
1233   {
1234     attrib(SM[2],"isCompleteIntersection",1);
1235   }
1236   else
1237   {
1238      attrib(SM[2],"isCompleteIntersection",0);
1239   }
1240   if(attrib(i,"isHypersurface")==1)
1241   {
1242     attrib(SM[2],"isHypersurface",1);
1243   }
1244   else
1245   {
1246      attrib(SM[2],"isHypersurface",0);
1247   }
1248
1249   if(attrib(i,"onlySingularAtZero")==1)
1250   {
1251      attrib(SM[2],"onlySingularAtZero",1);
1252   }
1253   else
1254   {
1255      attrib(SM[2],"onlySingularAtZero",0);
1256   }
1257
1258   //------- an easy and cheap test for onlySingularAtZero ---------
1259   if( (attrib(SM[2],"isIsolatedSingularity")==1) && (homog(SM[2])==1) )
1260   {
1261      attrib(SM[2],"onlySingularAtZero",1);
1262   }
1263
1264//-------------------- Trivial cases, in each case RETURN ------------------
1265// input ideal is the ideal of a partial normalization
1266
1267   // ------------ Trivial case: input ideal contains a unit ---------------
1268   if( dimSM == -1)
1269   {  "";
1270      "      // A unit ideal was found.";
1271      "      // Stop with partial result computed so far";"";
1272
1273         MB=SM[2];
1274         intvec rw;
1275         list LL=substpart(MB,ihp,0,rw);
1276         def newR6=LL[1];
1277         setring newR6;
1278         ideal norid=endid;
1279         ideal normap=endphi;
1280         kill endid,endphi;
1281         export norid;
1282         export normap;
1283         result=newR6;
1284         result[size(result)+1]=list(delt,delti);
1285         setring BAS;
1286         return(result);
1287   }
1288
1289   // --- Trivial case: input ideal is zero-dimensional and homog ---
1290   if( (dim(SM[1])==0) && (homog(SM[2])==1) )
1291   {
1292      if(y>=1)
1293      {
1294         "// the ideal was zero-dimensional and homogeneous";
1295      }
1296      MB=maxideal(1);
1297      intvec rw;
1298      list LL=substpart(MB,ihp,0,rw);
1299      def newR5=LL[1];
1300      setring newR5;
1301      ideal norid=endid;
1302      ideal normap=endphi;
1303      kill endid,endphi;
1304      export norid;
1305      export normap;
1306      result=newR5;
1307      result[size(result)+1]=list(delt,delti);
1308      setring BAS;
1309      return(result);
1310   }
1311
1312   // --- Trivial case: input ideal defines a line ---
1313   //the one-dimensional, homogeneous case and degree 1 case
1314   if( (dim(SM[1])==1) && (maxdeg1(SM[2])==1) && (homog(SM[2])==1) )
1315   {
1316      if(y>=1)
1317      {
1318         "// the ideal defines a line";
1319      }
1320      MB=SM[2];
1321      intvec rw;
1322      list LL=substpart(MB,ihp,0,rw);
1323      def newR4=LL[1];
1324      setring newR4;
1325      ideal norid=endid;
1326      ideal normap=endphi;
1327      kill endid,endphi;
1328      export norid;
1329      export normap;
1330      result=newR4;
1331      result[size(result)+1]=list(delt,delti);
1332      setring BAS;
1333      return(result);
1334   }
1335
1336//---------------------- The non-trivial cases start -------------------
1337   //the higher dimensional case
1338   //we test first hypersurface, CohenMacaulay and complete intersection
1339
1340   if( ((size(SM[2])+dim(SM[1])) == nvars(basering)) )
1341   {
1342      //the test for complete intersection
1343      attrib(SM[2],"isCohenMacaulay",1);
1344      attrib(SM[2],"isCompleteIntersection",1);
1345      attrib(SM[2],"isEquidimensional",1);
1346      if(y>=1)
1347      {
1348         "// the ideal is a complete intersection";
1349      }
1350   }
1351   if( size(SM[2]) == 1 )
1352   {
1353      attrib(SM[2],"isHypersurface",1);
1354      if(y>=1)
1355      {
1356         "// the ideal is a hypersurface";
1357      }
1358   }
1359
1360   //------------------- compute the singular locus -------------------
1361   // Computation if singular locus is critical
1362   // Notation: J ideal of singular locus or (if given) containing it
1363   // JM = mstd(J) or maxideal(1),maxideal(1)
1364   // JM[1] SB of singular locus, JM[2] minbasis, dimJ = dim(JM[1])
1365   // SM[1] SB of the input ideal i, SM[2] minbasis
1366   // Computation if singular locus is critical, because it determines the
1367   // size of the ring Hom_R(J,J). We only need a test ideal contained in J.
1368
1369   //----------------------- onlySingularAtZero -------------------------
1370   if( attrib(SM[2],"onlySingularAtZero") )
1371   {
1372       JM = maxideal(1),maxideal(1);
1373       attrib(JM[1],"isSB",1);
1374       attrib(JM[2],"isRadical",1);
1375       if( dim(SM[1]) >=2 )
1376       {
1377         attrib(SM[2],"isRegInCodim2",1);
1378       }
1379   }
1380
1381   //-------------------- not onlySingularAtZero -------------------------
1382   if( attrib(SM[2],"onlySingularAtZero") == 0 )
1383   {
1384      //--- the case where an ideal #[1] is given:
1385      if( size(#)>0 )
1386      {
1387         J = #[1],SM[2];
1388         JM = mstd(J);
1389         if( typeof(attrib(#[1],"isRadical"))!="int" )
1390         {
1391            attrib(JM[2],"isRadical",0);
1392         }
1393      }
1394
1395      //--- the case where an ideal #[1] is not given:
1396      if( (size(#)==0) )
1397      {
1398         if(y >=1 )
1399         {
1400            "// singular locus will be computed";
1401         }
1402
1403         J = SM[1],minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]);
1404         if( y >=1 )
1405         {
1406            "// SB of singular locus will be computed";
1407         }
1408         JM = mstd(J);
1409      }
1410
1411      int dimJ = dim(JM[1]);
1412      attrib(JM[1],"isSB",1);
1413      if( y>=1 )
1414      {
1415         "// the dimension of the singular locus is";  dimJ ; "";
1416      }
1417
1418      if(dim(JM[1]) <= dim(SM[1])-2)
1419      {
1420         attrib(SM[2],"isRegInCodim2",1);
1421      }
1422
1423      //------------------ the smooth case, RETURN -------------------
1424      if( dimJ == -1 )
1425      {
1426         if(y>=1)
1427         {
1428            "// the ideal is smooth";
1429         }
1430         MB=SM[2];
1431         intvec rw;
1432         list LL=substpart(MB,ihp,0,rw);
1433         def newR3=LL[1];
1434         setring newR3;
1435         ideal norid=endid;
1436         ideal normap=endphi;
1437         kill endid,endphi;
1438         export norid;
1439         export normap;
1440         result=newR3;
1441         result[size(result)+1]=list(delt,delti);
1442         setring BAS;
1443         return(result);
1444      }
1445
1446      //------- extra check for onlySingularAtZero, relatively cheap ----------
1447      //it uses the procedure 'locAtZero' from for testing
1448      //if an ideal is concentrated at 0
1449       if(y>=1)
1450       {
1451         "// extra test for onlySingularAtZero:";
1452       }
1453       if ( locAtZero(JM[1]) )
1454       {
1455           attrib(SM[2],"onlySingularAtZero",1);
1456           JM = maxideal(1),maxideal(1);
1457           attrib(JM[1],"isSB",1);
1458           attrib(JM[2],"isRadical",1);
1459       }
1460       else
1461       {
1462            attrib(SM[2],"onlySingularAtZero",0);
1463       }
1464   }
1465
1466  //displaying the attributes:
1467   if(y>=2)
1468   {
1469      "// the attributes of the ideal are:";
1470      "// isCohenMacaulay:", attrib(SM[2],"isCohenMacaulay");
1471      "// isCompleteIntersection:", attrib(SM[2],"isCompleteIntersection");
1472      "// isHypersurface:", attrib(SM[2],"isHypersurface");
1473      "// isEquidimensional:", attrib(SM[2],"isEquidimensional");
1474      "// isPrim:", attrib(SM[2],"isPrim");
1475      "// isRegInCodim2:", attrib(SM[2],"isRegInCodim2");
1476      "// isIsolatedSingularity:", attrib(SM[2],"isIsolatedSingularity");
1477      "// onlySingularAtZero:", attrib(SM[2],"onlySingularAtZero");
1478      "// isRad:", attrib(SM[2],"isRad");"";
1479   }
1480
1481   //------------- case: CohenMacaulay in codim 2, RETURN ---------------
1482   if( (attrib(SM[2],"isRegInCodim2")==1) &&
1483       (attrib(SM[2],"isCohenMacaulay")==1) )
1484   {
1485      if(y>=1)
1486      {
1487         "// the ideal was CohenMacaulay and regular in codim 2, hence normal";
1488      }
1489      MB=SM[2];
1490      intvec rw;
1491      list LL=substpart(MB,ihp,0,rw);
1492      def newR6=LL[1];
1493      setring newR6;
1494      ideal norid=endid;
1495      ideal normap=endphi;
1496      kill endid,endphi;
1497      export norid;
1498      export normap;
1499      result=newR6;
1500      result[size(result)+1]=list(delt,delti);
1501      setring BAS;
1502      return(result);
1503   }
1504
1505//---------- case: isolated singularity only at 0, RETURN ------------
1506   // In this case things are easier, we can use the maximal ideal as radical
1507   // of the singular locus;
1508   // JM mstd of ideal of singular locus, SM mstd of input ideal
1509
1510   if( attrib(SM[2],"onlySingularAtZero") )
1511   {
1512   //------ check variables for being a non zero-divizor ------
1513   // SL = ideal of vars not contained in ideal SM[1]:
1514
1515      attrib(SM[2],"isIsolatedSingularity",1);
1516      ideal SL = simplify(reduce(maxideal(1),SM[1]),2);
1517      ideal Ann = quotient(SM[2],SL[1]);
1518      ideal qAnn = simplify(reduce(Ann,SM[1]),2);
1519      //NOTE: qAnn=0 if and only if first var (=SL[1]) not in SM is a nzd of R/SM
1520
1521   //------------- We found a non-zerodivisor of R/SM -----------------------
1522   // here the enlarging of the ring via Hom_R(J,J) starts
1523
1524      if( size(qAnn)==0 )
1525      {
1526         if(y>=1)
1527         {
1528            "";
1529            "// the ideal rad(J):"; maxideal(1);
1530            "";
1531         }
1532
1533      // ------------- test for normality, compute Hom_R(J,J) -------------
1534      // Note:
1535      // HomJJ (ideal SBid, ideal id, ideal J, poly p) with
1536      //        SBid = SB of id, J = radical ideal of basering  P with:
1537      //        nonNormal(R) is in V(J), J contains the nonzero divisor p
1538      //        of R = P/id (J = test ideal)
1539      // returns a list l of three objects
1540      // l[1] : a polynomial ring, containing two ideals, 'endid' and 'endphi'
1541      //        s.t. l[1]/endid = Hom_R(J,J) and endphi= map R -> Hom_R(J,J)
1542      // l[2] : an integer which is 1 if phi is an isomorphism, 0 if not
1543      // l[3] : an integer, = dim_K(Hom_R(J,J)/R) if finite, -1 otherwise
1544
1545         list RR;
1546         RR = SM[1],SM[2],maxideal(1),SL[1];
1547         RR = HomJJ(RR,y);
1548         // --------------------- non-normal case ------------------
1549         //RR[2]==0 means that the test for normality is negative
1550         if( RR[2]==0 )
1551         {
1552            def newR=RR[1];
1553            setring newR;
1554            map psi=BAS,endphi;
1555            list JM = psi(JM); //###
1556            ideal J = JM[2];
1557            if ( delt>=0 && RR[3]>=0 )
1558            {
1559               delt = delt+RR[3];
1560            }
1561            else
1562            { delt = -1; }
1563            delti[size(delti)]=delt;
1564
1565            // ---------- recursive call of normalizationPrimes -----------
1566        //normalizationPrimes(ideal i,ideal ihp,int delt,intvec delti,list #)
1567        //ihp = (partial) normalisation map from basering
1568        //#[1] ideal s.t. V(#[1]) contains singular locus of i (test ideal)
1569
1570            if ( y>=1 )
1571            {
1572            "// case: onlySingularAtZero, non-zerodivisor found";
1573            "// contribution of delta in ringextension R -> Hom_R(J,J):"; delt;
1574            }
1575
1576            //intvec atr=getAttrib(endid);
1577            //"//### case: isolated singularity only at 0, recursive";
1578            //"size endid:", size(endid), size(string(endid));
1579            //"interred:";
1580            //endid = interred(endid);
1581            //endid = setAttrib(endid,atr);
1582            //"size endid:", size(endid), size(string(endid));
1583
1584           printlevel=printlevel+1;
1585           list tluser =
1586                normalizationPrimes(endid,psi(ihp),delt,delti);
1587           //list tluser =
1588           //     normalizationPrimes(endid,psi(ihp),delt,delti,J);
1589           //#### ??? improvement: give also the old ideal of sing locus???
1590
1591           printlevel = printlev;             //reset printlevel
1592           setring BAS;
1593           return(tluser);
1594         }
1595
1596         // ------------------ the normal case, RETURN -----------------
1597         // Now RR[2] must be 1, hence the test for normality was positive
1598         MB=SM[2];
1599         def newR7 = ring(gnirlist);
1600         setring newR7;
1601         ideal norid=fetch(BAS,MB);
1602         ideal normap=fetch(BAS,ihp);
1603         if ( delt>=0 && RR[3]>=0 )
1604         {
1605               delt = delt+RR[3];
1606         }
1607         else
1608         { delt = -1; }
1609         delti[size(delti)]=delt;
1610
1611         intvec atr = getAttrib(norid);
1612
1613         //"//### case: isolated singularity only at 0, final";
1614         //"size norid:", size(norid), size(string(norid));
1615         //"interred:";
1616         //norid = interred(norid);
1617         //norid = setAttrib(norid,atr);
1618         //"size norid:", size(norid), size(string(norid));
1619
1620         export norid;
1621         export normap;
1622         result=newR7;
1623         result[size(result)+1]=list(delt,delti);
1624         setring BAS;
1625         return(result);
1626      }
1627
1628   //------ zerodivisor of R/SM was found, gives a splitting ------------
1629   //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM
1630   //and we have found a splitting: id and id1
1631   //id = Ann defines components of R/SM in the complement of V(SL[1])
1632   //id1 defines components of R/SM in the complement of V(id)
1633
1634      else
1635       {
1636          ideal id = Ann;
1637          attrib(id,"isCohenMacaulay",0);
1638          attrib(id,"isPrim",0);
1639          attrib(id,"isIsolatedSingularity",1);
1640          attrib(id,"isRegInCodim2",0);
1641          attrib(id,"isHypersurface",0);
1642          attrib(id,"isCompleteIntersection",0);
1643          attrib(id,"isEquidimensional",0);
1644          attrib(id,"onlySingularAtZero",1);
1645
1646          ideal id1 = quotient(SM[2],Ann);
1647          attrib(id1,"isCohenMacaulay",0);
1648          attrib(id1,"isPrim",0);
1649          attrib(id1,"isIsolatedSingularity",1);
1650          attrib(id1,"isRegInCodim2",0);
1651          attrib(id1,"isHypersurface",0);
1652          attrib(id1,"isCompleteIntersection",0);
1653          attrib(id1,"isEquidimensional",0);
1654          attrib(id1,"onlySingularAtZero",1);
1655
1656          // ---------- recursive call of normalizationPrimes -----------
1657          if ( y>=1 )
1658          {
1659            "// case: onlySingularAtZero, zerodivisor found, splitting:";
1660            "// total delta before splitting:", delt;
1661            "// splitting in two components:";
1662          }
1663
1664          printlevel = printlevel+1;  //to see comments in normalizationPrimes
1665          keepresult1 = normalizationPrimes(id,ihp,0,0);   //1st split factor
1666          keepresult2 = normalizationPrimes(id1,ihp,0,0);  //2nd split factor
1667          printlevel = printlev;                           //reset printlevel
1668
1669          int delt1 = keepresult1[size(keepresult1)][1];
1670          int delt2 = keepresult2[size(keepresult2)][1];
1671          intvec delti1 = keepresult1[size(keepresult1)][2];
1672          intvec delti2 = keepresult2[size(keepresult2)][2];
1673
1674          if( delt>=0 && delt1>=0 && delt2>=0 )
1675          {  ideal idid1=id,id1;
1676             int mul = vdim(std(idid1));
1677             if ( mul>=0 )
1678             {
1679               delt = delt+mul+delt1+delt2;
1680             }
1681             else
1682             {
1683               delt = -1;
1684             }
1685          }
1686         if ( y>=1 )
1687         {
1688           "// delta of first component:", delt1;
1689           "// delta of second componenet:", delt2;
1690           "// intersection multiplicity of both components:", mul;
1691           "// total delta after splitting:", delt;
1692         }
1693
1694          else
1695          {
1696            delt = -1;
1697          }
1698          for(lauf=1;lauf<=size(keepresult2)-1;lauf++)
1699          {
1700             keepresult1=insert(keepresult1,keepresult2[lauf]);
1701          }
1702          keepresult1[size(keepresult1)]=list(delt,delti);
1703
1704          return(keepresult1);
1705       }
1706   }
1707   // Case "onlySingularAtZero" has finished and returned result
1708
1709//-------------- General case, not onlySingularAtZero, RETURN ---------------
1710   //test for non-normality, i.e. if Hom(I,I)<>R
1711   //we can use Hom(I,I) to continue
1712
1713   //------ check variables for being a non zero-divizor ------
1714   // SL = ideal of vars not contained in ideal SM[1]:
1715
1716   ideal SL = simplify(reduce(JM[2],SM[1]),2);
1717   ideal Ann = quotient(SM[2],SL[1]);
1718   ideal qAnn = simplify(reduce(Ann,SM[1]),2);
1719   //NOTE: qAnn=0 <==> first var (=SL[1]) not contained in SM is a nzd of R/SM
1720
1721   //------------- We found a non-zerodivisor of R/SM -----------------------
1722   //SM = mstd of ideal of variety, JM = mstd of ideal of singular locus
1723
1724   if( size(qAnn)==0 )
1725   {
1726      list RR;
1727      list RS;
1728      // ----------------- Computation of the radical -----------------
1729      if(y>=1)
1730      {
1731         "// radical computation of singular locus";
1732      }
1733      J = radical(JM[2]);   //the radical of singular locus
1734      JM = mstd(J);
1735
1736      if(y>=1)
1737      {
1738        "// radical is equal to:";"";  JM[2];
1739        "";
1740      }
1741      // ------------ choose non-zerodivisor of smaller degree ----------
1742      //### evtl. fuer SL[1] anderen Nichtnullteiler aus J waehlen ?
1743      if( deg(SL[1]) > deg(J[1]) )
1744      {
1745         Ann=quotient(SM[2],J[1]);
1746         qAnn=simplify(reduce(Ann,SM[1]),2);
1747         if(size(qAnn)==0)
1748         {
1749           SL[1]=J[1];
1750         }
1751      }
1752
1753      // --------------- computation of Hom(rad(J),rad(J)) --------------
1754      RR=SM[1],SM[2],JM[2],SL[1];
1755
1756     if(y>=1)
1757     {
1758        "// compute Hom(rad(J),rad(J))";
1759     }
1760
1761     RS=HomJJ(RR,y);               //most important subprocedure
1762
1763     // ------------------ the normal case, RETURN -----------------
1764     // RS[2]==1 means that the test for normality was positive
1765     if(RS[2]==1)
1766     {
1767         def lastR=RS[1];
1768         setring lastR;
1769         map psi1=BAS,endphi;
1770         ideal norid=endid;
1771         ideal normap=psi1(ihp);
1772         kill endid,endphi;
1773
1774        intvec atr=getAttrib(norid);
1775
1776        //"//### general case: not isolated singularity only at 0, final";
1777        //"size norid:", size(norid), size(string(norid));
1778        //"interred:";
1779        //norid = interred(norid);
1780        //norid = setAttrib(norid,atr);
1781        //"size norid:", size(norid), size(string(norid));
1782
1783         export norid;
1784         export normap;
1785         result=lastR;
1786         if ( y>=1 )
1787         {
1788            "// case: not onlySingularAtZero, last ring Hom_R(J,J) computed";
1789            "// delta before last ring:", delt;
1790         }
1791
1792         if ( delt>=0 && RS[3]>=0 )
1793         {
1794            delt = delt+RS[3];
1795         }
1796         else
1797         { delt = -1; }
1798
1799        // delti = delti,delt;
1800         delti[size(delti)]=delt;
1801
1802         if ( y>=1 )
1803         {
1804           "// delta of last ring:", delt;
1805         }
1806
1807         result[size(result)+1]=list(delt,delti);
1808         setring BAS;
1809         return(result);
1810     }
1811
1812    // ----- the non-normal case, recursive call of normalizationPrimes -------
1813    // RS=HomJJ(RR,y) was computed above, RS[1] contains endid and endphi
1814    // RS[1] = new ring Hom_R(J,J), RS[2]= 0 or 1, RS[2]=contribution to delta
1815    // now RS[2]must be 0, i.e. the test for normality was negative
1816
1817      int n = nvars(basering);
1818      ideal MJ = JM[2];
1819
1820      def newR=RS[1];
1821      setring newR;
1822      map psi=BAS,endphi;
1823      if ( y>=1 )
1824      {
1825        "// case: not onlySingularAtZero, compute new ring = Hom_R(J,J)";
1826        "// delta of old ring:", delt;
1827      }
1828      if ( delt>=0 && RS[3]>=0 )
1829      {
1830         delt = delt+RS[3];
1831      }
1832      else
1833      { delt = -1; }
1834      if ( y>=1 )
1835      {
1836        "// delta of new ring:", delt;
1837      }
1838
1839      delti[size(delti)]=delt;
1840      intvec atr=getAttrib(endid);
1841
1842      //"//### general case: not isolated singularity only at 0, recursive";
1843      //"size endid:", size(endid), size(string(endid));
1844      //"interred:";
1845      //endid = interred(endid);
1846      //endid = setAttrib(endid,atr);
1847      //"size endid:", size(endid), size(string(endid));
1848
1849      printlevel = printlevel+1;
1850      list tluser=
1851          normalizationPrimes(endid,psi(ihp),delt,delti,psi(MJ));
1852      printlevel = printlev;                //reset printlevel
1853      setring BAS;
1854      return(tluser);
1855   }
1856
1857   //---- A whole singular component was found, RETURN -----
1858   if( Ann == 1)
1859   {
1860      "// Input appeared not to be a radical ideal!";
1861      "// A (everywhere singular) component with ideal";
1862      "// equal to its Jacobian ideal was found";
1863      "// Procedure will stop with partial result computed so far";"";
1864
1865         MB=SM[2];
1866         intvec rw;
1867         list LL=substpart(MB,ihp,0,rw);
1868         def newR6=LL[1];
1869         setring newR6;
1870         ideal norid=endid;
1871         ideal normap=endphi;
1872         kill endid,endphi;
1873         export norid;
1874         export normap;
1875         result=newR6;
1876         result[size(result)+1]=lst(delt,delti);
1877         setring BAS;
1878         return(result);
1879   }
1880
1881   //------ zerodivisor of R/SM was found, gives a splitting ------------
1882   //Now the case where qAnn!=0, i.e. SL[1] is a zero divisor of R/SM
1883   //and we have found a splitting: new1 and new2
1884   //id = Ann defines components of R/SM in the complement of V(SL[1])
1885   //id1 defines components of R/SM in the complement of V(id)
1886
1887   else
1888   {
1889      if(y>=1)
1890      {
1891         "// zero-divisor found";
1892      }
1893      int equi = attrib(SM[2],"isEquidimensional");
1894      int oSAZ = attrib(SM[2],"onlySingularAtZero");
1895      int isIs = attrib(SM[2],"isIsolatedSingularity");
1896
1897      ideal new1 = Ann;
1898      ideal new2 = quotient(SM[2],Ann);
1899      //ideal new2=SL[1],SM[2];
1900
1901      def newR1 = ring(gnirlist);
1902      setring newR1;
1903
1904      ideal vid = fetch(BAS,new1);
1905      ideal ihp = fetch(BAS,ihp);
1906      attrib(vid,"isCohenMacaulay",0);
1907      attrib(vid,"isPrim",0);
1908      attrib(vid,"isIsolatedSingularity",isIs);
1909      attrib(vid,"isRegInCodim2",0);
1910      attrib(vid,"onlySingularAtZero",oSAZ);
1911      attrib(vid,"isEquidimensional",equi);
1912      attrib(vid,"isHypersurface",0);
1913      attrib(vid,"isCompleteIntersection",0);
1914
1915      // ---------- recursive call of normalizationPrimes -----------
1916      if ( y>=1 )
1917      {
1918        "// total delta before splitting:", delt;
1919        "// splitting in two components:";
1920      }
1921      printlevel = printlevel+1;
1922      keepresult1 =
1923                  normalizationPrimes(vid,ihp,0,0);  //1st split factor
1924
1925      list delta1 = keepresult1[size(keepresult1)];
1926
1927      setring BAS;
1928      def newR2 = ring(gnirlist);
1929      setring newR2;
1930
1931      ideal vid = fetch(BAS,new2);
1932      ideal ihp = fetch(BAS,ihp);
1933      attrib(vid,"isCohenMacaulay",0);
1934      attrib(vid,"isPrim",0);
1935      attrib(vid,"isIsolatedSingularity",isIs);
1936      attrib(vid,"isRegInCodim2",0);
1937      attrib(vid,"isEquidimensional",equi);
1938      attrib(vid,"isHypersurface",0);
1939      attrib(vid,"isCompleteIntersection",0);
1940      attrib(vid,"onlySingularAtZero",oSAZ);
1941
1942      keepresult2 =
1943                    normalizationPrimes(vid,ihp,0,0);
1944      list delta2 = keepresult2[size(keepresult2)];   //2nd split factor
1945      printlevel = printlev;                          //reset printlevel
1946
1947      setring BAS;
1948
1949      //compute intersection multiplicity of both components:
1950      new1 = new1,new2;
1951      int mul=vdim(std(new1));
1952
1953     // ----- normalizationPrimes finished, add up results, RETURN --------
1954      for(lauf=1;lauf<=size(keepresult2)-1;lauf++)
1955      {
1956         keepresult1 = insert(keepresult1,keepresult2[lauf]);
1957      }
1958      if ( delt >=0 && delta1[1] >=0 && delta2[1] >=0 && mul >=0 )
1959      {
1960         delt = delt+mul+delta1[1]+delta2[1];
1961      }
1962      else
1963      {  delt = -1; }
1964      delti = -2;
1965
1966      if ( y>=1 )
1967      {
1968        "// zero divisor produced a splitting into two components";
1969        "// delta of first component:", delta1;
1970        "// delta of second componenet:", delta2;
1971        "// intersection multiplicity of both components:", mul;
1972        "// total delta after splitting:", delt;
1973      }
1974      keepresult1[size(keepresult1)] = list(delt,delti);
1975      return(keepresult1);
1976   }
1977}
1978example
1979{ "EXAMPLE:";echo = 2;
1980   // Huneke
1981   ring qr=31991,(a,b,c,d,e),dp;
1982   ideal i=
1983   5abcde-a5-b5-c5-d5-e5,
1984   ab3c+bc3d+a3be+cd3e+ade3,
1985   a2bc2+b2cd2+a2d2e+ab2e2+c2de2,
1986   abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5,
1987   ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5,
1988   a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6,
1989   a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4,
1990   b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5;
1991
1992   list pr=normalizationPrimes(i);
1993   def r1 = pr[1];
1994   setring r1;
1995   norid;
1996   normap;
1997}
1998
1999///////////////////////////////////////////////////////////////////////////////
2000static proc substpart(ideal endid, ideal endphi, int homo, intvec rw)
2001
2002"//Repeated application of elimpart to endid, until no variables can be
2003//directy substituded. homo=1 if input is homogeneous, rw contains
2004//original weights, endphi (partial) normalization map";
2005
2006//NOTE concerning iteration of maps: Let phi: x->f(y,z), y->g(x,z) then
2007//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
2008//and so on: none of the x or y will be eliminated
2009//Now subst: first x and then y: x+y+z->f(g(x,z),z)+g(x,z)+z eliminates y
2010//further subst replaces x by y, makes no sense (objects more compicated).
2011//Subst first y and then x eliminates x
2012//In our situation we have triangular form: x->f(y,z), y->g(z).
2013//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
2014//subst x,y: x+y+z->f(g(z),z)+g(z)+z, eliminates x,y
2015//subst y,x: x+y+z->f(y,z)+g(z)+z eliminates only x
2016//HENCE: substitute vars depending on most other vars first
2017//However, if the sytem xi-fi is reduced then xi does not appear in any of the
2018//fj and hence the order does'nt matter when substitutinp xi by fi
2019
2020{
2021   ASSUME(1, not isQuotientRing(basering) );
2022
2023   def newRing = basering;
2024   int ii,jj;
2025   map phi = newRing,maxideal(1);    //identity map
2026   list Le = elimpart(endid);
2027   //this proc and the next loop try to substitute as many variables as
2028   //possible indices of substituted variables
2029
2030   int q = size(Le[2]);    //q vars, stored in Le[2], have been substitutet
2031   intvec rw1 = 0;         //will become indices of substituted variables
2032   rw1[nvars(basering)] = 0;
2033   rw1 = rw1+1;            //rw1=1,..,1 (as many 1 as nvars(basering))
2034
2035   while( size(Le[2]) != 0 )
2036   {
2037      endid = Le[1];
2038      if ( defined(ps) )
2039      { kill ps; }
2040      map ps = newRing,Le[5];
2041      phi = ps(phi);
2042      for(ii=1;ii<=size(Le[2]);ii++)
2043      {
2044         phi=phi(phi);
2045      }
2046      //eingefuegt wegen x2-y2z2+z3
2047
2048      for( ii=1; ii<=size(rw1); ii++ )
2049      {
2050         if( Le[4][ii]==0 )        //ii = index of var which was substituted
2051         {
2052            rw1[ii]=0;             //substituted vars have entry 0 in rw1
2053         }
2054      }
2055      Le=elimpart(endid);          //repeated application of elimpart
2056      q = q + size(Le[2]);
2057   }
2058   endphi = phi(endphi);
2059//---------- return -----------------------------------------------------------
2060// first the trivial case, where all variable have been eliminated
2061   if( nvars(newRing) == q )
2062   {
2063     ring lastRing = char(basering),T(1),dp;
2064     ideal endid = T(1);
2065     ideal endphi = T(1);
2066     for(ii=2; ii<=q; ii++ )
2067     {
2068        endphi[ii] = 0;
2069     }
2070     export(endid,endphi);
2071     list L = lastRing;
2072     setring newRing;
2073     return(L);
2074   }
2075
2076// in the homogeneous case put weights for the remaining vars correctly, i.e.
2077// delete from rw those weights for which the corresponding entry of rw1 is 0
2078
2079   if (homo==1 && nvars(newRing)-q >1 && size(endid) >0 )
2080   {
2081      jj=1;
2082      for( ii=2; ii<size(rw1); ii++)
2083      {
2084         jj++;
2085         if( rw1[ii]==0 )
2086         {
2087            rw=rw[1..jj-1],rw[jj+1..size(rw)];
2088            jj=jj-1;
2089         }
2090      }
2091      if( rw1[1]==0 ) { rw=rw[2..size(rw)]; }
2092      if( rw1[size(rw1)]==0 ){ rw=rw[1..size(rw)-1]; }
2093
2094      ring lastRing = char(basering),(T(1..nvars(newRing)-q)),(a(rw),dp);
2095   }
2096   else
2097   {
2098      ring lastRing = char(basering),(T(1..nvars(newRing)-q)),dp;
2099   }
2100   ideal lastmap;
2101   jj = 1;
2102
2103   for(ii=1; ii<=size(rw1); ii++ )
2104   {
2105      if ( rw1[ii]==1 ) { lastmap[ii] = T(jj); jj=jj+1; }
2106      if ( rw1[ii]==0 ) { lastmap[ii] = 0; }
2107   }
2108   map phi1 = newRing,lastmap;
2109   ideal endid  = phi1(endid);      //### bottelneck
2110   ideal endphi = phi1(endphi);
2111
2112/*
2113Versuch: subst statt phi
2114   for(ii=1; ii<=size(rw1); ii++ )
2115   {
2116      if ( rw1[ii]==1 ) { endid = subst(endid,var(ii),T(jj)); }
2117      if ( rw1[ii]==0 ) { endid = subst(endid,var(ii),0); }
2118   }
2119*/
2120   export(endid);
2121   export(endphi);
2122   list L = lastRing;
2123   setring newRing;
2124   return(L);
2125}
2126///////////////////////////////////////////////////////////////////////////////
2127static proc deltaP(ideal I)
2128{
2129   ASSUME(1, not isQuotientRing(basering) );
2130   def R=basering;
2131   int c,d,i;
2132   int n=nvars(R);
2133   list nor;
2134   if(size(I)>1){ERROR("no hypersurface");}
2135   ideal J=std(slocus(I));
2136   if(dim(J)<=0){return(0);}
2137   poly h;
2138   d=1;
2139   while((d)&&(i<n))
2140   {
2141      i++;
2142      h=var(i);
2143      d=dim(std(J+ideal(h)));
2144   }
2145   i=0;
2146   while(d)
2147   {
2148      i++;
2149      if(i>10){ERROR("delta not found, please inform the authors")};
2150      h=randomLast(100)[n];
2151      d=dim(std(J+ideal(h)));
2152   }
2153   I=I,h-1;
2154   if(char(R)<=19)
2155   {
2156      nor=normalP(I);
2157   }
2158   else
2159   {
2160      nor=normal(I);
2161   }
2162   return(nor[2][2]);
2163}
2164
2165proc genus(ideal I,list #)
2166"USAGE:   genus(I) or genus(I,<option>); I a 1-dimensional ideal over a perfect field
2167RETURN:  an integer, the geometric genus p_g = p_a - delta of the projective
2168         curve defined by i, where p_a is the arithmetic genus.
2169NOTE:    genus always treats projective curves and takes projective closure if input is affine 1-dim variety.
2170         delta is the sum of all local delta-invariants of the singularities,
2171         i.e. dim(R'/R), R' the normalization of the local ring R of the
2172         singularity. @*
2173         genus(I,"nor") uses the normalization to compute delta. Usually genus(I,"nor")
2174         is slower than genus(I) but sometimes not. @*
2175         genus(I,"pri") starts with a primary decompsition.
2176EXAMPLE: example genus; shows an example
2177"
2178{
2179   ASSUME(0, not isQuotientRing(basering) );
2180   if ( string(minpoly) !="0" )
2181   {
2182      ERROR("genus does not yet support extension fields");
2183   }
2184
2185   int w = printlevel-voice+2;  // w=printlevel (default: w=0)
2186
2187   int ono,rpr,ll;
2188   if(size(#)>0)
2189   {
2190     if(typeof(#[1])=="string")
2191     {
2192        if(#[1]=="nor"){ono=1;}
2193        if(#[1]=="pri"){rpr=1;}
2194     }
2195     else { ERROR("invalid option for genus");}
2196   }
2197   def R0=basering;
2198   if((char(basering)>0)||(ono))
2199   {
2200     def R1=changeord(list(list("dp",1:nvars(basering))));
2201     setring R1;
2202     ideal I=imap(R0,I);
2203     I=radical(I);
2204     I=std(I);
2205     if(dim(I)!=1)
2206     {
2207       if(((homog(I))&&(dim(I)!=2))||(!homog(I)))
2208       {
2209         ERROR("This is not a curve");
2210       }
2211     }
2212     if(homog(I)&&(dim(I)==2))
2213     {
2214       def S=R0;
2215       setring S;
2216       ideal J=I;
2217     }
2218     else
2219     {
2220       def S=changevar(varstr(R0)+",@t");
2221       setring S;
2222       ideal J=imap(R1,I);
2223       J=homog(J,@t);
2224       J=std(J);
2225     }
2226
2227     list LL=normal(J,"prim");
2228     int pa,i;
2229     for(i=1;i<=size(LL[1]);i++)
2230     {
2231        def T=LL[1][i];
2232        setring T;
2233        pa=pa-hilbPoly(std(norid))[1];
2234        setring S;
2235        kill T;
2236     }
2237     pa=pa+1;
2238     setring R0;
2239     return(pa);
2240   }
2241   if(rpr)
2242   {
2243      list LZ=minAssGTZ(I);
2244      if(size(LZ)>1)
2245      {
2246         int p_g;
2247         for(ll=1;ll<=size(LZ);ll++)
2248         {
2249            p_g=p_g+genus(LZ[ll],"pri")-1;
2250         }
2251         return(p_g+1);
2252      }
2253      else
2254      {
2255         I=LZ[1];
2256      }
2257   }
2258   else
2259   {
2260     I=radical(I);
2261   }
2262   I=std(I);
2263   if(dim(I)!=1)
2264   {
2265      if(((homog(I))&&(dim(I)!=2))||(!homog(I)))
2266      {
2267        // ERROR("This is not a curve");
2268        if(w==1){"** WARNING: Input does not define a curve **"; "";}
2269      }
2270   }
2271   list L=elimpart(I);
2272   if(size(L[2])!=0)
2273   {
2274      map psi=R0,L[5];
2275      I=std(psi(I));
2276   }
2277   if(size(I)==0)
2278   {
2279      return(0);
2280   }
2281   ideal N=variables(I);
2282   if(size(N)==1)
2283   {
2284      poly p=I[1];
2285     // if(deg(squarefree(p))<deg(p)){ERROR("Curve is not reduced");}
2286      return(-deg(p)+1);
2287   }
2288   if(size(N) < nvars(R0))
2289   {
2290     list newvar=N[1..ncols(N)];
2291     list @rl0=ringlist(R0);
2292     @rl0[2]=list(N[1..ncols(N)]);
2293     @rl0[3]=list(list("dp",1:ncols(N)),list("C",0));
2294     def R=ring(@rl0); kill @rl0;
2295     setring R;
2296     ideal I =imap(R0,I);
2297     list @rl0=ringlist(R0);
2298     if((@rl0[3][1][1]=="dp")&&(size(@rl0[3])==2))
2299     {
2300       attrib(I,"isSB",1);
2301     }
2302     else
2303     {
2304       I=std(I);
2305     }
2306     kill @rl0;
2307   }
2308   else
2309   {
2310     def R=changeord(list(list("dp",1:nvars(basering))));
2311     setring R;
2312     ideal I=imap(R0,I);
2313     I=std(I);
2314   }
2315   if(dim(I)==2)
2316   {
2317     def newR=basering;
2318   }
2319   else
2320   {
2321     list @rl0=ringlist(R0);
2322     if(dim(I)==0)
2323     {
2324       @rl0[2]=list("@s","@t");
2325       @rl0[3]=list(list("dp",1:2),list("C",0));
2326     }
2327     else
2328     {
2329       @rl0[2]=list("@s");
2330       @rl0[3]=list(list("dp",1),list("C",0));
2331     }
2332     def Rhelp=ring(@rl0);
2333     kill @rl0;
2334     def newR=R+Rhelp;
2335     setring newR;
2336     ideal I=imap(R,I);
2337     I=homog(I,@s);
2338     attrib(I,"isSB",1);
2339   }
2340
2341   if((nvars(basering)<=3)&&(size(I)>1))
2342   {
2343     ERROR("This is not equidimensional");
2344   }
2345
2346   intvec hp=hilbPoly(I);
2347   int p_a=1-hp[1];
2348   int d=hp[2];
2349
2350   if(w>=1)
2351   {
2352      "";"The ideal of the projective curve:";"";I;"";
2353      "The coefficients of the Hilbert polynomial";hp;
2354      "arithmetic genus:";p_a;
2355      "degree:";d;"";
2356   }
2357
2358   intvec v = hilb(I,1);
2359   int i,o;
2360   if(nvars(basering)>3)
2361   {
2362      map phi=newR,maxideal(1);
2363      int de;
2364      ideal K,L1;
2365      matrix M;
2366      poly m=var(4);
2367      poly he;
2368      for(i=5;i<=nvars(basering);i++){m=m*var(i);}
2369      K=eliminate(I,m,v);
2370      if(size(K)==1){de=deg(K[1]);}
2371      m=var(1);
2372      for(i=2;i<=nvars(basering)-3;i++){m=m*var(i);}
2373      i=0;
2374      while(d!=de)
2375      {
2376         o=1;
2377         i++;
2378         K=phi(I);
2379         K=eliminate(K,m,v);
2380         if(size(K)==1){de=deg(K[1]);}
2381         if((i==5)&&(d!=de))
2382         {
2383            K=reduce(equidimMax(I),I);
2384            if(size(K)!=0){ERROR("This is not equidimensional");}
2385         }
2386         if(i==10)
2387         {
2388            J;K;
2389            ERROR("genus: did not find a good projection for to
2390                           the plain");
2391         }
2392         if(i<5)
2393         {
2394            M=sparsetriag(nvars(newR),nvars(newR),80-5*i,i);
2395         }
2396         else
2397         {
2398            if(i<8)
2399            {
2400               M=transpose(sparsetriag(nvars(newR),nvars(newR),80-5*i,i));
2401            }
2402            else
2403            {
2404               he=0;
2405               while(he==0)
2406               {
2407                  M=randommat(nvars(newR),nvars(newR),ideal(1),20);
2408                  he=det(M);
2409               }
2410            }
2411         }
2412         L1=M*transpose(maxideal(1));
2413         phi=newR,L1;
2414      }
2415      I=K;
2416   }
2417   poly p=I[1];
2418
2419   execute("ring S=("+charstr(R)+"),(x,y,t),dp;");
2420   ideal L=maxideal(1);
2421   execute("ring C=("+charstr(R)+"),(x,y),ds;");
2422   ideal I;
2423   execute("ring A=("+charstr(R)+"),(x,t),dp;");
2424   map phi=S,1,x,t;
2425   map psi=S,x,1,t;
2426   poly g,h;
2427   ideal I,I1;
2428   execute("ring B=("+charstr(R)+"),(x,t),ds;");
2429
2430   setring S;
2431   if(o)
2432   {
2433     for(i=1;i<=nvars(newR)-3;i++){L[i]=0;}
2434     L=L,maxideal(1);
2435   }
2436   map sigma=newR,L;
2437   poly F=sigma(p);
2438   if(w>=1){"the projected curve:";"";F;"";}
2439
2440   kill newR;
2441
2442   int genus=(d-1)*(d-2) div 2;
2443   if(w>=1){"the arithmetic genus of the plane curve:";genus;pause();}
2444
2445   int delt,deltaloc,deltainf,tau,tauinf,cusps,iloc,iglob,l,nsing,
2446       tauloc,tausing,k,rat,nbranchinf,nbranch,nodes,cuspsinf,nodesinf;
2447   list inv;
2448
2449   if(w>=1)
2450     {"";"analyse the singularities at oo";"";"singular locus at (1,x,0):";"";}
2451   setring A;
2452   g=phi(F);
2453   h=psi(F);
2454   I=g,jacob(g),var(2);
2455   I=std(I);
2456   if(deg(I[1])>0)
2457   {
2458      list qr=minAssGTZ(I);
2459      if(w>=1){qr;"";}
2460
2461      for(k=1;k<=size(qr);k++)
2462      {
2463         if(w>=1){ nsing=nsing+vdim(std(qr[k]));}
2464         inv=deltaLoc(g,qr[k]);
2465         deltainf=deltainf+inv[1];
2466         tauinf=tauinf+inv[2];
2467         l=vdim(std(qr[k]));
2468         if(inv[2]==l){nodesinf=nodesinf+l;}
2469         if(inv[2]==2*l){cuspsinf=cuspsinf+l;}
2470         nbranchinf=nbranchinf+inv[3];
2471      }
2472   }
2473   else
2474   {
2475     if(w>=1){"            the curve is smooth at (1,x,0)";"";}
2476   }
2477   if(w>=1){"singular locus at (0,1,0):";"";}
2478   inv=deltaLoc(h,maxideal(1));
2479   if((w>=1)&&(inv[2]!=0)){ nsing++;}
2480   deltainf=deltainf+inv[1];
2481   tauinf=tauinf+inv[2];
2482   if(inv[2]==1){nodesinf++;}
2483   if(inv[2]==2){cuspsinf++;}
2484
2485   if((w>=1)&&(inv[2]==0)){"            the curve is smooth at (0,1,0)";"";}
2486   if(inv[2]>0){nbranchinf=nbranchinf+inv[3];}
2487
2488   if(w>=1)
2489   {
2490      if(tauinf==0)
2491      {
2492        "            the curve is smooth at oo";"";
2493      }
2494      else
2495      {
2496         "number of singularities at oo:";nsing;
2497         "nodes at oo:";nodesinf;
2498         "cusps at oo:";cuspsinf;
2499         "branches at oo:";nbranchinf;
2500         "Tjurina number at oo:";tauinf;
2501         "delta at oo:";deltainf;
2502         "Milnor number at oo:";2*deltainf-nbranchinf+nsing;
2503         pause();
2504      }
2505      "singularities at (x,y,1):";"";
2506   }
2507   execute("ring newR=("+charstr(R)+"),(x,y),dp;");
2508   //the singularities at the affine part
2509   map sigma=S,var(1),var(2),1;
2510   ideal I=sigma(F);
2511
2512   ideal I1=jacob(I);
2513   matrix Hess[2][2]=jacob(I1);
2514   ideal ID=I+I1+ideal(det(Hess));//singular locus of I+I1
2515
2516   ideal radID=std(radical(ID));//the non-nodal locus
2517   if(w>=1){"the non-nodal locus:";"";radID;pause();"";}
2518   if(deg(radID[1])==0)
2519   {
2520     ideal IDsing=1;
2521   }
2522   else
2523   {
2524     ideal IDsing=minor(jacob(ID),2)+radID;//singular locus of ID
2525   }
2526
2527   iglob=vdim(std(IDsing));
2528
2529   if(iglob!=0)//computation of the radical of IDsing
2530   {
2531      ideal radIDsing=reduce(IDsing,radID);
2532      if(size(radIDsing)==0)
2533      {
2534         radIDsing=radID;
2535         attrib(radIDsing,"isSB",1);
2536      }
2537      else
2538      {
2539         radIDsing=std(radical(IDsing));
2540      }
2541      iglob=vdim(radIDsing);
2542      if((w>=1)&&(iglob))
2543          {"the non-nodal-cuspidal locus:";radIDsing;pause();"";}
2544   }
2545   cusps=vdim(radID)-iglob;
2546   nsing=nsing+cusps;
2547
2548   if(iglob==0)
2549   {
2550      if(w>=1){"             there are only cusps and nodes";"";}
2551      tau=vdim(std(I+jacob(I)));
2552      tauinf=tauinf+tau;
2553      nodes=tau-2*cusps;
2554      delt=nodes+cusps;
2555      nbranch=2*tau-3*cusps;
2556      nsing=nsing+nodes;
2557   }
2558   else
2559   {
2560       if(w>=1){"the non-nodal-cuspidal singularities";"";}
2561       setring C;
2562       ideal I1=imap(newR,radIDsing);
2563       iloc=vdim(std(I1));
2564       if(iglob==iloc)
2565       {
2566          if(w>=1){"only cusps and nodes outside (0,0,1)";}
2567          setring newR;
2568          tau=vdim(std(I+jacob(I)));
2569          tauinf=tauinf+tau;
2570          inv=deltaLoc(I[1],maxideal(1));
2571          delt=inv[1];
2572          tauloc=inv[2];
2573          nodes=tau-tauloc-2*cusps;
2574          nsing=nsing+nodes;
2575          if (inv[2]!=0) { nsing++; }
2576          nbranch=inv[3]+ 2*nodes+cusps;
2577          delt=delt+nodes+cusps;
2578          if((w>=1)&&(inv[2]==0)){"smooth at (0,0,1)";}
2579        }
2580        else
2581        {
2582           setring newR;
2583           list pr=minAssGTZ(radIDsing);
2584           if(w>=1){pr;}
2585
2586           for(k=1;k<=size(pr);k++)
2587           {
2588              if(w>=1){nsing=nsing+vdim(std(pr[k]));}
2589              inv=deltaLoc(I[1],pr[k]);
2590              delt=delt+inv[1];
2591              tausing=tausing+inv[2];
2592              nbranch=nbranch+inv[3];
2593           }
2594           tau=vdim(std(I+jacob(I)));
2595           tauinf=tauinf+tau;
2596           nodes=tau-tausing-2*cusps;
2597           nsing=nsing+nodes;
2598           delt=delt+nodes+cusps;
2599           nbranch=nbranch+2*nodes+cusps;
2600        }
2601   }
2602   genus=genus-delt-deltainf;
2603   if(w>=1)
2604   {
2605      "The projected plane curve has locally:";"";
2606      "singularities:";nsing;
2607      "branches:";nbranch+nbranchinf;
2608      "nodes:"; nodes+nodesinf;
2609      "cusps:";cusps+cuspsinf;
2610      "Tjurina number:";tauinf;
2611      "Milnor number:";2*(delt+deltainf)-nbranch-nbranchinf+nsing;
2612      "delta of the projected curve:";delt+deltainf;
2613      "delta of the curve:";p_a-genus;
2614      "genus:";genus;
2615      "====================================================";
2616      "";
2617   }
2618   setring R0;
2619   return(genus);
2620}
2621example
2622{ "EXAMPLE:"; echo = 2;
2623   ring r=0,(x,y),dp;
2624   ideal i=y^9 - x^2*(x - 1)^9;
2625   genus(i);
2626   ring r7=7,(x,y),dp;
2627   ideal i=y^9 - x^2*(x - 1)^9;
2628   genus(i);
2629}
2630
2631///////////////////////////////////////////////////////////////////////////////
2632proc deltaLoc(poly f,ideal singL)
2633"USAGE:  deltaLoc(f,J);  f poly, J ideal
2634ASSUME: f is reduced bivariate polynomial; basering has exactly two variables;
2635        J is irreducible prime component of the singular locus of f (e.g., one
2636        entry of the output of @code{minAssGTZ(I);}, I = <f,jacob(f)>).
2637RETURN:  list L:
2638@texinfo
2639@table @asis
2640@item @code{L[1]}; int:
2641         the sum of (local) delta invariants of f at the (conjugated) singular
2642         points given by J.
2643@item @code{L[2]}; int:
2644         the sum of (local) Tjurina numbers of f at the (conjugated) singular
2645         points given by J.
2646@item @code{L[3]}; int:
2647         the sum of (local) number of branches of f at the (conjugated)
2648         singular points given by J.
2649@end table
2650@end texinfo
2651NOTE:    procedure makes use of @code{execute}; increasing printlevel displays
2652         more comments (default: printlevel=0).
2653SEE ALSO: delta, tjurina
2654KEYWORDS: delta invariant; Tjurina number
2655EXAMPLE: example deltaLoc;  shows an example
2656"
2657{
2658   ASSUME(0, not isQuotientRing(basering) );
2659
2660   intvec save_opt=option(get);
2661   option(redSB);
2662   def R=basering;
2663   list @rl=ringlist(R);
2664   @rl[2]=list("x","y");
2665   @rl[3]=list(list("lp",1:2),list("C",0));
2666   def S=ring(@rl); setring S;
2667   map phi=R,x,y;
2668   ideal singL=phi(singL);
2669   singL=simplify(std(singL),1);
2670   attrib(singL,"isSB",1);
2671   int d=vdim(singL);
2672   poly f=phi(f);
2673   int i;
2674   int w = printlevel-voice+2;  // w=printlevel (default: w=0)
2675   if(d==1)
2676   {
2677      map alpha=S,var(1)-singL[2][2],var(2)-singL[1][2];
2678      f=alpha(f);
2679      def C=changeordTo(S,"ds"); setring C;
2680      poly f=imap(S,f);
2681      ideal singL=imap(S,singL);
2682      if((w>=1)&&(ord(f)>=2))
2683      {
2684        "local analysis of the singularities";"";
2685        basering;
2686        singL;
2687        f;
2688        pause();
2689      }
2690   }
2691   else
2692   {
2693      poly p;
2694      poly c;
2695      map psi;
2696      number co;
2697
2698      while((deg(lead(singL[1]))>1)&&(deg(lead(singL[2]))>1))
2699      {
2700         psi=S,x,y+random(-100,100)*x;
2701         singL=psi(singL);
2702         singL=std(singL);
2703          f=psi(f);
2704      }
2705
2706      if(deg(lead(singL[2]))==1)
2707      {
2708         p=singL[1];
2709         c=singL[2]-lead(singL[2]);
2710         co=leadcoef(singL[2]);
2711      }
2712      if(deg(lead(singL[1]))==1)
2713      {
2714         psi=S,y,x;
2715         f=psi(f);
2716         singL=psi(singL);
2717         p=singL[2];
2718         c=singL[1]-lead(singL[1]);
2719         co=leadcoef(singL[1]);
2720      }
2721
2722      execute("ring B=("+charstr(S)+"),a,dp;");
2723      map beta=S,a,a;
2724      poly p=beta(p);
2725
2726      execute("ring C=("+charstr(S)+",a),(x,y),ds;");
2727      number p=number(imap(B,p));
2728
2729      minpoly=p;
2730      map iota=S,a,a;
2731      number c=number(iota(c));
2732      number co=iota(co);
2733
2734      map alpha=S,x-c/co,y+a;
2735      poly f=alpha(f);
2736      f=cleardenom(f);
2737      if((w>=1)&&(ord(f)>=2))
2738      {
2739        "local analysis of the singularities";"";
2740        basering;
2741        alpha;
2742        f;
2743        pause();
2744        "";
2745      }
2746   }
2747   option(noredSB);
2748   ideal fstd=std(ideal(f)+jacob(f));
2749   poly hc=highcorner(fstd);
2750   int tau=vdim(fstd);
2751   int o=ord(f);
2752   int delt,nb;
2753
2754   if(tau==0)                 //smooth case
2755   {
2756      setring R;
2757      option(set,save_opt);
2758      return(list(0,0,1));
2759   }
2760   if((char(basering)>=181)||(char(basering)==0))
2761   {
2762      if(o==2)                //A_k-singularity
2763      {
2764        if(w>=1){"A_k-singularity";"";}
2765         setring R;
2766         delt=(tau+1) div 2;
2767         option(set,save_opt);
2768         return(list(d*delt,d*tau,d*(2*delt-tau+1)));
2769      }
2770      if((lead(f)==var(1)*var(2)^2)||(lead(f)==var(1)^2*var(2)))
2771      {
2772        if(w>=1){"D_k- singularity";"";}
2773
2774         setring R;
2775         delt=(tau+2) div 2;
2776         option(set,save_opt);
2777         return(list(d*delt,d*tau,d*(2*delt-tau+1)));
2778      }
2779
2780      int mu=vdim(std(jacob(f)));
2781
2782      poly g=f+var(1)^mu+var(2)^mu;  //to obtain a convenient Newton-polygon
2783
2784      list NP=newtonpoly(g);
2785      if(w>=1){"Newton-Polygon:";NP;"";}
2786      int s=size(NP);
2787
2788      if(is_NND(f,mu,NP))
2789      { // the Newton-polygon is non-degenerate
2790        // compute nb, the number of branches
2791        for(i=1;i<=s-1;i++)
2792        {
2793          nb=nb+gcd(NP[i][2]-NP[i+1][2],NP[i][1]-NP[i+1][1]);
2794        }
2795        if(w>=1){"Newton-Polygon is non-degenerated";"";}
2796        setring R;
2797        option(set,save_opt);
2798        return(list(d*(mu+nb-1) div 2,d*tau,d*nb));
2799      }
2800
2801      if(w>=1){"Newton-Polygon is degenerated";"";}
2802/* need to re-consider the degree bound (de):
2803      // the following can certainly be made more efficient when replacing
2804      // 'hnexpansion' (used only for computing number of branches) by
2805      // successive blowing-up + test if Newton polygon degenerate:
2806      if(s>2)    //  splitting of f
2807      {
2808         if(w>=1){"Newton polygon can be used for splitting";"";}
2809         intvec v=NP[1][2]-NP[2][2],NP[2][1];
2810         int de=w_deg(g,v);
2811         //int st=w_deg(hc,v)+v[1]+v[2];
2812         int st=w_deg(var(1)^NP[size(NP)][1],v)+1;
2813         poly f1=var(2)^NP[2][2];
2814         poly f2=jet(g,de,v)/var(2)^NP[2][2];
2815         poly h=g-f1*f2;
2816         de=w_deg(h,v);
2817         poly k;
2818         ideal wi=var(2)^NP[2][2],f2;
2819         matrix li;
2820         while(de<st)
2821         {
2822           k=jet(h,de,v);
2823           li=lift(wi,k);
2824           f1=f1+li[2,1];
2825           f2=f2+li[1,1];
2826           h=g-f1*f2;
2827           de=w_deg(h,v);
2828         }
2829         nb=deltaLoc(f1,maxideal(1))[3]+deltaLoc(f2,maxideal(1))[3];
2830
2831         setring R;
2832         option(set,save_opt);
2833         return(list(d*(mu+nb-1) div 2,d*tau,d*nb));
2834      }
2835*/
2836      f=jet(f,deg(hc)+2);
2837      if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";}
2838      ideal fac=factorize(f,1);
2839      if(size(fac)>1)
2840      {
2841         nb=0;
2842         for(i=1;i<=size(fac);i++)
2843         {
2844            nb=nb+deltaLoc(fac[i],maxideal(1))[3];
2845         }
2846         setring R;
2847         option(set,save_opt);
2848         return(list(d*(mu+nb-1) div 2,d*tau,d*nb));
2849      }
2850      list HNEXP=hnexpansion(f);
2851      if (typeof(HNEXP[1])=="ring")
2852      {
2853        def altring = basering;
2854        def HNEring = HNEXP[1]; setring HNEring;
2855        nb=size(hne);
2856        setring R;
2857        kill HNEring;
2858      }
2859      else
2860      {
2861        nb=size(HNEXP);
2862      }
2863      setring R;
2864      option(set,save_opt);
2865      return(list(d*(mu+nb-1) div 2,d*tau,d*nb));
2866   }
2867   else             //the case of small characteristic
2868   {
2869      f=jet(f,deg(hc)+2);
2870      if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";}
2871      delt=delta(f);
2872      setring R;
2873      option(set,save_opt);
2874      return(list(d*delt,d*tau,d));
2875   }
2876   option(set,save_opt);
2877}
2878example
2879{ "EXAMPLE:"; echo = 2;
2880  ring r=0,(x,y),dp;
2881  poly f=(x2+y^2-1)^3 +27x2y2;
2882  ideal I=f,jacob(f);
2883  I=std(I);
2884  list qr=minAssGTZ(I);
2885  size(qr);
2886  // each component of the singular locus either describes a cusp or a pair
2887  // of conjugated nodes:
2888  deltaLoc(f,qr[1]);
2889  deltaLoc(f,qr[2]);
2890  deltaLoc(f,qr[3]);
2891  deltaLoc(f,qr[4]);
2892  deltaLoc(f,qr[5]);
2893  deltaLoc(f,qr[6]);
2894}
2895///////////////////////////////////////////////////////////////////////////////
2896// compute the weighted degree of p;
2897// this code is an exact copy of the proc in paraplanecurves.lib
2898// (since we do not want to make it non-static)
2899static proc w_deg(poly p, intvec v)
2900{
2901   if(p==0){return(-1);}
2902   int d=0;
2903   while(jet(p,d,v)==0){d++;}
2904   d=(transpose(leadexp(jet(p,d,v)))*v)[1];
2905   return(d);
2906}
2907
2908//proc hilbPoly(ideal J)
2909//{
2910//   poly hp;
2911//   int i;
2912//   if(!attrib(J,"isSB")){J=std(J);}
2913//   intvec v = hilb(J,2);
2914//   for(i=1; i<=size(v); i++){ hp=hp+v[i]*(var(1)-i+2);}
2915//   return(hp);
2916//}
2917
2918
2919//////////////////////////////////////////////////////////////////////////////
2920
2921proc primeClosure (list L, list #)
2922"USAGE:    primeClosure(L [,c]); L a list of a ring containing a prime ideal
2923          ker, c an optional integer
2924RETURN:   a list L (of size n+1) consisting of rings L[1],...,L[n] such that
2925          - L[1] is a copy of (not a reference to!) the input ring L[1]
2926          - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi
2927            such that
2928                    L[1]/ker --> ... --> L[n]/ker
2929            are injections given by the corresponding ideals phi, and L[n]/ker
2930            is the integral closure of L[1]/ker in its quotient field.
2931          - all rings L[i] contain a polynomial nzd such that elements of
2932            L[i]/ker are quotients of elements of L[i-1]/ker with denominator
2933            nzd via the injection phi.
2934            L[n+1] is the delta invariant
2935NOTE:     - L is constructed by recursive calls of primeClosure itself.
2936          - c determines the choice of nzd:
2937               - c not given or equal to 0: first generator of the ideal SL,
2938                 the singular locus of Spec(L[i]/ker)
2939               - c<>0: the generator of SL with least number of monomials.
2940EXAMPLE:  example primeClosure; shows an example
2941"
2942{
2943  //---- Start with a consistency check:
2944
2945  if (!(typeof(L[1])=="ring"))
2946  {
2947      "// Parameter must be a ring or a list containing a ring!";
2948      return(-1);
2949  }
2950
2951  int dblvl = printlevel-voice+2;
2952  list gnirlist = ringlist(basering);
2953
2954  //---- Some auxiliary variables:
2955  int delt;                      //finally the delta invariant
2956  if ( size(L) == 1 )
2957  {
2958      L[2] = delt;              //set delta to 0
2959  }
2960  int n = size(L)-1;            //L without delta invariant
2961
2962  //---- How to choose the non-zerodivisor later on?
2963
2964  int nzdoption=0;
2965  if (size(#)>0)
2966  {
2967      nzdoption=#[1];
2968  }
2969
2970// R0 below is the ring to work with, if we are in step one, make a copy of the
2971// input ring, so that all objects are created in the copy, not in the original
2972// ring (therefore a copy, not a reference is defined).
2973
2974  if (n==1)
2975  {
2976      def R = L[1];
2977      list Rlist = ringlist(R);
2978      def BAS = basering;
2979      setring R;
2980      if (!(typeof(ker)=="ideal"))
2981      {
2982          "// No ideal ker in the input ring!";
2983          return (-1);
2984      }
2985      ker=simplify(interred(ker),15);
2986      //execute ("ring R0="+charstr(R)+",("+varstr(R)+"),("+ordstr(R)+");");
2987      // Rlist may be not defined in this new ring, so we define it again.
2988      list Rlist2 = ringlist(R);
2989      def R0 = ring(Rlist2);
2990      setring R0;
2991      ideal ker=fetch(R,ker);
2992      // check whether we compute the normalization of the blow up of
2993      // an isolated singularity at the origin (checked in normalI)
2994
2995      if (typeof(attrib(L[1],"iso_sing_Rees"))=="int")
2996      {
2997        attrib(R0,"iso_sing_Rees",attrib(L[1],"iso_sing_Rees"));
2998      }
2999      L[1]=R0;
3000  }
3001  else
3002  {
3003      def R0 = L[n];
3004      setring R0;
3005  }
3006
3007// In order to apply HomJJ from normal.lib, we need the radical of the singular
3008// locus of ker, J:=rad(ker):
3009
3010   list SM=mstd(ker);
3011
3012// In the first iteration, we have to compute the singular locus "from
3013// scratch".
3014// In further iterations, we can fetch it from the previous one but
3015// have to compute its radical
3016// the next rings R1 contain already the (fetched) ideal
3017
3018  if (n==1)                              //we are in R0=L[1]
3019  {
3020      if (typeof(attrib(R0,"iso_sing_Rees"))=="int")
3021      {
3022        ideal J;
3023        for (int s=1;s<=attrib(R0,"iso_sing_Rees");s++)
3024        {
3025          J=J,var(s);
3026        }
3027        J = J,SM[2];
3028        list JM = mstd(J);
3029      }
3030      else
3031      {
3032        if ( dblvl >= 1 )
3033        {"";
3034           "// compute the singular locus";
3035        }
3036        //### Berechnung des singulaeren Orts geaendert (ist so schneller)
3037        ideal J = minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]);
3038        J = J,SM[2];
3039        list JM = mstd(J);
3040      }
3041
3042      if ( dblvl >= 1 )
3043      {"";
3044         "// dimension of singular locus is", dim(JM[1]);
3045         if (  dblvl >= 2 )
3046         {"";
3047            "// the singular locus is:"; JM[2];
3048         }
3049      }
3050
3051      if ( dblvl >= 1 )
3052      {"";
3053         "// compute radical of singular locus";
3054      }
3055
3056      J = simplify(radical(JM[2]),2);
3057      if ( dblvl >= 1 )
3058      {"";
3059         "// radical of singular locus is:"; J;
3060         pause();
3061      }
3062  }
3063  else
3064  {
3065      if ( dblvl >= 1 )
3066      {"";
3067         "// compute radical of test ideal in ideal of singular locus";
3068      }
3069      J = simplify(radical(J),2);
3070      if ( dblvl >= 1 )
3071      {"";
3072         "// radical of test ideal is:"; J;
3073         pause();
3074      }
3075  }
3076
3077  // having computed the radical J of/in the ideal of the singular locus,
3078  // we now need to pick an element nzd of J;
3079  // NOTE: nzd must be a non-zero divisor mod ker, i.e. not contained in ker
3080
3081  poly nzd = J[1];
3082  poly nzd1 = NF(nzd,SM[1]);
3083  if (nzd1 != 0)
3084  {
3085     if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) )
3086     {
3087        nzd = nzd1;
3088     }
3089  }
3090
3091  if (nzdoption || nzd1==0)
3092  {
3093    for (int ii=2;ii<=ncols(J);ii++)
3094    {
3095      nzd1 = NF(J[ii],SM[1]);
3096      if ( nzd1 != 0 )
3097      {
3098        if ( (deg(nzd)>=deg(J[ii])) && (size(nzd)>size(J[ii])) )
3099        {
3100          nzd=J[ii];
3101        }
3102        if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) )
3103        {
3104          nzd = nzd1;
3105        }
3106      }
3107    }
3108  }
3109
3110  export nzd;
3111  // In this case we do not eliminate variables, so that the maps
3112  // are well defined.
3113  list RR = SM[1],SM[2],J,nzd,1;
3114
3115  if ( dblvl >= 1 )
3116  {"";
3117     "// compute the first ring extension:";
3118     "RR: ";
3119     RR;
3120  }
3121
3122  list RS = HomJJ(RR);
3123  //NOTE: HomJJ creates new ring with variables X(i) and T(j)
3124//-------------------------------------------------------------------------
3125// If we've reached the integral closure (as determined by the result of
3126// HomJJ), then we are done, otherwise we have to prepare the next iteration.
3127
3128  if (RS[2]==1)     // we've reached the integral closure, we are still in R0
3129    {
3130      kill J;
3131      if ( n== 1)
3132      {
3133        def R1 = RS[1];
3134        setring R1;
3135        ideal norid, normap = endid, endphi;
3136        kill endid,  endphi;
3137
3138        //"//### case: primeClosure, final";
3139        //"size norid:", size(norid), size(string(norid));
3140        //"interred:";
3141        //norid = interred(norid);
3142        //"size norid:", size(norid), size(string(norid));
3143
3144        export (norid, normap);
3145        L[1] = R1;
3146      }
3147      return(L);
3148    }
3149  else                        // prepare the next iteration
3150    {
3151      if (n==1)               // In the first iteration: keep only the data
3152      {                       // needed later on.
3153         kill RR,SM;
3154         export(ker);
3155      }
3156      if ( dblvl >= 1 )
3157      {"";
3158         "// computing the next ring extension, we are in loop"; n+1;
3159      }
3160
3161      def R1 = RS[1];         // The data of the next ring R1:
3162      delt = RS[3];           // the delta invariant of the ring extension
3163      setring R1;             // keep only what is necessary and kill
3164      ideal ker=endid;        // everything else.
3165      export(ker);
3166      ideal norid=endid;
3167
3168      //"//### case: primeClosure, loop", n+1;
3169      //"size norid:", size(norid), size(string(norid));
3170      //"interred:";
3171      //norid = interred(norid);        //????
3172      //"size norid:", size(norid), size(string(norid));
3173
3174      export(norid);
3175      kill endid;
3176
3177      map phi = R0,endphi;                        // fetch the singular locus
3178      ideal J = mstd(simplify(phi(J)+ker,4))[2];  // ideal J in R1
3179      export(J);
3180      if(n>1)
3181      {
3182         ideal normap=phi(normap);
3183      }
3184      else
3185      {
3186         ideal normap=endphi;
3187      }
3188      export(normap);
3189      kill phi;              // we save phi as ideal, not as map, so that
3190      ideal phi=endphi;      // we have more flexibility in the ring names
3191      kill endphi;           // later on.
3192      export(phi);
3193      L=insert(L,R1,n);       // Add the new ring R1 and go on with the
3194                              // next iteration
3195      if ( L[size(L)] >= 0 && delt >= 0 )
3196      {
3197         delt = L[size(L)] + delt;
3198      }
3199      else
3200      {
3201         delt = -1;
3202      }
3203      L[size(L)] = delt;
3204
3205      if (size(#)>0)
3206      {
3207          return (primeClosure(L,#));
3208      }
3209      else
3210      {
3211          return(primeClosure(L));         // next iteration.
3212      }
3213    }
3214}
3215example
3216{
3217  "EXAMPLE:"; echo=2;
3218  ring R=0,(x,y),dp;
3219  ideal I=x4,y4;
3220  def K=ReesAlgebra(I)[1];        // K contains ker such that K/ker=R[It]
3221  list L=primeClosure(K);
3222  def R(1)=L[1];                  // L[4] contains ker, L[4]/ker is the
3223  def R(4)=L[4];                  // integral closure of L[1]/ker
3224  setring R(1);
3225  R(1);
3226  ker;
3227  setring R(4);
3228  R(4);
3229  ker;
3230}
3231
3232///////////////////////////////////////////////////////////////////////////////
3233
3234proc closureFrac(list L)
3235"USAGE:    closureFrac (L); L a list of size n+1 as in the result of
3236          primeClosure, L[n] contains an additional polynomial f
3237CREATE:   a list fraction of two elements of L[1], such that
3238          f=fraction[1]/fraction[2] via the injections phi L[i]-->L[i+1].
3239EXAMPLE:  example closureFrac; shows an example
3240"
3241{
3242// Define some auxiliary variables:
3243
3244  int n=size(L)-1;
3245  int i,j,k,l,n2,n3;
3246  intvec V;
3247  string mapstr;
3248  for (i=1; i<=n; i++)
3249  {
3250    ASSUME(0, not isQuotientRing( L[i] ) );
3251    def R(i) = L[i];
3252  }
3253
3254// The quotient representing f is computed as in 'closureGenerators' with
3255// the differences that
3256//   - the loop is done twice: for the numerator and for the denominator;
3257//   - the result is stored in the list fraction and
3258//   - we have to make sure that no more objects of the rings R(i) survive.
3259
3260  for (j=1; j<=2; j++)
3261    {
3262      setring R(n);
3263      if (j==1)
3264      {
3265         poly p=f;
3266      }
3267      else
3268      {
3269         p=1;
3270      }
3271
3272      for (k=n; k>1; k--)
3273      {
3274          if (j==1)
3275          {
3276             map phimap=R(k-1),phi;
3277          }
3278
3279          p=p*phimap(nzd);
3280
3281          if (j==2)
3282          {
3283            kill phimap;
3284          }
3285
3286          if (j==1)
3287          {
3288             //### noch abfragen ob Z(i) definiert ist
3289             list gnirlist = ringlist(R(k));
3290             n2 = size(gnirlist[2]);
3291             n3 = size(gnirlist[3]);
3292             for( i=1; i<=ncols(phi); i++)
3293             {
3294               gnirlist[2][n2+i] = "Z("+string(i)+")";
3295             }
3296             V=0;
3297             V[ncols(phi)]=0; V=V+1;
3298             gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1);
3299             def S(k) = ring(gnirlist);
3300             setring S(k);
3301
3302             //execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+",
3303             //          Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k)))
3304             //          +"),dp("+string(ncols(phi))+"));");
3305
3306              ideal phi = imap(R(k),phi);
3307              ideal J = imap (R(k),ker);
3308              for (l=1;l<=ncols(phi);l++)
3309              {
3310                  J=J+(Z(l)-phi[l]);
3311              }
3312              J=groebner(J);
3313              poly h=NF(imap(R(k),p),J);
3314          }
3315          else
3316          {
3317              setring S(k);
3318              h=NF(imap(R(k),p),J);
3319              setring R(k);
3320              kill p;
3321          }
3322
3323          setring R(k-1);
3324
3325          if (j==1)
3326          {
3327              ideal maxi;
3328              maxi[nvars(R(k))] = 0;
3329              maxi = maxi,maxideal(1);
3330              map backmap = S(k),maxi;
3331
3332              //mapstr=" map backmap = S(k),";
3333              //for (l=1;l<=nvars(R(k));l++)
3334              //{
3335              //  mapstr=mapstr+"0,";
3336              //}
3337              //execute (mapstr+"maxideal(1);");
3338              poly p;
3339          }
3340          p=NF(backmap(h),std(ker));
3341          if (j==2)
3342          {
3343            kill backmap;
3344          }
3345        }
3346
3347      if (j==1)
3348        {
3349          if (defined(fraction))
3350            {
3351              kill fraction;
3352              list fraction=p;
3353            }
3354          else
3355            {
3356              list fraction=p;
3357            }
3358        }
3359      else
3360        {
3361          fraction=insert(fraction,p,1);
3362        }
3363    }
3364  export(fraction);
3365  return ();
3366}
3367example
3368{
3369  "EXAMPLE:"; echo=2;
3370  ring R=0,(x,y),dp;
3371  ideal ker=x2+y2;
3372  export ker;
3373  list L=primeClosure(R);          // We normalize R/ker
3374  for (int i=1;i<=size(L);i++) { def R(i)=L[i]; }
3375  setring R(2);
3376  kill R;
3377  phi;                             // The map R(1)-->R(2)
3378  poly f=T(2);                     // We will get a representation of f
3379  export f;
3380  L[2]=R(2);
3381  closureFrac(L);
3382  setring R(1);
3383  kill R(2);
3384  fraction;                        // f=fraction[1]/fraction[2] via phi
3385  kill R(1);
3386}
3387
3388///////////////////////////////////////////////////////////////////////////////
3389// closureGenerators is called inside proc normal (option "withGens" )
3390//
3391
3392// INPUT is the output of proc primeClosure (except for the last element, the
3393// delta invariant) : hence input is a list L consisting of rings
3394// L[1],...,L[n] (denoted R(1)...R(n) below) such that
3395// - L[1] is a copy of (not a reference to!) the input ring L[1]
3396// - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi
3397// such that
3398//                L[1]/ker --> ... --> L[n]/ker
3399// are injections given by the corresponding ideals phi, and L[n]/ker
3400// is the integral closure of L[1]/ker in its quotient field.
3401// - all rings L[i] contain a polynomial nzd such that elements of
3402// L[i]/ker are quotients of elements of L[i-1]/ker with denominator
3403// nzd via the injection phi.
3404
3405// COMPUTE: In the list L of rings R(1),...,R(n), compute representations of
3406// the ring variables of the last ring R(n) as fractions of elements of R(1):
3407// The proc returns an ideal preim s.t. preim[i]/preim[size(preim)] expresses
3408// the ith variable of R(n) as fraction of elements of the basering R(1)
3409// preim[size(preim)] is a non-zero divisor of basering/i.
3410
3411proc closureGenerators(list L);
3412{
3413  def Rees=basering;         // when called inside normalI (in reesclos.lib)
3414                             // the Rees Algebra is the current basering
3415
3416  // ------- First of all we need some variable declarations -----------
3417  int n = size(L);                // the number of rings R(1)-->...-->R(n)
3418  int length = nvars(L[n]);       // the number of variables of the last ring
3419  int j,k,l,n2,n3;
3420  intvec V;
3421  string mapstr;
3422  list preimages;
3423  //Note: the empty list belongs to no ring, hence preimages can be used
3424  //later in R(1)
3425  //this is not possible for ideals (belong always to some ring)
3426
3427  for (int i=1; i<=n; i++)
3428  {
3429     ASSUME(0, not isQuotientRing(L[i]) );
3430     def R(i) = L[i];          //give the rings from L a name
3431  }
3432
3433  // For each variable (counter j) and for each intermediate ring (counter k):
3434  // Find a preimage of var_j*phi(nzd(k-1)) in R(k-1).
3435  // Finally, do the same for nzd.
3436
3437  for (j=1; j <= length+1; j++ )
3438  {
3439      setring R(n);
3440
3441      if (j==1)
3442      {
3443        poly p;
3444      }
3445      if (j <= length )
3446      {
3447        p=var(j);
3448      }
3449      else
3450      {
3451        p=1;
3452      }
3453      //i.e. p=j-th var of R(n) for j<=length and p=1 for j=length+1
3454
3455      for (k=n; k>1; k--)
3456      {
3457
3458        if (j==1)
3459        {
3460          map phimap=R(k-1),phi;   //phimap:R(k-1)-->R(n), k=2..n, is the map
3461                                   //belonging to phi in R(n)
3462        }
3463
3464        p = p*phimap(nzd);
3465
3466          // Compute the preimage of [p mod ker(k)] under phi in R(k-1):
3467          // As p is an element of Image(phi), there is a polynomial h such
3468          // that h is mapped to [p mod ker(k)], and h can be computed as the
3469          // normal form of p w.r.t. a Groebner basis of
3470          // J(k) := <ker(k),Z(l)-phi(k)(l)> in R(k)[Z]=:S(k)
3471
3472        if (j==1)   // In the first iteration: Create S(k), fetch phi and
3473                    // ker(k) and construct the ideal J(k).
3474        {
3475         //### noch abfragen ob Z(i) definiert ist
3476         list gnirlist = ringlist(R(k));
3477         n2 = size(gnirlist[2]);
3478         n3 = size(gnirlist[3]);
3479         for( i=1; i<=ncols(phi); i++)
3480         {
3481            gnirlist[2][n2+i] = "Z("+string(i)+")";
3482         }
3483         V=0;
3484         V[ncols(phi)]=0;
3485         V=V+1;
3486         gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1);
3487         def S(k) = ring(gnirlist);
3488         setring S(k);
3489
3490        // execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+",
3491        //           Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k)))
3492        //           +"),dp("+string(ncols(phi))+"));");
3493
3494          ideal phi = imap(R(k),phi);
3495          ideal J = imap (R(k),ker);
3496          for ( l=1; l<=ncols(phi); l++ )
3497          {
3498             J=J+(Z(l)-phi[l]);
3499          }
3500          J = groebner(J);
3501          poly h = NF(imap(R(k),p),J);
3502        }
3503        else
3504        {
3505           setring S(k);
3506           h = NF(imap(R(k),p),J);
3507        }
3508
3509        setring R(k-1);
3510
3511        if (j==1)  // In the first iteration: Compute backmap:S(k)-->R(k-1)
3512        {
3513           ideal maxi;
3514           maxi[nvars(R(k))] = 0;
3515           maxi = maxi,maxideal(1);
3516           map backmap = S(k),maxi;
3517
3518           //mapstr=" map backmap = S(k),";
3519           //for (l=1;l<=nvars(R(k));l++)
3520           //{
3521           //  mapstr=mapstr+"0,";
3522           //}
3523           //execute (mapstr+"maxideal(1);");
3524
3525           poly p;
3526        }
3527        p = NF(backmap(h),std(ker));
3528     }
3529     // Whe are down to R(1), store here the result in the list preimages
3530     preimages = insert(preimages,p,j-1);
3531  }
3532  ideal preim;                  //make the list preimages to an ideal preim
3533  for ( i=1; i<=size(preimages); i++ )
3534  {
3535     preim[i] = preimages[i];
3536  }
3537  // R(1) was a copy of Rees, so we have to get back to the basering Rees from
3538  // the beginning and fetch the result (the ideal preim) to this ring.
3539  setring Rees;
3540  return (fetch(R(1),preim));
3541}
3542
3543///////////////////////////////////////////////////////////////////////////////
3544//                From here: procedures for char p with Frobenius
3545///////////////////////////////////////////////////////////////////////////////
3546
3547proc normalP(ideal id,list #)
3548"USAGE:  normalP(id [,choose]); id = radical ideal, choose = optional list of
3549         strings.
3550         Optional parameters in list choose (can be entered in any order):@*
3551         \"withRing\", \"isPrim\", \"noFac\", \"noRed\", where@*
3552         - \"noFac\" -> factorization is avoided during the computation
3553         of the minimal associated primes.@*
3554         - \"isPrim\" -> assumes that the ideal is prime. If the assumption
3555         does not hold, output might be wrong.@*
3556         - \"withRing\" -> the ring structure of the normalization is
3557         computed. The number of variables in the new ring is reduced as much
3558         as possible.@*
3559         - \"noRed\" -> when computing the ring structure, no reduction on the
3560         number of variables is done, it creates one new variable for every
3561         new module generator of the integral closure in the quotient field.@*
3562ASSUME:  The characteristic of the ground field must be positive. If the
3563         option \"isPrim\" is not set, the minimal associated primes of id
3564         are computed first and hence normalP computes the normalization of
3565         the radical of id. If option \"isPrim\" is set, the ideal must be
3566         a prime ideal otherwise the result may be wrong.
3567RETURN:  a list, say 'nor' of size 2 (resp. 3 if \"withRing\" is set).@*
3568         ** If option \"withRing\" is not set: @*
3569         Only the module structure is computed: @*
3570         * nor[1] is a list of ideals Ii, i=1..r, in the basering R where r
3571         is the number of minimal associated prime ideals P_i of the input
3572         ideal id, describing the module structure:@*
3573         If Ii is given by polynomials g_1,...,g_k in R, then c:=g_k is
3574         non-zero in the ring R/P_i and g_1/c,...,g_k/c generate the integral
3575         closure of R/P_i as R-module in the quotient field of R/P_i.@*
3576         * nor[2] shows the delta invariants: it is a list of an intvec
3577         of size r, the delta invariants of the r components, and an integer,
3578         the total delta invariant of R/id
3579         (-1 means infinite, and 0 that R/P_i resp. R/id is normal). @*
3580         ** If option \"withRing\" is set: @*
3581         The ring structure is also computed, and in this case:@*
3582         * nor[1] is a list of r rings.@*
3583         Each ring Ri = nor[1][i], i=1..r, contains two ideals with given
3584         names @code{norid} and @code{normap} such that @*
3585         - Ri/norid is the normalization of R/P_i, i.e. isomorphic as
3586           K-algebra (K the ground field) to the integral closure of R/P_i in
3587           the field of fractions of R/P_i; @*
3588         - the direct sum of the rings Ri/norid is the normalization
3589           of R/id; @*
3590         - @code{normap} gives the normalization map from R to Ri/norid.@*
3591         * nor[2] gives the module generators of the normalization of R/P_i,
3592         it is the same as nor[1] if \"withRing\" is not set.@*
3593         * nor[3] shows the delta invariants, it is the same as nor[2] if
3594         \"withRing\" is not set.
3595THEORY:  normalP uses the Leonard-Pellikaan-Singh-Swanson algorithm (using the
3596         Frobenius) cf. [A. K. Singh, I. Swanson: An algorithm for computing
3597         the integral closure, arXiv:0901.0871].
3598         The delta invariant of a reduced ring A is dim_K(normalization(A)/A).
3599         For A=K[x1,...,xn]/id we call this number also the delta invariant of
3600         id. The procedure returns the delta invariants of the components P_i
3601         and of id.
3602NOTE:    To use the i-th ring type: @code{def R=nor[1][i]; setring R;}.
3603@*       Increasing/decreasing printlevel displays more/less comments
3604         (default: printlevel = 0).
3605@*       Not implemented for local or mixed orderings or quotient rings.
3606         For local or mixed orderings use proc 'normal'.
3607@*       If the input ideal id is weighted homogeneous a weighted ordering may
3608         be used (qhweight(id); computes weights).
3609@*       Works only in characteristic p > 0; use proc normal in char 0.
3610KEYWORDS: normalization; integral closure; delta invariant.
3611SEE ALSO: normal, normalC
3612EXAMPLE: example normalP; shows an example
3613"
3614{
3615   ASSUME(0, not isQuotientRing(basering) );
3616
3617   int i,j,y, sr, del, co;
3618   intvec deli;
3619   list resu, Resu, prim, Gens, mstdid;
3620   ideal gens;
3621
3622   // Default options
3623   int wring = 0;           // The ring structure is not computed.
3624   int noRed = 0;           // No reduction is done in the ring structure
3625   int isPrim = 0;          // Ideal is not assumed to be prime
3626   int noFac = 0;           // Use facstd when computing the decomposition
3627
3628
3629   y = printlevel-voice+2;
3630
3631   if ( attrib(basering,"global") != 1)
3632   {
3633     "";
3634     "// Not implemented for this ordering,";
3635     "// please change to global ordering!";
3636     return(resu);
3637   }
3638   if ( char(basering) <= 0)
3639   {
3640     "";
3641     "// Algorithm works only in positive characteristic,";
3642     "// use procedure 'normal' if the characteristic is 0";
3643     return(resu);
3644   }
3645
3646//--------------------------- define the method ---------------------------
3647   string method;                //make all options one string in order to use
3648                                 //all combinations of options simultaneously
3649   for ( i=1; i<= size(#); i++ )
3650   {
3651     if ( typeof(#[i]) == "string" )
3652     {
3653       method = method + #[i];
3654     }
3655   }
3656
3657   if ( find(method,"withring") or find(method,"withRing") )
3658   {
3659     wring=1;
3660   }
3661   if ( find(method,"noRed") or find(method,"nored") )
3662   {
3663     noRed=1;
3664   }
3665   if ( find(method,"isPrim") or find(method,"isprim") )
3666   {
3667     isPrim=1;
3668   }
3669   if ( find(method,"noFac") or find(method,"nofac"))
3670   {
3671     noFac=1;
3672   }
3673
3674   // check for 0-ideal
3675   if (size(id)==0)
3676   {
3677     list result=list(ideal(1)),list(intvec(0),int(0));
3678     // delta invariant,total delta invariant
3679     if (wring)
3680     {
3681       result[3]=result[2]; // pair(delta invariants , total delta invariant)
3682       result[2]=result[1];
3683       def BR = basering;
3684       list rl = ringlist(basering);
3685       def rng = ring(rl);
3686       setring rng;
3687       ideal norid = 0;
3688       ideal normap = maxideal(1);
3689       export(norid);
3690       export(normap);
3691       setring BR;
3692       result[1] = list(rng);
3693     }
3694     return (result);
3695   }
3696
3697   kill #;
3698   list #;
3699//--------------------------- start computation ---------------------------
3700   ideal II,K1,K2;
3701
3702   //----------- check first (or ignore) if input id is prime -------------
3703
3704   if ( isPrim )
3705   {
3706      prim[1] = id;
3707      if( y >= 0 )
3708      { "";
3709    "// ** WARNING: result is correct if ideal is prime (not checked) **";
3710    "// disable option \"isPrim\" to decompose ideal into prime components";"";
3711      }
3712   }
3713   else
3714   {
3715      if(y>=1)
3716      {  "// compute minimal associated primes"; }
3717
3718      if( noFac )
3719      { prim = minAssGTZ(id,1); }
3720      else
3721      { prim = minAssGTZ(id); }
3722
3723      if(y>=1)
3724      {
3725         prim;"";
3726         "// number of irreducible components is", size(prim);
3727      }
3728   }
3729
3730   //----------- compute integral closure for every component -------------
3731
3732      for(i=1; i<=size(prim); i++)
3733      {
3734         if(y>=1)
3735         {
3736            ""; pause(); "";
3737            "// start computation of component",i;
3738            "   --------------------------------";
3739         }
3740         if(y>=1)
3741         {  "// compute SB of ideal";
3742         }
3743         mstdid = mstd(prim[i]);
3744         if(y>=1)
3745         {  "// dimension of component is", dim(mstdid[1]);"";}
3746
3747      //------- 1-st main subprocedure: compute module generators ----------
3748         printlevel = printlevel+1;
3749         II = normalityTest(mstdid);
3750
3751      //------ compute also the ringstructure if "withRing" is given -------
3752         if ( wring )
3753         {
3754         //------ 2-nd main subprocedure: compute ring structure -----------
3755           if(noRed == 0){
3756             resu = list(computeRing(II,prim[i])) + resu;
3757           }
3758           else
3759           {
3760             resu = list(computeRing(II,prim[i], "noRed")) + resu;
3761           }
3762         }
3763         printlevel = printlevel-1;
3764
3765      //----- rearrange module generators s.t. denominator comes last ------
3766         gens=0;
3767         for( j=2; j<=size(II); j++ )
3768         {
3769            gens[j-1]=II[j];
3770         }
3771         gens[size(gens)+1]=II[1];
3772         Gens = list(gens) + Gens;
3773      //------------------------------ compute delta -----------------------
3774         K1 = mstdid[1]+II;
3775         K1 = std(K1);
3776         K2 = mstdid[1]+II[1];
3777         K2 = std(K2);
3778         // K1 = std(mstdid[1],II);      //### besser
3779         // K2 = std(mstdid[1],II[1]);   //### besser: Hannes, fixen!
3780         co = codim(K1,K2);
3781         deli = co,deli;
3782         if ( co >= 0 && del >= 0 )
3783         {
3784            del = del + co;
3785         }
3786         else
3787         { del = -1; }
3788      }
3789
3790      if ( del >= 0 )
3791      {
3792         int mul = iMult(prim);
3793         del = del + mul;
3794      }
3795      else
3796      { del = -1; }
3797
3798      deli = deli[1..size(deli)-1];
3799      if ( wring )
3800      { Resu = resu,Gens,list(deli,del); }
3801      else
3802      { Resu = Gens,list(deli,del); }
3803
3804   sr = size(prim);
3805
3806//-------------------- Finally print comments and return --------------------
3807   if(y >= 0)
3808   {"";
3809     if ( wring )
3810     {
3811"// 'normalP' created a list, say nor, of three lists:
3812// To see the result, type
3813     nor;
3814
3815// * nor[1] is a list of",sr,"ring(s):
3816// To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g.
3817     def R1 = nor[1][1]; setring R1;  norid; normap;
3818// for the other rings type first setring R; (if R is the name of your
3819// original basering) and then continue as for R1;
3820// Ri/norid is the affine algebra of the normalization of the i-th
3821// component R/P_i (where P_i is a min. associated prime of the input ideal)
3822// and normap the normalization map from R to Ri/norid;
3823
3824// * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of
3825// elements g1..gk of r such that the gj/gk generate the integral
3826// closure of R/P_i as R-module in the quotient field of R/P_i.
3827
3828// * nor[3] shows the delta-invariant of each component and of the input
3829// ideal (-1 means infinite, and 0 that r/P_i is normal).";
3830     }
3831     else
3832     {
3833"// 'normalP' computed a list, say nor, of two lists:
3834// To see the result, type
3835     nor;
3836
3837// * nor[1] is a list of",sr,"ideal(s), where each ideal nor[1][i] consists
3838// of elements g1..gk of the basering R such that gj/gk generate the integral
3839// closure of R/P_i (where P_i is a min. associated prime of the input ideal)
3840// as R-module in the quotient field of R/P_i;
3841
3842// * nor[2] shows the delta-invariant of each component and of the input ideal
3843// (-1 means infinite, and 0 that R/P_i is normal).";
3844     }
3845   }
3846
3847   return(Resu);
3848}
3849example
3850{ "EXAMPLE:"; echo = 2;
3851   ring r  = 11,(x,y,z),wp(2,1,2);
3852   ideal i = x*(z3 - xy4 + x2);
3853   list nor= normalP(i); nor;
3854   //the result says that both components of i are normal, but i itself
3855   //has infinite delta
3856   pause("hit return to continue");
3857
3858   ring s = 2,(x,y),dp;
3859   ideal i = y*((x-y^2)^2 - x^3);
3860   list nor = normalP(i,"withRing"); nor;
3861
3862   def R2  = nor[1][2]; setring R2;
3863   norid; normap;
3864}
3865
3866///////////////////////////////////////////////////////////////////////////////
3867// Assume: mstdid is the result of mstd(prim[i]), prim[i] a prime component of
3868// the input ideal id of normalP.
3869// Output is an ideal U s.t. U[i]/U[1] are module generators.
3870
3871static proc normalityTest(list mstdid)
3872{
3873   ASSUME(1, not isQuotientRing(basering) );
3874
3875   int y = printlevel-voice+2;
3876   intvec op = option(get);
3877   option(redSB);
3878   def R = basering;
3879   int n, p = nvars(R), char(R);
3880   int ii;
3881
3882   ideal J = mstdid[1];         //J is the SB of I
3883   if (J[1]==1) { return(ideal(0));}
3884   ideal I = mstdid[2];
3885   int h = n-dim(J);            //codimension of V(I), I is a prime ideal
3886
3887   //-------------------------- compute singular locus ----------------------
3888   qring Q = J;                 //pass to quotient ring
3889   ideal I = imap(R,I);
3890   ideal J = imap(R,J);
3891   attrib(J,"isSB",1);
3892   if ( y >= 1)
3893   { "start normality test";  "compute singular locus";}
3894
3895   ideal M = minor(jacob(I),h,J); //use the command minor modulo J (hence J=0)
3896   M = std(M);                    //this makes M much smaller
3897   //keep only minors which are not 0 mod I (!) this is important since we
3898   //need a nzd mod I
3899
3900   //---------------- choose nzd from ideal of singular locus --------------
3901   ideal D = M[1];
3902   for( ii=2; ii<=size(M); ii++ )            //look for the shortest one
3903   {
3904      if( size(M[ii]) < size(D[1]) )
3905      {
3906          D = M[ii];
3907      }
3908   }
3909
3910   //--------------- start p-th power algorithm and return ----------------
3911   ideal F = var(1)^p;
3912   for(ii=2; ii<=n; ii++)
3913   {
3914      F=F,var(ii)^p;
3915   }
3916
3917   ideal Dp=D^(p-1);
3918   ideal U=1;
3919   ideal K,L;
3920   map phi=Q,F;
3921   if ( y >= 1)
3922   {  "compute module generators of integral closure";
3923      "denominator D is:";  D;
3924      pause();
3925   }
3926
3927   ii=0;
3928   list LK;
3929   while(1)
3930   {
3931      ii=ii+1;
3932      if ( y >= 1)
3933      { "iteration", ii; }
3934      L = U*Dp + I;
3935      //### L=interred(L) oder mstd(L)[2]?
3936      //Wird dadurch kleiner aber string(L) wird groesser
3937      K = preimage(Q,phi,L);    //### Improvement by block ordering?
3938      option(returnSB);
3939      K = intersect(U,K);          //K is the new U, it is a SB
3940      LK = mstd(K);
3941      K = LK[2];
3942
3943   //---------------------------- simplify output --------------------------
3944      if(size(reduce(U,LK[1]))==0)  //previous U coincides with new U
3945      {                             //i.e. we reached the integral closure
3946         U=simplify(reduce(U,groebner(D)),2);
3947         U = D,U;
3948         poly gg = gcd(U[1],U[size(U)]);
3949         for(ii=2; ii<=size(U)-1 ;ii++)
3950         {
3951            gg = gcd(gg,U[ii]);
3952         }
3953         for(ii=1; ii<=size(U); ii++)
3954         {
3955            U[ii]=U[ii]/gg;
3956         }
3957         U = simplify(U,6);
3958         //if ( y >= 1)
3959         //{ "module generators are U[i]/U[1], with U:"; U;
3960         //  ""; pause(); }
3961         setring R;
3962         option(set,op);
3963         ideal U = imap(Q,U);
3964         return(U);
3965      }
3966      U=K;
3967   }
3968}
3969
3970///////////////////////////////////////////////////////////////////////////////
3971
3972static proc substpartSpecial(ideal endid, ideal endphi)
3973{
3974   ASSUME(1, not isQuotientRing(basering) );
3975
3976   //Note: newRing is of the form (R the original basering):
3977   //char(R),(T(1..N),X(1..nvars(R))),(dp(N),...);
3978
3979   int ii,jj,kk;
3980   def BAS = basering;
3981   int n = nvars(basering);
3982
3983   list Le = elimpart(endid);
3984   int q = size(Le[2]);                   //q variables have been substituted
3985//Le;"";
3986   if ( q == 0 )
3987   {
3988      ideal normap = endphi;
3989      ideal norid = endid;
3990      export(norid);
3991      export(normap);
3992      list L = BAS;
3993      return(L);
3994   }
3995
3996      list gnirlist = ringlist(basering);
3997      endid = Le[1];
3998//endphi;"";
3999      for( ii=1; ii<=n; ii++)
4000      {
4001         if( Le[4][ii] == 0 )            //ii=index of substituted var
4002         {
4003            endphi = subst(endphi,var(ii),Le[5][ii]);
4004         }
4005      }
4006//endphi;"";
4007      list g2 = gnirlist[2];             //the varlist
4008      list g3 = gnirlist[3];             //contains blocks of orderings
4009      int n3 = size(g3);
4010
4011   //----------------- first identify module ordering ------------------
4012      if ( g3[n3][1]== "c" or g3[n3][1] == "C" )
4013      {
4014         list gm = g3[n3];              //last blockis module ordering
4015         g3 = delete(g3,n3);
4016         int m = 0;
4017      }
4018      else
4019      {
4020         list gm = g3[1];              //first block is module ordering
4021         g3 = delete(g3,1);
4022         int m = 1;
4023      }
4024   //---- delete variables which were substituted and weights  --------
4025      intvec V;
4026      int n(0);
4027      list newg2;
4028      list newg3;
4029      for ( ii=1; ii<=n3-1; ii++ )
4030      {
4031        // If order is a matrix ordering, it is replaced by dp ordering.
4032        // TODO: replace it only when some of the original
4033        //       variables are eliminated.
4034        if(g3[ii][1] == "M"){
4035          g3[ii][1] = "dp";
4036          g3[ii][2] = (1..sqroot(size(g3[ii][2])))*0+1;
4037        }
4038        V = V,g3[ii][2];           //copy weights for ordering in each block
4039        if ( ii==1 )               //into one intvector
4040        {
4041           V = V[2..size(V)];
4042        }
4043        // int n(ii) = size(g3[ii][2]);
4044        int n(ii) = size(V);
4045        intvec V(ii);
4046
4047        for ( jj = n(ii-1)+1; jj<=n(ii); jj++)
4048        {
4049          if(  Le[4][jj] !=0 or                                             // jj=index of var which was not substituted
4050               (  (ii==n3-1) and ( jj==n(ii) ) and  (size(newg2)==0) )      // or we have no variables yet in the new ring and
4051                                                                            // want to keep at least the last one!
4052            )
4053          {
4054            kk=kk+1;
4055            newg2[kk] = g2[jj];   //not substituted var from varlist
4056            V(ii)=V(ii),V[jj];    //weight of not substituted variable
4057          }
4058        }
4059        if ( size(V(ii)) >= 2 )
4060        {
4061           V(ii) = V(ii)[2..size(V(ii))];
4062           list g3(ii)=g3[ii][1],V(ii);
4063           newg3 = insert(newg3,g3(ii),size(newg3));
4064//"newg3"; newg3;
4065        }
4066      }
4067//"newg3"; newg3;
4068      //newg3 = delete(newg3,1);    //delete empty list
4069
4070/*
4071//### neue Ordnung, 1 Block fuer alle vars, aber Gewichte erhalten;
4072//vorerst nicht realisiert, da bei leonhard1 alte Version (neue Variable T(i)
4073//ein neuer Block) ein kuerzeres Ergebnis liefert
4074      kill g3;
4075      list g3;
4076      V=0;
4077      for ( ii= 1; ii<=n3-1; ii++ )
4078      {
4079        V=V,V(ii);
4080      }
4081      V = V[2..size(V)];
4082
4083      if ( V==1 )
4084      {
4085         g3[1] = list("dp",V);
4086      }
4087      else
4088      {
4089         g3[1] = lis("wp",V);
4090      }
4091      newg3 = g3;
4092
4093//"newg3";newg3;"";
4094//### Ende neue Ordnung
4095*/
4096
4097      if ( m == 0 )
4098      {
4099         newg3 = insert(newg3,gm,size(newg3));
4100      }
4101      else
4102      {
4103         newg3 = insert(newg3,gm);
4104      }
4105      gnirlist[2] = newg2;
4106      gnirlist[3] = newg3;
4107
4108//gnirlist;
4109      def newBAS = ring(gnirlist);            //change of ring to less vars
4110      setring newBAS;
4111      ideal normap = imap(BAS,endphi);
4112      //normap = simplify(normap,2);
4113      ideal norid =  imap(BAS,endid);
4114      export(norid);
4115      export(normap);
4116      list L = newBAS;
4117      setring BAS;
4118      return(L);
4119
4120   //Hier scheint interred gut zu sein, da es Ergebnis relativ schnell
4121   //verkleinert. Hier wird z.B. bei leonard1 size(norid) verkleinert aber
4122   //size(string(norid)) stark vergroessert, aber es hat keine Auswirkungen
4123   //da keine map mehr folgt.
4124   //### Bei Leonard2 haengt interred (BUG)
4125   //mstd[2] verkleinert norid nocheinmal um die Haelfte, dauert aber 3.71 sec
4126   //### Ev. Hinweis auf mstd in der Hilfe?
4127
4128}
4129
4130///////////////////////////////////////////////////////////////////////////////
4131// Computes the ring structure of a ring given by module generators.
4132// Assume: J[i]/J[1] are the module generators in the quotient field
4133// with J[1] as universal denominator.
4134// If option "noRed" is not given, a reduction in the number of variables is
4135// attempted.
4136static proc computeRing(ideal J, ideal I, list #)
4137{
4138  ASSUME(1, not isQuotientRing(basering) );
4139
4140  int i, ii,jj;
4141  intvec V;                          // to be used for variable weights
4142  int y = printlevel-voice+2;
4143  def R = basering;
4144  poly c = J[1];                     // the denominator
4145  list gnirlist = ringlist(basering);
4146  string svars = varstr(basering);
4147  int nva = nvars(basering);
4148  string svar;
4149  ideal maxid = maxideal(1);
4150
4151  int noRed = 0;     // By default, we try to reduce the number of generators.
4152  if(size(#) > 0){
4153    if ( typeof(#[1]) == "string" )
4154    {
4155      if (#[1] == "noRed"){noRed = 1;}
4156    }
4157  }
4158
4159  if ( y >= 1){"// computing the ring structure...";}
4160
4161  if(c==1)
4162  {
4163/*    if( defined(norid) )  { kill norid; }
4164      if( defined(normap) ) { kill normap; }
4165      ideal norid = I;
4166      ideal normap =  maxid;  */
4167
4168    def R1 = ring(gnirlist);
4169    setring R1;
4170    ideal norid = imap(R, I);
4171    ideal normap = imap(R, maxid);
4172
4173
4174    if(noRed == 1){
4175      export norid;
4176      export normap;
4177      setring R;
4178      return(R1);
4179    }
4180    else
4181    {
4182      list L = substpartSpecial(norid,normap);
4183      def lastRing = L[1];
4184      setring R;
4185      return(lastRing);
4186    }
4187  }
4188
4189
4190  //-------------- Enlarge ring by creating new variables ------------------
4191  //check first whether variables T(i) and then whether Z(i),...,A(i) exist
4192  //old variable names are not touched
4193
4194  if ( find(svars,"T(") == 0 )
4195  {
4196    svar = "T";
4197  }
4198  else
4199  {
4200    for (ii=90; ii>=65; ii--)
4201    {
4202      if ( find(svars,ASCII(ii)+"(") == 0 )
4203      {
4204        svar = ASCII(ii);  break;
4205      }
4206    }
4207  }
4208
4209  int q = size(J)-1;
4210  if ( size(svar) != 0 )
4211  {
4212    for ( ii=q; ii>=1; ii-- )
4213    {
4214      gnirlist[2] = insert(gnirlist[2],svar+"("+string(ii)+")");
4215    }
4216  }
4217  else
4218  {
4219    for ( ii=q; ii>=1; ii-- )
4220    {
4221      gnirlist[2] = insert(gnirlist[2],"T("+string(100*nva+ii)+")");
4222    }
4223  }
4224
4225  V[q]=0;                        //create intvec of variable weights
4226  V=V+1;
4227  gnirlist[3] = insert(gnirlist[3],list("dp",V));
4228
4229  //this is a block ordering with one dp-block (1st block) for new vars
4230  //the remaining weights and blocks for old vars are kept
4231  //### perhaps better to make only one block, keeping weights ?
4232  //this might effect syz below
4233  //alt: ring newR = char(R),(X(1..nvars(R)),T(1..q)),dp;
4234  //Reihenfolge geaendert:neue Variablen kommen zuerst, Namen ev. nicht T(i)
4235
4236  def newR = ring(gnirlist);
4237  setring newR;                //new extended ring
4238  ideal I = imap(R,I);
4239
4240  //------------- Compute linear and quadratic relations ---------------
4241  if(y>=1)
4242  {
4243     "// compute linear relations:";
4244  }
4245  qring newQ = std(I);
4246
4247  ideal f = imap(R,J);
4248  module syzf = syz(f);
4249  ideal pf = f[1]*f;
4250  //f[1] is the denominator D from normalityTest, a non zero divisor of R/I
4251
4252  ideal newT = maxideal(1);
4253  newT = 1,newT[1..q];
4254  //matrix T = matrix(ideal(1,T(1..q)),1,q+1);   //alt
4255  matrix T = matrix(newT,1,q+1);
4256  ideal Lin = ideal(T*syzf);
4257  //Lin=interred(Lin);
4258  //### interred reduziert ev size aber size(string(LIN)) wird groesser
4259
4260  if(y>=1)
4261  {
4262    if(y>=3)
4263    {
4264      "//   the linear relations:";  Lin; pause();"";
4265    }
4266      "// the ring structure of the normalization as affine algebra";
4267      "//   number of linear relations:", size(Lin);
4268  }
4269
4270  if(y>=1)
4271  {
4272    "// compute quadratic relations:";
4273  }
4274  matrix A;
4275  ideal Quad;
4276  poly ff;
4277  newT = newT[2..size(newT)];
4278  matrix u;  // The units for non-global orderings.
4279
4280  // Quadratic relations
4281  for (ii=2; ii<=q+1; ii++ )
4282  {
4283    for ( jj=2; jj<=ii; jj++ )
4284    {
4285      ff = NF(f[ii]*f[jj],std(0));     // this makes lift much faster
4286      // For non-global orderings, we have to take care of the units.
4287      if(attrib(basering,"global") != 1)
4288      {
4289        A = lift(pf, ff, u);
4290        Quad = Quad,ideal(newT[jj-1]*newT[ii-1] * u[1, 1]- T*A);
4291      }
4292      else
4293      {
4294        A = lift(pf,ff);              // ff lin. comb. of elts of pf mod I
4295        Quad = Quad,ideal(newT[jj-1]*newT[ii-1] - T*A);
4296      }
4297      //A = lift(pf, f[ii]*f[jj]);
4298      //Quad = Quad, ideal(T(jj-1)*T(ii-1) - T*A);
4299    }
4300  }
4301  Quad = Quad[2..ncols(Quad)];
4302
4303  if(y>=1)
4304  {
4305    if(y>=3)
4306    {
4307      "//   the quadratic relations"; Quad; pause();"";
4308    }
4309      "//   number of quadratic relations:", size(Quad);
4310  }
4311  ideal Q1 = Lin,Quad;     //elements of Q1 are in NF w.r.t. I
4312
4313  //Q1 = mstd(Q1)[2];
4314  //### weglassen, ist sehr zeitaufwendig.
4315  //Ebenso interred, z.B. bei Leonard1 (1. Komponente von Leonard):
4316  //"size Q1:", size(Q1), size(string(Q1));   //75 60083
4317  //Q1 = interred(Q1);
4318  //"size Q1:", size(Q1), size(string(Q1));   //73 231956 (!)
4319  //### Speicherueberlauf bei substpartSpecial bei 'ideal norid  = phi1(endid)'
4320  //Beispiel fuer Hans um map zu testen!
4321
4322  setring newR;
4323  ideal endid  = imap(newQ,Q1),I;
4324  ideal endphi = imap(R,maxid);
4325
4326  if(noRed == 0){
4327    list L=substpartSpecial(endid,endphi);
4328    def lastRing=L[1];
4329    if(y>=1)
4330    {
4331      "//   number of substituted variables:", nvars(newR)-nvars(lastRing);
4332      pause();"";
4333    }
4334    setring R;
4335    return(lastRing);
4336  }
4337  else
4338  {
4339    ideal norid = endid;
4340    ideal normap = endphi;
4341    export(norid);
4342    export(normap);
4343    setring R;
4344    return(newR);
4345  }
4346}
4347
4348//                Up to here: procedures for char p with Frobenius
4349///////////////////////////////////////////////////////////////////////////////
4350
4351///////////////////////////////////////////////////////////////////////////////
4352//                From here: subprocedures for normal
4353
4354// inputJ is used in parametrization of rational curves algorithms, to specify
4355// a different test ideal.
4356
4357static proc normalM(ideal I, int decomp, int withDelta, int denomOption, ideal inputJ, ideal inputC){
4358// Computes the normalization of a ring R / I using the module structure as far
4359// as possible.
4360// The ring R is the basering.
4361// Input: ideal I
4362// Output: a list of 3 elements (resp 4 if withDelta = 1), say nor.
4363// - nor[1] = U, an ideal of R.
4364// - nor[2] = c, an element of R.
4365// U and c satisfy that 1/c * U is the normalization of R / I in the
4366// quotient field Q(R/I).
4367// - nor[3] = ring say T, containing two ideals norid and normap such that
4368// normap gives the normalization map from R / I to T / norid.
4369// - nor[4] = the delta invariant, if withDelta = 1.
4370
4371// Details:
4372// --------
4373// Computes the ideal of the minors in the first step and then reuses it in all
4374// steps.
4375// In step s, the denominator is D^s, where D is a nzd of the original quotient
4376// ring, contained in the radical of the singular locus.
4377// This denominator is used except when the degree of D^i is greater than the
4378// degree of a universal denominator.
4379// The nzd is taken as the smallest degree polynomial in the radical of the
4380// singular locus.
4381
4382// It assumes that the ideal I is equidimensional radical. This is not checked
4383// in the procedure!
4384// If decomp = 0 or decomp = 3 it assumes further that I is prime. Therefore
4385// any non-zero element in the jacobian ideal is assumed to be a
4386// non-zerodivisor.
4387
4388// It works over the given basering.
4389// If it has a non-global ordering, it changes it to dp global only for
4390// computing radical.
4391
4392// The delta invariant is only computed if withDelta = 1, and decomp = 0 or
4393// decomp = 3 (meaning that the ideal is prime).
4394
4395// denomOption = 0      -> Uses the smallest degree polynomial
4396// denomOption = i > 0  -> Uses a polynomial in the i-th variable
4397
4398  ASSUME(1, not isQuotientRing(basering) );
4399
4400  intvec save_opt=option(get);
4401  option(redSB);
4402  option(returnSB);
4403  int step = 0;                       // Number of steps. (for debugging)
4404  int dbg = printlevel - voice + 2;   // dbg = printlevel (default: dbg = 0)
4405  int i;                              // counter
4406  int isGlobal = attrib(basering,"global");
4407
4408  poly c;                     // The common denominator.
4409
4410  def R = basering;
4411
4412//------------------------ Groebner bases and dimension of I-----------------
4413  if(isGlobal == 1)
4414  {
4415    list IM = mstd(I);
4416    I = IM[1];
4417    ideal IMin = IM[2];   // A minimal set of generators in the groebner basis.
4418  }
4419  else
4420  {
4421    // The minimal set of generators is not computed by mstd for
4422    // non-global orderings.
4423    I = groebner(I);
4424    ideal IMin = I;
4425  }
4426  int d = dim(I);
4427
4428  // ---------------- computation of the singular locus ---------------------
4429  // We compute the radical of the ideal of minors modulo the original ideal.
4430  // This is done only in the first step.
4431  qring Q = I;   // We work in the quotient by the groebner base of the ideal I
4432  option(redSB);
4433  option(returnSB);
4434
4435  // If a conductor ideal was given as input, we use it instead of the
4436  // singular locus. If a test ideal was given as input, we do not compute the
4437  // singular locus.
4438  ideal inputC = fetch(R, inputC);
4439  ideal inputJ = fetch(R, inputJ);
4440  if((size(inputC) == 0) && (size(inputJ) == 0))
4441  {
4442    // We compute the radical of the ideal of minors modulo the original ideal.
4443    // This is done only in the first step.
4444    ideal I = fetch(R, I);
4445    attrib(I, "isSB", 1);
4446    ideal IMin = fetch(R, IMin);
4447
4448    dbprint(dbg, "Computing the jacobian ideal...");
4449
4450    // If a given conductor ideal is given, we use it.
4451    // If a given test ideal is given, we don't need to compute the jacobian
4452
4453    // reduction mod I in 'minor' is not working for local orderings!
4454    if(attrib(basering,"global"))
4455    {
4456      ideal J = minor(jacob(IMin), nvars(basering) - d, I);
4457    }
4458    else
4459    {
4460      ideal J = minor(jacob(IMin), nvars(basering) - d);
4461      J = reduce(J, groebner(I));
4462    }
4463    J = groebner(J);
4464  }
4465  else
4466  {
4467    ideal J = fetch(R, inputC);
4468    J = groebner(J);
4469  }
4470
4471  //------------------ We check if the singular locus is empty -------------
4472  if(J[1] == 1)
4473  {
4474    // The original ring R/I was normal. Nothing to do.
4475    // We define anyway a new ring, equal to R, to be able to return it.
4476    setring R;
4477    list lR = ringlist(R);
4478    def ROut = ring(lR);
4479    setring ROut;
4480    ideal norid = fetch(R, I);
4481    ideal normap = maxideal(1);
4482    export norid;
4483    export normap;
4484    setring R;
4485    if(withDelta)
4486    {
4487      list output = ideal(1), poly(1), ROut, 0;
4488    }
4489    else
4490    {
4491      list output = ideal(1), poly(1), ROut;
4492    }
4493    option(set,save_opt);
4494    return(list(output));
4495  }
4496
4497
4498  // -------------------- election of the universal denominator----------------
4499  // We first check if a conductor ideal was computed. If not, we don't
4500  // compute a universal denominator.
4501  ideal Id1;
4502  if(size(J) != 0)
4503  {
4504    if(denomOption == 0)
4505    {
4506      poly condu = getSmallest(J);   // Choses the polynomial of smallest degree
4507                                     // of J as universal denominator.
4508    }
4509    else
4510    {
4511      poly condu = getOneVar(J, denomOption);
4512    }
4513    if(dbg >= 1)
4514    {
4515      "";
4516      "The universal denominator is ", condu;
4517    }
4518
4519    // ----- splitting the ideal by the universal denominator (if possible) -----
4520    // If the ideal is equidimensional, but not necessarily prime, we check if
4521    // the universal denominator is a non-zerodivisor of R/I.
4522    // If not, we split I.
4523    if((decomp == 1) or (decomp == 2))
4524    {
4525      Id1 = quotient(0, condu);
4526      if(size(Id1) > 0)
4527      {
4528        // We have to split.
4529        if(dbg >= 1)
4530        {
4531          "A zerodivisor was found. We split the ideal. The zerodivisor is ", condu;
4532        }
4533        setring R;
4534        ideal Id1 = fetch(Q, Id1), I;
4535        Id1 = groebner(Id1);
4536        ideal Id2 = quotient(I, Id1);
4537        // I = I1 \cap I2
4538        printlevel = printlevel + 1;
4539        ideal JDefault = 0; // Now it uses the default J;
4540        list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault);
4541        list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault);
4542        printlevel = printlevel - 1;
4543        option(set,save_opt);
4544        list res = nor1 + nor2;
4545        return(res);
4546      }
4547    }
4548  }
4549  else
4550  {
4551    poly condu = 0;
4552  }
4553
4554  // --------------- computation of the first test ideal ---------------------
4555  // To compute the radical we go back to the original ring.
4556  // If we are using a non-global ordering, we must change to the global
4557  // ordering.
4558  setring R;
4559  // If a test ideal is given at the input, we use it.
4560  if(size(inputJ) == 0)
4561  {
4562    if(isGlobal == 1)
4563    {
4564      ideal J = fetch(Q, J);
4565      J = J, I;
4566      if(dbg >= 1)
4567      {
4568        "The original singular locus is";
4569        groebner(J);
4570        if(dbg >= 2){pause();}
4571        "";
4572      }
4573      // We check if the only singular point is the origin.
4574      // If so, the radical is the maximal ideal at the origin.
4575      J = groebner(J);
4576      if(locAtZero(J))
4577      {
4578        J = maxideal(1);
4579      }
4580      else
4581      {
4582        J = radical(J);
4583      }
4584    }
4585    else
4586    {
4587      // We change to global dp ordering.
4588      list rl = ringlist(R);
4589      list origOrd = rl[3];
4590      list newOrd = list("dp", intvec(1:nvars(R))), list("C", 0);
4591      rl[3] = newOrd;
4592      def globR = ring(rl);
4593      setring globR;
4594      ideal J = fetch(Q, J);
4595      ideal I = fetch(R, I);
4596      J = J, I;
4597      if(dbg >= 1)
4598      {
4599        "The original singular locus is";
4600        groebner(J);
4601        if(dbg>=2){pause();}
4602        "";
4603      }
4604      J = radical(J);
4605      setring R;
4606      ideal J = fetch(globR, J);
4607    }
4608  }
4609  else
4610  {
4611    ideal J = inputJ;
4612  }
4613
4614  if(dbg >= 1)
4615  {
4616    "The radical of the original singular locus is";
4617    J;
4618    if(dbg>=2){pause();}
4619  }
4620
4621  // ---------------- election of the non zero divisor ---------------------
4622  setring Q;
4623  J = fetch(R, J);
4624  J = interred(J);
4625  if(denomOption == 0)
4626  {
4627    poly D = getSmallest(J);    // Chooses the polynomial of smallest degree as
4628                                // non-zerodivisor.
4629  }
4630  else
4631  {
4632    poly D = getOneVar(J, denomOption);
4633  }
4634  if(dbg >= 1)
4635  {
4636    "The non zero divisor is ", D;
4637    "";
4638  }
4639
4640  // ------- splitting the ideal by the non-zerodivisor (if possible) --------
4641  // If the ideal is equidimensional, but not necessarily prime, we check if D
4642  // is actually a non-zerodivisor of R/I.
4643  // If not, we split I.
4644  if((decomp == 1) or (decomp == 2))
4645  {
4646    // We check if D is actually a non-zerodivisor of R/I.
4647    // If not, we split I.
4648    Id1 = quotient(0, D);
4649    if(size(Id1) > 0)
4650    {
4651      // We have to split.
4652      if(dbg >= 1)
4653      {
4654        "A zerodivisor was found. We split the ideal. The zerodivisor is ", D;
4655      }
4656      setring R;
4657      ideal Id1 = fetch(Q, Id1), I;
4658      Id1 = groebner(Id1);
4659      ideal Id2 = quotient(I, Id1);
4660      // I = Id1 \cap Id2
4661      printlevel = printlevel + 1;
4662
4663      ideal JDefault = 0;  // Now it uses the default J;
4664      list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault);
4665      list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault);
4666      printlevel = printlevel - 1;
4667      option(set,save_opt);
4668      list res = nor1 + nor2;
4669      return(res);
4670    }
4671  }
4672
4673  // --------------------- normalization ------------------------------------
4674  // We call normalMEqui to compute the normalization.
4675  setring R;
4676  poly D = fetch(Q, D);
4677  poly condu = fetch(Q, condu);
4678  J = fetch(Q, J);
4679  printlevel = printlevel + 1;
4680  list result = normalMEqui(I, J, condu, D, withDelta, denomOption);
4681  printlevel = printlevel - 1;
4682  option(set,save_opt);
4683  return(list(result));
4684}
4685
4686///////////////////////////////////////////////////////////////////////////////
4687
4688static proc normalMEqui(ideal I, ideal origJ, poly condu, poly D, int withDelta)
4689// Here is where the normalization is actually computed.
4690
4691// Computes the normalization of R/I. (basering is R)
4692// I is assumed to be radical and equidimensional.
4693// origJ is the first test ideal.
4694// D is a non-zerodivisor of R/I.
4695// condu is a non-zerodivisor in the conductor or 0 if it was not computed.
4696// If withDelta = 1, computes the delta invariant.
4697{
4698  ASSUME(1, not isQuotientRing(basering) );
4699  int step = 0;                       // Number of steps. (for debugging)
4700  int dbg = printlevel - voice + 2;   // dbg = printlevel (default: dbg = 0)
4701  int i;                              // counter
4702  int isNormal = 0;                   // check for exiting the loop
4703  int isGlobal = attrib(basering,"global");
4704  int delt;
4705
4706  def R = basering;
4707  poly c = D;
4708  ideal U,UU;
4709  ideal cJ;
4710  list testOut;                 // Output of proc testIdeal
4711                                // (the test ideal and the ring structure)
4712
4713  qring Q = groebner(I);
4714  intvec save_opt=option(get);
4715  option(redSB);
4716  option(returnSB);
4717  ideal J = imap(R, origJ);
4718  poly c = imap(R, c);
4719  poly D = imap(R, D);
4720  poly condu = imap(R, condu);
4721  ideal cJ;
4722  ideal cJMod;
4723
4724  dbprint(dbg, "Preliminar step begins.");
4725
4726  // --------------------- computation of A1 -------------------------------
4727  dbprint(dbg, "Computing the quotient (DJ : J)...");
4728  ideal U = groebner(quotient(D*J, J));
4729  ideal oldU = 1;
4730
4731  if(dbg >= 2) { "The quotient is"; U; }
4732
4733  // ----------------- Grauer-Remmert criterion check -----------------------
4734  // We check if the equality in Grauert - Remmert criterion is satisfied.
4735  isNormal = checkInclusions(D*oldU, U);
4736  if(isNormal == 0)
4737  {
4738    if(dbg >= 1)
4739    {
4740      "In this step, we have the ring 1/c * U, with c =", c;
4741      "and U = "; U;
4742    }
4743  }
4744  else
4745  {
4746    // The original ring R/I was normal. Nothing to do.
4747    // We define anyway a new ring, equal to R, to be able to return it.
4748    setring R;
4749    list lR = ringlist(R);
4750    def ROut = ring(lR);
4751    setring ROut;
4752    ideal norid = fetch(R, I);
4753    ideal normap = maxideal(1);
4754    export norid;
4755    export normap;
4756    setring R;
4757    if(withDelta)
4758    {
4759      list output = ideal(1), poly(1), ROut, 0;
4760    }
4761    else
4762    {
4763      list output = ideal(1), poly(1), ROut;
4764    }
4765    option(set,save_opt);
4766    return(output);
4767  }
4768
4769  // ----- computation of the chain of ideals A1 c A2 c ... c An ------------
4770  while(isNormal == 0)
4771  {
4772    step++;
4773    if(dbg >= 1) { ""; "Step ", step, " begins."; }
4774    dbprint(dbg, "Computing the test ideal...");
4775
4776    // --------------- computation of the test ideal ------------------------
4777    // Computes a test ideal for the new ring.
4778    // The test ideal will be the radical in the new ring of the original
4779    // test ideal.
4780    setring R;
4781    U = imap(Q, U);
4782    c = imap(Q, c);
4783    UU=0;
4784    for(i=1;i<=size(U);i++)
4785    {
4786       if(U[i]!=c){UU[size(UU)+1]=U[i];}
4787    }
4788    UU=interred(UU);
4789    attrib(UU,"isSB",1);
4790    U=c,UU;
4791    for(i=2;i<=size(U);i++)
4792    {
4793       U[i]=lead(U[i])+reduce(U[i]-lead(U[i]),UU);
4794    }
4795    testOut = testIdeal(I, U, origJ, c, D);
4796    cJ = testOut[1];
4797
4798    setring Q;
4799    U=imap(R,U);
4800    cJ = imap(R, cJ);
4801    cJ = groebner(cJ);
4802
4803    // cJ / c is now the ideal mapped back.
4804    // We have the generators as an ideal in the new ring,
4805    // but we want the generators as an ideal in the original ring.
4806    cJMod = getGenerators(cJ, U, c);
4807
4808    if(dbg >= 2) { "The test ideal in this step is "; cJMod; }
4809
4810    cJ = cJMod;
4811
4812    // ------------- computation of the quotient (DJ : J)--------------------
4813    oldU = U;
4814    dbprint(dbg, "Computing the quotient (c*D*cJ : cJ)...");
4815    U = quotient(c*D*cJ, cJ);
4816    if(dbg >= 2){"The quotient is "; U;}
4817
4818    // ------------- Grauert - Remmert criterion check ----------------------
4819    // We check if the equality in Grauert - Remmert criterion is satisfied.
4820    isNormal = checkInclusions(D*oldU, U);
4821
4822    if(isNormal == 1)
4823    {
4824      // We go one step back. In the last step we didnt get antyhing new,
4825      // we just verified that the ring was already normal.
4826      dbprint(dbg, "The ring in the previous step was already normal.");
4827      dbprint(dbg, "");
4828      U = oldU;
4829    }
4830    else
4831    {
4832      // ------------- preparation for next iteration ----------------------
4833      // We have to go on.
4834      // The new denominator is chosen.
4835      c = D * c;
4836
4837      // If we have a universal denominator of smaller degree than c,
4838      // we replace c by it.
4839      if(condu != 0)
4840      {
4841        if(deg(c) > deg(condu))
4842        {
4843          U = changeDenominatorQ(U, c, condu);
4844          c = condu;
4845        }
4846      }
4847      if(dbg >= 1)
4848      {
4849        "In this step, we have the ring 1/c * U, with c =", c;
4850        "and U = ";
4851        U;
4852        if(dbg>=2){pause();}
4853      }
4854    }
4855  }
4856
4857  // ------------------------- delta computation ----------------------------
4858  if(withDelta)
4859  {
4860    ideal UD = groebner(U);
4861    delt = vdim(std(modulo(UD, c)));
4862  }
4863
4864  // -------------------------- prepare output -----------------------------
4865  setring R;
4866  U = fetch(Q, U);
4867  c = fetch(Q, c);
4868
4869  // Ring structure of the new ring
4870  def ere = testOut[2];
4871  if(withDelta)
4872  {
4873    list output = U, c, ere, delt;
4874  }
4875  else
4876  {
4877    list output = U, c, ere;
4878  }
4879  option(set,save_opt);
4880  return(output);
4881}
4882
4883///////////////////////////////////////////////////////////////////////////////
4884
4885static proc lineUpLast(ideal U, poly c)
4886// Sets c as the last generator of U.
4887{
4888  int i;
4889  ideal newU;
4890  for (i = 1; i <= ncols(U); i++)
4891  {
4892    if(U[i] != c)
4893    {
4894      if(size(newU) == 0)
4895      { newU = U[i]; }
4896      else
4897      { newU = newU, U[i]; }
4898    }
4899  }
4900  if(size(newU) == 0)
4901  { newU = c; }
4902  else
4903  { newU = newU, c; }
4904  return(newU);
4905}
4906
4907///////////////////////////////////////////////////////////////////////////////
4908
4909static proc lineUp(ideal U, poly c)
4910// Sets c as the first generator of U.
4911{
4912  int i;
4913  ideal newU = c;
4914  for (i = 1; i <= ncols(U); i++)
4915  {
4916    if(U[i] != c)
4917    {
4918      newU = newU, U[i];
4919    }
4920  }
4921  return(newU);
4922}
4923
4924///////////////////////////////////////////////////////////////////////////////
4925
4926//WARNING - elim is not working here!! Check!!
4927//It is now replaced by computing an eliminating groebner basis.
4928proc getOneVar(ideal J, int vari)
4929"USAGE:   getOneVar(J, vari); J is a 0-dimensional ideal, vari is an integer.
4930RETURN:  a polynomial of J in the variable indicated by vari of smallest
4931         degree.@*
4932NOTE:    Works only over rings of two variables.@*
4933         It is intended mainly as an auxiliary procedure for computing
4934         integral bases. @*
4935EXAMPLE: example getOneVar; shows an example
4936"
4937{
4938  ASSUME(0, nvars(basering)==2 );
4939  ASSUME(0, (vari==2) || (vari==1) );
4940
4941  def R = basering;
4942  list RL = ringlist(R);
4943  // We keep everything from R but we change the ordering to lp, and we
4944  // order the variables as needed.
4945  RL[3] = list(list("lp", 1:2), list("C", 0:1));
4946  RL[2] = list(var(3-vari), var(vari));
4947  RL[4]=ideal(0); // does not work with qrings: Ex.7 of paraplanecurves
4948  def RR = ring(RL);
4949  setring RR;
4950  ideal J = imap(R, J);
4951  J = groebner(J);
4952  poly g = J[1];
4953  setring R;
4954  poly g = imap(RR, g);
4955  return(g);
4956}
4957example
4958{ "EXAMPLE:";
4959  printlevel = printlevel+1;
4960  echo = 2;
4961  ring s = 0,(x,y),dp;
4962  ideal J = x3-y, y3;
4963  getOneVar(J, 1);
4964
4965  echo = 0;
4966  printlevel = printlevel-1;
4967}
4968///////////////////////////////////////////////////////////////////////////////
4969
4970proc getSmallest(ideal J)
4971"USAGE:   getSmallest(J); J is an ideal.
4972RETURN:  the generator of J of smallest degree. If there are more than one, it
4973         chooses the one with smallest number of monomials.@*
4974NOTE:    It looks only at the generator of J, not at all the polynomials in
4975         the ideal.@*
4976         It is intended maninly to compute a good universal denominator in the
4977         normalization algorithms.@*
4978EXAMPLE: example getSmallest; shows an example
4979"
4980{
4981
4982// Computes the polynomial of smallest degree of J.
4983//
4984  int i;
4985  poly p = J[1];
4986  int d = deg(p);
4987  int di;
4988  for(i = 2; i <= ncols(J); i++)
4989  {
4990    if(J[i] != 0)
4991    {
4992      di = deg(J[i]);
4993      if(di < d)
4994      {
4995        p = J[i];
4996        d = di;
4997      }
4998      else
4999      {
5000        if(di == d)
5001        {
5002          if(size(J[i]) < size(p))
5003          {
5004            p = J[i];
5005          }
5006        }
5007      }
5008    }
5009  }
5010  return(p);
5011}
5012example
5013{ "EXAMPLE:";
5014  printlevel = printlevel+1;
5015  echo = 2;
5016  ring s = 0,(x,y),dp;
5017  ideal J = x3-y, y5, x2-y2+1;
5018  getSmallest(J);
5019
5020  echo = 0;
5021  printlevel = printlevel-1;
5022}
5023
5024///////////////////////////////////////////////////////////////////////////////
5025
5026static proc getGenerators(ideal J, ideal U, poly c)
5027{
5028
5029// Computes the generators of J as an ideal in the original ring,
5030// where J is given by generators in the new ring.
5031
5032// The new ring is given by 1/c * U in the total ring of fractions.
5033
5034  int i, j;                             // counters;
5035  int dbg = printlevel - voice + 2;     // dbg = printlevel (default: dbg = 0)
5036  poly p;                               // The lifted polynomial
5037  ideal JGr = groebner(J);              // Groebner base of J
5038
5039  if(dbg>1){"Checking for new generators...";}
5040  for(i = 1; i <= ncols(J); i++)
5041  {
5042    for(j = 1; j <= ncols(U); j++)
5043    {
5044      p = lift(c, J[i]*U[j])[1,1];
5045      p = reduce(p, JGr);
5046      if(p != 0)
5047      {
5048        if(dbg>1)
5049        {
5050          "New polynoial added:", p;
5051          if(dbg>4) {pause();}
5052        }
5053        JGr = JGr, p;
5054        JGr = groebner(JGr);
5055        J = J, p;
5056      }
5057    }
5058  }
5059  return(J);
5060}
5061
5062///////////////////////////////////////////////////////////////////////////////
5063
5064static proc testIdeal(ideal I, ideal U, ideal origJ, poly c, poly D)
5065{
5066
5067  ASSUME(1, not isQuotientRing(basering) );
5068
5069// Internal procedure, used in normalM.
5070// Computes the test ideal in the new ring.
5071// It takes the original test ideal and computes the radical of it in the
5072// new ring.
5073
5074// The new ring is 1/c * U.
5075// The original test ideal is origJ.
5076// The original ring is R / I, where R is the basering.
5077  intvec save_opt=option(get);
5078  int i;                                // counter
5079  int dbg = printlevel - voice + 2;     // dbg = printlevel (default: dbg = 0)
5080  def R = basering;                      // We dont work in the quo
5081  ideal J = origJ;
5082
5083  // ---------- computation of the ring structure of 1/c * U ----------------
5084  U = lineUp(U, c);
5085
5086  if(dbg > 1){"Computing the new ring structure...";}
5087  list ele = computeRing(U, I, "noRed");
5088
5089  def origEre = ele[1];
5090  setring origEre;
5091  if(dbg > 1){"The relations are"; norid;}
5092
5093  // ---------------- setting the ring to work in  --------------------------
5094  int isGlobal = attrib(origEre,"global");      // Checks if the original ring has
5095                                         // global ordering.
5096  if(isGlobal != 1)
5097  {
5098    list rl = ringlist(origEre);
5099    list origOrd = rl[3];
5100    list newOrd = list("dp", intvec(1:nvars(origEre))), list("C", 0);
5101    rl[3] = newOrd;
5102    def ere = ring(rl);     // globR is the original ring but
5103                            // with a global ordering.
5104    setring ere;
5105    ideal norid = imap(origEre, norid);
5106  }
5107  else
5108  {
5109    def ere = origEre;
5110  }
5111
5112  ideal I = imap(R, I);
5113  ideal J = imap(R, J);
5114  J = J, norid, I;
5115
5116
5117  // ----- computation of the test ideal using the ring structure of Ai -----
5118
5119  option(redSB);
5120  option(returnSB);
5121
5122  if(dbg > 1){"Computing the radical of J...";}
5123  J = radical(J);
5124  if(dbg > 1){"Computing the interreduction of the radical...";}
5125  J = groebner(J);
5126  //J = interred(J);
5127  if(dbg > 1)
5128  {
5129    "The radical in the generated ring is";
5130    J;
5131    if(dbg>4){pause();}
5132  }
5133
5134  setring ere;
5135
5136  // -------------- map from Ai to the total ring of fractions ---------------
5137  // Now we must map back this ideal J to U_i / c in the total ring of
5138  // fractions.
5139  // The map sends T_j -> u_j / c.
5140  // The map is built by the following steps:
5141  // 1) We compute the degree of the generators of J with respect to the
5142  //    new variables T_j.
5143  // 2) For each generator, we multiply each term by a power of c, as if
5144  //    taking c^n as a common denominator (considering the new variables as
5145  //    a polynomial in the old variables divided by c).
5146  // 3) We replace the new variables T_j by the corresponding numerator u_j.
5147  // 4) We lift the resulting polynomial to change the denominator
5148  //    from c^n to c.
5149  int nNewVars = nvars(ere) - nvars(R);      // Number of new variables
5150  poly c = imap(R, c);
5151  intvec @v = 1..nNewVars;    // Vector of the new variables.
5152                              // They must be the first ones.
5153  if(dbg > 1){"The indices of the new variables are", @v;}
5154
5155  // ---------------------- step 1 of the mapping ---------------------------
5156  intvec degs;
5157  for(i = 1; i<=ncols(J); i++)
5158  {
5159    degs[i] = degSubring(J[i], @v);
5160  }
5161  if(dbg > 1)
5162  {
5163    "The degrees with respect to the new variables are";
5164    degs;
5165  }
5166
5167  // ---------------------- step 2 of the mapping ---------------------------
5168  ideal mapJ = mapBackIdeal(J, c, @v);
5169
5170  setring R;
5171
5172  // ---------------------- step 3 of the mapping ---------------------------
5173  ideal z;                    // The variables of the original ring in order.
5174  for(i = 1; i<=nvars(R); i++)
5175  {
5176    z[i] = var(i);
5177  }
5178
5179  map f = ere, U[2..ncols(U)], z[1..ncols(z)]; // The map to the original ring.
5180  if(dbg > 1)
5181  {
5182    "The map is ";
5183    f;
5184    if(dbg>4){pause();}
5185  }
5186
5187  if(dbg > 1){ "Computing the map..."; }
5188
5189  J = f(mapJ);
5190  if(dbg > 1)
5191  {
5192    "The ideal J mapped back (before lifting) is";
5193    J;
5194    if(dbg>4){pause();}
5195  }
5196
5197  // ---------------------- step 4 of the mapping ---------------------------
5198  qring Q = groebner(I);
5199  ideal J = imap(R, J);
5200  poly c = imap(R, c);
5201  for(i = 1; i<=ncols(J); i++)
5202  {
5203    if(degs[i]>1)
5204    {
5205      J[i] = lift(c^(degs[i]-1), J[i])[1,1];
5206    }
5207    else
5208    {
5209      if(degs[i]==0) { J[i] = c*J[i]; }
5210    }
5211  }
5212
5213  if(dbg > 1)
5214  {
5215    "The ideal J lifted is";
5216    J;
5217    if(dbg>4){pause();}
5218  }
5219
5220  // --------------------------- prepare output ----------------------------
5221  J = groebner(J);
5222
5223  setring R;
5224  J = imap(Q, J);
5225
5226  option(set,save_opt);
5227  return(list(J, ele[1]));
5228}
5229
5230///////////////////////////////////////////////////////////////////////////////
5231
5232proc changeDenominator(ideal U1, poly c1, poly c2, ideal I)
5233"USAGE:   changeDenominator(U1, c1, c2, I); U1 and I ideals, c1 and c2
5234         polynomials.@*
5235RETURN:  an ideal U2 such that the A-modules 1/c1 * U1 and 1/c2 * U2 are equal,
5236         where A = R/I and R is the basering.@*
5237NOTE:    It assumes that such U2 exists. It is intended maninly as an auxiliary
5238         procedure in the normalization algorithms.@*
5239EXAMPLE: example changeDenominator; shows an example
5240"
5241{
5242  ASSUME(0, not isQuotientRing(basering) );
5243// Let A = R / I. Given an A-module in the form 1/c1 * U1 (U1 ideal of A), it
5244// computes a new ideal U2 such that the the A-module is 1/c2 * U2.
5245// The base ring is R, but the computations are to be done in R / I.
5246  int a;      // counter
5247  def R = basering;
5248  qring Q = I;
5249  ideal U1 = fetch(R, U1);
5250  poly c1 = fetch(R, c1);
5251  poly c2 = fetch(R, c2);
5252  ideal U2 = changeDenominatorQ(U1, c1, c2);
5253  setring R;
5254  ideal U2 = fetch(Q, U2);
5255  return(U2);
5256}
5257example
5258{
5259  "EXAMPLE:";
5260  echo = 2;
5261  ring s = 0,(x,y),dp;
5262  ideal I = y5-y4x+4y2x2-x4;
5263  ideal U1 = normal(I)[2][1];
5264  poly c1 = U1[4];
5265  U1;c1;
5266  // 1/c1 * U1 is the normalization of I.
5267  ideal U2 = changeDenominator(U1, c1, x3, I);
5268  U2;
5269  // 1/x3 * U2 is also the normalization of I, but with a different denominator.
5270  echo = 0;
5271}
5272
5273///////////////////////////////////////////////////////////////////////////////
5274
5275static proc changeDenominatorQ(ideal U1, poly c1, poly c2)
5276{
5277// Given a ring in the form 1/c1 * U, it computes a new U2 st the ring
5278// is 1/c2 * U2.
5279// The base ring is already a quotient ring R / I.
5280  int a;      // counter
5281  ideal U2;
5282  poly p;
5283  for(a = 1; a <= ncols(U1); a++)
5284  {
5285    p = lift(c1, c2*U1[a])[1,1];
5286    U2[a] = p;
5287  }
5288  return(U2);
5289}
5290
5291///////////////////////////////////////////////////////////////////////////////
5292
5293static proc checkInclusions(ideal U1, ideal U2)
5294{
5295// Checks if the identity A = Hom(J, J) of Grauert-Remmert criterion is
5296// satisfied.
5297  int dbg = printlevel - voice + 2;     // dbg = printlevel (default: dbg = 0)
5298  list reduction1;
5299  list reduction2;
5300
5301  // ---------------------- inclusion Hom(J, J) c A -------------------------
5302  if(dbg > 1){"Checking the inclusion Hom(J, J) c A:";}
5303  // This interred is used only because a bug in groebner!
5304  U1 = groebner(U1);
5305  reduction1 = reduce(U2, U1);
5306  if(dbg > 1){reduction1[1];}
5307
5308  // ---------------------- inclusion A c Hom(J, J) -------------------------
5309  // The following check should always be satisfied.
5310  // This is only used for debugging.
5311  if(dbg > 1)
5312  {
5313    "and the inclusion A c Hom(J, J): (this should always be satisfied)";
5314    // This interred is used only because a bug in groebner!
5315    U2 = groebner(U2);
5316    reduction2 = reduce(U1, groebner(U2));
5317    reduction2[1];
5318    if(size(reduction2[1]) > 0)
5319    {
5320      "Something went wrong... (this inclusion should always be satisfied)";
5321      ~;
5322    }
5323    else
5324    {
5325      if(dbg>4){pause();}
5326    }
5327  }
5328
5329  if(size(reduction1[1]) == 0)
5330  {
5331    // We are done! The ring computed in the last step was normal.
5332    return(1);
5333  }
5334  else
5335  {
5336    return(0);
5337  }
5338}
5339
5340///////////////////////////////////////////////////////////////////////////////
5341
5342static proc degSubring(poly p, intvec @v)
5343{
5344  ASSUME(1, not isQuotientRing(basering) );
5345// Computes the degree of a polynomial taking only some variables as variables
5346// and the others as parameters.
5347
5348// The degree is taken w.r.t. the variables indicated in v.
5349  int i;      // Counter
5350  int d = 0;  // The degree
5351  int e;      // Degree (auxiliar variable)
5352  for(i = 1; i <= size(p); i++)
5353  {
5354    e = sum(leadexp(p[i]), @v);
5355    if(e > d){d = e;}
5356  }
5357  return(d);
5358}
5359
5360///////////////////////////////////////////////////////////////////////////////
5361
5362static proc mapBackIdeal(ideal I, poly c, intvec @v)
5363{
5364   ASSUME(1, not isQuotientRing(basering) );
5365
5366// Modifies all polynomials in I so that a map x(i) -> y(i)/c can be
5367// carried out.
5368
5369// v indicates wicih variables x(i) of the ring will be mapped to y(i)/c.
5370
5371  int i;  // counter
5372  for(i = 1; i <= ncols(I); i++)
5373  {
5374    I[i] = mapBackPoly(I[i], c, @v);
5375  }
5376  return(I);
5377}
5378
5379///////////////////////////////////////////////////////////////////////////////
5380
5381static proc mapBackPoly(poly p, poly c, intvec @v)
5382{
5383  ASSUME(1, not isQuotientRing(basering) );
5384
5385// Multiplies each monomial of p by a power of c so that a map x(i) -> y(i)/c
5386// can be carried out.
5387
5388// v indicates wicih variables x(i) of the ring will be mapped to y(i)/c.
5389  int i;  // counter
5390  int e;  // exponent
5391  int d = degSubring(p, @v);
5392  poly g = 0;
5393  int size_p=size(p);
5394  for(i = 1; i <= size_p; i++)
5395  {
5396    e = sum(leadexp(p[i]), @v);
5397    g = g + p[i] * c^(d-e);
5398  }
5399  return(g);
5400}
5401
5402//                    End procedures for normal
5403///////////////////////////////////////////////////////////////////////////////
5404
5405
5406///////////////////////////////////////////////////////////////////////////////
5407//                  Begin procedures for normalC
5408
5409// We first define resp. copy some attributes to be used in proc normal and
5410// static proc normalizationPrimes, and ..., to speed up computation in
5411// special cases
5412//NOTE:  We use the following attributes:
5413// 1     attrib(id,"isCohenMacaulay");         //--- Cohen Macaulay
5414// 2     attrib(id,"isCompleteIntersection");  //--- complete intersection
5415// 3     attrib(id,"isHypersurface");          //--- hypersurface
5416// 4     attrib(id,"isEquidimensional");       //--- equidimensional ideal
5417// 5     attrib(id,"isPrim");                  //--- prime ideal
5418// 6     attrib(id,"isRegInCodim2");           //--- regular in codimension 2
5419// 7     attrib(id,"isIsolatedSingularity");   //--- isolated singularities
5420// 8     attrib(id,"onlySingularAtZero");      //--- only singular at 0
5421// 9     attrib(id,"isRadical");               //--- radical ideal
5422//Recall: (attrib(id,"xy"),1) sets attrib xy to TRUE and
5423//        (attrib(id,"xy"),0) to FALSE
5424
5425static proc getAttrib (ideal id)
5426"USAGE:   getAttrib(id);  id=ideal
5427COMPUTE: check attributes for id. If the attributes above are defined,
5428         take its value, otherwise define it and set it to 0
5429RETURN:  intvec of size 9, with entries 0 or 1,  values of attributes defined
5430         above (in this order)
5431EXAMPLE: no example
5432"
5433{
5434  int isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad;
5435
5436  if( typeof(attrib(id,"isCohenMacaulay"))=="int" )
5437  {
5438    if( attrib(id,"isCohenMacaulay")==1 )
5439    { isCoM=1; isEq=1; }
5440  }
5441
5442  if( typeof(attrib(id,"isCompleteIntersection"))=="int" )
5443  {
5444    if(attrib(id,"isCompleteIntersection")==1)
5445    { isCoI=1; isCoM=1; isEq=1; }
5446  }
5447
5448  if( typeof(attrib(id,"isHypersurface"))=="int" )
5449  {
5450    if(attrib(id,"isHypersurface")==1)
5451    { isHy=1; isCoI=1; isCoM=1; isEq=1; }
5452  }
5453
5454  if( typeof(attrib(id,"isEquidimensional"))=="int" )
5455  {
5456    if(attrib(id,"isEquidimensional")==1)
5457    { isEq=1; }
5458  }
5459
5460  if( typeof(attrib(id,"isPrim"))=="int" )
5461  {
5462    if(attrib(id,"isPrim")==1)
5463    { isPr=1; }
5464  }
5465
5466  if( typeof(attrib(id,"isRegInCodim2"))=="int" )
5467  {
5468    if(attrib(id,"isRegInCodim2")==1)
5469    { isReg=1; }
5470  }
5471
5472  if( typeof(attrib(id,"isIsolatedSingularity"))=="int" )
5473  {
5474    if(attrib(id,"isIsolatedSingularity")==1)
5475    { isIso=1; }
5476  }
5477
5478  if( typeof(attrib(id,"onlySingularAtZero"))=="int" )
5479  {
5480    if(attrib(id,"onlySingularAtZero")==1)
5481    { oSAZ=1; }
5482  }
5483
5484  if( typeof(attrib(id,"isRad"))=="int" )
5485  {
5486    if(attrib(id,"isRad")==1)
5487    { isRad=1; }
5488  }
5489
5490  intvec atr = isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad;
5491  return(atr);
5492}
5493
5494///////////////////////////////////////////////////////////////////////////////
5495
5496static proc setAttrib (ideal id, intvec atr)
5497"USAGE:   setAttrib(id,atr);  id ideal, atr intvec
5498COMPUTE: set attributes to id specified by atr
5499RETURN:  id, with assigned attributes from atr
5500EXAMPLE: no example
5501"
5502{
5503  attrib(id,"isCohenMacaulay",atr[1]);         //--- Cohen Macaulay
5504  attrib(id,"isCompleteIntersection",atr[2]);  //--- complete intersection
5505  attrib(id,"isHypersurface",atr[3]);          //--- hypersurface
5506  attrib(id,"isEquidimensional",atr[4]);       //--- equidimensional ideal
5507  attrib(id,"isPrim",atr[5]);                  //--- prime ideal
5508  attrib(id,"isRegInCodim2",atr[6]);           //--- regular in codimension 2
5509  attrib(id,"isIsolatedSingularity",atr[7]);   //--- isolated singularities
5510  attrib(id,"onlySingularAtZero",atr[8]);      //--- only singular at 0
5511  attrib(id,"isRadical",atr[9]);               //--- radical ideal
5512
5513  return(id);
5514}
5515
5516///////////////////////////////////////////////////////////////////////////////
5517// copyAttribs is not used anywhere so far
5518
5519static proc copyAttribs (ideal id1, ideal id)
5520"USAGE:   copyAttribs(id1,id);  id1, id ideals
5521COMPUTE: copy attributes from id1 to id
5522RETURN:  id, with assigned attributes from id1
5523EXAMPLE: no example
5524"
5525{
5526  if( typeof(attrib(id1,"isCohenMacaulay"))=="int" )
5527  {
5528    if( attrib(id1,"isCohenMacaulay")==1 )
5529    {
5530      attrib(id,"isEquidimensional",1);
5531    }
5532  }
5533  else
5534  {
5535    attrib(id,"isCohenMacaulay",0);
5536  }
5537
5538  if( typeof(attrib(id1,"isCompleteIntersection"))=="int" )
5539  {
5540    if(attrib(id1,"isCompleteIntersection")==1)
5541    {
5542      attrib(id,"isCohenMacaulay",1);
5543      attrib(id,"isEquidimensional",1);
5544    }
5545  }
5546  else
5547  {
5548    attrib(id,"isCompleteIntersection",0);
5549  }
5550
5551  if( typeof(attrib(id1,"isHypersurface"))=="int" )
5552  {
5553    if(attrib(id1,"isHypersurface")==1)
5554    {
5555      attrib(id,"isCompleteIntersection",1);
5556      attrib(id,"isCohenMacaulay",1);
5557      attrib(id,"isEquidimensional",1);
5558    }
5559  }
5560  else
5561  {
5562    attrib(id,"isHypersurface",0);
5563  }
5564
5565  if( (typeof(attrib(id1,"isEquidimensional"))=="int") )
5566  {
5567    if(attrib(id1,"isEquidimensional")==1)
5568    {
5569      attrib(id,"isEquidimensional",1);
5570    }
5571  }
5572  else
5573  {
5574    attrib(id,"isEquidimensional",0);
5575  }
5576
5577  if( typeof(attrib(id1,"isPrim"))=="int" )
5578  {
5579    if(attrib(id1,"isPrim")==1)
5580    {
5581      attrib(id,"isEquidimensional",1);
5582    }
5583  }
5584  else
5585  {
5586    attrib(id,"isPrim",0);
5587  }
5588
5589  if( (typeof(attrib(id1,"isRegInCodim2"))=="int") )
5590  {
5591    if(attrib(id1,"isRegInCodim2")==1)
5592    {
5593      attrib(id,"isRegInCodim2",1);
5594    }
5595  }
5596  else
5597  {
5598    attrib(id,"isRegInCodim2",0);
5599  }
5600
5601  if( (typeof(attrib(id1,"isIsolatedSingularity"))=="int") )
5602  {
5603    if(attrib(id1,"isIsolatedSingularity")==1)
5604    {
5605      attrib(id,"isIsolatedSingularity",1);
5606    }
5607  }
5608  else
5609  {
5610    attrib(id,"isIsolatedSingularity",0);
5611  }
5612
5613  if( typeof(attrib(id1,"onlySingularAtZero"))=="int" )
5614  {
5615    if(attrib(id1,"onlySingularAtZero")==1)
5616    {
5617      attrib(id,"isIsolatedSingularity",1);
5618    }
5619  }
5620  else
5621  {
5622    attrib(id,"onlySingularAtZero",0);
5623  }
5624
5625  if( typeof(attrib(id1,"isRad"))=="int" )
5626  {
5627    if(attrib(id1,"isRad")==1)
5628    {
5629      attrib(id,"isRad",1);
5630    }
5631  }
5632  else
5633  {
5634    attrib(id,"isRad",0);
5635  }
5636  return(id);
5637}
5638///////////////////////////////////////////////////////////////////////////////
5639
5640proc normalC(ideal id, list #)
5641"USAGE:  normalC(id [,choose]);  id = radical ideal, choose = optional list
5642         of string.
5643         Optional parameters in list choose (can be entered in any order):@*
5644         Decomposition:@*
5645         - \"equidim\" -> computes first an equidimensional decomposition,
5646         and then the normalization of each component (default).@*
5647         - \"prim\" -> computes first the minimal associated primes, and then
5648         the normalization of each prime. @*
5649         - \"noDeco\" -> no preliminary decomposition is done. If the ideal is
5650         not equidimensional radical, output might be wrong.@*
5651         - \"isPrim\" -> assumes that the ideal is prime. If the assumption does
5652         not hold, output might be wrong.@*
5653         - \"noFac\" -> factorization is avoided in the computation of the
5654         minimal associated primes;
5655         Other:@*
5656         - \"withGens\" -> the minimal associated primes P_i of id are
5657         computed and for each P_i, algebra generators of the integral closure
5658         of basering/P_i are computed as elements of its quotient field;@*
5659         If choose is not given or empty, the default options are used.@*
5660ASSUME:  The ideal must be radical, for non-radical ideals the output may
5661         be wrong (id=radical(id); makes id radical). However, if option
5662         \"prim\" is set the minimal associated primes are computed first
5663         and hence normalC computes the normalization of the radical of id.
5664         \"isPrim\" should only be used if id is known to be irreducible.
5665RETURN:  a list, say nor, of size 2 (resp. 3 if option \"withGens\" is set).@*
5666         * nor[1] is always a of r rings, where r is the number of associated
5667         primes with option \"prim\" (resp. >= no of equidimenensional
5668         components with option  \"equidim\").@*
5669         Each ring Ri=nor[1][i], i=1..r, contains two ideals with given
5670         names @code{norid} and @code{normap} such that @*
5671         - Ri/norid is the normalization of the i-th component, i.e. the
5672          integral closure in its field of fractions as affine ring, i.e. Ri is
5673          given in the form K[X(1..p),T(1..q)], where K is the ground field;
5674         - normap gives the normalization map from basering/id to
5675           Ri/norid for each i (the j-th element of normap is mapped to the
5676           j-th variable of R).@*
5677         - the direct sum of the rings Ri/norid is the normalization
5678           of basering/id; @*
5679         ** If option \"withGens\" is not set: @*
5680         * nor[2] shows the delta invariants: nor[2] is a list of an intvec of
5681         size r, the delta invariants of the r components, and an integer, the
5682         delta invariant of basering/id. (-1 means infinite, 0 that basering/P_i
5683         resp. basering/input is normal, -2 means that delta resp. delta of one
5684         of the components is not computed (which may happen if \"equidim\" is
5685         given). @*
5686         ** If option \"withGens\" is set:
5687         * nor[2] is a list of ideals Ii=nor[2][i], i=1..r, in the basering,
5688         generating the integral closure of basering/P_i in its quotient field
5689         as K-algebra (K the ground field):@*
5690         If Ii is given by polynomials g_1,...,g_k, then c:=g_k is a non-zero
5691         divisor and the j-th variables of the ring Ri satisfies var(j)=g_j/c,
5692         j=1..k-1, as element in the quotient field of basering/P_i. The
5693         g_j/g_k+1 are K-algebra generators  of the integral closure of
5694         basering/P_i.@*
5695         * nor[3] shows the delta invariant as above.
5696THEORY:  We use the Grauert-Remmert-de Jong algorithm [c.f. G.-M. Greuel,
5697         G. Pfister: A SINGULAR Introduction to Commutative Algebra, 2nd Edition.
5698         Springer Verlag (2007)].
5699         The procedure computes the algebra structure and the delta invariant of
5700         the normalization of R/id:@*
5701         The normalization is an affine algebra over the ground field K
5702         and nor[1] presents it as such: Ri = K[X(1..p),T(1..q)] and Ri/norid
5703         is the integral closure of R/P_i; if option \"withGens\" is set the
5704         X(j) and T(j) are expressed as quotients in the total ring of
5705         fractions. Note that the X(j) and T(j) generate the integral closure
5706         as K-algebra, but not necessarily as R-module (since relations of the
5707         form X(1)=T(1)*T(2) may have been eliminated). Geometrically the
5708         algebra structure is relevant since the variety of the ideal norid in
5709         Ri is the normalization of the variety of the ideal P_i in R.@*
5710         The delta invariant of a reduced ring A is dim_K(normalization(A)/A).
5711         For A=K[x1,...,xn]/id we call this number also the delta invariant of
5712         id. nor[3] returns the delta invariants of the components P_i and of
5713         id.
5714NOTE:    To use the i-th ring type: @code{def R=nor[1][i]; setring R;}.
5715@*       Increasing/decreasing printlevel displays more/less comments
5716         (default: printlevel=0).
5717@*       Not implemented for local or mixed orderings or quotient rings.
5718         For local or mixed orderings use proc 'normal'.
5719@*       If the input ideal id is weighted homogeneous a weighted ordering may
5720         be used (qhweight(id); computes weights).
5721KEYWORDS: normalization; integral closure; delta invariant.
5722SEE ALSO: normal, normalP.
5723EXAMPLE: example normalC; shows an example
5724"
5725{
5726   ASSUME(0, not isQuotientRing(basering) );
5727
5728   int i,j;
5729   int withGens, withEqui, withPrim, isPrim, noFac;
5730   int dbg = printlevel-voice+2;
5731   int nvar = nvars(basering);
5732   int chara  = char(basering);
5733   list result, prim, keepresult;
5734
5735  int decomp;   // Preliminar decomposition:
5736                // 0 -> no decomposition (id is assumed to be prime)
5737                // 1 -> no decomposition
5738                //      (id is assumed to be equidimensional radical)
5739                // 2 -> equidimensional decomposition
5740                // 3 -> minimal associated primes
5741
5742   // Default methods:
5743   noFac = 0;         // Use facstd when computing minimal associated primes
5744   decomp = 2;        // Equidimensional decomposition for nvar > 2
5745   if (nvar <= 2)
5746   { decomp = 3; }    // Compute minimal associated primes if nvar <= 2
5747
5748   if ( attrib(basering,"global") != 1 )
5749   {
5750     "";
5751     "// Not implemented for this ordering,";
5752     "// please change to global ordering or use proc normal";
5753     return(result);
5754   }
5755
5756//--------------------------- define the method ---------------------------
5757   string method;                //make all options one string in order to use
5758                                 //all combinations of options simultaneously
5759   for ( i=1; i <= size(#); i++ )
5760   {
5761     if ( typeof(#[i]) == "string" )
5762     {
5763       method = method + #[i];
5764     }
5765   }
5766
5767   //--------------------------- chosen methods -----------------------
5768   // "withGens": computes algebra generators for each irreducible component
5769   // ### the extra code for withGens should be incorporated in the general case
5770
5771   if ( find(method,"withgens") or find(method,"withGens"))
5772   {
5773     withGens = 1;
5774   }
5775
5776   // the general case: either equidim or minAssGTZ or no decomposition
5777
5778   if ( find(method,"isprim") or find(method,"isPrim") )
5779   {decomp = 0; isPrim=1;}
5780
5781   if ( find(method,"nodeco") or find(method,"noDeco") )
5782   {decomp = 1;}
5783
5784   if ( find(method,"equidim") )
5785   { decomp = 2; }
5786
5787   if ( find(method,"prim") )
5788   { decomp = 3; }
5789
5790   if ( find(method,"nofac") or find(method,"noFac") )
5791   { noFac = 1; }
5792
5793   kill #;
5794   list #;
5795
5796//------- Special algorithm with computation of the generators, RETURN -------
5797   //--------------------- method "withGens" ----------------------------------
5798   //the integral closure is computed in proc primeClosure. In the general case
5799   //it is computed in normalizationPrimes. The main difference is that in
5800   //primeClosure the singular locus is only computed in the first iteration,
5801   //that no attributes are used, and that the generators are computed.
5802   //In primeClosure the (algebra) generators for each irreducible component
5803   //are computed in the static proc closureGenerators
5804
5805   if( withGens )
5806   {
5807      if( dbg >= 1 )
5808      {  "";
5809         "// We use method 'withGens'";
5810      }
5811      if ( decomp == 0 or decomp == 1 )
5812      {
5813         prim[1] = id;
5814         if( dbg >= 0 )
5815         {
5816           "";
5817           "// ** WARNING: result is correct if ideal is prime (not checked) **";
5818           "// if procedure is called with string \"prim\", primality is checked";
5819         }
5820      }
5821      else
5822      {
5823         if(dbg >= 1)
5824         {  "// Computing minimal associated primes..."; }
5825
5826         if( noFac )
5827         { prim = minAssGTZ(id,1); }
5828         else
5829         { prim = minAssGTZ(id); }
5830
5831         if(dbg >= 2)
5832         {  prim;""; }
5833         if(dbg >= 1)
5834         {
5835            "// number of irreducible components is", size(prim);
5836         }
5837      }
5838   //----------- compute integral closure for every component -------------
5839      int del;
5840      intvec deli;
5841      list Gens,l,resu,Resu;
5842      ideal gens;
5843      def R = basering;
5844      poly gg;
5845
5846      for(i=1; i<=size(prim); i++)
5847      {
5848         if(dbg>=1)
5849         {
5850            ""; pause(); "";
5851            "// Computing normalization of component",i;
5852            "   ---------------------------------------";
5853         }
5854
5855         if( defined(ker) ) { kill ker; }
5856         ideal ker = prim[i];
5857         export(ker);
5858         l = R;
5859         l = primeClosure(l,1);              //here the work is done
5860         // primeClosure is called with list l consisting of the basering
5861         //### ausprobieren ob primeClosure(l,1) schneller als primeClosure(l)
5862         // 1 bedeutet: kuerzester nzd
5863         // l[size(l)] is the delta invariant
5864
5865         if ( l[size(l)] >= 0 && del >= 0 )
5866         {
5867            del = del + l[size(l)];
5868         }
5869         else
5870         { del = -1; }
5871         deli = l[size(l)],deli;
5872
5873         l = l[1..size(l)-1];
5874         resu = list(l[size(l)]) + resu;
5875         gens = closureGenerators(l);         //computes algebra(!) generators
5876
5877         //NOTE: gens[i]/gens[size(gens)] expresses the ith variable of resu[1]
5878         //(the normalization) as fraction of elements of the basering;
5879         //the variables of resu[1] are algebra generators.
5880         //gens[size(gens)] is a non-zero divisor of basering/i
5881
5882         //divide by the greatest common divisor:
5883         gg = gcd( gens[1],gens[size(gens)] );
5884         for(j=2; j<=size(gens)-1; j++)
5885         {
5886            gg=gcd(gg,gens[j]);
5887         }
5888         for(j=1; j<=size(gens); j++)
5889         {
5890            gens[j]=gens[j]/gg;
5891         }
5892         Gens = list(gens) + Gens;
5893
5894/*       ### Da die gens Algebra-Erzeuger sind, ist reduce nach Bestimmung
5895         der Algebra-Variablen T(i) nicht zulaessig!
5896         for(i=1;i<=size(gens)-1;i++)
5897         {
5898            gens[i]= reduce(gens[i],std(gens[size(gens)]));
5899         }
5900         for(i=size(gens)-1; i>=1; i--)
5901         {
5902            if(gens[i]==0)
5903            { gens = delete(gens,i); }
5904         }
5905*/
5906         if( defined(ker) ) { kill ker; }
5907      }
5908
5909      if ( del >= 0 )
5910      {
5911         int mul = iMult(prim);
5912         del = del + mul;
5913      }
5914      else
5915      { del = -1; }
5916      deli = deli[1..size(deli)-1];
5917      Resu = resu,Gens,list(deli,del);
5918      int sr = size(resu);
5919
5920      if ( dbg >= 0 )
5921      {"";
5922"// 'normalC' created a list, say nor, of three lists:
5923// To see the list type
5924      nor;
5925
5926// * nor[1] is a list of",sr,"ring(s)
5927// To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g.
5928     def R1 = nor[1][1]; setring R1;  norid; normap;
5929// For the other rings type first (if R is the name of your original basering)
5930     setring R;
5931// and then continue as for R1.
5932// Ri/norid is the affine algebra of the normalization of the i-th
5933// component R/P_i (where P_i is an associated prime of the input ideal id)
5934// and normap the normalization map from R to Ri/norid.
5935
5936// * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of
5937// elements g1..gk of R such that the gj/gk generate the integral
5938// closure of R/P_i as sub-algebra in the quotient field of R/P_i, with
5939// gj/gk being mapped by normap to the j-th variable of Ri;
5940
5941// * nor[3] shows the delta-invariant of each component and of id
5942// (-1 means infinite, and 0 that R/P_i resp. R/id is normal).";
5943      }
5944      return(Resu);
5945   }
5946   //----------------- end method "withGens" --------------------------------
5947
5948//-------- The general case without computation of the generators -----------
5949// (attrib(id,"xy"),1) sets attrib xy to TRUE and (attrib(id,"xy"),0) to FALSE
5950// We use the following attributes:
5951//   attrib(id,"isCohenMacaulay");         //--- Cohen Macaulay
5952//   attrib(id,"isCompleteIntersection");  //--- complete intersection
5953//   attrib(id,"isHypersurface");          //--- hypersurface
5954//   attrib(id,"isEquidimensional",-1);    //--- equidimensional ideal
5955//   attrib(id,"isPrim");                  //--- prime ideal
5956//   attrib(id,"isRegInCodim2");           //--- regular in codimension 2
5957//   attrib(id,"isIsolatedSingularity";    //--- isolated singularities
5958//   attrib(id,"onlySingularAtZero");      //--- only singular at 0
5959
5960 //------------------- first set the attributes ----------------------
5961   if( typeof(attrib(id,"isCohenMacaulay"))=="int" )
5962   {
5963      if( attrib(id,"isCohenMacaulay")==1 )
5964      {
5965         attrib(id,"isEquidimensional",1);
5966      }
5967   }
5968   else
5969   {
5970      attrib(id,"isCohenMacaulay",0);
5971   }
5972
5973   if( typeof(attrib(id,"isCompleteIntersection"))=="int" )
5974   {
5975      if(attrib(id,"isCompleteIntersection")==1)
5976      {
5977         attrib(id,"isCohenMacaulay",1);
5978         attrib(id,"isEquidimensional",1);
5979      }
5980   }
5981   else
5982   {
5983      attrib(id,"isCompleteIntersection",0);
5984   }
5985
5986   if( typeof(attrib(id,"isHypersurface"))=="int" )
5987   {
5988      if(attrib(id,"isHypersurface")==1)
5989      {
5990         attrib(id,"isCompleteIntersection",1);
5991         attrib(id,"isCohenMacaulay",1);
5992         attrib(id,"isEquidimensional",1);
5993      }
5994   }
5995   else
5996   {
5997      attrib(id,"isHypersurface",0);
5998   }
5999
6000   if( ! (typeof(attrib(id,"isEquidimensional"))=="int") )
6001   {
6002         attrib(id,"isEquidimensional",0);
6003   }
6004
6005   if( typeof(attrib(id,"isPrim"))=="int" )
6006   {
6007      if(attrib(id,"isPrim")==1)
6008      {
6009         attrib(id,"isEquidimensional",1);
6010      }
6011   }
6012   else
6013   {
6014      attrib(id,"isPrim",0);
6015   }
6016
6017   if( ! (typeof(attrib(id,"isRegInCodim2"))=="int") )
6018   {
6019         attrib(id,"isRegInCodim2",0);
6020   }
6021
6022   if( ! (typeof(attrib(id,"isIsolatedSingularity"))=="int") )
6023   {
6024         attrib(id,"isIsolatedSingularity",0);
6025   }
6026
6027   if( typeof(attrib(id,"onlySingularAtZero"))=="int" )
6028   {
6029      if(attrib(id,"onlySingularAtZero")==1)
6030      {
6031         attrib(id,"isIsolatedSingularity",1);
6032      }
6033   }
6034   else
6035   {
6036      attrib(id,"onlySingularAtZero",0);
6037   }
6038
6039   //-------------- compute equidimensional decomposition --------------------
6040   //If the method "equidim" is given, compute the equidim decomposition
6041   //and goto the next step (no normalization
6042   //ACHTUNG: equidim berechnet bei nicht reduzierten id die eingebetteten
6043   //Komponenten als niederdim Komponenten, waehrend diese bei primdecGTZ
6044   //nicht auftauchen: ideal(x,y)*xy
6045   //this is default for nvars > 2
6046
6047   if( decomp == 2 )
6048   {
6049      withPrim = 0;                 //this is used to check later that prim
6050                                    //contains equidim but not prime components
6051      if( dbg >= 1 )
6052      {
6053         "// We use method 'equidim'";
6054      }
6055      if( typeof(attrib(id,"isEquidimensional"))=="int" )
6056      {
6057         if(attrib(id,"isEquidimensional")==1)
6058         {
6059            prim[1] = id;
6060         }
6061         else
6062         {
6063            prim = equidim(id);
6064         }
6065      }
6066      else
6067      {
6068         prim = equidim(id);
6069      }
6070      if(dbg>=1)
6071      {  "";
6072         "// number of equidimensional components:", size(prim);
6073      }
6074      if ( !noFac )
6075      {
6076        intvec opt = option(get);
6077        option(redSB);
6078        for(j=1; j<=size(prim); j++)
6079        {
6080           keepresult = keepresult+facstd(prim[j]);
6081        }
6082        prim = keepresult;
6083        if ( size(prim) == 0 )
6084        {
6085          prim=ideal(0);     //Bug in facstd, liefert leere Liste bei 0-Ideal
6086        }
6087
6088        if(dbg>=1)
6089        {  "";
6090         "// number of components after application of facstd:", size(prim);
6091        }
6092        option(set,opt);
6093      }
6094   }
6095
6096   //------------------- compute associated primes -------------------------
6097   //the case where withEqui = 0, here the min. ass. primes are computed
6098   //start with the computation of the minimal associated primes:
6099
6100   else
6101   {
6102    if( isPrim )
6103    {
6104      if( dbg >= 0 )
6105      {
6106         "// ** WARNING: result is correct if ideal is prime";
6107         "// or equidimensional (not checked) **";
6108         "// disable option \"isPrim\" to decompose ideal into prime";
6109         "// or equidimensional components";"";
6110      }
6111      if( dbg >= 1 )
6112      {
6113        "// We use method 'isPrim'";"";
6114      }
6115      prim[1]=id;
6116    }
6117    else
6118    {
6119      withPrim = 1;                 //this is used to check later that prim
6120                                    //contains prime but not equidim components
6121      if( dbg >= 1 )
6122      {
6123         "// We use method 'prim'";
6124      }
6125
6126      if( typeof(attrib(id,"isPrim"))=="int" )
6127      {
6128         if(attrib(id,"isPrim")==1)
6129         {
6130            prim[1]=id;
6131         }
6132         else
6133         {
6134            if( noFac )
6135            { prim=minAssGTZ(id,1); }     //does not use factorizing groebner
6136            else
6137            { prim=minAssGTZ(id); }       //uses factorizing groebner
6138         }
6139      }
6140      else
6141      {
6142            if( noFac )
6143            { prim=minAssGTZ(id,1); }
6144            else
6145            { prim=minAssGTZ(id); }
6146      }
6147      if(dbg>=1)
6148      {  "";
6149         "// number of irreducible components:", size(prim);
6150      }
6151    }
6152   }
6153
6154   //----- for each component (equidim or irred) compute normalization -----
6155   int sr, skr, del;
6156   intvec deli;
6157   int sp = size(prim);     //size of list prim (# irred or equidim comp)
6158
6159   for(i=1; i<=sp; i++)
6160   {
6161      if(dbg>=1)
6162      {  "";
6163         "// computing the normalization of component",i;
6164         "   ----------------------------------------";
6165      }
6166      //-------------- first set attributes for components ------------------
6167      attrib(prim[i],"isEquidimensional",1);
6168      if( withPrim )
6169      {
6170         attrib(prim[i],"isPrim",1);
6171      }
6172      else
6173      { attrib(prim[i],"isPrim",0); }
6174
6175      if(attrib(id,"onlySingularAtZero")==1)
6176      { attrib(prim[i],"onlySingularAtZero",1); }
6177      else
6178      { attrib(prim[i],"onlySingularAtZero",0); }
6179
6180      if(attrib(id,"isIsolatedSingularity")==1)
6181      { attrib(prim[i],"isIsolatedSingularity",1); }
6182      else
6183      { attrib(prim[i],"isIsolatedSingularity",0); }
6184
6185      if( attrib(id,"isHypersurface")==1 )
6186      {
6187         attrib(prim[i],"isHypersurface",1);
6188         attrib(prim[i],"isCompleteIntersection",1);
6189         attrib(prim[i],"isCohenMacaulay",1);
6190      }
6191      else
6192      { attrib(prim[i],"isHypersurface",0); }
6193
6194      if ( sp == 1)         //the case of one component: copy attribs from id
6195      {
6196        if(attrib(id,"isRegInCodim2")==1)
6197        {attrib(prim[i],"isRegInCodim2",1); }
6198        else
6199        {attrib(prim[i],"isRegInCodim2",0); }
6200
6201        if(attrib(id,"isCohenMacaulay")==1)
6202        {attrib(prim[i],"isCohenMacaulay",1); }
6203        else
6204        {attrib(prim[i],"isCohenMacaulay",0); }
6205
6206        if(attrib(id,"isCompleteIntersection")==1)
6207        {attrib(prim[i],"isCompleteIntersection",1); }
6208        else
6209        {attrib(prim[i],"isCompleteIntersection",0); }
6210      }
6211      else
6212      {
6213        attrib(prim[i],"isRegInCodim2",0);
6214        attrib(prim[i],"isCohenMacaulay",0);
6215        attrib(prim[i],"isCompleteIntersection",0);
6216      }
6217
6218      //------ Now compute the normalization of each component ---------
6219      //note: for equidimensional components the "splitting tools" can
6220      //create further decomposition
6221      //We now start normalizationPrimes with
6222      //ihp = partial normalisation map = identity map = maxideal(1)
6223      //del = partial delta invariant = 0
6224      //deli= intvec of partial delta invariants of components
6225      //in normalizationPrimes all the work is done:
6226
6227      keepresult = normalizationPrimes(prim[i],maxideal(1),0,0);
6228
6229      for(j=1; j<=size(keepresult)-1; j++)
6230      {
6231         result=insert(result,keepresult[j]);
6232      }
6233      skr = size(keepresult);
6234
6235      //compute delta:
6236      if( del >= 0 && keepresult[skr][1] >=0 )
6237      {
6238         del = del + keepresult[skr][1];
6239      }
6240      else
6241      {
6242         del = -1;
6243      }
6244      deli = keepresult[skr][2],deli;
6245
6246      if ( dbg>=1 )
6247      {
6248           "// delta of component",i; keepresult[skr][1];
6249      }
6250   }
6251   sr = size(result);
6252
6253   // -------------- Now compute intersection multiplicities -------------
6254   //intersection multiplicities of list prim, sp=size(prim).
6255      if ( dbg>=1 )
6256      {
6257        "// Sum of delta for all components"; del;
6258        if ( sp>1 )
6259        {
6260           "// Compute intersection multiplicities of the components";
6261        }
6262      }
6263
6264      if ( sp > 1 )
6265      {
6266        int mul = iMult(prim);
6267        if ( mul < 0 )
6268        {
6269           del = -1;
6270        }
6271        else
6272        {
6273           del = del + mul;
6274        }
6275      }
6276   deli = deli[1..size(deli)-1];
6277   result = result,list(deli,del);
6278
6279//--------------- Finally print comments and return ------------------
6280   if ( dbg >= 0)
6281   {"";
6282"// 'normalC' created a list, say nor, of two lists:
6283// To see the result, type
6284      nor;
6285
6286// * nor[1] is a list of",sr,"ring(s).
6287// To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g.
6288      def R1 = nor[1][1];  setring R1;  norid;  normap;
6289// and similair for the other rings nor[1][i];
6290// Ri/norid is the affine algebra of the normalization of r/P_i  (where P_i
6291// is an associated prime or an equidimensional part of the input ideal id)
6292// and normap the normalization map from the basering to Ri/norid;
6293
6294// * nor[2] shows the delta-invariant of each component and of id
6295// (-1 means infinite, 0 that r/P_i resp. r/id is normal, and -2 that delta
6296// of a component was not computed).";
6297   }
6298   return(result);
6299}
6300
6301example
6302{ "EXAMPLE:";
6303   printlevel = printlevel+1;
6304   echo = 2;
6305   ring s = 0,(x,y),dp;
6306   ideal i = (x2-y3)*(x2+y2)*x;
6307
6308   list nor = normalC(i);
6309
6310   nor;
6311   // 2 branches have delta = 1, and 1 branch has delta = 0
6312   // the total delta invariant is 13
6313
6314   def R2 = nor[1][2];  setring R2;
6315   norid; normap;
6316
6317   echo = 0;
6318   printlevel = printlevel-1;
6319   pause("   hit return to continue"); echo=2;
6320
6321   ring r = 2,(x,y,z),dp;
6322   ideal i = z3-xy4;
6323   nor = normalC(i);  nor;
6324   // the delta invariant is infinite
6325   // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module
6326   // in its quotient field Quot(r/i)
6327
6328   // the normalization as affine algebra over the ground field:
6329   def R = nor[1][1]; setring R;
6330   norid; normap;
6331
6332   echo = 0;
6333   pause("   hit return to continue");echo = 2;
6334
6335   setring r;
6336   nor = normalC(i, "withGens", "prim");    // a different algorithm
6337   nor;
6338}
6339
6340//////////////////////////////////////////////////////////////////////////////
6341//closureRingtower seems not to be used anywhere
6342static proc closureRingtower(list L)
6343"USAGE:    closureRingtower(list L); L a list of rings
6344CREATE:   rings R(1),...,R(n) such that R(i)=L[i] for all i
6345EXAMPLE:  example closureRingtower; shows an example
6346"
6347{
6348  int n=size(L);
6349  for (int i=1;i<=n;i++)
6350    {
6351      if (defined(R(i)))
6352      {
6353        string s="Fixed name R("+string(i)+") leads to conflict with existing "
6354              +"object having this name";
6355        ERROR(s);
6356      }
6357      def R(i)=L[i];
6358      export R(i);
6359    }
6360
6361  return();
6362}
6363example
6364{
6365  "EXAMPLE:"; echo=2;
6366  ring R=0,(x,y),dp;
6367  ideal I=x4,y4;
6368  list L=primeClosure(ReesAlgebra(I)[1]);
6369  L=delete(L,size(L));
6370  L;
6371  closureRingtower(L);
6372  R(1);
6373  R(4);
6374  kill R(1),R(2),R(3),R(4);
6375}
6376
6377//                Up to here: procedures for normalC
6378///////////////////////////////////////////////////////////////////////////////
6379
6380///////////////////////////////////////////////////////////////////////////////
6381//                From here: miscellaneous procedures
6382
6383// Used for timing and comparing the different normalization procedures.
6384// Option (can be entered in any order)
6385// "normal"   -> uses the new algortihm (normal)
6386// "normalP"  -> uses normalP
6387// "normalC"  -> uses normalC, without "withGens" option
6388// "primCl"   -> uses normalC, with option "withGens".
6389// "111"      -> checks the output of normalM using norTest.
6390// "p"        -> compares the output of norM with the output of normalP
6391//               ("normalP" option must also be set).
6392// "pc"       -> compares the output of norM with the output of normalC with
6393//               option "withGens"
6394//               ("primCl" option must also be set).
6395
6396proc timeNormal(ideal I, list #)
6397{
6398  ASSUME(0, not isQuotientRing(basering) );
6399
6400  def r = basering;
6401
6402  //--------------------------- define the method ---------------------------
6403  int isPrim, useRing;
6404  int decomp = -1;
6405  int norM, norC, norP, primCl;
6406  int checkP, check111, checkPC;
6407  int i;
6408  ideal U1, U2, W;
6409  poly c1, c2;
6410  int ch;
6411  string check;
6412  string method;                //make all options one string in order to use
6413                                //all combinations of options simultaneously
6414  for ( i=1; i <= size(#); i++ )
6415  {
6416    if ( typeof(#[i]) == "string" )
6417    {
6418      method = method + #[i];
6419    }
6420  }
6421  if ( find(method, "normal"))
6422  {norM = 1;}
6423  if ( find(method, "normalP") and (char(basering) > 0))
6424  {norP = 1;}
6425  if ( find(method, "normalC"))
6426  {norC = 1;}
6427  if ( find(method, "primCl"))
6428  {primCl = 1;}
6429  if ( find(method, "isprim") or find(method,"isPrim") )
6430  {decomp = 0;}
6431  if ( find(method, "p") )
6432  {checkP = 1;}
6433  if ( find(method, "pc") )
6434  {checkPC = 1;}
6435  if ( find(method, "111") )
6436  {check111 = 1;}
6437
6438  int tt;
6439  if(norM)
6440  {
6441    tt = timer;
6442    if(decomp == 0)
6443    {
6444      "Running normal(useRing, isPrim)...";
6445      list a1 = normal(I, "useRing", "isPrim");
6446      "Time normal(useRing, isPrim): ", timer - tt;
6447    }
6448    else
6449    {
6450      "Running normal(useRing)...";
6451      list a1 = normal(I, "useRing");
6452      "Time normal(useRing): ", timer - tt;
6453    }
6454    "";
6455  }
6456  if(norP)
6457  {
6458    tt = timer;
6459    if(decomp == 0)
6460    {
6461      "Running normalP(isPrim)...";
6462      list a2 = normalP(I, "isPrim");
6463      "Time normalP(isPrim): ", timer - tt;
6464    }
6465    else
6466    {
6467      "Running normalP()...";
6468      list a2 = normalP(I);
6469      "Time normalP(): ", timer - tt;
6470    }
6471    "";
6472  }
6473
6474  if(norC)
6475  {
6476    tt = timer;
6477    if(decomp == 0)
6478    {
6479      "Running normalC(isPrim)...";
6480      list a3 = normalC(I, "isPrim");
6481      "Time normalC(isPrim): ", timer - tt;
6482    }
6483    else
6484    {
6485      "Running normalC()...";
6486      list a3 = normalC(I);
6487      "Time normalC(): ", timer - tt;
6488    }
6489    "";
6490  }
6491
6492  if(primCl)
6493  {
6494    tt = timer;
6495    if(decomp == 0)
6496    {
6497      "Running normalC(withGens, isPrim)...";
6498      list a4 = normalC(I, "isPrim", "withGens");
6499      "Time normalC(withGens, isPrim): ", timer - tt;
6500    }
6501    else
6502    {
6503      "Running normalC(withGens)...";
6504      list a4 = normalC(I, "withGens");
6505      "Time normalC(withGens): ", timer - tt;
6506    }
6507    "";
6508  }
6509
6510  if(check111 and norM)
6511  {
6512    "Checking output with norTest...";
6513    "WARNING: this checking only works if the original ideal was prime.";
6514    norTest(I, a1);
6515    "";
6516  }
6517
6518  if(checkP and norP and norM)
6519  {
6520    "Comparing with normalP output...";
6521    if(size(a2) > 0)
6522    {
6523      "WARNING: this checking only works if the original ideal was prime.";
6524      U1 = a1[2][1];
6525      c1 = U1[size(U1)];
6526      U2 = a2[1][1];
6527      c2 = a2[1][1][size(a2[1][1])];
6528      W = changeDenominator(U1, c1, c2, groebner(I));
6529      qring q = groebner(I);
6530      ideal U2 = fetch(r, U2);
6531      ideal W = fetch(r, W);
6532      ch = 0;
6533      if(size(reduce(U2, groebner(W))) == 0)
6534      {
6535        "U2 c U1";
6536        ch = 1;
6537      }
6538      if(size(reduce(W, groebner(U2))) == 0)
6539      {
6540        "U1 c U2";
6541        ch = ch + 1;
6542      }
6543      if(ch == 2)
6544      {
6545        "Output of normalP is equal.";
6546      }
6547      else
6548      {
6549        "ERROR: Output of normalP is different.";
6550      }
6551      setring r;
6552      kill q;
6553    }
6554    else
6555    {
6556      "normalP returned no output. Comparison is not possible.";
6557    }
6558    "";
6559  }
6560
6561  if(checkPC and norM and primCl)
6562  {
6563    "Comparing with primeClosure output...";
6564    if(size(a4) > 0)
6565    {
6566      "WARNING: this checking only works if the original ideal was prime.";
6567      // primeClosure check
6568      U1 = a1[2][1];
6569      c1 = U1[size(U1)];
6570      U2 = a4[2][1];
6571      c2 = a4[2][1][size(a4[2][1])];
6572      W = changeDenominator(U1, c1, c2, groebner(I));
6573      qring q = groebner(I);
6574      ideal U2 = fetch(r, U2);
6575      ideal W = fetch(r, W);
6576      ch = 0;
6577      if(size(reduce(U2, groebner(W))) == 0)
6578      {
6579        "U2 c U1";
6580        ch = 1;
6581      }
6582      if(size(reduce(W, groebner(U2))) == 0)
6583      {
6584        "U1 c U2";
6585        ch = ch + 1;
6586      }
6587      if(ch == 2)
6588      {
6589        "Output of normalC(withGens) is equal.";
6590      }
6591      else
6592      {
6593        "ERROR: Output of normalC(withGens) is different.";
6594      }
6595      setring r;
6596      kill q;
6597    }
6598    else
6599    {
6600      "normalC(withGens) returned no output. Comparison is not possible.";
6601    }
6602    "";
6603  }
6604}
6605
6606///////////////////////////////////////////////////////////////////////////
6607static proc sqroot(int n);
6608{
6609  int s = 1;
6610  while(s*s < n) { s++; }
6611  return(s);
6612}
6613
6614///////////////////////////////////////////////////////////////////////////
6615proc norTest (ideal i, list nor, list #)
6616"USAGE:   norTest(i,nor,[n]); i=prime ideal, nor=list, n=optional integer
6617ASSUME:  nor is the output of normal(i) (any options) or
6618         normalP(i,"withRing") or normalC(i) (any options).
6619         In particular, the ring nor[1][1] contains the ideal norid
6620         and the map normap: basering/i --> nor[1][1]/norid.
6621RETURN:  an intvec v such that:
6622@format
6623         v[1] = 1 if the normap is injective and 0 otherwise
6624         v[2] = 1 if the normap is finite and 0 otherwise
6625         v[3] = 1 if nor[1][1]/norid is normal and 0 otherwise
6626@end format
6627         If n=1 (resp n=2) only v[1] (resp. v[2]) is computed and returned
6628THEORY:  The procedure can be used to test whether the computation of the
6629         normalization was correct: basering/i --> nor[1][1]/norid is the
6630         normalization of basering/i if and only if v=1,1,0.
6631NOTE:    For big examples it can be hard to fully test correctness; the
6632         partial test norTest(i,nor,2) is usually fast
6633EXAMPLE: example norTest; shows an example
6634"
6635{
6636   ASSUME(0, not isQuotientRing(basering) );
6637//### Sollte erweitert werden auf den reduziblen Fall: einen neuen affinen
6638// Ring nor[1][1]+...+nor[1][r] (direkte Summe) erzeugen, map dorthin
6639// definieren und dann testen.
6640
6641    int prl = printlevel - voice + 2;
6642    int a,b,d;
6643    int n,ii;
6644    if (size(#) > 0) {  n = #[1];  }
6645
6646    def BAS = basering;
6647
6648    //### make a copy of nor to have a cpoy of nor[1][1]  (not a reference to)
6649    // in order not to override norid and normap.
6650    // delete nor[2] (if it contains the module generators, which are not used)
6651    // s.t. newnor does not belong to a ring.
6652
6653    list newnor = nor;
6654    if ( size(newnor) == 3 )
6655    {
6656       newnor = delete(newnor,2);
6657    }
6658    def R = newnor[1][1];
6659    qring QAS = std(i);
6660
6661
6662    setring R;
6663    int nva = nvars(R);
6664    string svars = varstr(R);
6665    string svar;
6666
6667    norid = interred(norid);
6668
6669    //--------- create new ring with one dp block keeping weights ------------
6670    list LR = ringlist(R);
6671    list g3 = LR[3];
6672    int n3 = size(g3);
6673    list newg3;
6674    intvec V;
6675
6676    //--------- check first whether variables Z(i),...,A(i) exist -----------
6677    for (ii=90; ii>=65; ii--)
6678    {
6679       if ( find(svars,ASCII(ii)+"(") == 0 )
6680       {
6681          svar = ASCII(ii);  break;
6682       }
6683    }
6684    if ( size(svar) != 0 )
6685    {
6686        for ( ii = 1; ii <= nva; ii++ )
6687        {
6688            LR[2][ii] = svar+"("+string(ii)+")";
6689            V[ii] = 1;
6690        }
6691    }
6692    else
6693    {
6694        for ( ii = 1; ii <= nva; ii++ )
6695        {
6696           LR[2][ii] = "Z("+string(100*nva+ii)+")";
6697           V[ii] = 1;
6698        }
6699    }
6700
6701    if ( g3[n3][1]== "c" or g3[n3][1] == "C" )
6702    {
6703       list gm = g3[n3];       //last blockis module ordering
6704       newg3[1] = list("dp",V);
6705       newg3 = insert(newg3,gm,size(newg3));
6706    }
6707    else
6708    {
6709       list gm = g3[1];              //first block is module ordering
6710       newg3[1] = list("dp",V);
6711       newg3 = insert(newg3,gm);
6712    }
6713    LR[3] = newg3;
6714//LR;"";
6715    def newR = ring(LR);
6716    kill LR; //otherwise it keeps defined and will cause a warning next time norTest is run.
6717    setring newR;
6718    ideal norid = fetch(R,norid);
6719    ideal normap = fetch(R,normap);
6720    if( defined(lnorid) )  { kill lnorid; }     //um ** redefinig zu beheben
6721    if( defined(snorid) )  { kill snorid; }     //sollte nicht noetig sein
6722
6723    //----------- go to quotient ring for checking injectivity -------------
6724//"mstd";
6725    list lnorid = mstd(norid);
6726    ideal snorid = lnorid[1];
6727//"size mstdnorid:", size(snorid),size(lnorid[2]);
6728//"size string mstdnorid:", size(string(snorid)),size(string(lnorid[2]));
6729    qring QR = snorid;
6730    ideal qnormap = fetch(newR,normap);
6731    //ideal qnormap = imap(newR,normap);
6732    //ideal qnormap = imap(R,normap);
6733    map Qnormap = QAS,qnormap;    //r/id --> R/norid
6734
6735    //------------------------ check injectivity ---------------------------
6736//"injective:";
6737    a = is_injective(Qnormap,QAS);          //a. Test for injectivity of Qnormap
6738    dbprint ( prl, "injective: "+string(a) );
6739    if ( n==1 )
6740    {
6741     intvec result = intvec(a);
6742     setring BAS;
6743     return (result);
6744   }
6745   a;
6746
6747    //------------------------ check finiteness ---------------------------
6748    setring newR;
6749    b = mapIsFinite(normap,BAS,lnorid[2]);  //b. Test for finiteness of normap
6750    dbprint ( prl, "finite: "+string(b) );
6751    if ( n==2 )
6752    {
6753       intvec result = intvec(a,b);
6754       setring BAS;
6755       return (result);
6756    }
6757   b;
6758
6759    //------------------------ check normality ---------------------------
6760    list testnor = normal(lnorid[2],"isPrim","noFac", "withDelta");
6761    //### Problem: bei mehrfachem Aufruf von norTest gibt es
6762    // ** redefining norid & ** redefining normap
6763    //Dies produziert Fehler, da alte norid und normap ueberschrieben werden
6764    //norid und normap werden innnerhalb von proc computeRing ueberschrieben
6765    //Die Kopie newR scheint das Problem zu loesen
6766
6767
6768    d = testnor[3][2];             //d = delta
6769    kill testnor;                              //### sollte ueberfluessig sein
6770    int d1 = (d==0);                           //d1=1 if delta=0
6771    dbprint ( prl, "delta: "+string(d) );
6772    intvec result = intvec(a,b,d1);
6773    setring BAS;
6774    return(result);
6775}
6776example
6777{ "EXAMPLE:"; echo = 2;
6778   int prl = printlevel;
6779   printlevel = -1;
6780   ring r = 0,(x,y),dp;
6781   ideal i = (x-y^2)^2 - y*x^3;
6782   list nor = normal(i);
6783   norTest(i,nor);                //1,1,1 means that normal was correct
6784
6785   nor = normalC(i);
6786   norTest(i,nor);                //1,1,1 means that normal was correct
6787
6788   ring s = 2,(x,y),dp;
6789   ideal i = (x-y^2)^2 - y*x^3;
6790   nor = normalP(i,"withRing");
6791   norTest(i,nor);               //1,1,1 means that normalP was correct
6792   printlevel = prl;
6793}
6794
6795proc normalConductor(ideal I, list #)
6796"USAGE:     normalConductor(I); I ideal
6797ASSUME:     I is a radical ideal
6798RETURN:     the conductor of R/I as ideal in R
6799REMARKS:    The procedures makes use of the minimal primes and
6800            the generators of the normalization given by the normalization algorithm.
6801NOTE:       the optional parameter can be used if the normalization has already
6802            been computed. If a list L contains the output of the procedure
6803            normal (with options prim, wd and usering if the ring has a mixed ordering),
6804            apply normalConductor(I,L)
6805KEYWORDS:   conductor; normalization
6806SEE ALSO:   curveConductorMult
6807EXAMPLE:    example normalConductor; shows an example"
6808{
6809//SEE ALSO:   conductorIdealIntersect, conductorMinPrime, curveConductorMult
6810
6811    if(size(#) > 0){
6812        list norma = #;
6813    }else{
6814        // Compute the normalization with delta invariants
6815        list norma = normal(I,"useRing","prim","wd");
6816    }
6817
6818    // Prepare computation
6819        int r = size(norma[1]);
6820        int i;
6821        def savering = basering;
6822        list min_prime;
6823    list DEN;
6824    def S;
6825
6826    // List of all minimal primes
6827    for(i = 1; i <= r; i++){
6828        S = norma[1][i];
6829        min_prime[i] = CurveInv::conductorMinPrime(S);
6830    }
6831
6832        // List of ideals U generating Norm(R/P_i)
6833        list U = norma[2];
6834
6835        // List of denominators DEN
6836    r = size(U);
6837        for(i = 1; i <= r; i++){
6838                DEN[i] = U[i][size(U[i])];
6839        }
6840
6841        // Compute the conductor C
6842        ideal C = 1;
6843        ideal C_current;
6844        ideal min_prime_isect;
6845
6846        for(i = 1; i <= r; i++){
6847
6848                // Intersection of min_prime_j, j!=i
6849                min_prime_isect = CurveInv::conductorIdealIntersect(min_prime,i);
6850
6851                // Compute the quotient
6852                C_current = std(quotient(min_prime[i] + DEN[i]*min_prime_isect, U[i]));
6853
6854                // Intersect it with previous computation
6855                C = intersect(C,C_current);
6856        }
6857
6858        return(std(C));
6859
6860}
6861example
6862{
6863"EXAMPLE:"; echo = 2;
6864
6865///////////////////////////////////////////
6866// Computation of small conductor ideals //
6867///////////////////////////////////////////
6868
6869ring R = 0,(x,y,z),ds;
6870ideal I = x2y2 - z;
6871normalConductor(I);
6872// The conductor is the whole ring - so the ring is normal
6873// We can also see this using the delta invariant:
6874curveDeltaInv(I);
6875
6876ring S = 0,(a,b,c),dp;
6877ideal J = abc;
6878normalConductor(J);
6879// The conductor is not the whole ring - so it is not normal
6880// We can also see this using the delta invariant, which is even infinite
6881curveDeltaInv(J);
6882
6883kill R,S;
6884
6885/////////////////////////////////////
6886// Computation of a bigger example //
6887/////////////////////////////////////
6888
6889ring R = 0,(x,y,z,t),ds;
6890ideal I = xyz - yzt, x2y3 - z2t4;
6891I = std(radical(I));
6892// Ideal I
6893I;
6894// Conductor
6895normalConductor(I);
6896}
6897
6898///////////////////////////////////////////////////////////////////////////
6899//
6900//                            EXAMPLES
6901//
6902///////////////////////////////////////////////////////////////////////////
6903/*
6904//commands for computing the normalization:
6905// options for normal:  "equidim", "prim"
6906//                      "noDeco", "isPrim", "noFac"
6907//                       (prim by default)
6908// options for normalP: "withRing", "isPrim" or "noFac"
6909// options for normalC: "equidim", "prim", "withGens",
6910//                      "noDeco", "isPrim", "noFac"
6911
6912//Commands for testing 'normal'
6913 list nor = normal(i); nor;
6914 list nor = normal(i,"isPrim");nor;
6915 list nor = normal(i,"equidim");nor;
6916 list nor = normal(i,"prim");nor;
6917 list nor = normal(i,"equidim","noFac");nor;
6918 list nor = normal(i,"prim","noFac");nor;
6919
6920//Commands for testing 'normalP' in positive char
6921 list nor = normalP(i);nor;              //withGens but no ringstructure
6922 list nor = normalP(i,"withRing"); nor;  //compute the ringstructure
6923 list nor = normalP(i,"isPrim"); nor;    //if i is known to be prime
6924
6925//Commands for testing 'normalC'
6926 list nor = normal(i); nor;
6927 list nor = normal(i,"withGens");nor;
6928 list nor = normal(i,"isPrim");nor;
6929 list nor = normal(i,"equidim");nor;
6930 list nor = normal(i,"prim");nor;
6931 list nor = normal(i,"equidim","noFac");nor;
6932 list nor = normal(i,"prim","noFac");nor;
6933
6934//Commands for testing correctness (i must be prime):
6935list nor = normalP(i,"withRing","isPrim");
6936list nor = normal(i,"isPrim");
6937norTest(i,nor);       //full test for not too big examples (1,1,1 => ok)
6938norTest(i,nor,2);     //partial test for big examples (1,1 => ok)
6939factorize(i[1]);      //checks for irreducibility
6940
6941/////////////////////////////////////////////////////////////////////////////
6942
6943//----------------------Examples for normal (new algorithm)------------------
6944// Timings with Computeserver Dual AMD Opteron 242 1.60GHz.
6945// Examples from "Normalization of Rings" paper.
6946
6947// Example 1
6948// char 0 : normal = 0 secs (7 steps) - normalC = 75 secs
6949// char 2 : normal = 0 secs (7 steps) - normalP = 0 secs - normalC = 0 secs
6950// char 5 : normal = 1 secs (7 steps) - normalP = 71 - normalC = 1 secs
6951// char 11 : normal = 2 secs (7 steps) - normalP = 12 secs - normalC doesn't finish
6952// char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 1 sec
6953LIB"normal.lib";
6954ring r = 2, (x, y), dp;
6955ideal i = (x-y)*x*(y+x^2)^3-y^3*(x^3+x*y-y^2);
6956timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p");
6957
6958// Example 2
6959// char 0  : normal = 1 sec (7 steps) - normalC doesn't finish
6960// char 3 : normal = 1 secs (8 steps) - normalP = 0 secs - normalC = 4 secs
6961// char 13 : normal = 1 sec (7 steps) - normalP doesn't finish - normalC = 13 secs
6962// char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 10 sec
6963//Example is reducible in char 5 and 7
6964LIB"normal.lib";
6965ring r = 3, (x, y), dp;
6966ideal 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;
6967timeNormal(i, "normal", "normalC", "normalP", "p", "isPrim");
6968
6969// Example 3
6970// char 0 : normal = 3 secs (6 steps) - normalC doesn't finish
6971// char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish
6972// char 5 : normal = 0 secs (6 steps) - normalP = 8 secs - normalC doesn't finish
6973LIB"normal.lib";
6974ring r=5,(x, y),dp;
6975ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9;
6976timeNormal(i, "normal", "normalC", "normalP", "isPrim");
6977
6978// Example 4
6979// char 0 : normal = 0 secs (1 step) - normalC = 0 secs
6980// char 5 : normal = 0 secs (1 step) - normalP = 3 secs - normalC = 0 secs
6981// char 11 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs
6982// char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs
6983LIB"normal.lib";
6984ring r=5,(x,y),dp;   // genus 0 4 nodes and 6 cusps im P2
6985ideal i=(x2+y^2-1)^3 +27x2y2;
6986timeNormal(i, "normal", "normalC", "normalP", "isPrim");
6987
6988// Example 5
6989// char 0 : normal = 0 secs (1 step) - normalC = 0 secs
6990// char 5 : normal = 1 secs (3 step) - normalP doesn't finish - normalC doesn't finish
6991// char 11 : normal = 0 secs (1 step) - normalP 0 secs - normalC = 0 secs
6992// char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs
6993LIB"normal.lib";
6994ring r=11,(x,y),dp;    //24 sing, delta 24
6995ideal i=-x10+x8y2-x6y4-x2y8+2y10-x8+2x6y2+x4y4-x2y6-y8+2x6-x4y2+x2y4+2x4+2x2y2-y4-x2+y2-1;
6996timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p");
6997
6998// Example 6
6999// char 2 : normal = 5 secs (2 steps) - normalP = 25 secs - normalC = 166 secs
7000LIB"normal.lib";
7001ring r=2,(v,u,z,y,x),dp;
7002ideal i = z3+zyx+y3x2+y2x3, uyx+z2,uz+z+y2x+yx2, u2+u+zy+zx, v3+vux+vz2+vzyx+vzx+uz3+uz2y+z3+z2yx2;
7003timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p");
7004
7005// Example 7
7006// char 0 : normal = 11 secs (6 steps) - normalC = 11 secs
7007// char 2 : normal = 11 secs (6 steps) - normalP = 0 secs - normalC = 11 secs
7008// char 5 : normal = 11 secs (6 steps) - normalP = 3 secs - normalC = 11 secs
7009// char 11 : normal = 11 secs (6 steps) - normalP = 43 secs - normalC = 11 secs
7010// char 32003 : normal = 11 secs (6 steps) - normalP doesn't finish - normalC = 11 secs
7011LIB"normal.lib";
7012ring r=11,(x,y,z,w,t),dp;   //dim 2, dim s_locus 1
7013ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3;
7014timeNormal(i, "normal", "normalC", "normalP", "isPrim");
7015
7016////////////////////////////////////////////////////////////////////////////////
7017
7018// Other examples with new algorithm
7019
7020// Example 1
7021// char 0 : normal = 1 secs (13 steps) - normalC doesn't finish
7022// char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish
7023// char 5 : normal = 1 secs (13 steps) - normalP = 29 secs - normalC doesn't finish
7024ring r=2,(x,y),dp;  //genus 35
7025ideal i=y30+y13x+x4y5+x3*(x+1)^2;
7026timeNormal(i, "normal", "normalC", "normalP");
7027
7028// Example 2
7029// char 0 : normal = 1 secs (13 steps) - normalC doesn't finish
7030// char 3 : normal = 2 secs (13 steps) - normalP = 0 secs - normalC doesn't finish
7031ring r=3,(x,y),dp;  //genus 19, delta 21
7032ideal i=y20+y13x+x4y5+x3*(x+1)^2;
7033timeNormal(i, "normal", "normalC", "normalP");
7034
7035// Example 3
7036// Very fast with all algorithms
7037ring r = 3, (x, y), dp;
7038ideal I = (x-y^2)^2-x*y^3;
7039timeNormal(I, "normal", "normalC", "normalP", "primCl", "111", "p", "pc");
7040
7041
7042
7043//----------------------Test Example for charp -------------------
7044//Zu tun:
7045//### nach minor nur std statt mstd verwenden
7046//***hat bei keinem Beisp etwas gebracht -> wieder zurueck
7047//### wenn interred ok, dann wieder einsetzen (am Schluss)
7048//### bottelnecks bei maps beheben
7049//### minor verbessern
7050//### preimage verbessern (Ist imm Kern map oder imap verwendet?)
7051//### Gleich in Ordnung dp wechseln, ringlist verwenden
7052//### interred ev nur zum Schluss
7053//    (z.B. wenn nacher std; wenn nacher minor: testen )
7054
7055//Zeiten mit normalV5.lib (mstd aktiv, interred inaktiv)
7056
7057//SWANSON EXAMPLES: (Macaulay2, icFracP=normalP, icFractions<->normal)
7058//---------------------------------------------------------------------
7059//1. Series Fp[x,y,u,v]/(x2v-y2u)
7060//-------------------------------
7061//characteristic p   2   3    5    7    11   13   17   37   97
7062//icFracP          0.04 0.03 0.04 0.04 0.04 0.05 0.05 0.13 0.59  Mac
7063//normalP           0   0    0    0     0    0    0    0   1    Sing
7064//icFractions      0.08 0.09 0.09 0.09 0.14 0.15 0.15 0.15 0.15  Mac
7065//normal             0   0    0    0     0    0    0    0    0   Sing
7066
70672. Series Fp[u, v, w, x, y, z]/u2x4+uvy4+v2z4
7068//--------------------------------------------
7069//characteristic p 2    3    5    7   11
7070//icFracP         0.07 0.22 9.67 143 12543
7071//normalP          0    0    5   42  1566
7072//icFractions     1.16   *    *   *    *       *: > 6h
7073//normal            0    0    0   0    0
7074
7075//3. Series Fp[u, v, w, x, y, z]/(u2xp+uvyp+v2zp)
7076//-----------------------------------------------
7077//characteristic p  2    3    5    7    11   13  17 19 23
7078//icFracP          0.06 0.07 0.09 0.27 1.81 4.89 26 56 225
7079//normalP          0     0    0    0    1    2  6  10  27
7080//icFractions      0.16 1.49 75.00 4009 *    *   *  *  *
7081//normal            0     0    2   836
7082//normal(neu)       0     0    1   2    10  155
7083//### p=7 normal braucht 807 sec in:
7084// ideal endid  = phi1(endid);      //### bottelneck'
7085
7086//1.
7087int p = 2;  ring r = p,(u,v,x,y,z),dp; ideal i = x2v-y2u;
7088//2.
7089int p = 7; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2x4+uvy4+v2z4;
7090//3.
7091int p=11; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2*x^p+uv*y^p+v2*z^p;
7092
7093//IRREDUCIBLE EXAMPLES:
7094//---------------------
7095//timing for MacBookPro 2.2GHz Intel Core 2 Duo, 4GB Ram
7096//Sing. ix86Mac-darwin version 3-1-0 (3100-2008101314)  Oct 13 2008 14:46:59
7097//if no time is given: < 1  sec
7098
7099//Apply:
7100list nor = normal(i,"isPrim"); nor;
7101list nor = normalP(i,"withRing","isPrim"); nor;
7102def R=nor[1][1]; setring R; norid; normap;
7103setring r;
7104norTest(i,nor);
7105
7106int tt = timer;
7107list nor = normalP(i,"withRing","isPrim"); nor;
7108timer-tt;
7109int tt = timer;
7110list nor = normal(i,"isPrim");
7111timer-tt;
7112
7113ring r=19,(x,y,u,v),dp;    //delta -1
7114ideal i=x2v-y2u;
7115//norTest 2 sec
7116
7117ring r=2,(y,x2,x1),lp;     //delta -1
7118ideal i=y^4+y^2*x2*x1+x2^3*x1^2+x2^2*x1^3;
7119//### norid hat 1 Element nach interred
7120
7121ring r  = 11,(x,y,z),wp(2,1,2); //alles < 1 sec
7122ideal i=z3 - xy4 + x2;          //not reduced, delta =0 ok
7123ideal i=y4+x5+y2x;              //not reduced, delta -1
7124//interred verkleinert norid
7125
7126ring r=3,(u,v,x,y,z),dp;   //delta -1
7127ideal i=u2x3+uvy3+v2z3;
7128
7129ring r=3,(u,v,x,y,z),dp;   //delta -1
7130ideal i=u2x4+uvy4+v2z4;
7131//norTest(i,nor);  0 sec, norTest(i,nor) haengt!
7132
7133ring r=5,(u,v,x,y,z),dp;   //delta -1
7134ideal i=u2x6+uvy6+v2z6;
7135//normalP 5sec, normalC 1sec
7136//V5: norTest(i,nor); 45 sec bei normalP, V6 12 sec
7137//28 sec bei normal
7138
7139ring r=5,(u,v,x,y,z),dp;   //delta -1
7140ideal i=u2x5+uvy5+v2z5;
7141//normalP 1sec, normalC 1 sec,
7142//norTest lange: minor(jacob(I),h,J) 193 (308)sec, haengt dann bei M = std(M);
7143//norTest(i,nor,2); verwenden!
7144//Sing 3.0-4 orig  >9h! haengt bei Q = mstd(Q)[2];
7145
7146ring r=2,(y,x),wp(12,5);  //delta 3
7147ideal i=y5+y2x4+y2x+yx2+x12;
7148//normalP 0 sec (Test 0 sec), normalC 2 sec (Test 2 sec)
7149//normalC withGens (ohne interred) 0sec
7150
7151ring r=2,(y,x),dp;       //delta= 22
7152ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9;
7153//normalP 1sec, interred verkleinert norid betraechtlich
7154//normalC haengt bei minor, ideal im loop wird zu gross ###
7155//interred bei normalC vergroeesert string um Faktor 4000!
7156//withGens haengt bei interred in loop 4 (> 10 h) oder
7157//(nach Ausschalten von interred) bei
7158//int delt=vdim(std(modulo(f,ideal(p)))); (>?h)
7159
7160//Leonard1: (1. Komponente von Leonard),  delta -1
7161ring r=2,(v,u,z,y,x),dp;
7162ideal i = z3+zyx+y3x2+y2x3, uyx+z2,uz+z+y2x+yx2, u2+u+zy+zx,
7163          v3+vux+vz2+vzyx+vzx+uz3+uz2y+z3+z2yx2;
7164//normalP 5 sec (withRing 9 sec), norTest(i,nor,2); 45 sec
7165//normalC 102sec, 99sec
7166//### Zeit wird bei ideal Ann = quotient(SM[2],SL[1]); und bei
7167// f  = quotient(p*J,J); verbraucht
7168//withGens (ohne interred) 131sec, norTest(i,nor,2); 2min25sec
7169//norTest(i,nor,2);  45 sec
7170
7171 ring r=2,(y,x),wp(25,21); //Leonard2, delta 232
7172 ring r=2,(y,x),dp;
7173 ideal i=
7174 y^21+y^20*x +y^18*(x^3+x+1) +y^17*(x^3+1) +y^16*(x^4+x)
7175 +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)
7176 +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)
7177 +y^10*(x^12+x^9+x^8+x^7+x^5+x^3+x+1)
7178 +y^9*(x^14+x^13+x^10+x^9+x^8+x^7+x^6+x^3+x^2+1)
7179 +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)
7180 +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)
7181 +y^4*(x^19+x^16+x^15+x^12+x^6+x^5+x^3+1)
7182 +y^3*(x^18+x^15+x^12+x^10+x^9+x^7+x^4+x)
7183 +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)
7184 +y*(x^23+x^22+x^20+x^17+x^15+x^14+x^12+x^9)
7185 +(x^25+x^23+x^19+x^17+x^15+x^13+x^11+x^5);
7186//normalP: dp 2sec withRing 8sec,
7187//wp 4sec, withRing:51sec Zeit in lin = subst(lin, var(ii), vip); in elimpart ),
7188//norTest(i,nor,2): haengt bei mstd(norid);
7189//### normalC: (m. interred): haengt bei endid = interred(endid);
7190//GEFIXTES INTERRED ABWARTEN. Dann interred aktivieren
7191//interred(norid) haengt u. mst(norid) zu lange
7192//(o.interred): haengt bei  haengt bei list SM = mstd(i);
7193//ideal in der Mitte zu gross
7194//i = Ideal (size 118, 13 var) fuer die neue Normalisierung
7195//normal(neu) haengt bei return(std(i)) (offensichtlich in eineranderen lib)
7196
7197REDUCIBLE EXAMPLES:
7198------------------
7199//Apply:
7200int tt = timer;
7201list nor=normalP(i,"isPrim","withRing");
7202timer-tt;
7203
7204list nor = normal(i); nor;
7205list nor = normalC(i); nor;
7206list nor = normalC(i, "withGens"); nor;
7207list nor = normalP(i,"withRing"); nor;
7208list nor = normalP(i); nor;
7209def R=nor[1][1]; setring R; norid; normap;
7210
7211//Leonhard 4 Komponenten, dim=2, delta: 0,0,0,-1
7212ring r=2,(v,u,z,y,x),dp;      //lp zu lange
7213ideal i=z3+zyx+y3x2+y2x3, uyx+z2, v3+vuyx+vux+vzyx+vzx+uy3x2+uy2x+zy3x+zy2x2;
7214//normalP: 19 sec, withRing: 22 sec
7215//normalC ohne (mit) interred: 112 (113)sec, equidim: 99sec
7216//normalC 1. mal 111 sec, (2.mal) 450sec!! 3.mal 172 sec
7217//(unterschiedlich lange primdec, mit Auswirkungen)
7218//char 19: normalC: 15sec , withGens: 14sec (o.interr.)
7219
7220//----------------------Test Example for special cases -------------------
7221int tt = timer;
7222list nor=normalP(i,"withRing");nor;
7223//list nor=normalP(i,"withRing", "isPrim");nor;
7224timer-tt;
7225def R1 = nor[1][1]; setring R1;  norid; normap; interred(norid);
7226setring r;
7227
7228int tt = timer;
7229list nor=normal(i,"isPrim");nor;
7230timer-tt;
7231
7232ring r = 29,(x,y,z),dp;
7233ideal i = x2y2,x2z2;       //Nicht equidimensional, equidim reduziert nicht, ok
7234ideal i  = xyz*(z3-xy4);   //### interred(norid) verkuerzt
7235//je 0 sec
7236
7237ideal j = x,y;
7238ideal i = j*xy;
7239equidim(i);
7240//hat eingebettete Komponente, equidim rechnet wie in Beschreibung (ok)
7241
7242ring r  = 19,(x,y),dp;
7243   ideal i = x3-y4;                   //delta = 3
7244   ideal i = y*x*(x3-y4);             //delta = 11; 0,0,3
7245   ideal i = (x2-y3)*(x3-y4);         //delta = 13; 1,3
7246   ideal i = (x-y)*(x3+y2)*(x3-y4);   //delta = 23; 0,1,3
7247   ideal i = (x-1)*(x3+y2)*(x2-y3);   //delta = 16; 0,1,1
7248   ideal i = (x-y^2)^2 - y*x^3;       //delta = 3
7249   //singularities at not only at 0, hier rechnet equidim falsch
7250
7251// -------------------------- General Examples  ---------------------------//Huneke, irred., delta=2 (Version 3-0-4: < 1sec)
7252//Version 3-0-6 default: 1sec, mit gens 2sec, mit delta 5 sec
7253//(prim,noFac):ca 7 Min, prim:ca 10 min(wg facstd)
7254//
7255// "equidim" < 1sec irred. 5sec
7256// ring r=31991,(a,b,c,d,e),dp;
7257ring r=2,(a,b,c,d,e),dp;                    //delta=2
7258ideal i=
72595abcde-a5-b5-c5-d5-e5,
7260ab3c+bc3d+a3be+cd3e+ade3,
7261a2bc2+b2cd2+a2d2e+ab2e2+c2de2,
7262abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5,
7263ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5,
7264a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6,
7265a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4,
7266b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5;
7267//normalC: char 2, 31991: 0 sec (isPrim); char 2, equidim: 7 sec
7268//norTest(i,nor,2); 1sec
7269//normalP char 2: 1sec (isPrim)
7270//size(norid); size(string(norid));21 1219 interred(norid): 21 1245 (0 sec)
7271
7272int tt = timer;
7273list nor=normalC(i);nor;
7274timer-tt;
7275
7276list nor = normalP(i,"isPrim");
7277
7278//Vasconcelos irred., delta -1 (dauert laenger)
7279//auf macbook pro = 20 sec mit alter Version,
7280//Sing 3-0-6:
7281// Char 32003: "equidim" 30 sec, "noFac": 30sec
7282//gens: nach 9 min abgebr (haengt in Lin = ideal(T*syzf);) !!!! Hans zu tun
7283//Char 2: default (charp) 2 sec, normalC ca 30 sec
7284//ring r=32003,(x,y,z,w,t),dp;   //dim 2, dim s_locus 1
7285ring r=2,(x,y,z,w,t),dp;   //dim 2, dim s_locus 1
7286ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3;
7287//normalC: char 2: 22,  sec (mit und ohne isPrim)
7288//normalP char 2: 0sec (isPrim)      o. interred
7289//char 32003: ### haengt in ideal endid  = phi1(endid);
7290
7291//-------------------------------------------------------
7292//kleine Beispiele:
7293
7294//Theo1, irred, delta=-1
7295//normalC: 1sec, normalP: 3 sec
7296ring r=32003,(x,y,z),wp(2,3,6); //dim 2,dim slocus 1
7297ideal i=zy2-zx3-x6;
7298//normalC: char 2,19,32003: 0  sec (isPrim)
7299//normalP (isPrim) char 2,19: 0sec, char 29: 1sec
7300
7301//Theo1a, CohenMacaulay regular in codim 2, dim slocus=1, delta=0
7302//normalC: 0 sec, normalP: haegt in K=preimage(R,phi,L);
7303ring r=32003,(x,y,z,u),dp;
7304ideal i=zy2-zx3-x6+u2;
7305//normalC: char 2,32003: 0  sec (isPrim)
7306//normalP (isPrim) char 2: 0sec, char 19: haengt in K = preimage(Q,phi,L);
7307
7308//Theo2, irreduzibel, reduziert, < 1sec, delta -1
7309ring r=0,(x,y,z),wp(3,4,12);
7310ideal i=z*(y3-x4)+x8;
7311//normalC: char 2,32003,0: 0  sec (isPrim)
7312//normalP (isPrim) char 2: 0 1sec, char 19: 1sec char 29: 7 sec
7313
7314//Theo2a, reduiziert, 2-dim, dim_slocus=1, alte Version 3 sec,
7315//normalP ca 30 sec, normalC ca 4sec, delta -1
7316//ring r=32003,(T(1..4)),wp(3,4,12,17);
7317//ring r=11,(T(1..4)),dp;
7318ring r=11,(T(1..4)),wp(3,4,12,17);
7319ideal i=
7320T(1)^8-T(1)^4*T(3)+T(2)^3*T(3),
7321T(1)^4*T(2)^2-T(2)^2*T(3)+T(1)*T(4),
7322T(1)^7+T(1)^3*T(2)^3-T(1)^3*T(3)+T(2)*T(4),
7323T(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;
7324//normalC: char 2,32003: 0  sec (isPrim)
7325//normalP (isPrim) char 2: 0sec, char 11 2se, char 19: 13sec
7326//norTest 48sec in char11
7327//### interred verkuerzt
7328//char 29: haengt in K = preimage(Q,phi,L);
7329
7330//Theo3, irred, 2-dim, 1-dim sing, < 1sec
7331ring r=11,(x,y,z),wp(3,5,15);
7332ideal i=z*(y3-x5)+x10;
7333//normalC: char 2,0: 0  sec (withRing)
7334//normalP (withRing) char 2,11: 0sec, char 19: 13sec norTest 12sec(char 11)
7335
7336//Theo4 reducible, delta (0,0,0) -1
7337ring r=29,(x,y,z),dp;
7338ideal i=(x-y)*(x-z)*(y-z);
7339//normalC: char 2,32003: 0  sec
7340//normalP char withRing 2, 29: 0sec, 6sec
7341
7342//Theo6
7343ring r=32003,(x,y,z),dp;
7344ideal i=x2y2+x2z2+y2z2;
7345//normalC: char 2,32003: 0  sec
7346//normalP char withRing 2, 29: 0sec, 4sec
7347
7348//Sturmfels, CM, 15 componenten, alle glatt
7349ring r=0,(b,s,t,u,v,w,x,y,z),dp;
7350ideal i= bv+su, bw+tu, sw+tv, by+sx, bz+tx, sz+ty,uy+vx,uz+wx,vz+wy,bvz;
7351//normalC car 11, 0: 1sec, normalP 0 sec
7352
7353//riemenschneider, , dim 3, 5 Komp. delta (0,0,0,0,0), -1
7354ring r=2,(p,q,s,t,u,v,w,x,y,z),wp(1,1,1,1,1,1,2,1,1,1);
7355ideal i=xz,vx,ux,su,qu,txy,stx,qtx,uv2z-uwz,uv3-uvw,puv2-puw;
7356//alles 0 sec in char 2
7357
7358//4 Komponenten, alle glatt, 0sec
7359ring r=11,(x,y,z,t),dp;
7360ideal i=x2z+xzt,xyz,xy2-xyt,x2y+xyt;
7361
7362//dim 3, 2 Komponenten delta (-1,0), -1
7363ring r=2,(u,v,w,x,y,z),wp(1,1,1,3,2,1);
7364ideal i=wx,wy,wz,vx,vy,vz,ux,uy,uz,y3-x2;
7365//alles 0 sec in char 2
7366//---------------------------------------------------------
7367int tt = timer;
7368list nor=normalP(i,"normalC","withRing");nor;
7369timer-tt;
7370
7371//St_S/Y, 3 Komponenten, 2 glatt, 1 normal
7372//charp haengt (in char 20) in K=preimage(R,phi,L);
7373//ring r=32003,(b,s,t,u,v,w,x,y,z),dp;
7374ring r=11,(b,s,t,u,v,w,x,y,z),dp;
7375ideal i=wy-vz,vx-uy,tv-sw,su-bv,tuy-bvz;
7376//normalC: char 2,32003: 0  sec
7377//normalP char withRing 2: 1sec, char 11: 40sec
7378
7379//Horrocks: cahr 0: 17 (8 in char 11) Komponenten alle normal, delta 1
7380//char 11: 8 Komponenten alle normal, delta -1
7381ring r=0,(a,b,c,d,e,f),dp;
7382//ring r=11,(a,b,c,d,e,f),dp; //Charp bis p = 200 ca 3sec
7383ideal i=
7384adef-16000be2f+16001cef2, ad2f+8002bdef+8001cdf2, abdf-16000b2ef+16001bcf2,
7385a2df+8002abef+8001acf2, ad2e-8000bde2-7999cdef, acde-16000bce2+16001c2ef,
7386a2de-8000abe2-7999acef, acd2+8002bcde+8001c2df, abd2-8000b2de-7999bcdf,
7387a2d2+9603abde-10800b2e2-9601acdf+800bcef+11601c2f2,
7388abde-8000b2e2-acdf-16001bcef-8001c2f2, abcd-16000b2ce+16001bc2f,
7389a2cd+8002abce+8001ac2f, a2bd-8000ab2e-7999abcf, ab3f-3bdf3,
7390a2b2f-2adf3-16000bef3+16001cf4, a3bf+4aef3, ac3e-10668cde3,
7391a2c2e+10667ade3+16001be4+5334ce3f, a3ce+10669ae3f, bc3d+8001cd3e,
7392ac3d+8000bc3e+16001cd2e2+8001c4f, b2c2d+16001ad4+4000bd3e+12001cd3f,
7393b2c2e-10668bc3f-10667cd2ef, abc2e-cde2f, b3cd-8000bd3f, b3ce-10668b2c2f-10667bd2ef, abc2f-cdef2, a2bce-16000be3f+16001ce2f2,
7394ab3d-8000b4e-8001b3cf+16000bd2f2, ab2cf-bdef2,
7395a2bcf-16000be2f2+16001cef3, a4d-8000a3be+8001a3cf-2ae2f2;
7396//normalC: char 0: 1sec char 11: 0sec
7397//normalP: char 11: 0sec
7398
7399//2sec mit normalC, in char 2 ebenfalls (char 20 mit charp >1 min)
7400//4 Komp. in char 2, delta (0,0,0,0) -1, char 11:delta (-1,0,0,0) -1
7401ring r=32003,(b,s,t,u,v,w,x,y,z),dp;
7402ideal i=
7403wx2y3-vx2y2z+wx2yz2+wy3z2-vx2z3-vy2z3,
7404vx3y2-ux2y3+vx3z2-ux2yz2+vxy2z2-uy3z2,
7405tvx2y2-swx2y2+tvx2z2-swx2z2+tvy2z2-swy2z2,
7406sux2y2-bvx2y2+sux2z2-bvx2z2+suy2z2-bvy2z2,
7407tux2y3-bvx2y2z+tux2yz2+tuy3z2-bvx2z3-bvy2z3;
7408//normalC: char 2,32003: 1 sec
7409//normalP char withRing 2: 1sec, char 11: 40sec
7410
7411//---------------------------------------------------------
7412//genus:
7413int tt = timer;
7414list nor=normal(i, "noFac");nor;
7415timer-tt;
7416
7417//Yoshihiko Sakai, irred, 0sec, delta = 8
7418ring r=0,(x,y),dp;                    //genus 0 4 nodes and 6 cusps im P2
7419//ring r=7,(x,y),dp;                  //charp haengt in K = preimage(Q,phi,L)
7420ideal i=(x2+y^2-1)^3 +27x2y2;
7421
7422ring r=0,(x,y),dp;   //genus 0
7423ideal i=(x-y^2)^2 - y*x^3;
7424
7425ring r=0,(x,y),dp;  //genus 4
7426ideal i=y3-x6+1;
7427
7428int m=9;           // q=9: genus 0
7429int p=2;
7430int q=9;//2,...,9
7431ring r=0,(x,y),dp;
7432ideal i=y^m - x^p*(x - 1)^q;
7433
7434ring r=0,(x,y),dp;  //genus 19
7435ideal 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;
7436
7437ring r=23,(x,y),dp;  //genus 34, delta 2
7438ideal i=y10+(-2494x2+474)*y8+(84366+2042158x4-660492)*y6
7439        +(128361096x4-47970216x2+6697080-761328152x6)*y4
7440        +(-12024807786x4-506101284x2+15052058268x6+202172841-3212x8)*y2
7441        +34263110700x4-228715574724x6+5431439286x2+201803238
7442        -9127158539954x10-3212722859346x8;
7443//normalC, normalP 0 sec
7444
7445//Rob Koelman
7446//ring r=0,(x,y,z),dp;      //dim sing = 1 (nach ca 15 min abgebrochen)
7447ring r=32003,(x,y,z),dp;
7448ideal i=
7449761328152*x^6*z^4-5431439286*x^2*y^8+2494*x^2*z^8+228715574724*x^6*y^4+
7450 9127158539954*x^10-15052058268*x^6*y^2*z^2+3212722859346*x^8*y^2-
7451 134266087241*x^8*z^2-202172841*y^8*z^2-34263110700*x^4*y^6-6697080*y^6*z^4-
7452 2042158*x^4*z^6-201803238*y^10+12024807786*x^4*y^4*z^2-128361096*x^4*y^2*z^4+
7453 506101284*x^2*z^2*y^6+47970216*x^2*z^4*y^4+660492*x^2*z^6*y^2-
7454 z^10-474*z^8*y^2-84366*z^6*y^4;
7455//normalC char 32003: 10 sec, char 0 :
7456
7457//ring r=0,(x,y),dp;//genus 10  with 26 cusps (nach ca 4 min abgebrochen)
7458ring r=32003,(x,y),dp;    //24 sing, delta 24
7459ideal i=9127158539954x10+3212722859346x8y2+228715574724x6y4-34263110700x4y6
7460-5431439286x2y8-201803238y10-134266087241x8-15052058268x6y2+12024807786x4y4
7461+506101284x2y6-202172841y8+761328152x6-128361096x4y2+47970216x2y4-6697080y6
7462-2042158x4+660492x2y2-84366y4+2494x2-474y2-1;
7463//normalC 32003: 4 sec, char 0: abgebrochen bei pr = facstd(i); ###
7464
7465ring r=0,(x,y),dp;   //irred, genus 1  with 5 cusps, delta 5
7466ideal i=57y5+516x4y-320x4+66y4-340x2y3+73y3+128x2-84x2y2-96x2y;
7467//normalC 0 sec
7468
7469ring r=2,(x,y),dp;  //genus 4, 2 Zweige, delta (13,9) 89
7470ideal i=((x2+y3)^2+xy6)*((x3+y2)^2+x10y);
7471//normalC: char 2 : 1sec, char 0: lange
7472//normalP char 2 withRing: 0sec
7473
7474ring r=2,(y,z,w,u),dp; //2 Komp. genus -5
7475ideal i=y2+z2+w2+u2,w4-u4;
7476//normalC: char 2 : 0sec, char 0: 1sec
7477//normalP char 2 withRing: 0sec
7478
7479ring r=0,(y,z,w,u),dp; //irred. genus 9
7480ideal i=y2+z2+w2+u2,z4+w4+u4;
7481//char 0: 0sec
7482
7483ring r=0,(x,y,t),dp;  //irred, delta -1
7484ideal i= 25x8+200x7y+720x6y2+1520x5y3+2064x4y4+1856x3y5+1088x2y6+384xy7+64y8-12x6t2-72x5yt2-184x4y2t2-256x3y3t2-192x2y4t2-64xy5t2-2x4t4-8x3yt4+16xy3t4+16y4t4+4x2t6+8xyt6+8y2t6+t8;
7485//char 0: 0sec
7486
7487ring r=0,(x,y,z,w,u),dp;
7488ideal i=x2+y2+z2+w2+u2,x3+y3+z3,z4+w4+u4;
7489//char 0: 0sec
7490
7491//---------------------------------------------------------
7492//Probleme mit normalC in char 2 und char 0
7493
7494int tt = timer;
7495list nor=normalC(i,"withRing");nor;
7496timer-tt;
7497
7498//Mark van Hoeij
7499ring r=3,(x,y),dp;  //genus 19, delta 21
7500ideal i=y20+y13x+x4y5+x3*(x+1)^2;
7501//normalC: char 2 > 10 min   bei list SM = mstd(i);###
7502//normalP char 2 withRing: 0sec, char 11: haengt bei K = preimage(Q,phi,L);
7503
7504ring r=2,(x,y),dp;  //genus 35
7505ideal i=y30+y13x+x4y5+x3*(x+1)^2;
7506//char 0 abgebrochen bei list SM = mstd(i); ###
7507//char 2 nach ca 30 min
7508//normalC: char 2: abgebr. bei list SM = mstd(i);  //Now the work starts'
7509//normalC, withGens, char 2: abgebrochen bei Q=mstd(Q)[2];
7510//normalP char 2 withRing: 0sec
7511
7512ring r=0,(x,y),dp;   //irred, genus 55, delta 21
7513ideal i=y40+y13x+x4y5+x3*(x+1)^2;
7514//normalC: char 2 lange
7515//normalP char 2 withRing: 0sec
7516
7517ring r=29,(x,y,t),dp; //char 0: genus -5, 4 Komp, delta (-1,-1,0,0), -1
7518ideal 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;
7519//normalC: char 29 : 0sec, char 0: 0sec  //char 29 6 Komponenten
7520//normalP char 29 withRing: 1sec
7521
7522//-------------------------- problematic examples ------------------------
7523//ring r=0,(x,y,t),dp;
7524ring r=32003,(x,y,t),dp;
7525ideal i=
752632761x8+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;
7527//char 0: lange (es liegt an den grossen Zahlen), char 32003: 0 sec
7528
7529//dasselbe Beipiel in char 19: irred
7530ring r=0,(x,y,t),dp;
7531ideal i=
75325x8+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;
7533//normalP: char 2,3: 0sec, norTest 0,2 sec, char 11 haengt bei peimage
7534//normalC: char 3: 0 sec, char 0: 1sec
7535
7536//ring r=0,(x,y),dp;
7537ring r=32003,(x,y),dp;
7538ideal i=
7539x30y21+21x29y20+210x28y19+10x27y19+1330x27y18+190x26y18+5985x26y17
7540+1710x25y17+20349x25y16+45x24y17+9690x24y16+54264x24y15+765x23y16
7541+38760x23y15+116280x23y14+6120x22y15+116280x22y14+120x21y15
7542+203490x22y13+30600x21y14+271320x21y13+1799x20y14+293930x21y12+107100x20y13
7543+503880x20y12+12586x19y13+352716x20y11+278460x19y12+210x18y13+755820x19y11
7544+54509x18y12+352716x19y10+556920x18y11+2723x17y12+923780x18y10+163436x17y11
7545+293930x18y9+875160x17y10+16296x16y11+923780x17y9+359359x16y10+252x15y11
7546+203490x17y8+1093950x16y9+59598x15y10+755820x16y8+598598x15y9+2751x14y10
7547+116280x16y7+1093950x15y8+148610x14y9+503880x15y7+769197x14y8+13650x13y9
7548+54264x15y6+875160x14y7+266805x13y8+210x12y9+271320x14y6+768768x13y7
7549+40635x12y8+20349x14y5+556920x13y6+354816x12y7+1855x11y8+116280x13y5
7550+597597x12y6+80640x11y7+5985x13y4+278460x12y5+353892x11y6+7280x10y7+38760x12y4
7551+358358x11y5+112014x10y6+120x9y7+1330x12y3+107100x11y4+264726x10y5+16660x9y6
7552+9690x11y3+162799x10y4+111132x9y5+805x8y6+210x11y2+30600x10y3+146685x9y4
7553+24500x8y5+1710x10y2+54236x9y3+78750x8y4+2310x7y5+21x10y+6120x9y2+58520x8y3
7554+24010x7y4+45x6y5+190x9y+12509x8y2+39060x7y3+3675x6y4+x9+765x8y+15918x7y2
7555+15680x6y3+204x5y4+10x8+1786x7y+12915x6y2+3500x5y3+45x7+2646x6y+6580x5y2
7556+366x4y3+119x6+2562x5y+1995x4y2+10x3y3+203x5+1610x4y+324x3y2+231x4+630x3y
7557+23x2y2+175x3+141x2y+85x2+16xy+24x+y+4;
7558list nor = normal(i);
7559//normalC: char 0: ### haengt in SB of singular locus JM = mstd(J);
7560//normalC: char 32003,"noFac","equidim": 0sec, "noFac": 1sec
7561// ev neues interred
7562genus(i);         // haengt bei int mu=vdim(std(jacob(f)));
7563                  //### ist das noetig?
7564
7565//Singular rechnet genus richtig, auch im Fall, dass Kurve irreduzibel,
7566//aber nicht absolut irreduzibel ist:
7567ring r = 0,(x,y),dp;
7568ideal i = x2+y2;      //irreduzibel /Q aber reduzibel /C (x-iy)*(x+iy)
7569factorize( x2+y2);    //liefert irreduzibel
7570genus(i);             //sollte 0+0-2+1= -1 sein
7571genus(i,1);           //beides ist korrekt in Singular
7572
7573*/
Note: See TracBrowser for help on using the repository browser.