source: git/Singular/LIB/normal.lib @ 347543

spielwiese
Last change on this file since 347543 was 347543, checked in by Jakob Kroeker <kroeker@…>, 7 years ago
fix one error for sage in debug mode, see https://trac.sagemath.org/ticket/21624#comment:11
  • Property mode set to 100644
File size: 223.8 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
2728      minpoly=number(imap(B,p));
2729      map iota=S,a,a;
2730      number c=number(iota(c));
2731      number co=iota(co);
2732
2733      map alpha=S,x-c/co,y+a;
2734      poly f=alpha(f);
2735      f=cleardenom(f);
2736      if((w>=1)&&(ord(f)>=2))
2737      {
2738        "local analysis of the singularities";"";
2739        basering;
2740        alpha;
2741        f;
2742        pause();
2743        "";
2744      }
2745   }
2746   option(noredSB);
2747   ideal fstd=std(ideal(f)+jacob(f));
2748   poly hc=highcorner(fstd);
2749   int tau=vdim(fstd);
2750   int o=ord(f);
2751   int delt,nb;
2752
2753   if(tau==0)                 //smooth case
2754   {
2755      setring R;
2756      option(set,save_opt);
2757      return(list(0,0,1));
2758   }
2759   if((char(basering)>=181)||(char(basering)==0))
2760   {
2761      if(o==2)                //A_k-singularity
2762      {
2763        if(w>=1){"A_k-singularity";"";}
2764         setring R;
2765         delt=(tau+1) div 2;
2766         option(set,save_opt);
2767         return(list(d*delt,d*tau,d*(2*delt-tau+1)));
2768      }
2769      if((lead(f)==var(1)*var(2)^2)||(lead(f)==var(1)^2*var(2)))
2770      {
2771        if(w>=1){"D_k- singularity";"";}
2772
2773         setring R;
2774         delt=(tau+2) div 2;
2775         option(set,save_opt);
2776         return(list(d*delt,d*tau,d*(2*delt-tau+1)));
2777      }
2778
2779      int mu=vdim(std(jacob(f)));
2780
2781      poly g=f+var(1)^mu+var(2)^mu;  //to obtain a convenient Newton-polygon
2782
2783      list NP=newtonpoly(g);
2784      if(w>=1){"Newton-Polygon:";NP;"";}
2785      int s=size(NP);
2786
2787      if(is_NND(f,mu,NP))
2788      { // the Newton-polygon is non-degenerate
2789        // compute nb, the number of branches
2790        for(i=1;i<=s-1;i++)
2791        {
2792          nb=nb+gcd(NP[i][2]-NP[i+1][2],NP[i][1]-NP[i+1][1]);
2793        }
2794        if(w>=1){"Newton-Polygon is non-degenerated";"";}
2795        setring R;
2796        option(set,save_opt);
2797        return(list(d*(mu+nb-1) div 2,d*tau,d*nb));
2798      }
2799
2800      if(w>=1){"Newton-Polygon is degenerated";"";}
2801/* need to re-consider the degree bound (de):
2802      // the following can certainly be made more efficient when replacing
2803      // 'hnexpansion' (used only for computing number of branches) by
2804      // successive blowing-up + test if Newton polygon degenerate:
2805      if(s>2)    //  splitting of f
2806      {
2807         if(w>=1){"Newton polygon can be used for splitting";"";}
2808         intvec v=NP[1][2]-NP[2][2],NP[2][1];
2809         int de=w_deg(g,v);
2810         //int st=w_deg(hc,v)+v[1]+v[2];
2811         int st=w_deg(var(1)^NP[size(NP)][1],v)+1;
2812         poly f1=var(2)^NP[2][2];
2813         poly f2=jet(g,de,v)/var(2)^NP[2][2];
2814         poly h=g-f1*f2;
2815         de=w_deg(h,v);
2816         poly k;
2817         ideal wi=var(2)^NP[2][2],f2;
2818         matrix li;
2819         while(de<st)
2820         {
2821           k=jet(h,de,v);
2822           li=lift(wi,k);
2823           f1=f1+li[2,1];
2824           f2=f2+li[1,1];
2825           h=g-f1*f2;
2826           de=w_deg(h,v);
2827         }
2828         nb=deltaLoc(f1,maxideal(1))[3]+deltaLoc(f2,maxideal(1))[3];
2829
2830         setring R;
2831         option(set,save_opt);
2832         return(list(d*(mu+nb-1) div 2,d*tau,d*nb));
2833      }
2834*/
2835      f=jet(f,deg(hc)+2);
2836      if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";}
2837      ideal fac=factorize(f,1);
2838      if(size(fac)>1)
2839      {
2840         nb=0;
2841         for(i=1;i<=size(fac);i++)
2842         {
2843            nb=nb+deltaLoc(fac[i],maxideal(1))[3];
2844         }
2845         setring R;
2846         option(set,save_opt);
2847         return(list(d*(mu+nb-1) div 2,d*tau,d*nb));
2848      }
2849      list HNEXP=hnexpansion(f);
2850      if (typeof(HNEXP[1])=="ring")
2851      {
2852        def altring = basering;
2853        def HNEring = HNEXP[1]; setring HNEring;
2854        nb=size(hne);
2855        setring R;
2856        kill HNEring;
2857      }
2858      else
2859      {
2860        nb=size(HNEXP);
2861      }
2862      setring R;
2863      option(set,save_opt);
2864      return(list(d*(mu+nb-1) div 2,d*tau,d*nb));
2865   }
2866   else             //the case of small characteristic
2867   {
2868      f=jet(f,deg(hc)+2);
2869      if(w>=1){"now we have to use Hamburger-Noether (Puiseux) expansion";}
2870      delt=delta(f);
2871      setring R;
2872      option(set,save_opt);
2873      return(list(d*delt,d*tau,d));
2874   }
2875   option(set,save_opt);
2876}
2877example
2878{ "EXAMPLE:"; echo = 2;
2879  ring r=0,(x,y),dp;
2880  poly f=(x2+y^2-1)^3 +27x2y2;
2881  ideal I=f,jacob(f);
2882  I=std(I);
2883  list qr=minAssGTZ(I);
2884  size(qr);
2885  // each component of the singular locus either describes a cusp or a pair
2886  // of conjugated nodes:
2887  deltaLoc(f,qr[1]);
2888  deltaLoc(f,qr[2]);
2889  deltaLoc(f,qr[3]);
2890  deltaLoc(f,qr[4]);
2891  deltaLoc(f,qr[5]);
2892  deltaLoc(f,qr[6]);
2893}
2894///////////////////////////////////////////////////////////////////////////////
2895// compute the weighted degree of p;
2896// this code is an exact copy of the proc in paraplanecurves.lib
2897// (since we do not want to make it non-static)
2898static proc w_deg(poly p, intvec v)
2899{
2900   if(p==0){return(-1);}
2901   int d=0;
2902   while(jet(p,d,v)==0){d++;}
2903   d=(transpose(leadexp(jet(p,d,v)))*v)[1];
2904   return(d);
2905}
2906
2907//proc hilbPoly(ideal J)
2908//{
2909//   poly hp;
2910//   int i;
2911//   if(!attrib(J,"isSB")){J=std(J);}
2912//   intvec v = hilb(J,2);
2913//   for(i=1; i<=size(v); i++){ hp=hp+v[i]*(var(1)-i+2);}
2914//   return(hp);
2915//}
2916
2917
2918//////////////////////////////////////////////////////////////////////////////
2919
2920proc primeClosure (list L, list #)
2921"USAGE:    primeClosure(L [,c]); L a list of a ring containing a prime ideal
2922          ker, c an optional integer
2923RETURN:   a list L (of size n+1) consisting of rings L[1],...,L[n] such that
2924          - L[1] is a copy of (not a reference to!) the input ring L[1]
2925          - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi
2926            such that
2927                    L[1]/ker --> ... --> L[n]/ker
2928            are injections given by the corresponding ideals phi, and L[n]/ker
2929            is the integral closure of L[1]/ker in its quotient field.
2930          - all rings L[i] contain a polynomial nzd such that elements of
2931            L[i]/ker are quotients of elements of L[i-1]/ker with denominator
2932            nzd via the injection phi.
2933            L[n+1] is the delta invariant
2934NOTE:     - L is constructed by recursive calls of primeClosure itself.
2935          - c determines the choice of nzd:
2936               - c not given or equal to 0: first generator of the ideal SL,
2937                 the singular locus of Spec(L[i]/ker)
2938               - c<>0: the generator of SL with least number of monomials.
2939EXAMPLE:  example primeClosure; shows an example
2940"
2941{
2942  //---- Start with a consistency check:
2943
2944  if (!(typeof(L[1])=="ring"))
2945  {
2946      "// Parameter must be a ring or a list containing a ring!";
2947      return(-1);
2948  }
2949
2950  int dblvl = printlevel-voice+2;
2951  list gnirlist = ringlist(basering);
2952
2953  //---- Some auxiliary variables:
2954  int delt;                      //finally the delta invariant
2955  if ( size(L) == 1 )
2956  {
2957      L[2] = delt;              //set delta to 0
2958  }
2959  int n = size(L)-1;            //L without delta invariant
2960
2961  //---- How to choose the non-zerodivisor later on?
2962
2963  int nzdoption=0;
2964  if (size(#)>0)
2965  {
2966      nzdoption=#[1];
2967  }
2968
2969// R0 below is the ring to work with, if we are in step one, make a copy of the
2970// input ring, so that all objects are created in the copy, not in the original
2971// ring (therefore a copy, not a reference is defined).
2972
2973  if (n==1)
2974  {
2975      def R = L[1];
2976      list Rlist = ringlist(R);
2977      def BAS = basering;
2978      setring R;
2979      if (!(typeof(ker)=="ideal"))
2980      {
2981          "// No ideal ker in the input ring!";
2982          return (-1);
2983      }
2984      ker=simplify(interred(ker),15);
2985      //execute ("ring R0="+charstr(R)+",("+varstr(R)+"),("+ordstr(R)+");");
2986      // Rlist may be not defined in this new ring, so we define it again.
2987      list Rlist2 = ringlist(R);
2988      def R0 = ring(Rlist2);
2989      setring R0;
2990      ideal ker=fetch(R,ker);
2991      // check whether we compute the normalization of the blow up of
2992      // an isolated singularity at the origin (checked in normalI)
2993
2994      if (typeof(attrib(L[1],"iso_sing_Rees"))=="int")
2995      {
2996        attrib(R0,"iso_sing_Rees",attrib(L[1],"iso_sing_Rees"));
2997      }
2998      L[1]=R0;
2999  }
3000  else
3001  {
3002      def R0 = L[n];
3003      setring R0;
3004  }
3005
3006// In order to apply HomJJ from normal.lib, we need the radical of the singular
3007// locus of ker, J:=rad(ker):
3008
3009   list SM=mstd(ker);
3010
3011// In the first iteration, we have to compute the singular locus "from
3012// scratch".
3013// In further iterations, we can fetch it from the previous one but
3014// have to compute its radical
3015// the next rings R1 contain already the (fetched) ideal
3016
3017  if (n==1)                              //we are in R0=L[1]
3018  {
3019      if (typeof(attrib(R0,"iso_sing_Rees"))=="int")
3020      {
3021        ideal J;
3022        for (int s=1;s<=attrib(R0,"iso_sing_Rees");s++)
3023        {
3024          J=J,var(s);
3025        }
3026        J = J,SM[2];
3027        list JM = mstd(J);
3028      }
3029      else
3030      {
3031        if ( dblvl >= 1 )
3032        {"";
3033           "// compute the singular locus";
3034        }
3035        //### Berechnung des singulaeren Orts geaendert (ist so schneller)
3036        ideal J = minor(jacob(SM[2]),nvars(basering)-dim(SM[1]),SM[1]);
3037        J = J,SM[2];
3038        list JM = mstd(J);
3039      }
3040
3041      if ( dblvl >= 1 )
3042      {"";
3043         "// dimension of singular locus is", dim(JM[1]);
3044         if (  dblvl >= 2 )
3045         {"";
3046            "// the singular locus is:"; JM[2];
3047         }
3048      }
3049
3050      if ( dblvl >= 1 )
3051      {"";
3052         "// compute radical of singular locus";
3053      }
3054
3055      J = simplify(radical(JM[2]),2);
3056      if ( dblvl >= 1 )
3057      {"";
3058         "// radical of singular locus is:"; J;
3059         pause();
3060      }
3061  }
3062  else
3063  {
3064      if ( dblvl >= 1 )
3065      {"";
3066         "// compute radical of test ideal in ideal of singular locus";
3067      }
3068      J = simplify(radical(J),2);
3069      if ( dblvl >= 1 )
3070      {"";
3071         "// radical of test ideal is:"; J;
3072         pause();
3073      }
3074  }
3075
3076  // having computed the radical J of/in the ideal of the singular locus,
3077  // we now need to pick an element nzd of J;
3078  // NOTE: nzd must be a non-zero divisor mod ker, i.e. not contained in ker
3079
3080  poly nzd = J[1];
3081  poly nzd1 = NF(nzd,SM[1]);
3082  if (nzd1 != 0)
3083  {
3084     if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) )
3085     {
3086        nzd = nzd1;
3087     }
3088  }
3089
3090  if (nzdoption || nzd1==0)
3091  {
3092    for (int ii=2;ii<=ncols(J);ii++)
3093    {
3094      nzd1 = NF(J[ii],SM[1]);
3095      if ( nzd1 != 0 )
3096      {
3097        if ( (deg(nzd)>=deg(J[ii])) && (size(nzd)>size(J[ii])) )
3098        {
3099          nzd=J[ii];
3100        }
3101        if ( deg(nzd)>=deg(nzd1) && size(nzd)>size(nzd1) )
3102        {
3103          nzd = nzd1;
3104        }
3105      }
3106    }
3107  }
3108
3109  export nzd;
3110  // In this case we do not eliminate variables, so that the maps
3111  // are well defined.
3112  list RR = SM[1],SM[2],J,nzd,1;
3113
3114  if ( dblvl >= 1 )
3115  {"";
3116     "// compute the first ring extension:";
3117     "RR: ";
3118     RR;
3119  }
3120
3121  list RS = HomJJ(RR);
3122  //NOTE: HomJJ creates new ring with variables X(i) and T(j)
3123//-------------------------------------------------------------------------
3124// If we've reached the integral closure (as determined by the result of
3125// HomJJ), then we are done, otherwise we have to prepare the next iteration.
3126
3127  if (RS[2]==1)     // we've reached the integral closure, we are still in R0
3128    {
3129      kill J;
3130      if ( n== 1)
3131      {
3132        def R1 = RS[1];
3133        setring R1;
3134        ideal norid, normap = endid, endphi;
3135        kill endid,  endphi;
3136
3137        //"//### case: primeClosure, final";
3138        //"size norid:", size(norid), size(string(norid));
3139        //"interred:";
3140        //norid = interred(norid);
3141        //"size norid:", size(norid), size(string(norid));
3142
3143        export (norid, normap);
3144        L[1] = R1;
3145      }
3146      return(L);
3147    }
3148  else                        // prepare the next iteration
3149    {
3150      if (n==1)               // In the first iteration: keep only the data
3151      {                       // needed later on.
3152         kill RR,SM;
3153         export(ker);
3154      }
3155      if ( dblvl >= 1 )
3156      {"";
3157         "// computing the next ring extension, we are in loop"; n+1;
3158      }
3159
3160      def R1 = RS[1];         // The data of the next ring R1:
3161      delt = RS[3];           // the delta invariant of the ring extension
3162      setring R1;             // keep only what is necessary and kill
3163      ideal ker=endid;        // everything else.
3164      export(ker);
3165      ideal norid=endid;
3166
3167      //"//### case: primeClosure, loop", n+1;
3168      //"size norid:", size(norid), size(string(norid));
3169      //"interred:";
3170      //norid = interred(norid);        //????
3171      //"size norid:", size(norid), size(string(norid));
3172
3173      export(norid);
3174      kill endid;
3175
3176      map phi = R0,endphi;                        // fetch the singular locus
3177      ideal J = mstd(simplify(phi(J)+ker,4))[2];  // ideal J in R1
3178      export(J);
3179      if(n>1)
3180      {
3181         ideal normap=phi(normap);
3182      }
3183      else
3184      {
3185         ideal normap=endphi;
3186      }
3187      export(normap);
3188      kill phi;              // we save phi as ideal, not as map, so that
3189      ideal phi=endphi;      // we have more flexibility in the ring names
3190      kill endphi;           // later on.
3191      export(phi);
3192      L=insert(L,R1,n);       // Add the new ring R1 and go on with the
3193                              // next iteration
3194      if ( L[size(L)] >= 0 && delt >= 0 )
3195      {
3196         delt = L[size(L)] + delt;
3197      }
3198      else
3199      {
3200         delt = -1;
3201      }
3202      L[size(L)] = delt;
3203
3204      if (size(#)>0)
3205      {
3206          return (primeClosure(L,#));
3207      }
3208      else
3209      {
3210          return(primeClosure(L));         // next iteration.
3211      }
3212    }
3213}
3214example
3215{
3216  "EXAMPLE:"; echo=2;
3217  ring R=0,(x,y),dp;
3218  ideal I=x4,y4;
3219  def K=ReesAlgebra(I)[1];        // K contains ker such that K/ker=R[It]
3220  list L=primeClosure(K);
3221  def R(1)=L[1];                  // L[4] contains ker, L[4]/ker is the
3222  def R(4)=L[4];                  // integral closure of L[1]/ker
3223  setring R(1);
3224  R(1);
3225  ker;
3226  setring R(4);
3227  R(4);
3228  ker;
3229}
3230
3231///////////////////////////////////////////////////////////////////////////////
3232
3233proc closureFrac(list L)
3234"USAGE:    closureFrac (L); L a list of size n+1 as in the result of
3235          primeClosure, L[n] contains an additional polynomial f
3236CREATE:   a list fraction of two elements of L[1], such that
3237          f=fraction[1]/fraction[2] via the injections phi L[i]-->L[i+1].
3238EXAMPLE:  example closureFrac; shows an example
3239"
3240{
3241// Define some auxiliary variables:
3242
3243  int n=size(L)-1;
3244  int i,j,k,l,n2,n3;
3245  intvec V;
3246  string mapstr;
3247  for (i=1; i<=n; i++)
3248  {
3249    ASSUME(0, not isQuotientRing( L[i] ) );
3250    def R(i) = L[i];
3251  }
3252
3253// The quotient representing f is computed as in 'closureGenerators' with
3254// the differences that
3255//   - the loop is done twice: for the numerator and for the denominator;
3256//   - the result is stored in the list fraction and
3257//   - we have to make sure that no more objects of the rings R(i) survive.
3258
3259  for (j=1; j<=2; j++)
3260    {
3261      setring R(n);
3262      if (j==1)
3263      {
3264         poly p=f;
3265      }
3266      else
3267      {
3268         p=1;
3269      }
3270
3271      for (k=n; k>1; k--)
3272      {
3273          if (j==1)
3274          {
3275             map phimap=R(k-1),phi;
3276          }
3277
3278          p=p*phimap(nzd);
3279
3280          if (j==2)
3281          {
3282            kill phimap;
3283          }
3284
3285          if (j==1)
3286          {
3287             //### noch abfragen ob Z(i) definiert ist
3288             list gnirlist = ringlist(R(k));
3289             n2 = size(gnirlist[2]);
3290             n3 = size(gnirlist[3]);
3291             for( i=1; i<=ncols(phi); i++)
3292             {
3293               gnirlist[2][n2+i] = "Z("+string(i)+")";
3294             }
3295             V=0;
3296             V[ncols(phi)]=0; V=V+1;
3297             gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1);
3298             def S(k) = ring(gnirlist);
3299             setring S(k);
3300
3301             //execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+",
3302             //          Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k)))
3303             //          +"),dp("+string(ncols(phi))+"));");
3304
3305              ideal phi = imap(R(k),phi);
3306              ideal J = imap (R(k),ker);
3307              for (l=1;l<=ncols(phi);l++)
3308              {
3309                  J=J+(Z(l)-phi[l]);
3310              }
3311              J=groebner(J);
3312              poly h=NF(imap(R(k),p),J);
3313          }
3314          else
3315          {
3316              setring S(k);
3317              h=NF(imap(R(k),p),J);
3318              setring R(k);
3319              kill p;
3320          }
3321
3322          setring R(k-1);
3323
3324          if (j==1)
3325          {
3326              ideal maxi;
3327              maxi[nvars(R(k))] = 0;
3328              maxi = maxi,maxideal(1);
3329              map backmap = S(k),maxi;
3330
3331              //mapstr=" map backmap = S(k),";
3332              //for (l=1;l<=nvars(R(k));l++)
3333              //{
3334              //  mapstr=mapstr+"0,";
3335              //}
3336              //execute (mapstr+"maxideal(1);");
3337              poly p;
3338          }
3339          p=NF(backmap(h),std(ker));
3340          if (j==2)
3341          {
3342            kill backmap;
3343          }
3344        }
3345
3346      if (j==1)
3347        {
3348          if (defined(fraction))
3349            {
3350              kill fraction;
3351              list fraction=p;
3352            }
3353          else
3354            {
3355              list fraction=p;
3356            }
3357        }
3358      else
3359        {
3360          fraction=insert(fraction,p,1);
3361        }
3362    }
3363  export(fraction);
3364  return ();
3365}
3366example
3367{
3368  "EXAMPLE:"; echo=2;
3369  ring R=0,(x,y),dp;
3370  ideal ker=x2+y2;
3371  export ker;
3372  list L=primeClosure(R);          // We normalize R/ker
3373  for (int i=1;i<=size(L);i++) { def R(i)=L[i]; }
3374  setring R(2);
3375  kill R;
3376  phi;                             // The map R(1)-->R(2)
3377  poly f=T(2);                     // We will get a representation of f
3378  export f;
3379  L[2]=R(2);
3380  closureFrac(L);
3381  setring R(1);
3382  kill R(2);
3383  fraction;                        // f=fraction[1]/fraction[2] via phi
3384  kill R(1);
3385}
3386
3387///////////////////////////////////////////////////////////////////////////////
3388// closureGenerators is called inside proc normal (option "withGens" )
3389//
3390
3391// INPUT is the output of proc primeClosure (except for the last element, the
3392// delta invariant) : hence input is a list L consisting of rings
3393// L[1],...,L[n] (denoted R(1)...R(n) below) such that
3394// - L[1] is a copy of (not a reference to!) the input ring L[1]
3395// - all rings L[i] contain ideals ker, L[2],...,L[n] contain ideals phi
3396// such that
3397//                L[1]/ker --> ... --> L[n]/ker
3398// are injections given by the corresponding ideals phi, and L[n]/ker
3399// is the integral closure of L[1]/ker in its quotient field.
3400// - all rings L[i] contain a polynomial nzd such that elements of
3401// L[i]/ker are quotients of elements of L[i-1]/ker with denominator
3402// nzd via the injection phi.
3403
3404// COMPUTE: In the list L of rings R(1),...,R(n), compute representations of
3405// the ring variables of the last ring R(n) as fractions of elements of R(1):
3406// The proc returns an ideal preim s.t. preim[i]/preim[size(preim)] expresses
3407// the ith variable of R(n) as fraction of elements of the basering R(1)
3408// preim[size(preim)] is a non-zero divisor of basering/i.
3409
3410proc closureGenerators(list L);
3411{
3412  def Rees=basering;         // when called inside normalI (in reesclos.lib)
3413                             // the Rees Algebra is the current basering
3414
3415  // ------- First of all we need some variable declarations -----------
3416  int n = size(L);                // the number of rings R(1)-->...-->R(n)
3417  int length = nvars(L[n]);       // the number of variables of the last ring
3418  int j,k,l,n2,n3;
3419  intvec V;
3420  string mapstr;
3421  list preimages;
3422  //Note: the empty list belongs to no ring, hence preimages can be used
3423  //later in R(1)
3424  //this is not possible for ideals (belong always to some ring)
3425
3426  for (int i=1; i<=n; i++)
3427  {
3428     ASSUME(0, not isQuotientRing(L[i]) );
3429     def R(i) = L[i];          //give the rings from L a name
3430  }
3431
3432  // For each variable (counter j) and for each intermediate ring (counter k):
3433  // Find a preimage of var_j*phi(nzd(k-1)) in R(k-1).
3434  // Finally, do the same for nzd.
3435
3436  for (j=1; j <= length+1; j++ )
3437  {
3438      setring R(n);
3439
3440      if (j==1)
3441      {
3442        poly p;
3443      }
3444      if (j <= length )
3445      {
3446        p=var(j);
3447      }
3448      else
3449      {
3450        p=1;
3451      }
3452      //i.e. p=j-th var of R(n) for j<=length and p=1 for j=length+1
3453
3454      for (k=n; k>1; k--)
3455      {
3456
3457        if (j==1)
3458        {
3459          map phimap=R(k-1),phi;   //phimap:R(k-1)-->R(n), k=2..n, is the map
3460                                   //belonging to phi in R(n)
3461        }
3462
3463        p = p*phimap(nzd);
3464
3465          // Compute the preimage of [p mod ker(k)] under phi in R(k-1):
3466          // As p is an element of Image(phi), there is a polynomial h such
3467          // that h is mapped to [p mod ker(k)], and h can be computed as the
3468          // normal form of p w.r.t. a Groebner basis of
3469          // J(k) := <ker(k),Z(l)-phi(k)(l)> in R(k)[Z]=:S(k)
3470
3471        if (j==1)   // In the first iteration: Create S(k), fetch phi and
3472                    // ker(k) and construct the ideal J(k).
3473        {
3474         //### noch abfragen ob Z(i) definiert ist
3475         list gnirlist = ringlist(R(k));
3476         n2 = size(gnirlist[2]);
3477         n3 = size(gnirlist[3]);
3478         for( i=1; i<=ncols(phi); i++)
3479         {
3480            gnirlist[2][n2+i] = "Z("+string(i)+")";
3481         }
3482         V=0;
3483         V[ncols(phi)]=0;
3484         V=V+1;
3485         gnirlist[3] = insert(gnirlist[3],list("dp",V),n3-1);
3486         def S(k) = ring(gnirlist);
3487         setring S(k);
3488
3489        // execute ("ring S(k) = "+charstr(R(k))+",("+varstr(R(k))+",
3490        //           Z(1.."+string(ncols(phi))+")),(dp("+string(nvars(R(k)))
3491        //           +"),dp("+string(ncols(phi))+"));");
3492
3493          ideal phi = imap(R(k),phi);
3494          ideal J = imap (R(k),ker);
3495          for ( l=1; l<=ncols(phi); l++ )
3496          {
3497             J=J+(Z(l)-phi[l]);
3498          }
3499          J = groebner(J);
3500          poly h = NF(imap(R(k),p),J);
3501        }
3502        else
3503        {
3504           setring S(k);
3505           h = NF(imap(R(k),p),J);
3506        }
3507
3508        setring R(k-1);
3509
3510        if (j==1)  // In the first iteration: Compute backmap:S(k)-->R(k-1)
3511        {
3512           ideal maxi;
3513           maxi[nvars(R(k))] = 0;
3514           maxi = maxi,maxideal(1);
3515           map backmap = S(k),maxi;
3516
3517           //mapstr=" map backmap = S(k),";
3518           //for (l=1;l<=nvars(R(k));l++)
3519           //{
3520           //  mapstr=mapstr+"0,";
3521           //}
3522           //execute (mapstr+"maxideal(1);");
3523
3524           poly p;
3525        }
3526        p = NF(backmap(h),std(ker));
3527     }
3528     // Whe are down to R(1), store here the result in the list preimages
3529     preimages = insert(preimages,p,j-1);
3530  }
3531  ideal preim;                  //make the list preimages to an ideal preim
3532  for ( i=1; i<=size(preimages); i++ )
3533  {
3534     preim[i] = preimages[i];
3535  }
3536  // R(1) was a copy of Rees, so we have to get back to the basering Rees from
3537  // the beginning and fetch the result (the ideal preim) to this ring.
3538  setring Rees;
3539  return (fetch(R(1),preim));
3540}
3541
3542///////////////////////////////////////////////////////////////////////////////
3543//                From here: procedures for char p with Frobenius
3544///////////////////////////////////////////////////////////////////////////////
3545
3546proc normalP(ideal id,list #)
3547"USAGE:  normalP(id [,choose]); id = radical ideal, choose = optional list of
3548         strings.
3549         Optional parameters in list choose (can be entered in any order):@*
3550         \"withRing\", \"isPrim\", \"noFac\", \"noRed\", where@*
3551         - \"noFac\" -> factorization is avoided during the computation
3552         of the minimal associated primes.@*
3553         - \"isPrim\" -> assumes that the ideal is prime. If the assumption
3554         does not hold, output might be wrong.@*
3555         - \"withRing\" -> the ring structure of the normalization is
3556         computed. The number of variables in the new ring is reduced as much
3557         as possible.@*
3558         - \"noRed\" -> when computing the ring structure, no reduction on the
3559         number of variables is done, it creates one new variable for every
3560         new module generator of the integral closure in the quotient field.@*
3561ASSUME:  The characteristic of the ground field must be positive. If the
3562         option \"isPrim\" is not set, the minimal associated primes of id
3563         are computed first and hence normalP computes the normalization of
3564         the radical of id. If option \"isPrim\" is set, the ideal must be
3565         a prime ideal otherwise the result may be wrong.
3566RETURN:  a list, say 'nor' of size 2 (resp. 3 if \"withRing\" is set).@*
3567         ** If option \"withRing\" is not set: @*
3568         Only the module structure is computed: @*
3569         * nor[1] is a list of ideals Ii, i=1..r, in the basering R where r
3570         is the number of minimal associated prime ideals P_i of the input
3571         ideal id, describing the module structure:@*
3572         If Ii is given by polynomials g_1,...,g_k in R, then c:=g_k is
3573         non-zero in the ring R/P_i and g_1/c,...,g_k/c generate the integral
3574         closure of R/P_i as R-module in the quotient field of R/P_i.@*
3575         * nor[2] shows the delta invariants: it is a list of an intvec
3576         of size r, the delta invariants of the r components, and an integer,
3577         the total delta invariant of R/id
3578         (-1 means infinite, and 0 that R/P_i resp. R/id is normal). @*
3579         ** If option \"withRing\" is set: @*
3580         The ring structure is also computed, and in this case:@*
3581         * nor[1] is a list of r rings.@*
3582         Each ring Ri = nor[1][i], i=1..r, contains two ideals with given
3583         names @code{norid} and @code{normap} such that @*
3584         - Ri/norid is the normalization of R/P_i, i.e. isomorphic as
3585           K-algebra (K the ground field) to the integral closure of R/P_i in
3586           the field of fractions of R/P_i; @*
3587         - the direct sum of the rings Ri/norid is the normalization
3588           of R/id; @*
3589         - @code{normap} gives the normalization map from R to Ri/norid.@*
3590         * nor[2] gives the module generators of the normalization of R/P_i,
3591         it is the same as nor[1] if \"withRing\" is not set.@*
3592         * nor[3] shows the delta invariants, it is the same as nor[2] if
3593         \"withRing\" is not set.
3594THEORY:  normalP uses the Leonard-Pellikaan-Singh-Swanson algorithm (using the
3595         Frobenius) cf. [A. K. Singh, I. Swanson: An algorithm for computing
3596         the integral closure, arXiv:0901.0871].
3597         The delta invariant of a reduced ring A is dim_K(normalization(A)/A).
3598         For A=K[x1,...,xn]/id we call this number also the delta invariant of
3599         id. The procedure returns the delta invariants of the components P_i
3600         and of id.
3601NOTE:    To use the i-th ring type: @code{def R=nor[1][i]; setring R;}.
3602@*       Increasing/decreasing printlevel displays more/less comments
3603         (default: printlevel = 0).
3604@*       Not implemented for local or mixed orderings or quotient rings.
3605         For local or mixed orderings use proc 'normal'.
3606@*       If the input ideal id is weighted homogeneous a weighted ordering may
3607         be used (qhweight(id); computes weights).
3608@*       Works only in characteristic p > 0; use proc normal in char 0.
3609KEYWORDS: normalization; integral closure; delta invariant.
3610SEE ALSO: normal, normalC
3611EXAMPLE: example normalP; shows an example
3612"
3613{
3614   ASSUME(0, not isQuotientRing(basering) );
3615
3616   int i,j,y, sr, del, co;
3617   intvec deli;
3618   list resu, Resu, prim, Gens, mstdid;
3619   ideal gens;
3620
3621   // Default options
3622   int wring = 0;           // The ring structure is not computed.
3623   int noRed = 0;           // No reduction is done in the ring structure
3624   int isPrim = 0;          // Ideal is not assumed to be prime
3625   int noFac = 0;           // Use facstd when computing the decomposition
3626
3627
3628   y = printlevel-voice+2;
3629
3630   if ( attrib(basering,"global") != 1)
3631   {
3632     "";
3633     "// Not implemented for this ordering,";
3634     "// please change to global ordering!";
3635     return(resu);
3636   }
3637   if ( char(basering) <= 0)
3638   {
3639     "";
3640     "// Algorithm works only in positive characteristic,";
3641     "// use procedure 'normal' if the characteristic is 0";
3642     return(resu);
3643   }
3644
3645//--------------------------- define the method ---------------------------
3646   string method;                //make all options one string in order to use
3647                                 //all combinations of options simultaneously
3648   for ( i=1; i<= size(#); i++ )
3649   {
3650     if ( typeof(#[i]) == "string" )
3651     {
3652       method = method + #[i];
3653     }
3654   }
3655
3656   if ( find(method,"withring") or find(method,"withRing") )
3657   {
3658     wring=1;
3659   }
3660   if ( find(method,"noRed") or find(method,"nored") )
3661   {
3662     noRed=1;
3663   }
3664   if ( find(method,"isPrim") or find(method,"isprim") )
3665   {
3666     isPrim=1;
3667   }
3668   if ( find(method,"noFac") or find(method,"nofac"))
3669   {
3670     noFac=1;
3671   }
3672
3673   // check for 0-ideal
3674   if (size(id)==0)
3675   {
3676     list result=list(ideal(1)),list(intvec(0),int(0));
3677     // delta invariant,total delta invariant
3678     if (wring)
3679     {
3680       result[3]=result[2]; // pair(delta invariants , total delta invariant)
3681       result[2]=result[1];
3682       def BR = basering;
3683       list rl = ringlist(basering);
3684       def rng = ring(rl);
3685       setring rng;
3686       ideal norid = 0;
3687       ideal normap = maxideal(1);
3688       export(norid);
3689       export(normap);
3690       setring BR;
3691       result[1] = list(rng);
3692     }
3693     return (result);
3694   }
3695
3696   kill #;
3697   list #;
3698//--------------------------- start computation ---------------------------
3699   ideal II,K1,K2;
3700
3701   //----------- check first (or ignore) if input id is prime -------------
3702
3703   if ( isPrim )
3704   {
3705      prim[1] = id;
3706      if( y >= 0 )
3707      { "";
3708    "// ** WARNING: result is correct if ideal is prime (not checked) **";
3709    "// disable option \"isPrim\" to decompose ideal into prime components";"";
3710      }
3711   }
3712   else
3713   {
3714      if(y>=1)
3715      {  "// compute minimal associated primes"; }
3716
3717      if( noFac )
3718      { prim = minAssGTZ(id,1); }
3719      else
3720      { prim = minAssGTZ(id); }
3721
3722      if(y>=1)
3723      {
3724         prim;"";
3725         "// number of irreducible components is", size(prim);
3726      }
3727   }
3728
3729   //----------- compute integral closure for every component -------------
3730
3731      for(i=1; i<=size(prim); i++)
3732      {
3733         if(y>=1)
3734         {
3735            ""; pause(); "";
3736            "// start computation of component",i;
3737            "   --------------------------------";
3738         }
3739         if(y>=1)
3740         {  "// compute SB of ideal";
3741         }
3742         mstdid = mstd(prim[i]);
3743         if(y>=1)
3744         {  "// dimension of component is", dim(mstdid[1]);"";}
3745
3746      //------- 1-st main subprocedure: compute module generators ----------
3747         printlevel = printlevel+1;
3748         II = normalityTest(mstdid);
3749
3750      //------ compute also the ringstructure if "withRing" is given -------
3751         if ( wring )
3752         {
3753         //------ 2-nd main subprocedure: compute ring structure -----------
3754           if(noRed == 0){
3755             resu = list(computeRing(II,prim[i])) + resu;
3756           }
3757           else
3758           {
3759             resu = list(computeRing(II,prim[i], "noRed")) + resu;
3760           }
3761         }
3762         printlevel = printlevel-1;
3763
3764      //----- rearrange module generators s.t. denominator comes last ------
3765         gens=0;
3766         for( j=2; j<=size(II); j++ )
3767         {
3768            gens[j-1]=II[j];
3769         }
3770         gens[size(gens)+1]=II[1];
3771         Gens = list(gens) + Gens;
3772      //------------------------------ compute delta -----------------------
3773         K1 = mstdid[1]+II;
3774         K1 = std(K1);
3775         K2 = mstdid[1]+II[1];
3776         K2 = std(K2);
3777         // K1 = std(mstdid[1],II);      //### besser
3778         // K2 = std(mstdid[1],II[1]);   //### besser: Hannes, fixen!
3779         co = codim(K1,K2);
3780         deli = co,deli;
3781         if ( co >= 0 && del >= 0 )
3782         {
3783            del = del + co;
3784         }
3785         else
3786         { del = -1; }
3787      }
3788
3789      if ( del >= 0 )
3790      {
3791         int mul = iMult(prim);
3792         del = del + mul;
3793      }
3794      else
3795      { del = -1; }
3796
3797      deli = deli[1..size(deli)-1];
3798      if ( wring )
3799      { Resu = resu,Gens,list(deli,del); }
3800      else
3801      { Resu = Gens,list(deli,del); }
3802
3803   sr = size(prim);
3804
3805//-------------------- Finally print comments and return --------------------
3806   if(y >= 0)
3807   {"";
3808     if ( wring )
3809     {
3810"// 'normalP' created a list, say nor, of three lists:
3811// To see the result, type
3812     nor;
3813
3814// * nor[1] is a list of",sr,"ring(s):
3815// To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g.
3816     def R1 = nor[1][1]; setring R1;  norid; normap;
3817// for the other rings type first setring R; (if R is the name of your
3818// original basering) and then continue as for R1;
3819// Ri/norid is the affine algebra of the normalization of the i-th
3820// component R/P_i (where P_i is a min. associated prime of the input ideal)
3821// and normap the normalization map from R to Ri/norid;
3822
3823// * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of
3824// elements g1..gk of r such that the gj/gk generate the integral
3825// closure of R/P_i as R-module in the quotient field of R/P_i.
3826
3827// * nor[3] shows the delta-invariant of each component and of the input
3828// ideal (-1 means infinite, and 0 that r/P_i is normal).";
3829     }
3830     else
3831     {
3832"// 'normalP' computed a list, say nor, of two lists:
3833// To see the result, type
3834     nor;
3835
3836// * nor[1] is a list of",sr,"ideal(s), where each ideal nor[1][i] consists
3837// of elements g1..gk of the basering R such that gj/gk generate the integral
3838// closure of R/P_i (where P_i is a min. associated prime of the input ideal)
3839// as R-module in the quotient field of R/P_i;
3840
3841// * nor[2] shows the delta-invariant of each component and of the input ideal
3842// (-1 means infinite, and 0 that R/P_i is normal).";
3843     }
3844   }
3845
3846   return(Resu);
3847}
3848example
3849{ "EXAMPLE:"; echo = 2;
3850   ring r  = 11,(x,y,z),wp(2,1,2);
3851   ideal i = x*(z3 - xy4 + x2);
3852   list nor= normalP(i); nor;
3853   //the result says that both components of i are normal, but i itself
3854   //has infinite delta
3855   pause("hit return to continue");
3856
3857   ring s = 2,(x,y),dp;
3858   ideal i = y*((x-y^2)^2 - x^3);
3859   list nor = normalP(i,"withRing"); nor;
3860
3861   def R2  = nor[1][2]; setring R2;
3862   norid; normap;
3863}
3864
3865///////////////////////////////////////////////////////////////////////////////
3866// Assume: mstdid is the result of mstd(prim[i]), prim[i] a prime component of
3867// the input ideal id of normalP.
3868// Output is an ideal U s.t. U[i]/U[1] are module generators.
3869
3870static proc normalityTest(list mstdid)
3871{
3872   ASSUME(1, not isQuotientRing(basering) );
3873
3874   int y = printlevel-voice+2;
3875   intvec op = option(get);
3876   option(redSB);
3877   def R = basering;
3878   int n, p = nvars(R), char(R);
3879   int ii;
3880
3881   ideal J = mstdid[1];         //J is the SB of I
3882   if (J[1]==1) { return(ideal(0));}
3883   ideal I = mstdid[2];
3884   int h = n-dim(J);            //codimension of V(I), I is a prime ideal
3885
3886   //-------------------------- compute singular locus ----------------------
3887   qring Q = J;                 //pass to quotient ring
3888   ideal I = imap(R,I);
3889   ideal J = imap(R,J);
3890   attrib(J,"isSB",1);
3891   if ( y >= 1)
3892   { "start normality test";  "compute singular locus";}
3893
3894   ideal M = minor(jacob(I),h,J); //use the command minor modulo J (hence J=0)
3895   M = std(M);                    //this makes M much smaller
3896   //keep only minors which are not 0 mod I (!) this is important since we
3897   //need a nzd mod I
3898
3899   //---------------- choose nzd from ideal of singular locus --------------
3900   ideal D = M[1];
3901   for( ii=2; ii<=size(M); ii++ )            //look for the shortest one
3902   {
3903      if( size(M[ii]) < size(D[1]) )
3904      {
3905          D = M[ii];
3906      }
3907   }
3908
3909   //--------------- start p-th power algorithm and return ----------------
3910   ideal F = var(1)^p;
3911   for(ii=2; ii<=n; ii++)
3912   {
3913      F=F,var(ii)^p;
3914   }
3915
3916   ideal Dp=D^(p-1);
3917   ideal U=1;
3918   ideal K,L;
3919   map phi=Q,F;
3920   if ( y >= 1)
3921   {  "compute module generators of integral closure";
3922      "denominator D is:";  D;
3923      pause();
3924   }
3925
3926   ii=0;
3927   list LK;
3928   while(1)
3929   {
3930      ii=ii+1;
3931      if ( y >= 1)
3932      { "iteration", ii; }
3933      L = U*Dp + I;
3934      //### L=interred(L) oder mstd(L)[2]?
3935      //Wird dadurch kleiner aber string(L) wird groesser
3936      K = preimage(Q,phi,L);    //### Improvement by block ordering?
3937      option(returnSB);
3938      K = intersect(U,K);          //K is the new U, it is a SB
3939      LK = mstd(K);
3940      K = LK[2];
3941
3942   //---------------------------- simplify output --------------------------
3943      if(size(reduce(U,LK[1]))==0)  //previous U coincides with new U
3944      {                             //i.e. we reached the integral closure
3945         U=simplify(reduce(U,groebner(D)),2);
3946         U = D,U;
3947         poly gg = gcd(U[1],U[size(U)]);
3948         for(ii=2; ii<=size(U)-1 ;ii++)
3949         {
3950            gg = gcd(gg,U[ii]);
3951         }
3952         for(ii=1; ii<=size(U); ii++)
3953         {
3954            U[ii]=U[ii]/gg;
3955         }
3956         U = simplify(U,6);
3957         //if ( y >= 1)
3958         //{ "module generators are U[i]/U[1], with U:"; U;
3959         //  ""; pause(); }
3960         setring R;
3961         option(set,op);
3962         ideal U = imap(Q,U);
3963         return(U);
3964      }
3965      U=K;
3966   }
3967}
3968
3969///////////////////////////////////////////////////////////////////////////////
3970
3971static proc substpartSpecial(ideal endid, ideal endphi)
3972{
3973   ASSUME(1, not isQuotientRing(basering) );
3974
3975   //Note: newRing is of the form (R the original basering):
3976   //char(R),(T(1..N),X(1..nvars(R))),(dp(N),...);
3977
3978   int ii,jj,kk;
3979   def BAS = basering;
3980   int n = nvars(basering);
3981
3982   list Le = elimpart(endid);
3983   int q = size(Le[2]);                   //q variables have been substituted
3984//Le;"";
3985   if ( q == 0 )
3986   {
3987      ideal normap = endphi;
3988      ideal norid = endid;
3989      export(norid);
3990      export(normap);
3991      list L = BAS;
3992      return(L);
3993   }
3994
3995      list gnirlist = ringlist(basering);
3996      endid = Le[1];
3997//endphi;"";
3998      for( ii=1; ii<=n; ii++)
3999      {
4000         if( Le[4][ii] == 0 )            //ii=index of substituted var
4001         {
4002            endphi = subst(endphi,var(ii),Le[5][ii]);
4003         }
4004      }
4005//endphi;"";
4006      list g2 = gnirlist[2];             //the varlist
4007      list g3 = gnirlist[3];             //contains blocks of orderings
4008      int n3 = size(g3);
4009
4010   //----------------- first identify module ordering ------------------
4011      if ( g3[n3][1]== "c" or g3[n3][1] == "C" )
4012      {
4013         list gm = g3[n3];              //last blockis module ordering
4014         g3 = delete(g3,n3);
4015         int m = 0;
4016      }
4017      else
4018      {
4019         list gm = g3[1];              //first block is module ordering
4020         g3 = delete(g3,1);
4021         int m = 1;
4022      }
4023   //---- delete variables which were substituted and weights  --------
4024      intvec V;
4025      int n(0);
4026      list newg2;
4027      list newg3;
4028      for ( ii=1; ii<=n3-1; ii++ )
4029      {
4030        // If order is a matrix ordering, it is replaced by dp ordering.
4031        // TODO: replace it only when some of the original
4032        //       variables are eliminated.
4033        if(g3[ii][1] == "M"){
4034          g3[ii][1] = "dp";
4035          g3[ii][2] = (1..sqroot(size(g3[ii][2])))*0+1;
4036        }
4037        V = V,g3[ii][2];           //copy weights for ordering in each block
4038        if ( ii==1 )               //into one intvector
4039        {
4040           V = V[2..size(V)];
4041        }
4042        // int n(ii) = size(g3[ii][2]);
4043        int n(ii) = size(V);
4044        intvec V(ii);
4045
4046        for ( jj = n(ii-1)+1; jj<=n(ii); jj++)
4047        {
4048          if(  Le[4][jj] !=0 or                                             // jj=index of var which was not substituted
4049               (  (ii==n3-1) and ( jj==n(ii) ) and  (size(newg2)==0) )      // or we have no variables yet in the new ring and
4050                                                                            // want to keep at least the last one!
4051            )
4052          {
4053            kk=kk+1;
4054            newg2[kk] = g2[jj];   //not substituted var from varlist
4055            V(ii)=V(ii),V[jj];    //weight of not substituted variable
4056          }
4057        }
4058        if ( size(V(ii)) >= 2 )
4059        {
4060           V(ii) = V(ii)[2..size(V(ii))];
4061           list g3(ii)=g3[ii][1],V(ii);
4062           newg3 = insert(newg3,g3(ii),size(newg3));
4063//"newg3"; newg3;
4064        }
4065      }
4066//"newg3"; newg3;
4067      //newg3 = delete(newg3,1);    //delete empty list
4068
4069/*
4070//### neue Ordnung, 1 Block fuer alle vars, aber Gewichte erhalten;
4071//vorerst nicht realisiert, da bei leonhard1 alte Version (neue Variable T(i)
4072//ein neuer Block) ein kuerzeres Ergebnis liefert
4073      kill g3;
4074      list g3;
4075      V=0;
4076      for ( ii= 1; ii<=n3-1; ii++ )
4077      {
4078        V=V,V(ii);
4079      }
4080      V = V[2..size(V)];
4081
4082      if ( V==1 )
4083      {
4084         g3[1] = list("dp",V);
4085      }
4086      else
4087      {
4088         g3[1] = lis("wp",V);
4089      }
4090      newg3 = g3;
4091
4092//"newg3";newg3;"";
4093//### Ende neue Ordnung
4094*/
4095
4096      if ( m == 0 )
4097      {
4098         newg3 = insert(newg3,gm,size(newg3));
4099      }
4100      else
4101      {
4102         newg3 = insert(newg3,gm);
4103      }
4104      gnirlist[2] = newg2;
4105      gnirlist[3] = newg3;
4106
4107//gnirlist;
4108      def newBAS = ring(gnirlist);            //change of ring to less vars
4109      setring newBAS;
4110      ideal normap = imap(BAS,endphi);
4111      //normap = simplify(normap,2);
4112      ideal norid =  imap(BAS,endid);
4113      export(norid);
4114      export(normap);
4115      list L = newBAS;
4116      setring BAS;
4117      return(L);
4118
4119   //Hier scheint interred gut zu sein, da es Ergebnis relativ schnell
4120   //verkleinert. Hier wird z.B. bei leonard1 size(norid) verkleinert aber
4121   //size(string(norid)) stark vergroessert, aber es hat keine Auswirkungen
4122   //da keine map mehr folgt.
4123   //### Bei Leonard2 haengt interred (BUG)
4124   //mstd[2] verkleinert norid nocheinmal um die Haelfte, dauert aber 3.71 sec
4125   //### Ev. Hinweis auf mstd in der Hilfe?
4126
4127}
4128
4129///////////////////////////////////////////////////////////////////////////////
4130// Computes the ring structure of a ring given by module generators.
4131// Assume: J[i]/J[1] are the module generators in the quotient field
4132// with J[1] as universal denominator.
4133// If option "noRed" is not given, a reduction in the number of variables is
4134// attempted.
4135static proc computeRing(ideal J, ideal I, list #)
4136{
4137  ASSUME(1, not isQuotientRing(basering) );
4138
4139  int i, ii,jj;
4140  intvec V;                          // to be used for variable weights
4141  int y = printlevel-voice+2;
4142  def R = basering;
4143  poly c = J[1];                     // the denominator
4144  list gnirlist = ringlist(basering);
4145  string svars = varstr(basering);
4146  int nva = nvars(basering);
4147  string svar;
4148  ideal maxid = maxideal(1);
4149
4150  int noRed = 0;     // By default, we try to reduce the number of generators.
4151  if(size(#) > 0){
4152    if ( typeof(#[1]) == "string" )
4153    {
4154      if (#[1] == "noRed"){noRed = 1;}
4155    }
4156  }
4157
4158  if ( y >= 1){"// computing the ring structure...";}
4159
4160  if(c==1)
4161  {
4162/*    if( defined(norid) )  { kill norid; }
4163      if( defined(normap) ) { kill normap; }
4164      ideal norid = I;
4165      ideal normap =  maxid;  */
4166
4167    def R1 = ring(gnirlist);
4168    setring R1;
4169    ideal norid = imap(R, I);
4170    ideal normap = imap(R, maxid);
4171
4172
4173    if(noRed == 1){
4174      export norid;
4175      export normap;
4176      setring R;
4177      return(R1);
4178    }
4179    else
4180    {
4181      list L = substpartSpecial(norid,normap);
4182      def lastRing = L[1];
4183      setring R;
4184      return(lastRing);
4185    }
4186  }
4187
4188
4189  //-------------- Enlarge ring by creating new variables ------------------
4190  //check first whether variables T(i) and then whether Z(i),...,A(i) exist
4191  //old variable names are not touched
4192
4193  if ( find(svars,"T(") == 0 )
4194  {
4195    svar = "T";
4196  }
4197  else
4198  {
4199    for (ii=90; ii>=65; ii--)
4200    {
4201      if ( find(svars,ASCII(ii)+"(") == 0 )
4202      {
4203        svar = ASCII(ii);  break;
4204      }
4205    }
4206  }
4207
4208  int q = size(J)-1;
4209  if ( size(svar) != 0 )
4210  {
4211    for ( ii=q; ii>=1; ii-- )
4212    {
4213      gnirlist[2] = insert(gnirlist[2],svar+"("+string(ii)+")");
4214    }
4215  }
4216  else
4217  {
4218    for ( ii=q; ii>=1; ii-- )
4219    {
4220      gnirlist[2] = insert(gnirlist[2],"T("+string(100*nva+ii)+")");
4221    }
4222  }
4223
4224  V[q]=0;                        //create intvec of variable weights
4225  V=V+1;
4226  gnirlist[3] = insert(gnirlist[3],list("dp",V));
4227
4228  //this is a block ordering with one dp-block (1st block) for new vars
4229  //the remaining weights and blocks for old vars are kept
4230  //### perhaps better to make only one block, keeping weights ?
4231  //this might effect syz below
4232  //alt: ring newR = char(R),(X(1..nvars(R)),T(1..q)),dp;
4233  //Reihenfolge geaendert:neue Variablen kommen zuerst, Namen ev. nicht T(i)
4234
4235  def newR = ring(gnirlist);
4236  setring newR;                //new extended ring
4237  ideal I = imap(R,I);
4238
4239  //------------- Compute linear and quadratic relations ---------------
4240  if(y>=1)
4241  {
4242     "// compute linear relations:";
4243  }
4244  qring newQ = std(I);
4245
4246  ideal f = imap(R,J);
4247  module syzf = syz(f);
4248  ideal pf = f[1]*f;
4249  //f[1] is the denominator D from normalityTest, a non zero divisor of R/I
4250
4251  ideal newT = maxideal(1);
4252  newT = 1,newT[1..q];
4253  //matrix T = matrix(ideal(1,T(1..q)),1,q+1);   //alt
4254  matrix T = matrix(newT,1,q+1);
4255  ideal Lin = ideal(T*syzf);
4256  //Lin=interred(Lin);
4257  //### interred reduziert ev size aber size(string(LIN)) wird groesser
4258
4259  if(y>=1)
4260  {
4261    if(y>=3)
4262    {
4263      "//   the linear relations:";  Lin; pause();"";
4264    }
4265      "// the ring structure of the normalization as affine algebra";
4266      "//   number of linear relations:", size(Lin);
4267  }
4268
4269  if(y>=1)
4270  {
4271    "// compute quadratic relations:";
4272  }
4273  matrix A;
4274  ideal Quad;
4275  poly ff;
4276  newT = newT[2..size(newT)];
4277  matrix u;  // The units for non-global orderings.
4278
4279  // Quadratic relations
4280  for (ii=2; ii<=q+1; ii++ )
4281  {
4282    for ( jj=2; jj<=ii; jj++ )
4283    {
4284      ff = NF(f[ii]*f[jj],std(0));     // this makes lift much faster
4285      // For non-global orderings, we have to take care of the units.
4286      if(attrib(basering,"global") != 1)
4287      {
4288        A = lift(pf, ff, u);
4289        Quad = Quad,ideal(newT[jj-1]*newT[ii-1] * u[1, 1]- T*A);
4290      }
4291      else
4292      {
4293        A = lift(pf,ff);              // ff lin. comb. of elts of pf mod I
4294        Quad = Quad,ideal(newT[jj-1]*newT[ii-1] - T*A);
4295      }
4296      //A = lift(pf, f[ii]*f[jj]);
4297      //Quad = Quad, ideal(T(jj-1)*T(ii-1) - T*A);
4298    }
4299  }
4300  Quad = Quad[2..ncols(Quad)];
4301
4302  if(y>=1)
4303  {
4304    if(y>=3)
4305    {
4306      "//   the quadratic relations"; Quad; pause();"";
4307    }
4308      "//   number of quadratic relations:", size(Quad);
4309  }
4310  ideal Q1 = Lin,Quad;     //elements of Q1 are in NF w.r.t. I
4311
4312  //Q1 = mstd(Q1)[2];
4313  //### weglassen, ist sehr zeitaufwendig.
4314  //Ebenso interred, z.B. bei Leonard1 (1. Komponente von Leonard):
4315  //"size Q1:", size(Q1), size(string(Q1));   //75 60083
4316  //Q1 = interred(Q1);
4317  //"size Q1:", size(Q1), size(string(Q1));   //73 231956 (!)
4318  //### Speicherueberlauf bei substpartSpecial bei 'ideal norid  = phi1(endid)'
4319  //Beispiel fuer Hans um map zu testen!
4320
4321  setring newR;
4322  ideal endid  = imap(newQ,Q1),I;
4323  ideal endphi = imap(R,maxid);
4324
4325  if(noRed == 0){
4326    list L=substpartSpecial(endid,endphi);
4327    def lastRing=L[1];
4328    if(y>=1)
4329    {
4330      "//   number of substituted variables:", nvars(newR)-nvars(lastRing);
4331      pause();"";
4332    }
4333    setring R;
4334    return(lastRing);
4335  }
4336  else
4337  {
4338    ideal norid = endid;
4339    ideal normap = endphi;
4340    export(norid);
4341    export(normap);
4342    setring R;
4343    return(newR);
4344  }
4345}
4346
4347//                Up to here: procedures for char p with Frobenius
4348///////////////////////////////////////////////////////////////////////////////
4349
4350///////////////////////////////////////////////////////////////////////////////
4351//                From here: subprocedures for normal
4352
4353// inputJ is used in parametrization of rational curves algorithms, to specify
4354// a different test ideal.
4355
4356static proc normalM(ideal I, int decomp, int withDelta, int denomOption, ideal inputJ, ideal inputC){
4357// Computes the normalization of a ring R / I using the module structure as far
4358// as possible.
4359// The ring R is the basering.
4360// Input: ideal I
4361// Output: a list of 3 elements (resp 4 if withDelta = 1), say nor.
4362// - nor[1] = U, an ideal of R.
4363// - nor[2] = c, an element of R.
4364// U and c satisfy that 1/c * U is the normalization of R / I in the
4365// quotient field Q(R/I).
4366// - nor[3] = ring say T, containing two ideals norid and normap such that
4367// normap gives the normalization map from R / I to T / norid.
4368// - nor[4] = the delta invariant, if withDelta = 1.
4369
4370// Details:
4371// --------
4372// Computes the ideal of the minors in the first step and then reuses it in all
4373// steps.
4374// In step s, the denominator is D^s, where D is a nzd of the original quotient
4375// ring, contained in the radical of the singular locus.
4376// This denominator is used except when the degree of D^i is greater than the
4377// degree of a universal denominator.
4378// The nzd is taken as the smallest degree polynomial in the radical of the
4379// singular locus.
4380
4381// It assumes that the ideal I is equidimensional radical. This is not checked
4382// in the procedure!
4383// If decomp = 0 or decomp = 3 it assumes further that I is prime. Therefore
4384// any non-zero element in the jacobian ideal is assumed to be a
4385// non-zerodivisor.
4386
4387// It works over the given basering.
4388// If it has a non-global ordering, it changes it to dp global only for
4389// computing radical.
4390
4391// The delta invariant is only computed if withDelta = 1, and decomp = 0 or
4392// decomp = 3 (meaning that the ideal is prime).
4393
4394// denomOption = 0      -> Uses the smallest degree polynomial
4395// denomOption = i > 0  -> Uses a polynomial in the i-th variable
4396
4397  ASSUME(1, not isQuotientRing(basering) );
4398
4399  intvec save_opt=option(get);
4400  option(redSB);
4401  option(returnSB);
4402  int step = 0;                       // Number of steps. (for debugging)
4403  int dbg = printlevel - voice + 2;   // dbg = printlevel (default: dbg = 0)
4404  int i;                              // counter
4405  int isGlobal = attrib(basering,"global");
4406
4407  poly c;                     // The common denominator.
4408
4409  def R = basering;
4410
4411//------------------------ Groebner bases and dimension of I-----------------
4412  if(isGlobal == 1)
4413  {
4414    list IM = mstd(I);
4415    I = IM[1];
4416    ideal IMin = IM[2];   // A minimal set of generators in the groebner basis.
4417  }
4418  else
4419  {
4420    // The minimal set of generators is not computed by mstd for
4421    // non-global orderings.
4422    I = groebner(I);
4423    ideal IMin = I;
4424  }
4425  int d = dim(I);
4426
4427  // ---------------- computation of the singular locus ---------------------
4428  // We compute the radical of the ideal of minors modulo the original ideal.
4429  // This is done only in the first step.
4430  qring Q = I;   // We work in the quotient by the groebner base of the ideal I
4431  option(redSB);
4432  option(returnSB);
4433
4434  // If a conductor ideal was given as input, we use it instead of the
4435  // singular locus. If a test ideal was given as input, we do not compute the
4436  // singular locus.
4437  ideal inputC = fetch(R, inputC);
4438  ideal inputJ = fetch(R, inputJ);
4439  if((size(inputC) == 0) && (size(inputJ) == 0))
4440  {
4441    // We compute the radical of the ideal of minors modulo the original ideal.
4442    // This is done only in the first step.
4443    ideal I = fetch(R, I);
4444    attrib(I, "isSB", 1);
4445    ideal IMin = fetch(R, IMin);
4446
4447    dbprint(dbg, "Computing the jacobian ideal...");
4448
4449    // If a given conductor ideal is given, we use it.
4450    // If a given test ideal is given, we don't need to compute the jacobian
4451
4452    // reduction mod I in 'minor' is not working for local orderings!
4453    if(attrib(basering,"global"))
4454    {
4455      ideal J = minor(jacob(IMin), nvars(basering) - d, I);
4456    }
4457    else
4458    {
4459      ideal J = minor(jacob(IMin), nvars(basering) - d);
4460      J = reduce(J, groebner(I));
4461    }
4462    J = groebner(J);
4463  }
4464  else
4465  {
4466    ideal J = fetch(R, inputC);
4467    J = groebner(J);
4468  }
4469
4470  //------------------ We check if the singular locus is empty -------------
4471  if(J[1] == 1)
4472  {
4473    // The original ring R/I was normal. Nothing to do.
4474    // We define anyway a new ring, equal to R, to be able to return it.
4475    setring R;
4476    list lR = ringlist(R);
4477    def ROut = ring(lR);
4478    setring ROut;
4479    ideal norid = fetch(R, I);
4480    ideal normap = maxideal(1);
4481    export norid;
4482    export normap;
4483    setring R;
4484    if(withDelta)
4485    {
4486      list output = ideal(1), poly(1), ROut, 0;
4487    }
4488    else
4489    {
4490      list output = ideal(1), poly(1), ROut;
4491    }
4492    option(set,save_opt);
4493    return(list(output));
4494  }
4495
4496
4497  // -------------------- election of the universal denominator----------------
4498  // We first check if a conductor ideal was computed. If not, we don't
4499  // compute a universal denominator.
4500  ideal Id1;
4501  if(size(J) != 0)
4502  {
4503    if(denomOption == 0)
4504    {
4505      poly condu = getSmallest(J);   // Choses the polynomial of smallest degree
4506                                     // of J as universal denominator.
4507    }
4508    else
4509    {
4510      poly condu = getOneVar(J, denomOption);
4511    }
4512    if(dbg >= 1)
4513    {
4514      "";
4515      "The universal denominator is ", condu;
4516    }
4517
4518    // ----- splitting the ideal by the universal denominator (if possible) -----
4519    // If the ideal is equidimensional, but not necessarily prime, we check if
4520    // the universal denominator is a non-zerodivisor of R/I.
4521    // If not, we split I.
4522    if((decomp == 1) or (decomp == 2))
4523    {
4524      Id1 = quotient(0, condu);
4525      if(size(Id1) > 0)
4526      {
4527        // We have to split.
4528        if(dbg >= 1)
4529        {
4530          "A zerodivisor was found. We split the ideal. The zerodivisor is ", condu;
4531        }
4532        setring R;
4533        ideal Id1 = fetch(Q, Id1), I;
4534        Id1 = groebner(Id1);
4535        ideal Id2 = quotient(I, Id1);
4536        // I = I1 \cap I2
4537        printlevel = printlevel + 1;
4538        ideal JDefault = 0; // Now it uses the default J;
4539        list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault);
4540        list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault);
4541        printlevel = printlevel - 1;
4542        option(set,save_opt);
4543        list res = nor1 + nor2;
4544        return(res);
4545      }
4546    }
4547  }
4548  else
4549  {
4550    poly condu = 0;
4551  }
4552
4553  // --------------- computation of the first test ideal ---------------------
4554  // To compute the radical we go back to the original ring.
4555  // If we are using a non-global ordering, we must change to the global
4556  // ordering.
4557  setring R;
4558  // If a test ideal is given at the input, we use it.
4559  if(size(inputJ) == 0)
4560  {
4561    if(isGlobal == 1)
4562    {
4563      ideal J = fetch(Q, J);
4564      J = J, I;
4565      if(dbg >= 1)
4566      {
4567        "The original singular locus is";
4568        groebner(J);
4569        if(dbg >= 2){pause();}
4570        "";
4571      }
4572      // We check if the only singular point is the origin.
4573      // If so, the radical is the maximal ideal at the origin.
4574      J = groebner(J);
4575      if(locAtZero(J))
4576      {
4577        J = maxideal(1);
4578      }
4579      else
4580      {
4581        J = radical(J);
4582      }
4583    }
4584    else
4585    {
4586      // We change to global dp ordering.
4587      list rl = ringlist(R);
4588      list origOrd = rl[3];
4589      list newOrd = list("dp", intvec(1:nvars(R))), list("C", 0);
4590      rl[3] = newOrd;
4591      def globR = ring(rl);
4592      setring globR;
4593      ideal J = fetch(Q, J);
4594      ideal I = fetch(R, I);
4595      J = J, I;
4596      if(dbg >= 1)
4597      {
4598        "The original singular locus is";
4599        groebner(J);
4600        if(dbg>=2){pause();}
4601        "";
4602      }
4603      J = radical(J);
4604      setring R;
4605      ideal J = fetch(globR, J);
4606    }
4607  }
4608  else
4609  {
4610    ideal J = inputJ;
4611  }
4612
4613  if(dbg >= 1)
4614  {
4615    "The radical of the original singular locus is";
4616    J;
4617    if(dbg>=2){pause();}
4618  }
4619
4620  // ---------------- election of the non zero divisor ---------------------
4621  setring Q;
4622  J = fetch(R, J);
4623  J = interred(J);
4624  if(denomOption == 0)
4625  {
4626    poly D = getSmallest(J);    // Chooses the polynomial of smallest degree as
4627                                // non-zerodivisor.
4628  }
4629  else
4630  {
4631    poly D = getOneVar(J, denomOption);
4632  }
4633  if(dbg >= 1)
4634  {
4635    "The non zero divisor is ", D;
4636    "";
4637  }
4638
4639  // ------- splitting the ideal by the non-zerodivisor (if possible) --------
4640  // If the ideal is equidimensional, but not necessarily prime, we check if D
4641  // is actually a non-zerodivisor of R/I.
4642  // If not, we split I.
4643  if((decomp == 1) or (decomp == 2))
4644  {
4645    // We check if D is actually a non-zerodivisor of R/I.
4646    // If not, we split I.
4647    Id1 = quotient(0, D);
4648    if(size(Id1) > 0)
4649    {
4650      // We have to split.
4651      if(dbg >= 1)
4652      {
4653        "A zerodivisor was found. We split the ideal. The zerodivisor is ", D;
4654      }
4655      setring R;
4656      ideal Id1 = fetch(Q, Id1), I;
4657      Id1 = groebner(Id1);
4658      ideal Id2 = quotient(I, Id1);
4659      // I = Id1 \cap Id2
4660      printlevel = printlevel + 1;
4661
4662      ideal JDefault = 0;  // Now it uses the default J;
4663      list nor1 = normalM(Id1, decomp, withDelta, denomOption, JDefault, JDefault);
4664      list nor2 = normalM(Id2, decomp, withDelta, denomOption, JDefault, JDefault);
4665      printlevel = printlevel - 1;
4666      option(set,save_opt);
4667      list res = nor1 + nor2;
4668      return(res);
4669    }
4670  }
4671
4672  // --------------------- normalization ------------------------------------
4673  // We call normalMEqui to compute the normalization.
4674  setring R;
4675  poly D = fetch(Q, D);
4676  poly condu = fetch(Q, condu);
4677  J = fetch(Q, J);
4678  printlevel = printlevel + 1;
4679  list result = normalMEqui(I, J, condu, D, withDelta, denomOption);
4680  printlevel = printlevel - 1;
4681  option(set,save_opt);
4682  return(list(result));
4683}
4684
4685///////////////////////////////////////////////////////////////////////////////
4686
4687static proc normalMEqui(ideal I, ideal origJ, poly condu, poly D, int withDelta)
4688// Here is where the normalization is actually computed.
4689
4690// Computes the normalization of R/I. (basering is R)
4691// I is assumed to be radical and equidimensional.
4692// origJ is the first test ideal.
4693// D is a non-zerodivisor of R/I.
4694// condu is a non-zerodivisor in the conductor or 0 if it was not computed.
4695// If withDelta = 1, computes the delta invariant.
4696{
4697  ASSUME(1, not isQuotientRing(basering) );
4698  int step = 0;                       // Number of steps. (for debugging)
4699  int dbg = printlevel - voice + 2;   // dbg = printlevel (default: dbg = 0)
4700  int i;                              // counter
4701  int isNormal = 0;                   // check for exiting the loop
4702  int isGlobal = attrib(basering,"global");
4703  int delt;
4704
4705  def R = basering;
4706  poly c = D;
4707  ideal U,UU;
4708  ideal cJ;
4709  list testOut;                 // Output of proc testIdeal
4710                                // (the test ideal and the ring structure)
4711
4712  qring Q = groebner(I);
4713  intvec save_opt=option(get);
4714  option(redSB);
4715  option(returnSB);
4716  ideal J = imap(R, origJ);
4717  poly c = imap(R, c);
4718  poly D = imap(R, D);
4719  poly condu = imap(R, condu);
4720  ideal cJ;
4721  ideal cJMod;
4722
4723  dbprint(dbg, "Preliminar step begins.");
4724
4725  // --------------------- computation of A1 -------------------------------
4726  dbprint(dbg, "Computing the quotient (DJ : J)...");
4727  ideal U = groebner(quotient(D*J, J));
4728  ideal oldU = 1;
4729
4730  if(dbg >= 2) { "The quotient is"; U; }
4731
4732  // ----------------- Grauer-Remmert criterion check -----------------------
4733  // We check if the equality in Grauert - Remmert criterion is satisfied.
4734  isNormal = checkInclusions(D*oldU, U);
4735  if(isNormal == 0)
4736  {
4737    if(dbg >= 1)
4738    {
4739      "In this step, we have the ring 1/c * U, with c =", c;
4740      "and U = "; U;
4741    }
4742  }
4743  else
4744  {
4745    // The original ring R/I was normal. Nothing to do.
4746    // We define anyway a new ring, equal to R, to be able to return it.
4747    setring R;
4748    list lR = ringlist(R);
4749    def ROut = ring(lR);
4750    setring ROut;
4751    ideal norid = fetch(R, I);
4752    ideal normap = maxideal(1);
4753    export norid;
4754    export normap;
4755    setring R;
4756    if(withDelta)
4757    {
4758      list output = ideal(1), poly(1), ROut, 0;
4759    }
4760    else
4761    {
4762      list output = ideal(1), poly(1), ROut;
4763    }
4764    option(set,save_opt);
4765    return(output);
4766  }
4767
4768  // ----- computation of the chain of ideals A1 c A2 c ... c An ------------
4769  while(isNormal == 0)
4770  {
4771    step++;
4772    if(dbg >= 1) { ""; "Step ", step, " begins."; }
4773    dbprint(dbg, "Computing the test ideal...");
4774
4775    // --------------- computation of the test ideal ------------------------
4776    // Computes a test ideal for the new ring.
4777    // The test ideal will be the radical in the new ring of the original
4778    // test ideal.
4779    setring R;
4780    U = imap(Q, U);
4781    c = imap(Q, c);
4782    UU=0;
4783    for(i=1;i<=size(U);i++)
4784    {
4785       if(U[i]!=c){UU[size(UU)+1]=U[i];}
4786    }
4787    UU=interred(UU);
4788    attrib(UU,"isSB",1);
4789    U=c,UU;
4790    for(i=2;i<=size(U);i++)
4791    {
4792       U[i]=lead(U[i])+reduce(U[i]-lead(U[i]),UU);
4793    }
4794    testOut = testIdeal(I, U, origJ, c, D);
4795    cJ = testOut[1];
4796
4797    setring Q;
4798    U=imap(R,U);
4799    cJ = imap(R, cJ);
4800    cJ = groebner(cJ);
4801
4802    // cJ / c is now the ideal mapped back.
4803    // We have the generators as an ideal in the new ring,
4804    // but we want the generators as an ideal in the original ring.
4805    cJMod = getGenerators(cJ, U, c);
4806
4807    if(dbg >= 2) { "The test ideal in this step is "; cJMod; }
4808
4809    cJ = cJMod;
4810
4811    // ------------- computation of the quotient (DJ : J)--------------------
4812    oldU = U;
4813    dbprint(dbg, "Computing the quotient (c*D*cJ : cJ)...");
4814    U = quotient(c*D*cJ, cJ);
4815    if(dbg >= 2){"The quotient is "; U;}
4816
4817    // ------------- Grauert - Remmert criterion check ----------------------
4818    // We check if the equality in Grauert - Remmert criterion is satisfied.
4819    isNormal = checkInclusions(D*oldU, U);
4820
4821    if(isNormal == 1)
4822    {
4823      // We go one step back. In the last step we didnt get antyhing new,
4824      // we just verified that the ring was already normal.
4825      dbprint(dbg, "The ring in the previous step was already normal.");
4826      dbprint(dbg, "");
4827      U = oldU;
4828    }
4829    else
4830    {
4831      // ------------- preparation for next iteration ----------------------
4832      // We have to go on.
4833      // The new denominator is chosen.
4834      c = D * c;
4835
4836      // If we have a universal denominator of smaller degree than c,
4837      // we replace c by it.
4838      if(condu != 0)
4839      {
4840        if(deg(c) > deg(condu))
4841        {
4842          U = changeDenominatorQ(U, c, condu);
4843          c = condu;
4844        }
4845      }
4846      if(dbg >= 1)
4847      {
4848        "In this step, we have the ring 1/c * U, with c =", c;
4849        "and U = ";
4850        U;
4851        if(dbg>=2){pause();}
4852      }
4853    }
4854  }
4855
4856  // ------------------------- delta computation ----------------------------
4857  if(withDelta)
4858  {
4859    ideal UD = groebner(U);
4860    delt = vdim(std(modulo(UD, c)));
4861  }
4862
4863  // -------------------------- prepare output -----------------------------
4864  setring R;
4865  U = fetch(Q, U);
4866  c = fetch(Q, c);
4867
4868  // Ring structure of the new ring
4869  def ere = testOut[2];
4870  if(withDelta)
4871  {
4872    list output = U, c, ere, delt;
4873  }
4874  else
4875  {
4876    list output = U, c, ere;
4877  }
4878  option(set,save_opt);
4879  return(output);
4880}
4881
4882///////////////////////////////////////////////////////////////////////////////
4883
4884static proc lineUpLast(ideal U, poly c)
4885// Sets c as the last generator of U.
4886{
4887  int i;
4888  ideal newU;
4889  for (i = 1; i <= ncols(U); i++)
4890  {
4891    if(U[i] != c)
4892    {
4893      if(size(newU) == 0)
4894      { newU = U[i]; }
4895      else
4896      { newU = newU, U[i]; }
4897    }
4898  }
4899  if(size(newU) == 0)
4900  { newU = c; }
4901  else
4902  { newU = newU, c; }
4903  return(newU);
4904}
4905
4906///////////////////////////////////////////////////////////////////////////////
4907
4908static proc lineUp(ideal U, poly c)
4909// Sets c as the first generator of U.
4910{
4911  int i;
4912  ideal newU = c;
4913  for (i = 1; i <= ncols(U); i++)
4914  {
4915    if(U[i] != c)
4916    {
4917      newU = newU, U[i];
4918    }
4919  }
4920  return(newU);
4921}
4922
4923///////////////////////////////////////////////////////////////////////////////
4924
4925//WARNING - elim is not working here!! Check!!
4926//It is now replaced by computing an eliminating groebner basis.
4927proc getOneVar(ideal J, int vari)
4928"USAGE:   getOneVar(J, vari); J is a 0-dimensional ideal, vari is an integer.
4929RETURN:  a polynomial of J in the variable indicated by vari of smallest
4930         degree.@*
4931NOTE:    Works only over rings of two variables.@*
4932         It is intended mainly as an auxiliary procedure for computing
4933         integral bases. @*
4934EXAMPLE: example getOneVar; shows an example
4935"
4936{
4937  ASSUME(0, nvars(basering)==2 );
4938  ASSUME(0, (vari==2) || (vari==1) );
4939
4940  def R = basering;
4941  list RL = ringlist(R);
4942  // We keep everything from R but we change the ordering to lp, and we
4943  // order the variables as needed.
4944  RL[3] = list(list("lp", 1:2), list("C", 0:1));
4945  RL[2] = list(var(3-vari), var(vari));
4946  RL[4]=ideal(0); // does not work with qrings: Ex.7 of paraplanecurves
4947  def RR = ring(RL);
4948  setring RR;
4949  ideal J = imap(R, J);
4950  J = groebner(J);
4951  poly g = J[1];
4952  setring R;
4953  poly g = imap(RR, g);
4954  return(g);
4955}
4956example
4957{ "EXAMPLE:";
4958  printlevel = printlevel+1;
4959  echo = 2;
4960  ring s = 0,(x,y),dp;
4961  ideal J = x3-y, y3;
4962  getOneVar(J, 1);
4963
4964  echo = 0;
4965  printlevel = printlevel-1;
4966}
4967///////////////////////////////////////////////////////////////////////////////
4968
4969proc getSmallest(ideal J)
4970"USAGE:   getSmallest(J); J is an ideal.
4971RETURN:  the generator of J of smallest degree. If there are more than one, it
4972         chooses the one with smallest number of monomials.@*
4973NOTE:    It looks only at the generator of J, not at all the polynomials in
4974         the ideal.@*
4975         It is intended maninly to compute a good universal denominator in the
4976         normalization algorithms.@*
4977EXAMPLE: example getSmallest; shows an example
4978"
4979{
4980
4981// Computes the polynomial of smallest degree of J.
4982//
4983  int i;
4984  poly p = J[1];
4985  int d = deg(p);
4986  int di;
4987  for(i = 2; i <= ncols(J); i++)
4988  {
4989    if(J[i] != 0)
4990    {
4991      di = deg(J[i]);
4992      if(di < d)
4993      {
4994        p = J[i];
4995        d = di;
4996      }
4997      else
4998      {
4999        if(di == d)
5000        {
5001          if(size(J[i]) < size(p))
5002          {
5003            p = J[i];
5004          }
5005        }
5006      }
5007    }
5008  }
5009  return(p);
5010}
5011example
5012{ "EXAMPLE:";
5013  printlevel = printlevel+1;
5014  echo = 2;
5015  ring s = 0,(x,y),dp;
5016  ideal J = x3-y, y5, x2-y2+1;
5017  getSmallest(J);
5018
5019  echo = 0;
5020  printlevel = printlevel-1;
5021}
5022
5023///////////////////////////////////////////////////////////////////////////////
5024
5025static proc getGenerators(ideal J, ideal U, poly c)
5026{
5027
5028// Computes the generators of J as an ideal in the original ring,
5029// where J is given by generators in the new ring.
5030
5031// The new ring is given by 1/c * U in the total ring of fractions.
5032
5033  int i, j;                             // counters;
5034  int dbg = printlevel - voice + 2;     // dbg = printlevel (default: dbg = 0)
5035  poly p;                               // The lifted polynomial
5036  ideal JGr = groebner(J);              // Groebner base of J
5037
5038  if(dbg>1){"Checking for new generators...";}
5039  for(i = 1; i <= ncols(J); i++)
5040  {
5041    for(j = 1; j <= ncols(U); j++)
5042    {
5043      p = lift(c, J[i]*U[j])[1,1];
5044      p = reduce(p, JGr);
5045      if(p != 0)
5046      {
5047        if(dbg>1)
5048        {
5049          "New polynoial added:", p;
5050          if(dbg>4) {pause();}
5051        }
5052        JGr = JGr, p;
5053        JGr = groebner(JGr);
5054        J = J, p;
5055      }
5056    }
5057  }
5058  return(J);
5059}
5060
5061///////////////////////////////////////////////////////////////////////////////
5062
5063static proc testIdeal(ideal I, ideal U, ideal origJ, poly c, poly D)
5064{
5065
5066  ASSUME(1, not isQuotientRing(basering) );
5067
5068// Internal procedure, used in normalM.
5069// Computes the test ideal in the new ring.
5070// It takes the original test ideal and computes the radical of it in the
5071// new ring.
5072
5073// The new ring is 1/c * U.
5074// The original test ideal is origJ.
5075// The original ring is R / I, where R is the basering.
5076  intvec save_opt=option(get);
5077  int i;                                // counter
5078  int dbg = printlevel - voice + 2;     // dbg = printlevel (default: dbg = 0)
5079  def R = basering;                      // We dont work in the quo
5080  ideal J = origJ;
5081
5082  // ---------- computation of the ring structure of 1/c * U ----------------
5083  U = lineUp(U, c);
5084
5085  if(dbg > 1){"Computing the new ring structure...";}
5086  list ele = computeRing(U, I, "noRed");
5087
5088  def origEre = ele[1];
5089  setring origEre;
5090  if(dbg > 1){"The relations are"; norid;}
5091
5092  // ---------------- setting the ring to work in  --------------------------
5093  int isGlobal = attrib(origEre,"global");      // Checks if the original ring has
5094                                         // global ordering.
5095  if(isGlobal != 1)
5096  {
5097    list rl = ringlist(origEre);
5098    list origOrd = rl[3];
5099    list newOrd = list("dp", intvec(1:nvars(origEre))), list("C", 0);
5100    rl[3] = newOrd;
5101    def ere = ring(rl);     // globR is the original ring but
5102                            // with a global ordering.
5103    setring ere;
5104    ideal norid = imap(origEre, norid);
5105  }
5106  else
5107  {
5108    def ere = origEre;
5109  }
5110
5111  ideal I = imap(R, I);
5112  ideal J = imap(R, J);
5113  J = J, norid, I;
5114
5115
5116  // ----- computation of the test ideal using the ring structure of Ai -----
5117
5118  option(redSB);
5119  option(returnSB);
5120
5121  if(dbg > 1){"Computing the radical of J...";}
5122  J = radical(J);
5123  if(dbg > 1){"Computing the interreduction of the radical...";}
5124  J = groebner(J);
5125  //J = interred(J);
5126  if(dbg > 1)
5127  {
5128    "The radical in the generated ring is";
5129    J;
5130    if(dbg>4){pause();}
5131  }
5132
5133  setring ere;
5134
5135  // -------------- map from Ai to the total ring of fractions ---------------
5136  // Now we must map back this ideal J to U_i / c in the total ring of
5137  // fractions.
5138  // The map sends T_j -> u_j / c.
5139  // The map is built by the following steps:
5140  // 1) We compute the degree of the generators of J with respect to the
5141  //    new variables T_j.
5142  // 2) For each generator, we multiply each term by a power of c, as if
5143  //    taking c^n as a common denominator (considering the new variables as
5144  //    a polynomial in the old variables divided by c).
5145  // 3) We replace the new variables T_j by the corresponding numerator u_j.
5146  // 4) We lift the resulting polynomial to change the denominator
5147  //    from c^n to c.
5148  int nNewVars = nvars(ere) - nvars(R);      // Number of new variables
5149  poly c = imap(R, c);
5150  intvec @v = 1..nNewVars;    // Vector of the new variables.
5151                              // They must be the first ones.
5152  if(dbg > 1){"The indices of the new variables are", @v;}
5153
5154  // ---------------------- step 1 of the mapping ---------------------------
5155  intvec degs;
5156  for(i = 1; i<=ncols(J); i++)
5157  {
5158    degs[i] = degSubring(J[i], @v);
5159  }
5160  if(dbg > 1)
5161  {
5162    "The degrees with respect to the new variables are";
5163    degs;
5164  }
5165
5166  // ---------------------- step 2 of the mapping ---------------------------
5167  ideal mapJ = mapBackIdeal(J, c, @v);
5168
5169  setring R;
5170
5171  // ---------------------- step 3 of the mapping ---------------------------
5172  ideal z;                    // The variables of the original ring in order.
5173  for(i = 1; i<=nvars(R); i++)
5174  {
5175    z[i] = var(i);
5176  }
5177
5178  map f = ere, U[2..ncols(U)], z[1..ncols(z)]; // The map to the original ring.
5179  if(dbg > 1)
5180  {
5181    "The map is ";
5182    f;
5183    if(dbg>4){pause();}
5184  }
5185
5186  if(dbg > 1){ "Computing the map..."; }
5187
5188  J = f(mapJ);
5189  if(dbg > 1)
5190  {
5191    "The ideal J mapped back (before lifting) is";
5192    J;
5193    if(dbg>4){pause();}
5194  }
5195
5196  // ---------------------- step 4 of the mapping ---------------------------
5197  qring Q = groebner(I);
5198  ideal J = imap(R, J);
5199  poly c = imap(R, c);
5200  for(i = 1; i<=ncols(J); i++)
5201  {
5202    if(degs[i]>1)
5203    {
5204      J[i] = lift(c^(degs[i]-1), J[i])[1,1];
5205    }
5206    else
5207    {
5208      if(degs[i]==0) { J[i] = c*J[i]; }
5209    }
5210  }
5211
5212  if(dbg > 1)
5213  {
5214    "The ideal J lifted is";
5215    J;
5216    if(dbg>4){pause();}
5217  }
5218
5219  // --------------------------- prepare output ----------------------------
5220  J = groebner(J);
5221
5222  setring R;
5223  J = imap(Q, J);
5224
5225  option(set,save_opt);
5226  return(list(J, ele[1]));
5227}
5228
5229///////////////////////////////////////////////////////////////////////////////
5230
5231proc changeDenominator(ideal U1, poly c1, poly c2, ideal I)
5232"USAGE:   changeDenominator(U1, c1, c2, I); U1 and I ideals, c1 and c2
5233         polynomials.@*
5234RETURN:  an ideal U2 such that the A-modules 1/c1 * U1 and 1/c2 * U2 are equal,
5235         where A = R/I and R is the basering.@*
5236NOTE:    It assumes that such U2 exists. It is intended maninly as an auxiliary
5237         procedure in the normalization algorithms.@*
5238EXAMPLE: example changeDenominator; shows an example
5239"
5240{
5241  ASSUME(0, not isQuotientRing(basering) );
5242// Let A = R / I. Given an A-module in the form 1/c1 * U1 (U1 ideal of A), it
5243// computes a new ideal U2 such that the the A-module is 1/c2 * U2.
5244// The base ring is R, but the computations are to be done in R / I.
5245  int a;      // counter
5246  def R = basering;
5247  qring Q = I;
5248  ideal U1 = fetch(R, U1);
5249  poly c1 = fetch(R, c1);
5250  poly c2 = fetch(R, c2);
5251  ideal U2 = changeDenominatorQ(U1, c1, c2);
5252  setring R;
5253  ideal U2 = fetch(Q, U2);
5254  return(U2);
5255}
5256example
5257{
5258  "EXAMPLE:";
5259  echo = 2;
5260  ring s = 0,(x,y),dp;
5261  ideal I = y5-y4x+4y2x2-x4;
5262  ideal U1 = normal(I)[2][1];
5263  poly c1 = U1[4];
5264  U1;c1;
5265  // 1/c1 * U1 is the normalization of I.
5266  ideal U2 = changeDenominator(U1, c1, x3, I);
5267  U2;
5268  // 1/x3 * U2 is also the normalization of I, but with a different denominator.
5269  echo = 0;
5270}
5271
5272///////////////////////////////////////////////////////////////////////////////
5273
5274static proc changeDenominatorQ(ideal U1, poly c1, poly c2)
5275{
5276// Given a ring in the form 1/c1 * U, it computes a new U2 st the ring
5277// is 1/c2 * U2.
5278// The base ring is already a quotient ring R / I.
5279  int a;      // counter
5280  ideal U2;
5281  poly p;
5282  for(a = 1; a <= ncols(U1); a++)
5283  {
5284    p = lift(c1, c2*U1[a])[1,1];
5285    U2[a] = p;
5286  }
5287  return(U2);
5288}
5289
5290///////////////////////////////////////////////////////////////////////////////
5291
5292static proc checkInclusions(ideal U1, ideal U2)
5293{
5294// Checks if the identity A = Hom(J, J) of Grauert-Remmert criterion is
5295// satisfied.
5296  int dbg = printlevel - voice + 2;     // dbg = printlevel (default: dbg = 0)
5297  list reduction1;
5298  list reduction2;
5299
5300  // ---------------------- inclusion Hom(J, J) c A -------------------------
5301  if(dbg > 1){"Checking the inclusion Hom(J, J) c A:";}
5302  // This interred is used only because a bug in groebner!
5303  U1 = groebner(U1);
5304  reduction1 = reduce(U2, U1);
5305  if(dbg > 1){reduction1[1];}
5306
5307  // ---------------------- inclusion A c Hom(J, J) -------------------------
5308  // The following check should always be satisfied.
5309  // This is only used for debugging.
5310  if(dbg > 1)
5311  {
5312    "and the inclusion A c Hom(J, J): (this should always be satisfied)";
5313    // This interred is used only because a bug in groebner!
5314    U2 = groebner(U2);
5315    reduction2 = reduce(U1, groebner(U2));
5316    reduction2[1];
5317    if(size(reduction2[1]) > 0)
5318    {
5319      "Something went wrong... (this inclusion should always be satisfied)";
5320      ~;
5321    }
5322    else
5323    {
5324      if(dbg>4){pause();}
5325    }
5326  }
5327
5328  if(size(reduction1[1]) == 0)
5329  {
5330    // We are done! The ring computed in the last step was normal.
5331    return(1);
5332  }
5333  else
5334  {
5335    return(0);
5336  }
5337}
5338
5339///////////////////////////////////////////////////////////////////////////////
5340
5341static proc degSubring(poly p, intvec @v)
5342{
5343  ASSUME(1, not isQuotientRing(basering) );
5344// Computes the degree of a polynomial taking only some variables as variables
5345// and the others as parameters.
5346
5347// The degree is taken w.r.t. the variables indicated in v.
5348  int i;      // Counter
5349  int d = 0;  // The degree
5350  int e;      // Degree (auxiliar variable)
5351  for(i = 1; i <= size(p); i++)
5352  {
5353    e = sum(leadexp(p[i]), @v);
5354    if(e > d){d = e;}
5355  }
5356  return(d);
5357}
5358
5359///////////////////////////////////////////////////////////////////////////////
5360
5361static proc mapBackIdeal(ideal I, poly c, intvec @v)
5362{
5363   ASSUME(1, not isQuotientRing(basering) );
5364
5365// Modifies all polynomials in I so that a map x(i) -> y(i)/c can be
5366// carried out.
5367
5368// v indicates wicih variables x(i) of the ring will be mapped to y(i)/c.
5369
5370  int i;  // counter
5371  for(i = 1; i <= ncols(I); i++)
5372  {
5373    I[i] = mapBackPoly(I[i], c, @v);
5374  }
5375  return(I);
5376}
5377
5378///////////////////////////////////////////////////////////////////////////////
5379
5380static proc mapBackPoly(poly p, poly c, intvec @v)
5381{
5382  ASSUME(1, not isQuotientRing(basering) );
5383
5384// Multiplies each monomial of p by a power of c so that a map x(i) -> y(i)/c
5385// can be carried out.
5386
5387// v indicates wicih variables x(i) of the ring will be mapped to y(i)/c.
5388  int i;  // counter
5389  int e;  // exponent
5390  int d = degSubring(p, @v);
5391  poly g = 0;
5392  int size_p=size(p);
5393  for(i = 1; i <= size_p; i++)
5394  {
5395    e = sum(leadexp(p[i]), @v);
5396    g = g + p[i] * c^(d-e);
5397  }
5398  return(g);
5399}
5400
5401//                    End procedures for normal
5402///////////////////////////////////////////////////////////////////////////////
5403
5404
5405///////////////////////////////////////////////////////////////////////////////
5406//                  Begin procedures for normalC
5407
5408// We first define resp. copy some attributes to be used in proc normal and
5409// static proc normalizationPrimes, and ..., to speed up computation in
5410// special cases
5411//NOTE:  We use the following attributes:
5412// 1     attrib(id,"isCohenMacaulay");         //--- Cohen Macaulay
5413// 2     attrib(id,"isCompleteIntersection");  //--- complete intersection
5414// 3     attrib(id,"isHypersurface");          //--- hypersurface
5415// 4     attrib(id,"isEquidimensional");       //--- equidimensional ideal
5416// 5     attrib(id,"isPrim");                  //--- prime ideal
5417// 6     attrib(id,"isRegInCodim2");           //--- regular in codimension 2
5418// 7     attrib(id,"isIsolatedSingularity");   //--- isolated singularities
5419// 8     attrib(id,"onlySingularAtZero");      //--- only singular at 0
5420// 9     attrib(id,"isRadical");               //--- radical ideal
5421//Recall: (attrib(id,"xy"),1) sets attrib xy to TRUE and
5422//        (attrib(id,"xy"),0) to FALSE
5423
5424static proc getAttrib (ideal id)
5425"USAGE:   getAttrib(id);  id=ideal
5426COMPUTE: check attributes for id. If the attributes above are defined,
5427         take its value, otherwise define it and set it to 0
5428RETURN:  intvec of size 9, with entries 0 or 1,  values of attributes defined
5429         above (in this order)
5430EXAMPLE: no example
5431"
5432{
5433  int isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad;
5434
5435  if( typeof(attrib(id,"isCohenMacaulay"))=="int" )
5436  {
5437    if( attrib(id,"isCohenMacaulay")==1 )
5438    { isCoM=1; isEq=1; }
5439  }
5440
5441  if( typeof(attrib(id,"isCompleteIntersection"))=="int" )
5442  {
5443    if(attrib(id,"isCompleteIntersection")==1)
5444    { isCoI=1; isCoM=1; isEq=1; }
5445  }
5446
5447  if( typeof(attrib(id,"isHypersurface"))=="int" )
5448  {
5449    if(attrib(id,"isHypersurface")==1)
5450    { isHy=1; isCoI=1; isCoM=1; isEq=1; }
5451  }
5452
5453  if( typeof(attrib(id,"isEquidimensional"))=="int" )
5454  {
5455    if(attrib(id,"isEquidimensional")==1)
5456    { isEq=1; }
5457  }
5458
5459  if( typeof(attrib(id,"isPrim"))=="int" )
5460  {
5461    if(attrib(id,"isPrim")==1)
5462    { isPr=1; }
5463  }
5464
5465  if( typeof(attrib(id,"isRegInCodim2"))=="int" )
5466  {
5467    if(attrib(id,"isRegInCodim2")==1)
5468    { isReg=1; }
5469  }
5470
5471  if( typeof(attrib(id,"isIsolatedSingularity"))=="int" )
5472  {
5473    if(attrib(id,"isIsolatedSingularity")==1)
5474    { isIso=1; }
5475  }
5476
5477  if( typeof(attrib(id,"onlySingularAtZero"))=="int" )
5478  {
5479    if(attrib(id,"onlySingularAtZero")==1)
5480    { oSAZ=1; }
5481  }
5482
5483  if( typeof(attrib(id,"isRad"))=="int" )
5484  {
5485    if(attrib(id,"isRad")==1)
5486    { isRad=1; }
5487  }
5488
5489  intvec atr = isCoM,isCoI,isHy,isEq,isPr,isReg,isIso,oSAZ,isRad;
5490  return(atr);
5491}
5492
5493///////////////////////////////////////////////////////////////////////////////
5494
5495static proc setAttrib (ideal id, intvec atr)
5496"USAGE:   setAttrib(id,atr);  id ideal, atr intvec
5497COMPUTE: set attributes to id specified by atr
5498RETURN:  id, with assigned attributes from atr
5499EXAMPLE: no example
5500"
5501{
5502  attrib(id,"isCohenMacaulay",atr[1]);         //--- Cohen Macaulay
5503  attrib(id,"isCompleteIntersection",atr[2]);  //--- complete intersection
5504  attrib(id,"isHypersurface",atr[3]);          //--- hypersurface
5505  attrib(id,"isEquidimensional",atr[4]);       //--- equidimensional ideal
5506  attrib(id,"isPrim",atr[5]);                  //--- prime ideal
5507  attrib(id,"isRegInCodim2",atr[6]);           //--- regular in codimension 2
5508  attrib(id,"isIsolatedSingularity",atr[7]);   //--- isolated singularities
5509  attrib(id,"onlySingularAtZero",atr[8]);      //--- only singular at 0
5510  attrib(id,"isRadical",atr[9]);               //--- radical ideal
5511
5512  return(id);
5513}
5514
5515///////////////////////////////////////////////////////////////////////////////
5516// copyAttribs is not used anywhere so far
5517
5518static proc copyAttribs (ideal id1, ideal id)
5519"USAGE:   copyAttribs(id1,id);  id1, id ideals
5520COMPUTE: copy attributes from id1 to id
5521RETURN:  id, with assigned attributes from id1
5522EXAMPLE: no example
5523"
5524{
5525  if( typeof(attrib(id1,"isCohenMacaulay"))=="int" )
5526  {
5527    if( attrib(id1,"isCohenMacaulay")==1 )
5528    {
5529      attrib(id,"isEquidimensional",1);
5530    }
5531  }
5532  else
5533  {
5534    attrib(id,"isCohenMacaulay",0);
5535  }
5536
5537  if( typeof(attrib(id1,"isCompleteIntersection"))=="int" )
5538  {
5539    if(attrib(id1,"isCompleteIntersection")==1)
5540    {
5541      attrib(id,"isCohenMacaulay",1);
5542      attrib(id,"isEquidimensional",1);
5543    }
5544  }
5545  else
5546  {
5547    attrib(id,"isCompleteIntersection",0);
5548  }
5549
5550  if( typeof(attrib(id1,"isHypersurface"))=="int" )
5551  {
5552    if(attrib(id1,"isHypersurface")==1)
5553    {
5554      attrib(id,"isCompleteIntersection",1);
5555      attrib(id,"isCohenMacaulay",1);
5556      attrib(id,"isEquidimensional",1);
5557    }
5558  }
5559  else
5560  {
5561    attrib(id,"isHypersurface",0);
5562  }
5563
5564  if( (typeof(attrib(id1,"isEquidimensional"))=="int") )
5565  {
5566    if(attrib(id1,"isEquidimensional")==1)
5567    {
5568      attrib(id,"isEquidimensional",1);
5569    }
5570  }
5571  else
5572  {
5573    attrib(id,"isEquidimensional",0);
5574  }
5575
5576  if( typeof(attrib(id1,"isPrim"))=="int" )
5577  {
5578    if(attrib(id1,"isPrim")==1)
5579    {
5580      attrib(id,"isEquidimensional",1);
5581    }
5582  }
5583  else
5584  {
5585    attrib(id,"isPrim",0);
5586  }
5587
5588  if( (typeof(attrib(id1,"isRegInCodim2"))=="int") )
5589  {
5590    if(attrib(id1,"isRegInCodim2")==1)
5591    {
5592      attrib(id,"isRegInCodim2",1);
5593    }
5594  }
5595  else
5596  {
5597    attrib(id,"isRegInCodim2",0);
5598  }
5599
5600  if( (typeof(attrib(id1,"isIsolatedSingularity"))=="int") )
5601  {
5602    if(attrib(id1,"isIsolatedSingularity")==1)
5603    {
5604      attrib(id,"isIsolatedSingularity",1);
5605    }
5606  }
5607  else
5608  {
5609    attrib(id,"isIsolatedSingularity",0);
5610  }
5611
5612  if( typeof(attrib(id1,"onlySingularAtZero"))=="int" )
5613  {
5614    if(attrib(id1,"onlySingularAtZero")==1)
5615    {
5616      attrib(id,"isIsolatedSingularity",1);
5617    }
5618  }
5619  else
5620  {
5621    attrib(id,"onlySingularAtZero",0);
5622  }
5623
5624  if( typeof(attrib(id1,"isRad"))=="int" )
5625  {
5626    if(attrib(id1,"isRad")==1)
5627    {
5628      attrib(id,"isRad",1);
5629    }
5630  }
5631  else
5632  {
5633    attrib(id,"isRad",0);
5634  }
5635  return(id);
5636}
5637///////////////////////////////////////////////////////////////////////////////
5638
5639proc normalC(ideal id, list #)
5640"USAGE:  normalC(id [,choose]);  id = radical ideal, choose = optional list
5641         of string.
5642         Optional parameters in list choose (can be entered in any order):@*
5643         Decomposition:@*
5644         - \"equidim\" -> computes first an equidimensional decomposition,
5645         and then the normalization of each component (default).@*
5646         - \"prim\" -> computes first the minimal associated primes, and then
5647         the normalization of each prime. @*
5648         - \"noDeco\" -> no preliminary decomposition is done. If the ideal is
5649         not equidimensional radical, output might be wrong.@*
5650         - \"isPrim\" -> assumes that the ideal is prime. If the assumption does
5651         not hold, output might be wrong.@*
5652         - \"noFac\" -> factorization is avoided in the computation of the
5653         minimal associated primes;
5654         Other:@*
5655         - \"withGens\" -> the minimal associated primes P_i of id are
5656         computed and for each P_i, algebra generators of the integral closure
5657         of basering/P_i are computed as elements of its quotient field;@*
5658         If choose is not given or empty, the default options are used.@*
5659ASSUME:  The ideal must be radical, for non-radical ideals the output may
5660         be wrong (id=radical(id); makes id radical). However, if option
5661         \"prim\" is set the minimal associated primes are computed first
5662         and hence normalC computes the normalization of the radical of id.
5663         \"isPrim\" should only be used if id is known to be irreducible.
5664RETURN:  a list, say nor, of size 2 (resp. 3 if option \"withGens\" is set).@*
5665         * nor[1] is always a of r rings, where r is the number of associated
5666         primes with option \"prim\" (resp. >= no of equidimenensional
5667         components with option  \"equidim\").@*
5668         Each ring Ri=nor[1][i], i=1..r, contains two ideals with given
5669         names @code{norid} and @code{normap} such that @*
5670         - Ri/norid is the normalization of the i-th component, i.e. the
5671          integral closure in its field of fractions as affine ring, i.e. Ri is
5672          given in the form K[X(1..p),T(1..q)], where K is the ground field;
5673         - normap gives the normalization map from basering/id to
5674           Ri/norid for each i (the j-th element of normap is mapped to the
5675           j-th variable of R).@*
5676         - the direct sum of the rings Ri/norid is the normalization
5677           of basering/id; @*
5678         ** If option \"withGens\" is not set: @*
5679         * nor[2] shows the delta invariants: nor[2] is a list of an intvec of
5680         size r, the delta invariants of the r components, and an integer, the
5681         delta invariant of basering/id. (-1 means infinite, 0 that basering/P_i
5682         resp. basering/input is normal, -2 means that delta resp. delta of one
5683         of the components is not computed (which may happen if \"equidim\" is
5684         given). @*
5685         ** If option \"withGens\" is set:
5686         * nor[2] is a list of ideals Ii=nor[2][i], i=1..r, in the basering,
5687         generating the integral closure of basering/P_i in its quotient field
5688         as K-algebra (K the ground field):@*
5689         If Ii is given by polynomials g_1,...,g_k, then c:=g_k is a non-zero
5690         divisor and the j-th variables of the ring Ri satisfies var(j)=g_j/c,
5691         j=1..k-1, as element in the quotient field of basering/P_i. The
5692         g_j/g_k+1 are K-algebra generators  of the integral closure of
5693         basering/P_i.@*
5694         * nor[3] shows the delta invariant as above.
5695THEORY:  We use the Grauert-Remmert-de Jong algorithm [c.f. G.-M. Greuel,
5696         G. Pfister: A SINGULAR Introduction to Commutative Algebra, 2nd Edition.
5697         Springer Verlag (2007)].
5698         The procedure computes the algebra structure and the delta invariant of
5699         the normalization of R/id:@*
5700         The normalization is an affine algebra over the ground field K
5701         and nor[1] presents it as such: Ri = K[X(1..p),T(1..q)] and Ri/norid
5702         is the integral closure of R/P_i; if option \"withGens\" is set the
5703         X(j) and T(j) are expressed as quotients in the total ring of
5704         fractions. Note that the X(j) and T(j) generate the integral closure
5705         as K-algebra, but not necessarily as R-module (since relations of the
5706         form X(1)=T(1)*T(2) may have been eliminated). Geometrically the
5707         algebra structure is relevant since the variety of the ideal norid in
5708         Ri is the normalization of the variety of the ideal P_i in R.@*
5709         The delta invariant of a reduced ring A is dim_K(normalization(A)/A).
5710         For A=K[x1,...,xn]/id we call this number also the delta invariant of
5711         id. nor[3] returns the delta invariants of the components P_i and of
5712         id.
5713NOTE:    To use the i-th ring type: @code{def R=nor[1][i]; setring R;}.
5714@*       Increasing/decreasing printlevel displays more/less comments
5715         (default: printlevel=0).
5716@*       Not implemented for local or mixed orderings or quotient rings.
5717         For local or mixed orderings use proc 'normal'.
5718@*       If the input ideal id is weighted homogeneous a weighted ordering may
5719         be used (qhweight(id); computes weights).
5720KEYWORDS: normalization; integral closure; delta invariant.
5721SEE ALSO: normal, normalP.
5722EXAMPLE: example normalC; shows an example
5723"
5724{
5725   ASSUME(0, not isQuotientRing(basering) );
5726
5727   int i,j;
5728   int withGens, withEqui, withPrim, isPrim, noFac;
5729   int dbg = printlevel-voice+2;
5730   int nvar = nvars(basering);
5731   int chara  = char(basering);
5732   list result, prim, keepresult;
5733
5734  int decomp;   // Preliminar decomposition:
5735                // 0 -> no decomposition (id is assumed to be prime)
5736                // 1 -> no decomposition
5737                //      (id is assumed to be equidimensional radical)
5738                // 2 -> equidimensional decomposition
5739                // 3 -> minimal associated primes
5740
5741   // Default methods:
5742   noFac = 0;         // Use facstd when computing minimal associated primes
5743   decomp = 2;        // Equidimensional decomposition for nvar > 2
5744   if (nvar <= 2)
5745   { decomp = 3; }    // Compute minimal associated primes if nvar <= 2
5746
5747   if ( attrib(basering,"global") != 1 )
5748   {
5749     "";
5750     "// Not implemented for this ordering,";
5751     "// please change to global ordering or use proc normal";
5752     return(result);
5753   }
5754
5755//--------------------------- define the method ---------------------------
5756   string method;                //make all options one string in order to use
5757                                 //all combinations of options simultaneously
5758   for ( i=1; i <= size(#); i++ )
5759   {
5760     if ( typeof(#[i]) == "string" )
5761     {
5762       method = method + #[i];
5763     }
5764   }
5765
5766   //--------------------------- chosen methods -----------------------
5767   // "withGens": computes algebra generators for each irreducible component
5768   // ### the extra code for withGens should be incorporated in the general case
5769
5770   if ( find(method,"withgens") or find(method,"withGens"))
5771   {
5772     withGens = 1;
5773   }
5774
5775   // the general case: either equidim or minAssGTZ or no decomposition
5776
5777   if ( find(method,"isprim") or find(method,"isPrim") )
5778   {decomp = 0; isPrim=1;}
5779
5780   if ( find(method,"nodeco") or find(method,"noDeco") )
5781   {decomp = 1;}
5782
5783   if ( find(method,"equidim") )
5784   { decomp = 2; }
5785
5786   if ( find(method,"prim") )
5787   { decomp = 3; }
5788
5789   if ( find(method,"nofac") or find(method,"noFac") )
5790   { noFac = 1; }
5791
5792   kill #;
5793   list #;
5794
5795//------- Special algorithm with computation of the generators, RETURN -------
5796   //--------------------- method "withGens" ----------------------------------
5797   //the integral closure is computed in proc primeClosure. In the general case
5798   //it is computed in normalizationPrimes. The main difference is that in
5799   //primeClosure the singular locus is only computed in the first iteration,
5800   //that no attributes are used, and that the generators are computed.
5801   //In primeClosure the (algebra) generators for each irreducible component
5802   //are computed in the static proc closureGenerators
5803
5804   if( withGens )
5805   {
5806      if( dbg >= 1 )
5807      {  "";
5808         "// We use method 'withGens'";
5809      }
5810      if ( decomp == 0 or decomp == 1 )
5811      {
5812         prim[1] = id;
5813         if( dbg >= 0 )
5814         {
5815           "";
5816           "// ** WARNING: result is correct if ideal is prime (not checked) **";
5817           "// if procedure is called with string \"prim\", primality is checked";
5818         }
5819      }
5820      else
5821      {
5822         if(dbg >= 1)
5823         {  "// Computing minimal associated primes..."; }
5824
5825         if( noFac )
5826         { prim = minAssGTZ(id,1); }
5827         else
5828         { prim = minAssGTZ(id); }
5829
5830         if(dbg >= 2)
5831         {  prim;""; }
5832         if(dbg >= 1)
5833         {
5834            "// number of irreducible components is", size(prim);
5835         }
5836      }
5837   //----------- compute integral closure for every component -------------
5838      int del;
5839      intvec deli;
5840      list Gens,l,resu,Resu;
5841      ideal gens;
5842      def R = basering;
5843      poly gg;
5844
5845      for(i=1; i<=size(prim); i++)
5846      {
5847         if(dbg>=1)
5848         {
5849            ""; pause(); "";
5850            "// Computing normalization of component",i;
5851            "   ---------------------------------------";
5852         }
5853
5854         if( defined(ker) ) { kill ker; }
5855         ideal ker = prim[i];
5856         export(ker);
5857         l = R;
5858         l = primeClosure(l,1);              //here the work is done
5859         // primeClosure is called with list l consisting of the basering
5860         //### ausprobieren ob primeClosure(l,1) schneller als primeClosure(l)
5861         // 1 bedeutet: kuerzester nzd
5862         // l[size(l)] is the delta invariant
5863
5864         if ( l[size(l)] >= 0 && del >= 0 )
5865         {
5866            del = del + l[size(l)];
5867         }
5868         else
5869         { del = -1; }
5870         deli = l[size(l)],deli;
5871
5872         l = l[1..size(l)-1];
5873         resu = list(l[size(l)]) + resu;
5874         gens = closureGenerators(l);         //computes algebra(!) generators
5875
5876         //NOTE: gens[i]/gens[size(gens)] expresses the ith variable of resu[1]
5877         //(the normalization) as fraction of elements of the basering;
5878         //the variables of resu[1] are algebra generators.
5879         //gens[size(gens)] is a non-zero divisor of basering/i
5880
5881         //divide by the greatest common divisor:
5882         gg = gcd( gens[1],gens[size(gens)] );
5883         for(j=2; j<=size(gens)-1; j++)
5884         {
5885            gg=gcd(gg,gens[j]);
5886         }
5887         for(j=1; j<=size(gens); j++)
5888         {
5889            gens[j]=gens[j]/gg;
5890         }
5891         Gens = list(gens) + Gens;
5892
5893/*       ### Da die gens Algebra-Erzeuger sind, ist reduce nach Bestimmung
5894         der Algebra-Variablen T(i) nicht zulaessig!
5895         for(i=1;i<=size(gens)-1;i++)
5896         {
5897            gens[i]= reduce(gens[i],std(gens[size(gens)]));
5898         }
5899         for(i=size(gens)-1; i>=1; i--)
5900         {
5901            if(gens[i]==0)
5902            { gens = delete(gens,i); }
5903         }
5904*/
5905         if( defined(ker) ) { kill ker; }
5906      }
5907
5908      if ( del >= 0 )
5909      {
5910         int mul = iMult(prim);
5911         del = del + mul;
5912      }
5913      else
5914      { del = -1; }
5915      deli = deli[1..size(deli)-1];
5916      Resu = resu,Gens,list(deli,del);
5917      int sr = size(resu);
5918
5919      if ( dbg >= 0 )
5920      {"";
5921"// 'normalC' created a list, say nor, of three lists:
5922// To see the list type
5923      nor;
5924
5925// * nor[1] is a list of",sr,"ring(s)
5926// To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g.
5927     def R1 = nor[1][1]; setring R1;  norid; normap;
5928// For the other rings type first (if R is the name of your original basering)
5929     setring R;
5930// and then continue as for R1.
5931// Ri/norid is the affine algebra of the normalization of the i-th
5932// component R/P_i (where P_i is an associated prime of the input ideal id)
5933// and normap the normalization map from R to Ri/norid.
5934
5935// * nor[2] is a list of",sr,"ideal(s), each ideal nor[2][i] consists of
5936// elements g1..gk of R such that the gj/gk generate the integral
5937// closure of R/P_i as sub-algebra in the quotient field of R/P_i, with
5938// gj/gk being mapped by normap to the j-th variable of Ri;
5939
5940// * nor[3] shows the delta-invariant of each component and of id
5941// (-1 means infinite, and 0 that R/P_i resp. R/id is normal).";
5942      }
5943      return(Resu);
5944   }
5945   //----------------- end method "withGens" --------------------------------
5946
5947//-------- The general case without computation of the generators -----------
5948// (attrib(id,"xy"),1) sets attrib xy to TRUE and (attrib(id,"xy"),0) to FALSE
5949// We use the following attributes:
5950//   attrib(id,"isCohenMacaulay");         //--- Cohen Macaulay
5951//   attrib(id,"isCompleteIntersection");  //--- complete intersection
5952//   attrib(id,"isHypersurface");          //--- hypersurface
5953//   attrib(id,"isEquidimensional",-1);    //--- equidimensional ideal
5954//   attrib(id,"isPrim");                  //--- prime ideal
5955//   attrib(id,"isRegInCodim2");           //--- regular in codimension 2
5956//   attrib(id,"isIsolatedSingularity";    //--- isolated singularities
5957//   attrib(id,"onlySingularAtZero");      //--- only singular at 0
5958
5959 //------------------- first set the attributes ----------------------
5960   if( typeof(attrib(id,"isCohenMacaulay"))=="int" )
5961   {
5962      if( attrib(id,"isCohenMacaulay")==1 )
5963      {
5964         attrib(id,"isEquidimensional",1);
5965      }
5966   }
5967   else
5968   {
5969      attrib(id,"isCohenMacaulay",0);
5970   }
5971
5972   if( typeof(attrib(id,"isCompleteIntersection"))=="int" )
5973   {
5974      if(attrib(id,"isCompleteIntersection")==1)
5975      {
5976         attrib(id,"isCohenMacaulay",1);
5977         attrib(id,"isEquidimensional",1);
5978      }
5979   }
5980   else
5981   {
5982      attrib(id,"isCompleteIntersection",0);
5983   }
5984
5985   if( typeof(attrib(id,"isHypersurface"))=="int" )
5986   {
5987      if(attrib(id,"isHypersurface")==1)
5988      {
5989         attrib(id,"isCompleteIntersection",1);
5990         attrib(id,"isCohenMacaulay",1);
5991         attrib(id,"isEquidimensional",1);
5992      }
5993   }
5994   else
5995   {
5996      attrib(id,"isHypersurface",0);
5997   }
5998
5999   if( ! (typeof(attrib(id,"isEquidimensional"))=="int") )
6000   {
6001         attrib(id,"isEquidimensional",0);
6002   }
6003
6004   if( typeof(attrib(id,"isPrim"))=="int" )
6005   {
6006      if(attrib(id,"isPrim")==1)
6007      {
6008         attrib(id,"isEquidimensional",1);
6009      }
6010   }
6011   else
6012   {
6013      attrib(id,"isPrim",0);
6014   }
6015
6016   if( ! (typeof(attrib(id,"isRegInCodim2"))=="int") )
6017   {
6018         attrib(id,"isRegInCodim2",0);
6019   }
6020
6021   if( ! (typeof(attrib(id,"isIsolatedSingularity"))=="int") )
6022   {
6023         attrib(id,"isIsolatedSingularity",0);
6024   }
6025
6026   if( typeof(attrib(id,"onlySingularAtZero"))=="int" )
6027   {
6028      if(attrib(id,"onlySingularAtZero")==1)
6029      {
6030         attrib(id,"isIsolatedSingularity",1);
6031      }
6032   }
6033   else
6034   {
6035      attrib(id,"onlySingularAtZero",0);
6036   }
6037
6038   //-------------- compute equidimensional decomposition --------------------
6039   //If the method "equidim" is given, compute the equidim decomposition
6040   //and goto the next step (no normalization
6041   //ACHTUNG: equidim berechnet bei nicht reduzierten id die eingebetteten
6042   //Komponenten als niederdim Komponenten, waehrend diese bei primdecGTZ
6043   //nicht auftauchen: ideal(x,y)*xy
6044   //this is default for nvars > 2
6045
6046   if( decomp == 2 )
6047   {
6048      withPrim = 0;                 //this is used to check later that prim
6049                                    //contains equidim but not prime components
6050      if( dbg >= 1 )
6051      {
6052         "// We use method 'equidim'";
6053      }
6054      if( typeof(attrib(id,"isEquidimensional"))=="int" )
6055      {
6056         if(attrib(id,"isEquidimensional")==1)
6057         {
6058            prim[1] = id;
6059         }
6060         else
6061         {
6062            prim = equidim(id);
6063         }
6064      }
6065      else
6066      {
6067         prim = equidim(id);
6068      }
6069      if(dbg>=1)
6070      {  "";
6071         "// number of equidimensional components:", size(prim);
6072      }
6073      if ( !noFac )
6074      {
6075        intvec opt = option(get);
6076        option(redSB);
6077        for(j=1; j<=size(prim); j++)
6078        {
6079           keepresult = keepresult+facstd(prim[j]);
6080        }
6081        prim = keepresult;
6082        if ( size(prim) == 0 )
6083        {
6084          prim=ideal(0);     //Bug in facstd, liefert leere Liste bei 0-Ideal
6085        }
6086
6087        if(dbg>=1)
6088        {  "";
6089         "// number of components after application of facstd:", size(prim);
6090        }
6091        option(set,opt);
6092      }
6093   }
6094
6095   //------------------- compute associated primes -------------------------
6096   //the case where withEqui = 0, here the min. ass. primes are computed
6097   //start with the computation of the minimal associated primes:
6098
6099   else
6100   {
6101    if( isPrim )
6102    {
6103      if( dbg >= 0 )
6104      {
6105         "// ** WARNING: result is correct if ideal is prime";
6106         "// or equidimensional (not checked) **";
6107         "// disable option \"isPrim\" to decompose ideal into prime";
6108         "// or equidimensional components";"";
6109      }
6110      if( dbg >= 1 )
6111      {
6112        "// We use method 'isPrim'";"";
6113      }
6114      prim[1]=id;
6115    }
6116    else
6117    {
6118      withPrim = 1;                 //this is used to check later that prim
6119                                    //contains prime but not equidim components
6120      if( dbg >= 1 )
6121      {
6122         "// We use method 'prim'";
6123      }
6124
6125      if( typeof(attrib(id,"isPrim"))=="int" )
6126      {
6127         if(attrib(id,"isPrim")==1)
6128         {
6129            prim[1]=id;
6130         }
6131         else
6132         {
6133            if( noFac )
6134            { prim=minAssGTZ(id,1); }     //does not use factorizing groebner
6135            else
6136            { prim=minAssGTZ(id); }       //uses factorizing groebner
6137         }
6138      }
6139      else
6140      {
6141            if( noFac )
6142            { prim=minAssGTZ(id,1); }
6143            else
6144            { prim=minAssGTZ(id); }
6145      }
6146      if(dbg>=1)
6147      {  "";
6148         "// number of irreducible components:", size(prim);
6149      }
6150    }
6151   }
6152
6153   //----- for each component (equidim or irred) compute normalization -----
6154   int sr, skr, del;
6155   intvec deli;
6156   int sp = size(prim);     //size of list prim (# irred or equidim comp)
6157
6158   for(i=1; i<=sp; i++)
6159   {
6160      if(dbg>=1)
6161      {  "";
6162         "// computing the normalization of component",i;
6163         "   ----------------------------------------";
6164      }
6165      //-------------- first set attributes for components ------------------
6166      attrib(prim[i],"isEquidimensional",1);
6167      if( withPrim )
6168      {
6169         attrib(prim[i],"isPrim",1);
6170      }
6171      else
6172      { attrib(prim[i],"isPrim",0); }
6173
6174      if(attrib(id,"onlySingularAtZero")==1)
6175      { attrib(prim[i],"onlySingularAtZero",1); }
6176      else
6177      { attrib(prim[i],"onlySingularAtZero",0); }
6178
6179      if(attrib(id,"isIsolatedSingularity")==1)
6180      { attrib(prim[i],"isIsolatedSingularity",1); }
6181      else
6182      { attrib(prim[i],"isIsolatedSingularity",0); }
6183
6184      if( attrib(id,"isHypersurface")==1 )
6185      {
6186         attrib(prim[i],"isHypersurface",1);
6187         attrib(prim[i],"isCompleteIntersection",1);
6188         attrib(prim[i],"isCohenMacaulay",1);
6189      }
6190      else
6191      { attrib(prim[i],"isHypersurface",0); }
6192
6193      if ( sp == 1)         //the case of one component: copy attribs from id
6194      {
6195        if(attrib(id,"isRegInCodim2")==1)
6196        {attrib(prim[i],"isRegInCodim2",1); }
6197        else
6198        {attrib(prim[i],"isRegInCodim2",0); }
6199
6200        if(attrib(id,"isCohenMacaulay")==1)
6201        {attrib(prim[i],"isCohenMacaulay",1); }
6202        else
6203        {attrib(prim[i],"isCohenMacaulay",0); }
6204
6205        if(attrib(id,"isCompleteIntersection")==1)
6206        {attrib(prim[i],"isCompleteIntersection",1); }
6207        else
6208        {attrib(prim[i],"isCompleteIntersection",0); }
6209      }
6210      else
6211      {
6212        attrib(prim[i],"isRegInCodim2",0);
6213        attrib(prim[i],"isCohenMacaulay",0);
6214        attrib(prim[i],"isCompleteIntersection",0);
6215      }
6216
6217      //------ Now compute the normalization of each component ---------
6218      //note: for equidimensional components the "splitting tools" can
6219      //create further decomposition
6220      //We now start normalizationPrimes with
6221      //ihp = partial normalisation map = identity map = maxideal(1)
6222      //del = partial delta invariant = 0
6223      //deli= intvec of partial delta invariants of components
6224      //in normalizationPrimes all the work is done:
6225
6226      keepresult = normalizationPrimes(prim[i],maxideal(1),0,0);
6227
6228      for(j=1; j<=size(keepresult)-1; j++)
6229      {
6230         result=insert(result,keepresult[j]);
6231      }
6232      skr = size(keepresult);
6233
6234      //compute delta:
6235      if( del >= 0 && keepresult[skr][1] >=0 )
6236      {
6237         del = del + keepresult[skr][1];
6238      }
6239      else
6240      {
6241         del = -1;
6242      }
6243      deli = keepresult[skr][2],deli;
6244
6245      if ( dbg>=1 )
6246      {
6247           "// delta of component",i; keepresult[skr][1];
6248      }
6249   }
6250   sr = size(result);
6251
6252   // -------------- Now compute intersection multiplicities -------------
6253   //intersection multiplicities of list prim, sp=size(prim).
6254      if ( dbg>=1 )
6255      {
6256        "// Sum of delta for all components"; del;
6257        if ( sp>1 )
6258        {
6259           "// Compute intersection multiplicities of the components";
6260        }
6261      }
6262
6263      if ( sp > 1 )
6264      {
6265        int mul = iMult(prim);
6266        if ( mul < 0 )
6267        {
6268           del = -1;
6269        }
6270        else
6271        {
6272           del = del + mul;
6273        }
6274      }
6275   deli = deli[1..size(deli)-1];
6276   result = result,list(deli,del);
6277
6278//--------------- Finally print comments and return ------------------
6279   if ( dbg >= 0)
6280   {"";
6281"// 'normalC' created a list, say nor, of two lists:
6282// To see the result, type
6283      nor;
6284
6285// * nor[1] is a list of",sr,"ring(s).
6286// To access the i-th ring nor[1][i] give it a name, say Ri, and type e.g.
6287      def R1 = nor[1][1];  setring R1;  norid;  normap;
6288// and similair for the other rings nor[1][i];
6289// Ri/norid is the affine algebra of the normalization of r/P_i  (where P_i
6290// is an associated prime or an equidimensional part of the input ideal id)
6291// and normap the normalization map from the basering to Ri/norid;
6292
6293// * nor[2] shows the delta-invariant of each component and of id
6294// (-1 means infinite, 0 that r/P_i resp. r/id is normal, and -2 that delta
6295// of a component was not computed).";
6296   }
6297   return(result);
6298}
6299
6300example
6301{ "EXAMPLE:";
6302   printlevel = printlevel+1;
6303   echo = 2;
6304   ring s = 0,(x,y),dp;
6305   ideal i = (x2-y3)*(x2+y2)*x;
6306
6307   list nor = normalC(i);
6308
6309   nor;
6310   // 2 branches have delta = 1, and 1 branch has delta = 0
6311   // the total delta invariant is 13
6312
6313   def R2 = nor[1][2];  setring R2;
6314   norid; normap;
6315
6316   echo = 0;
6317   printlevel = printlevel-1;
6318   pause("   hit return to continue"); echo=2;
6319
6320   ring r = 2,(x,y,z),dp;
6321   ideal i = z3-xy4;
6322   nor = normalC(i);  nor;
6323   // the delta invariant is infinite
6324   // xy2z/z2 and xy3/z2 generate the integral closure of r/i as r/i-module
6325   // in its quotient field Quot(r/i)
6326
6327   // the normalization as affine algebra over the ground field:
6328   def R = nor[1][1]; setring R;
6329   norid; normap;
6330
6331   echo = 0;
6332   pause("   hit return to continue");echo = 2;
6333
6334   setring r;
6335   nor = normalC(i, "withGens", "prim");    // a different algorithm
6336   nor;
6337}
6338
6339//////////////////////////////////////////////////////////////////////////////
6340//closureRingtower seems not to be used anywhere
6341static proc closureRingtower(list L)
6342"USAGE:    closureRingtower(list L); L a list of rings
6343CREATE:   rings R(1),...,R(n) such that R(i)=L[i] for all i
6344EXAMPLE:  example closureRingtower; shows an example
6345"
6346{
6347  int n=size(L);
6348  for (int i=1;i<=n;i++)
6349    {
6350      if (defined(R(i)))
6351      {
6352        string s="Fixed name R("+string(i)+") leads to conflict with existing "
6353              +"object having this name";
6354        ERROR(s);
6355      }
6356      def R(i)=L[i];
6357      export R(i);
6358    }
6359
6360  return();
6361}
6362example
6363{
6364  "EXAMPLE:"; echo=2;
6365  ring R=0,(x,y),dp;
6366  ideal I=x4,y4;
6367  list L=primeClosure(ReesAlgebra(I)[1]);
6368  L=delete(L,size(L));
6369  L;
6370  closureRingtower(L);
6371  R(1);
6372  R(4);
6373  kill R(1),R(2),R(3),R(4);
6374}
6375
6376//                Up to here: procedures for normalC
6377///////////////////////////////////////////////////////////////////////////////
6378
6379///////////////////////////////////////////////////////////////////////////////
6380//                From here: miscellaneous procedures
6381
6382// Used for timing and comparing the different normalization procedures.
6383// Option (can be entered in any order)
6384// "normal"   -> uses the new algortihm (normal)
6385// "normalP"  -> uses normalP
6386// "normalC"  -> uses normalC, without "withGens" option
6387// "primCl"   -> uses normalC, with option "withGens".
6388// "111"      -> checks the output of normalM using norTest.
6389// "p"        -> compares the output of norM with the output of normalP
6390//               ("normalP" option must also be set).
6391// "pc"       -> compares the output of norM with the output of normalC with
6392//               option "withGens"
6393//               ("primCl" option must also be set).
6394
6395proc timeNormal(ideal I, list #)
6396{
6397  ASSUME(0, not isQuotientRing(basering) );
6398
6399  def r = basering;
6400
6401  //--------------------------- define the method ---------------------------
6402  int isPrim, useRing;
6403  int decomp = -1;
6404  int norM, norC, norP, primCl;
6405  int checkP, check111, checkPC;
6406  int i;
6407  ideal U1, U2, W;
6408  poly c1, c2;
6409  int ch;
6410  string check;
6411  string method;                //make all options one string in order to use
6412                                //all combinations of options simultaneously
6413  for ( i=1; i <= size(#); i++ )
6414  {
6415    if ( typeof(#[i]) == "string" )
6416    {
6417      method = method + #[i];
6418    }
6419  }
6420  if ( find(method, "normal"))
6421  {norM = 1;}
6422  if ( find(method, "normalP") and (char(basering) > 0))
6423  {norP = 1;}
6424  if ( find(method, "normalC"))
6425  {norC = 1;}
6426  if ( find(method, "primCl"))
6427  {primCl = 1;}
6428  if ( find(method, "isprim") or find(method,"isPrim") )
6429  {decomp = 0;}
6430  if ( find(method, "p") )
6431  {checkP = 1;}
6432  if ( find(method, "pc") )
6433  {checkPC = 1;}
6434  if ( find(method, "111") )
6435  {check111 = 1;}
6436
6437  int tt;
6438  if(norM)
6439  {
6440    tt = timer;
6441    if(decomp == 0)
6442    {
6443      "Running normal(useRing, isPrim)...";
6444      list a1 = normal(I, "useRing", "isPrim");
6445      "Time normal(useRing, isPrim): ", timer - tt;
6446    }
6447    else
6448    {
6449      "Running normal(useRing)...";
6450      list a1 = normal(I, "useRing");
6451      "Time normal(useRing): ", timer - tt;
6452    }
6453    "";
6454  }
6455  if(norP)
6456  {
6457    tt = timer;
6458    if(decomp == 0)
6459    {
6460      "Running normalP(isPrim)...";
6461      list a2 = normalP(I, "isPrim");
6462      "Time normalP(isPrim): ", timer - tt;
6463    }
6464    else
6465    {
6466      "Running normalP()...";
6467      list a2 = normalP(I);
6468      "Time normalP(): ", timer - tt;
6469    }
6470    "";
6471  }
6472
6473  if(norC)
6474  {
6475    tt = timer;
6476    if(decomp == 0)
6477    {
6478      "Running normalC(isPrim)...";
6479      list a3 = normalC(I, "isPrim");
6480      "Time normalC(isPrim): ", timer - tt;
6481    }
6482    else
6483    {
6484      "Running normalC()...";
6485      list a3 = normalC(I);
6486      "Time normalC(): ", timer - tt;
6487    }
6488    "";
6489  }
6490
6491  if(primCl)
6492  {
6493    tt = timer;
6494    if(decomp == 0)
6495    {
6496      "Running normalC(withGens, isPrim)...";
6497      list a4 = normalC(I, "isPrim", "withGens");
6498      "Time normalC(withGens, isPrim): ", timer - tt;
6499    }
6500    else
6501    {
6502      "Running normalC(withGens)...";
6503      list a4 = normalC(I, "withGens");
6504      "Time normalC(withGens): ", timer - tt;
6505    }
6506    "";
6507  }
6508
6509  if(check111 and norM)
6510  {
6511    "Checking output with norTest...";
6512    "WARNING: this checking only works if the original ideal was prime.";
6513    norTest(I, a1);
6514    "";
6515  }
6516
6517  if(checkP and norP and norM)
6518  {
6519    "Comparing with normalP output...";
6520    if(size(a2) > 0)
6521    {
6522      "WARNING: this checking only works if the original ideal was prime.";
6523      U1 = a1[2][1];
6524      c1 = U1[size(U1)];
6525      U2 = a2[1][1];
6526      c2 = a2[1][1][size(a2[1][1])];
6527      W = changeDenominator(U1, c1, c2, groebner(I));
6528      qring q = groebner(I);
6529      ideal U2 = fetch(r, U2);
6530      ideal W = fetch(r, W);
6531      ch = 0;
6532      if(size(reduce(U2, groebner(W))) == 0)
6533      {
6534        "U2 c U1";
6535        ch = 1;
6536      }
6537      if(size(reduce(W, groebner(U2))) == 0)
6538      {
6539        "U1 c U2";
6540        ch = ch + 1;
6541      }
6542      if(ch == 2)
6543      {
6544        "Output of normalP is equal.";
6545      }
6546      else
6547      {
6548        "ERROR: Output of normalP is different.";
6549      }
6550      setring r;
6551      kill q;
6552    }
6553    else
6554    {
6555      "normalP returned no output. Comparison is not possible.";
6556    }
6557    "";
6558  }
6559
6560  if(checkPC and norM and primCl)
6561  {
6562    "Comparing with primeClosure output...";
6563    if(size(a4) > 0)
6564    {
6565      "WARNING: this checking only works if the original ideal was prime.";
6566      // primeClosure check
6567      U1 = a1[2][1];
6568      c1 = U1[size(U1)];
6569      U2 = a4[2][1];
6570      c2 = a4[2][1][size(a4[2][1])];
6571      W = changeDenominator(U1, c1, c2, groebner(I));
6572      qring q = groebner(I);
6573      ideal U2 = fetch(r, U2);
6574      ideal W = fetch(r, W);
6575      ch = 0;
6576      if(size(reduce(U2, groebner(W))) == 0)
6577      {
6578        "U2 c U1";
6579        ch = 1;
6580      }
6581      if(size(reduce(W, groebner(U2))) == 0)
6582      {
6583        "U1 c U2";
6584        ch = ch + 1;
6585      }
6586      if(ch == 2)
6587      {
6588        "Output of normalC(withGens) is equal.";
6589      }
6590      else
6591      {
6592        "ERROR: Output of normalC(withGens) is different.";
6593      }
6594      setring r;
6595      kill q;
6596    }
6597    else
6598    {
6599      "normalC(withGens) returned no output. Comparison is not possible.";
6600    }
6601    "";
6602  }
6603}
6604
6605///////////////////////////////////////////////////////////////////////////
6606static proc sqroot(int n);
6607{
6608  int s = 1;
6609  while(s*s < n) { s++; }
6610  return(s);
6611}
6612
6613///////////////////////////////////////////////////////////////////////////
6614proc norTest (ideal i, list nor, list #)
6615"USAGE:   norTest(i,nor,[n]); i=prime ideal, nor=list, n=optional integer
6616ASSUME:  nor is the output of normal(i) (any options) or
6617         normalP(i,"withRing") or normalC(i) (any options).
6618         In particular, the ring nor[1][1] contains the ideal norid
6619         and the map normap: basering/i --> nor[1][1]/norid.
6620RETURN:  an intvec v such that:
6621@format
6622         v[1] = 1 if the normap is injective and 0 otherwise
6623         v[2] = 1 if the normap is finite and 0 otherwise
6624         v[3] = 1 if nor[1][1]/norid is normal and 0 otherwise
6625@end format
6626         If n=1 (resp n=2) only v[1] (resp. v[2]) is computed and returned
6627THEORY:  The procedure can be used to test whether the computation of the
6628         normalization was correct: basering/i --> nor[1][1]/norid is the
6629         normalization of basering/i if and only if v=1,1,0.
6630NOTE:    For big examples it can be hard to fully test correctness; the
6631         partial test norTest(i,nor,2) is usually fast
6632EXAMPLE: example norTest; shows an example
6633"
6634{
6635   ASSUME(0, not isQuotientRing(basering) );
6636//### Sollte erweitert werden auf den reduziblen Fall: einen neuen affinen
6637// Ring nor[1][1]+...+nor[1][r] (direkte Summe) erzeugen, map dorthin
6638// definieren und dann testen.
6639
6640    int prl = printlevel - voice + 2;
6641    int a,b,d;
6642    int n,ii;
6643    if (size(#) > 0) {  n = #[1];  }
6644
6645    def BAS = basering;
6646
6647    //### make a copy of nor to have a cpoy of nor[1][1]  (not a reference to)
6648    // in order not to override norid and normap.
6649    // delete nor[2] (if it contains the module generators, which are not used)
6650    // s.t. newnor does not belong to a ring.
6651
6652    list newnor = nor;
6653    if ( size(newnor) == 3 )
6654    {
6655       newnor = delete(newnor,2);
6656    }
6657    def R = newnor[1][1];
6658    qring QAS = std(i);
6659
6660
6661    setring R;
6662    int nva = nvars(R);
6663    string svars = varstr(R);
6664    string svar;
6665
6666    norid = interred(norid);
6667
6668    //--------- create new ring with one dp block keeping weights ------------
6669    list LR = ringlist(R);
6670    list g3 = LR[3];
6671    int n3 = size(g3);
6672    list newg3;
6673    intvec V;
6674
6675    //--------- check first whether variables Z(i),...,A(i) exist -----------
6676    for (ii=90; ii>=65; ii--)
6677    {
6678       if ( find(svars,ASCII(ii)+"(") == 0 )
6679       {
6680          svar = ASCII(ii);  break;
6681       }
6682    }
6683    if ( size(svar) != 0 )
6684    {
6685        for ( ii = 1; ii <= nva; ii++ )
6686        {
6687            LR[2][ii] = svar+"("+string(ii)+")";
6688            V[ii] = 1;
6689        }
6690    }
6691    else
6692    {
6693        for ( ii = 1; ii <= nva; ii++ )
6694        {
6695           LR[2][ii] = "Z("+string(100*nva+ii)+")";
6696           V[ii] = 1;
6697        }
6698    }
6699
6700    if ( g3[n3][1]== "c" or g3[n3][1] == "C" )
6701    {
6702       list gm = g3[n3];       //last blockis module ordering
6703       newg3[1] = list("dp",V);
6704       newg3 = insert(newg3,gm,size(newg3));
6705    }
6706    else
6707    {
6708       list gm = g3[1];              //first block is module ordering
6709       newg3[1] = list("dp",V);
6710       newg3 = insert(newg3,gm);
6711    }
6712    LR[3] = newg3;
6713//LR;"";
6714    def newR = ring(LR);
6715    kill LR; //otherwise it keeps defined and will cause a warning next time norTest is run.
6716    setring newR;
6717    ideal norid = fetch(R,norid);
6718    ideal normap = fetch(R,normap);
6719    if( defined(lnorid) )  { kill lnorid; }     //um ** redefinig zu beheben
6720    if( defined(snorid) )  { kill snorid; }     //sollte nicht noetig sein
6721
6722    //----------- go to quotient ring for checking injectivity -------------
6723//"mstd";
6724    list lnorid = mstd(norid);
6725    ideal snorid = lnorid[1];
6726//"size mstdnorid:", size(snorid),size(lnorid[2]);
6727//"size string mstdnorid:", size(string(snorid)),size(string(lnorid[2]));
6728    qring QR = snorid;
6729    ideal qnormap = fetch(newR,normap);
6730    //ideal qnormap = imap(newR,normap);
6731    //ideal qnormap = imap(R,normap);
6732    map Qnormap = QAS,qnormap;    //r/id --> R/norid
6733
6734    //------------------------ check injectivity ---------------------------
6735//"injective:";
6736    a = is_injective(Qnormap,QAS);          //a. Test for injectivity of Qnormap
6737    dbprint ( prl, "injective: "+string(a) );
6738    if ( n==1 )
6739    {
6740     intvec result = intvec(a);
6741     setring BAS;
6742     return (result);
6743   }
6744   a;
6745
6746    //------------------------ check finiteness ---------------------------
6747    setring newR;
6748    b = mapIsFinite(normap,BAS,lnorid[2]);  //b. Test for finiteness of normap
6749    dbprint ( prl, "finite: "+string(b) );
6750    if ( n==2 )
6751    {
6752       intvec result = intvec(a,b);
6753       setring BAS;
6754       return (result);
6755    }
6756   b;
6757
6758    //------------------------ check normality ---------------------------
6759    list testnor = normal(lnorid[2],"isPrim","noFac", "withDelta");
6760    //### Problem: bei mehrfachem Aufruf von norTest gibt es
6761    // ** redefining norid & ** redefining normap
6762    //Dies produziert Fehler, da alte norid und normap ueberschrieben werden
6763    //norid und normap werden innnerhalb von proc computeRing ueberschrieben
6764    //Die Kopie newR scheint das Problem zu loesen
6765
6766
6767    d = testnor[3][2];             //d = delta
6768    kill testnor;                              //### sollte ueberfluessig sein
6769    int d1 = (d==0);                           //d1=1 if delta=0
6770    dbprint ( prl, "delta: "+string(d) );
6771    intvec result = intvec(a,b,d1);
6772    setring BAS;
6773    return(result);
6774}
6775example
6776{ "EXAMPLE:"; echo = 2;
6777   int prl = printlevel;
6778   printlevel = -1;
6779   ring r = 0,(x,y),dp;
6780   ideal i = (x-y^2)^2 - y*x^3;
6781   list nor = normal(i);
6782   norTest(i,nor);                //1,1,1 means that normal was correct
6783
6784   nor = normalC(i);
6785   norTest(i,nor);                //1,1,1 means that normal was correct
6786
6787   ring s = 2,(x,y),dp;
6788   ideal i = (x-y^2)^2 - y*x^3;
6789   nor = normalP(i,"withRing");
6790   norTest(i,nor);               //1,1,1 means that normalP was correct
6791   printlevel = prl;
6792}
6793
6794proc normalConductor(ideal I, list #)
6795"USAGE:     normalConductor(I); I ideal
6796ASSUME:     I is a radical ideal
6797RETURN:     the conductor of R/I as ideal in R
6798REMARKS:    The procedures makes use of the minimal primes and
6799            the generators of the normalization given by the normalization algorithm.
6800NOTE:       the optional parameter can be used if the normalization has already
6801            been computed. If a list L contains the output of the procedure
6802            normal (with options prim, wd and usering if the ring has a mixed ordering),
6803            apply normalConductor(I,L)
6804KEYWORDS:   conductor; normalization
6805SEE ALSO:   curveConductorMult
6806EXAMPLE:    example normalConductor; shows an example"
6807{
6808//SEE ALSO:   conductorIdealIntersect, conductorMinPrime, curveConductorMult
6809
6810    if(size(#) > 0){
6811        list norma = #;
6812    }else{
6813        // Compute the normalization with delta invariants
6814        list norma = normal(I,"useRing","prim","wd");
6815    }
6816
6817    // Prepare computation
6818        int r = size(norma[1]);
6819        int i;
6820        def savering = basering;
6821        list min_prime;
6822    list DEN;
6823    def S;
6824
6825    // List of all minimal primes
6826    for(i = 1; i <= r; i++){
6827        S = norma[1][i];
6828        min_prime[i] = CurveInv::conductorMinPrime(S);
6829    }
6830
6831        // List of ideals U generating Norm(R/P_i)
6832        list U = norma[2];
6833
6834        // List of denominators DEN
6835    r = size(U);
6836        for(i = 1; i <= r; i++){
6837                DEN[i] = U[i][size(U[i])];
6838        }
6839
6840        // Compute the conductor C
6841        ideal C = 1;
6842        ideal C_current;
6843        ideal min_prime_isect;
6844
6845        for(i = 1; i <= r; i++){
6846
6847                // Intersection of min_prime_j, j!=i
6848                min_prime_isect = CurveInv::conductorIdealIntersect(min_prime,i);
6849
6850                // Compute the quotient
6851                C_current = std(quotient(min_prime[i] + DEN[i]*min_prime_isect, U[i]));
6852
6853                // Intersect it with previous computation
6854                C = intersect(C,C_current);
6855        }
6856
6857        return(std(C));
6858
6859}
6860example
6861{
6862"EXAMPLE:"; echo = 2;
6863
6864///////////////////////////////////////////
6865// Computation of small conductor ideals //
6866///////////////////////////////////////////
6867
6868ring R = 0,(x,y,z),ds;
6869ideal I = x2y2 - z;
6870normalConductor(I);
6871// The conductor is the whole ring - so the ring is normal
6872// We can also see this using the delta invariant:
6873curveDeltaInv(I);
6874
6875ring S = 0,(a,b,c),dp;
6876ideal J = abc;
6877normalConductor(J);
6878// The conductor is not the whole ring - so it is not normal
6879// We can also see this using the delta invariant, which is even infinite
6880curveDeltaInv(J);
6881
6882kill R,S;
6883
6884/////////////////////////////////////
6885// Computation of a bigger example //
6886/////////////////////////////////////
6887
6888ring R = 0,(x,y,z,t),ds;
6889ideal I = xyz - yzt, x2y3 - z2t4;
6890I = std(radical(I));
6891// Ideal I
6892I;
6893// Conductor
6894normalConductor(I);
6895}
6896
6897///////////////////////////////////////////////////////////////////////////
6898//
6899//                            EXAMPLES
6900//
6901///////////////////////////////////////////////////////////////////////////
6902/*
6903//commands for computing the normalization:
6904// options for normal:  "equidim", "prim"
6905//                      "noDeco", "isPrim", "noFac"
6906//                       (prim by default)
6907// options for normalP: "withRing", "isPrim" or "noFac"
6908// options for normalC: "equidim", "prim", "withGens",
6909//                      "noDeco", "isPrim", "noFac"
6910
6911//Commands for testing 'normal'
6912 list nor = normal(i); nor;
6913 list nor = normal(i,"isPrim");nor;
6914 list nor = normal(i,"equidim");nor;
6915 list nor = normal(i,"prim");nor;
6916 list nor = normal(i,"equidim","noFac");nor;
6917 list nor = normal(i,"prim","noFac");nor;
6918
6919//Commands for testing 'normalP' in positive char
6920 list nor = normalP(i);nor;              //withGens but no ringstructure
6921 list nor = normalP(i,"withRing"); nor;  //compute the ringstructure
6922 list nor = normalP(i,"isPrim"); nor;    //if i is known to be prime
6923
6924//Commands for testing 'normalC'
6925 list nor = normal(i); nor;
6926 list nor = normal(i,"withGens");nor;
6927 list nor = normal(i,"isPrim");nor;
6928 list nor = normal(i,"equidim");nor;
6929 list nor = normal(i,"prim");nor;
6930 list nor = normal(i,"equidim","noFac");nor;
6931 list nor = normal(i,"prim","noFac");nor;
6932
6933//Commands for testing correctness (i must be prime):
6934list nor = normalP(i,"withRing","isPrim");
6935list nor = normal(i,"isPrim");
6936norTest(i,nor);       //full test for not too big examples (1,1,1 => ok)
6937norTest(i,nor,2);     //partial test for big examples (1,1 => ok)
6938factorize(i[1]);      //checks for irreducibility
6939
6940/////////////////////////////////////////////////////////////////////////////
6941
6942//----------------------Examples for normal (new algorithm)------------------
6943// Timings with Computeserver Dual AMD Opteron 242 1.60GHz.
6944// Examples from "Normalization of Rings" paper.
6945
6946// Example 1
6947// char 0 : normal = 0 secs (7 steps) - normalC = 75 secs
6948// char 2 : normal = 0 secs (7 steps) - normalP = 0 secs - normalC = 0 secs
6949// char 5 : normal = 1 secs (7 steps) - normalP = 71 - normalC = 1 secs
6950// char 11 : normal = 2 secs (7 steps) - normalP = 12 secs - normalC doesn't finish
6951// char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 1 sec
6952LIB"normal.lib";
6953ring r = 2, (x, y), dp;
6954ideal i = (x-y)*x*(y+x^2)^3-y^3*(x^3+x*y-y^2);
6955timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p");
6956
6957// Example 2
6958// char 0  : normal = 1 sec (7 steps) - normalC doesn't finish
6959// char 3 : normal = 1 secs (8 steps) - normalP = 0 secs - normalC = 4 secs
6960// char 13 : normal = 1 sec (7 steps) - normalP doesn't finish - normalC = 13 secs
6961// char 32003 : normal = 1 secs (7 steps) - normalP doesn't finish - normalC = 10 sec
6962//Example is reducible in char 5 and 7
6963LIB"normal.lib";
6964ring r = 3, (x, y), dp;
6965ideal 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;
6966timeNormal(i, "normal", "normalC", "normalP", "p", "isPrim");
6967
6968// Example 3
6969// char 0 : normal = 3 secs (6 steps) - normalC doesn't finish
6970// char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish
6971// char 5 : normal = 0 secs (6 steps) - normalP = 8 secs - normalC doesn't finish
6972LIB"normal.lib";
6973ring r=5,(x, y),dp;
6974ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9;
6975timeNormal(i, "normal", "normalC", "normalP", "isPrim");
6976
6977// Example 4
6978// char 0 : normal = 0 secs (1 step) - normalC = 0 secs
6979// char 5 : normal = 0 secs (1 step) - normalP = 3 secs - normalC = 0 secs
6980// char 11 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs
6981// char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs
6982LIB"normal.lib";
6983ring r=5,(x,y),dp;   // genus 0 4 nodes and 6 cusps im P2
6984ideal i=(x2+y^2-1)^3 +27x2y2;
6985timeNormal(i, "normal", "normalC", "normalP", "isPrim");
6986
6987// Example 5
6988// char 0 : normal = 0 secs (1 step) - normalC = 0 secs
6989// char 5 : normal = 1 secs (3 step) - normalP doesn't finish - normalC doesn't finish
6990// char 11 : normal = 0 secs (1 step) - normalP 0 secs - normalC = 0 secs
6991// char 32003 : normal = 0 secs (1 step) - normalP doesn't finish - normalC = 0 secs
6992LIB"normal.lib";
6993ring r=11,(x,y),dp;    //24 sing, delta 24
6994ideal i=-x10+x8y2-x6y4-x2y8+2y10-x8+2x6y2+x4y4-x2y6-y8+2x6-x4y2+x2y4+2x4+2x2y2-y4-x2+y2-1;
6995timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p");
6996
6997// Example 6
6998// char 2 : normal = 5 secs (2 steps) - normalP = 25 secs - normalC = 166 secs
6999LIB"normal.lib";
7000ring r=2,(v,u,z,y,x),dp;
7001ideal i = z3+zyx+y3x2+y2x3, uyx+z2,uz+z+y2x+yx2, u2+u+zy+zx, v3+vux+vz2+vzyx+vzx+uz3+uz2y+z3+z2yx2;
7002timeNormal(i, "normal", "normalC", "normalP", "isPrim", "p");
7003
7004// Example 7
7005// char 0 : normal = 11 secs (6 steps) - normalC = 11 secs
7006// char 2 : normal = 11 secs (6 steps) - normalP = 0 secs - normalC = 11 secs
7007// char 5 : normal = 11 secs (6 steps) - normalP = 3 secs - normalC = 11 secs
7008// char 11 : normal = 11 secs (6 steps) - normalP = 43 secs - normalC = 11 secs
7009// char 32003 : normal = 11 secs (6 steps) - normalP doesn't finish - normalC = 11 secs
7010LIB"normal.lib";
7011ring r=11,(x,y,z,w,t),dp;   //dim 2, dim s_locus 1
7012ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3;
7013timeNormal(i, "normal", "normalC", "normalP", "isPrim");
7014
7015////////////////////////////////////////////////////////////////////////////////
7016
7017// Other examples with new algorithm
7018
7019// Example 1
7020// char 0 : normal = 1 secs (13 steps) - normalC doesn't finish
7021// char 2 : normal = 1 secs (13 steps) - normalP = 0 secs - normalC doesn't finish
7022// char 5 : normal = 1 secs (13 steps) - normalP = 29 secs - normalC doesn't finish
7023ring r=2,(x,y),dp;  //genus 35
7024ideal i=y30+y13x+x4y5+x3*(x+1)^2;
7025timeNormal(i, "normal", "normalC", "normalP");
7026
7027// Example 2
7028// char 0 : normal = 1 secs (13 steps) - normalC doesn't finish
7029// char 3 : normal = 2 secs (13 steps) - normalP = 0 secs - normalC doesn't finish
7030ring r=3,(x,y),dp;  //genus 19, delta 21
7031ideal i=y20+y13x+x4y5+x3*(x+1)^2;
7032timeNormal(i, "normal", "normalC", "normalP");
7033
7034// Example 3
7035// Very fast with all algorithms
7036ring r = 3, (x, y), dp;
7037ideal I = (x-y^2)^2-x*y^3;
7038timeNormal(I, "normal", "normalC", "normalP", "primCl", "111", "p", "pc");
7039
7040
7041
7042//----------------------Test Example for charp -------------------
7043//Zu tun:
7044//### nach minor nur std statt mstd verwenden
7045//***hat bei keinem Beisp etwas gebracht -> wieder zurueck
7046//### wenn interred ok, dann wieder einsetzen (am Schluss)
7047//### bottelnecks bei maps beheben
7048//### minor verbessern
7049//### preimage verbessern (Ist imm Kern map oder imap verwendet?)
7050//### Gleich in Ordnung dp wechseln, ringlist verwenden
7051//### interred ev nur zum Schluss
7052//    (z.B. wenn nacher std; wenn nacher minor: testen )
7053
7054//Zeiten mit normalV5.lib (mstd aktiv, interred inaktiv)
7055
7056//SWANSON EXAMPLES: (Macaulay2, icFracP=normalP, icFractions<->normal)
7057//---------------------------------------------------------------------
7058//1. Series Fp[x,y,u,v]/(x2v-y2u)
7059//-------------------------------
7060//characteristic p   2   3    5    7    11   13   17   37   97
7061//icFracP          0.04 0.03 0.04 0.04 0.04 0.05 0.05 0.13 0.59  Mac
7062//normalP           0   0    0    0     0    0    0    0   1    Sing
7063//icFractions      0.08 0.09 0.09 0.09 0.14 0.15 0.15 0.15 0.15  Mac
7064//normal             0   0    0    0     0    0    0    0    0   Sing
7065
70662. Series Fp[u, v, w, x, y, z]/u2x4+uvy4+v2z4
7067//--------------------------------------------
7068//characteristic p 2    3    5    7   11
7069//icFracP         0.07 0.22 9.67 143 12543
7070//normalP          0    0    5   42  1566
7071//icFractions     1.16   *    *   *    *       *: > 6h
7072//normal            0    0    0   0    0
7073
7074//3. Series Fp[u, v, w, x, y, z]/(u2xp+uvyp+v2zp)
7075//-----------------------------------------------
7076//characteristic p  2    3    5    7    11   13  17 19 23
7077//icFracP          0.06 0.07 0.09 0.27 1.81 4.89 26 56 225
7078//normalP          0     0    0    0    1    2  6  10  27
7079//icFractions      0.16 1.49 75.00 4009 *    *   *  *  *
7080//normal            0     0    2   836
7081//normal(neu)       0     0    1   2    10  155
7082//### p=7 normal braucht 807 sec in:
7083// ideal endid  = phi1(endid);      //### bottelneck'
7084
7085//1.
7086int p = 2;  ring r = p,(u,v,x,y,z),dp; ideal i = x2v-y2u;
7087//2.
7088int p = 7; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2x4+uvy4+v2z4;
7089//3.
7090int p=11; ring r=p,(u,v,w,x,y,z),dp; ideal i=u2*x^p+uv*y^p+v2*z^p;
7091
7092//IRREDUCIBLE EXAMPLES:
7093//---------------------
7094//timing for MacBookPro 2.2GHz Intel Core 2 Duo, 4GB Ram
7095//Sing. ix86Mac-darwin version 3-1-0 (3100-2008101314)  Oct 13 2008 14:46:59
7096//if no time is given: < 1  sec
7097
7098//Apply:
7099list nor = normal(i,"isPrim"); nor;
7100list nor = normalP(i,"withRing","isPrim"); nor;
7101def R=nor[1][1]; setring R; norid; normap;
7102setring r;
7103norTest(i,nor);
7104
7105int tt = timer;
7106list nor = normalP(i,"withRing","isPrim"); nor;
7107timer-tt;
7108int tt = timer;
7109list nor = normal(i,"isPrim");
7110timer-tt;
7111
7112ring r=19,(x,y,u,v),dp;    //delta -1
7113ideal i=x2v-y2u;
7114//norTest 2 sec
7115
7116ring r=2,(y,x2,x1),lp;     //delta -1
7117ideal i=y^4+y^2*x2*x1+x2^3*x1^2+x2^2*x1^3;
7118//### norid hat 1 Element nach interred
7119
7120ring r  = 11,(x,y,z),wp(2,1,2); //alles < 1 sec
7121ideal i=z3 - xy4 + x2;          //not reduced, delta =0 ok
7122ideal i=y4+x5+y2x;              //not reduced, delta -1
7123//interred verkleinert norid
7124
7125ring r=3,(u,v,x,y,z),dp;   //delta -1
7126ideal i=u2x3+uvy3+v2z3;
7127
7128ring r=3,(u,v,x,y,z),dp;   //delta -1
7129ideal i=u2x4+uvy4+v2z4;
7130//norTest(i,nor);  0 sec, norTest(i,nor) haengt!
7131
7132ring r=5,(u,v,x,y,z),dp;   //delta -1
7133ideal i=u2x6+uvy6+v2z6;
7134//normalP 5sec, normalC 1sec
7135//V5: norTest(i,nor); 45 sec bei normalP, V6 12 sec
7136//28 sec bei normal
7137
7138ring r=5,(u,v,x,y,z),dp;   //delta -1
7139ideal i=u2x5+uvy5+v2z5;
7140//normalP 1sec, normalC 1 sec,
7141//norTest lange: minor(jacob(I),h,J) 193 (308)sec, haengt dann bei M = std(M);
7142//norTest(i,nor,2); verwenden!
7143//Sing 3.0-4 orig  >9h! haengt bei Q = mstd(Q)[2];
7144
7145ring r=2,(y,x),wp(12,5);  //delta 3
7146ideal i=y5+y2x4+y2x+yx2+x12;
7147//normalP 0 sec (Test 0 sec), normalC 2 sec (Test 2 sec)
7148//normalC withGens (ohne interred) 0sec
7149
7150ring r=2,(y,x),dp;       //delta= 22
7151ideal i=y9+y8x+y8+y5+y4x+y3x2+y2x3+yx8+x9;
7152//normalP 1sec, interred verkleinert norid betraechtlich
7153//normalC haengt bei minor, ideal im loop wird zu gross ###
7154//interred bei normalC vergroeesert string um Faktor 4000!
7155//withGens haengt bei interred in loop 4 (> 10 h) oder
7156//(nach Ausschalten von interred) bei
7157//int delt=vdim(std(modulo(f,ideal(p)))); (>?h)
7158
7159//Leonard1: (1. Komponente von Leonard),  delta -1
7160ring r=2,(v,u,z,y,x),dp;
7161ideal i = z3+zyx+y3x2+y2x3, uyx+z2,uz+z+y2x+yx2, u2+u+zy+zx,
7162          v3+vux+vz2+vzyx+vzx+uz3+uz2y+z3+z2yx2;
7163//normalP 5 sec (withRing 9 sec), norTest(i,nor,2); 45 sec
7164//normalC 102sec, 99sec
7165//### Zeit wird bei ideal Ann = quotient(SM[2],SL[1]); und bei
7166// f  = quotient(p*J,J); verbraucht
7167//withGens (ohne interred) 131sec, norTest(i,nor,2); 2min25sec
7168//norTest(i,nor,2);  45 sec
7169
7170 ring r=2,(y,x),wp(25,21); //Leonard2, delta 232
7171 ring r=2,(y,x),dp;
7172 ideal i=
7173 y^21+y^20*x +y^18*(x^3+x+1) +y^17*(x^3+1) +y^16*(x^4+x)
7174 +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)
7175 +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)
7176 +y^10*(x^12+x^9+x^8+x^7+x^5+x^3+x+1)
7177 +y^9*(x^14+x^13+x^10+x^9+x^8+x^7+x^6+x^3+x^2+1)
7178 +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)
7179 +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)
7180 +y^4*(x^19+x^16+x^15+x^12+x^6+x^5+x^3+1)
7181 +y^3*(x^18+x^15+x^12+x^10+x^9+x^7+x^4+x)
7182 +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)
7183 +y*(x^23+x^22+x^20+x^17+x^15+x^14+x^12+x^9)
7184 +(x^25+x^23+x^19+x^17+x^15+x^13+x^11+x^5);
7185//normalP: dp 2sec withRing 8sec,
7186//wp 4sec, withRing:51sec Zeit in lin = subst(lin, var(ii), vip); in elimpart ),
7187//norTest(i,nor,2): haengt bei mstd(norid);
7188//### normalC: (m. interred): haengt bei endid = interred(endid);
7189//GEFIXTES INTERRED ABWARTEN. Dann interred aktivieren
7190//interred(norid) haengt u. mst(norid) zu lange
7191//(o.interred): haengt bei  haengt bei list SM = mstd(i);
7192//ideal in der Mitte zu gross
7193//i = Ideal (size 118, 13 var) fuer die neue Normalisierung
7194//normal(neu) haengt bei return(std(i)) (offensichtlich in eineranderen lib)
7195
7196REDUCIBLE EXAMPLES:
7197------------------
7198//Apply:
7199int tt = timer;
7200list nor=normalP(i,"isPrim","withRing");
7201timer-tt;
7202
7203list nor = normal(i); nor;
7204list nor = normalC(i); nor;
7205list nor = normalC(i, "withGens"); nor;
7206list nor = normalP(i,"withRing"); nor;
7207list nor = normalP(i); nor;
7208def R=nor[1][1]; setring R; norid; normap;
7209
7210//Leonhard 4 Komponenten, dim=2, delta: 0,0,0,-1
7211ring r=2,(v,u,z,y,x),dp;      //lp zu lange
7212ideal i=z3+zyx+y3x2+y2x3, uyx+z2, v3+vuyx+vux+vzyx+vzx+uy3x2+uy2x+zy3x+zy2x2;
7213//normalP: 19 sec, withRing: 22 sec
7214//normalC ohne (mit) interred: 112 (113)sec, equidim: 99sec
7215//normalC 1. mal 111 sec, (2.mal) 450sec!! 3.mal 172 sec
7216//(unterschiedlich lange primdec, mit Auswirkungen)
7217//char 19: normalC: 15sec , withGens: 14sec (o.interr.)
7218
7219//----------------------Test Example for special cases -------------------
7220int tt = timer;
7221list nor=normalP(i,"withRing");nor;
7222//list nor=normalP(i,"withRing", "isPrim");nor;
7223timer-tt;
7224def R1 = nor[1][1]; setring R1;  norid; normap; interred(norid);
7225setring r;
7226
7227int tt = timer;
7228list nor=normal(i,"isPrim");nor;
7229timer-tt;
7230
7231ring r = 29,(x,y,z),dp;
7232ideal i = x2y2,x2z2;       //Nicht equidimensional, equidim reduziert nicht, ok
7233ideal i  = xyz*(z3-xy4);   //### interred(norid) verkuerzt
7234//je 0 sec
7235
7236ideal j = x,y;
7237ideal i = j*xy;
7238equidim(i);
7239//hat eingebettete Komponente, equidim rechnet wie in Beschreibung (ok)
7240
7241ring r  = 19,(x,y),dp;
7242   ideal i = x3-y4;                   //delta = 3
7243   ideal i = y*x*(x3-y4);             //delta = 11; 0,0,3
7244   ideal i = (x2-y3)*(x3-y4);         //delta = 13; 1,3
7245   ideal i = (x-y)*(x3+y2)*(x3-y4);   //delta = 23; 0,1,3
7246   ideal i = (x-1)*(x3+y2)*(x2-y3);   //delta = 16; 0,1,1
7247   ideal i = (x-y^2)^2 - y*x^3;       //delta = 3
7248   //singularities at not only at 0, hier rechnet equidim falsch
7249
7250// -------------------------- General Examples  ---------------------------//Huneke, irred., delta=2 (Version 3-0-4: < 1sec)
7251//Version 3-0-6 default: 1sec, mit gens 2sec, mit delta 5 sec
7252//(prim,noFac):ca 7 Min, prim:ca 10 min(wg facstd)
7253//
7254// "equidim" < 1sec irred. 5sec
7255// ring r=31991,(a,b,c,d,e),dp;
7256ring r=2,(a,b,c,d,e),dp;                    //delta=2
7257ideal i=
72585abcde-a5-b5-c5-d5-e5,
7259ab3c+bc3d+a3be+cd3e+ade3,
7260a2bc2+b2cd2+a2d2e+ab2e2+c2de2,
7261abc5-b4c2d-2a2b2cde+ac3d2e-a4de2+bcd2e3+abe5,
7262ab2c4-b5cd-a2b3de+2abc2d2e+ad4e2-a2bce3-cde5,
7263a3b2cd-bc2d4+ab2c3e-b5de-d6e+3abcd2e2-a2be4-de6,
7264a4b2c-abc2d3-ab5e-b3c2de-ad5e+2a2bcde2+cd2e4,
7265b6c+bc6+a2b4e-3ab2c2de+c4d2e-a3cde2-abd3e2+bce5;
7266//normalC: char 2, 31991: 0 sec (isPrim); char 2, equidim: 7 sec
7267//norTest(i,nor,2); 1sec
7268//normalP char 2: 1sec (isPrim)
7269//size(norid); size(string(norid));21 1219 interred(norid): 21 1245 (0 sec)
7270
7271int tt = timer;
7272list nor=normalC(i);nor;
7273timer-tt;
7274
7275list nor = normalP(i,"isPrim");
7276
7277//Vasconcelos irred., delta -1 (dauert laenger)
7278//auf macbook pro = 20 sec mit alter Version,
7279//Sing 3-0-6:
7280// Char 32003: "equidim" 30 sec, "noFac": 30sec
7281//gens: nach 9 min abgebr (haengt in Lin = ideal(T*syzf);) !!!! Hans zu tun
7282//Char 2: default (charp) 2 sec, normalC ca 30 sec
7283//ring r=32003,(x,y,z,w,t),dp;   //dim 2, dim s_locus 1
7284ring r=2,(x,y,z,w,t),dp;   //dim 2, dim s_locus 1
7285ideal i= x2+zw, y3+xwt, xw3+z3t+ywt2, y2w4-xy2z2t-w3t3;
7286//normalC: char 2: 22,  sec (mit und ohne isPrim)
7287//normalP char 2: 0sec (isPrim)      o. interred
7288//char 32003: ### haengt in ideal endid  = phi1(endid);
7289
7290//-------------------------------------------------------
7291//kleine Beispiele:
7292
7293//Theo1, irred, delta=-1
7294//normalC: 1sec, normalP: 3 sec
7295ring r=32003,(x,y,z),wp(2,3,6); //dim 2,dim slocus 1
7296ideal i=zy2-zx3-x6;
7297//normalC: char 2,19,32003: 0  sec (isPrim)
7298//normalP (isPrim) char 2,19: 0sec, char 29: 1sec
7299
7300//Theo1a, CohenMacaulay regular in codim 2, dim slocus=1, delta=0
7301//normalC: 0 sec, normalP: haegt in K=preimage(R,phi,L);
7302ring r=32003,(x,y,z,u),dp;
7303ideal i=zy2-zx3-x6+u2;
7304//normalC: char 2,32003: 0  sec (isPrim)
7305//normalP (isPrim) char 2: 0sec, char 19: haengt in K = preimage(Q,phi,L);
7306
7307//Theo2, irreduzibel, reduziert, < 1sec, delta -1
7308ring r=0,(x,y,z),wp(3,4,12);
7309ideal i=z*(y3-x4)+x8;
7310//normalC: char 2,32003,0: 0  sec (isPrim)
7311//normalP (isPrim) char 2: 0 1sec, char 19: 1sec char 29: 7 sec
7312
7313//Theo2a, reduiziert, 2-dim, dim_slocus=1, alte Version 3 sec,
7314//normalP ca 30 sec, normalC ca 4sec, delta -1
7315//ring r=32003,(T(1..4)),wp(3,4,12,17);
7316//ring r=11,(T(1..4)),dp;
7317ring r=11,(T(1..4)),wp(3,4,12,17);
7318ideal i=
7319T(1)^8-T(1)^4*T(3)+T(2)^3*T(3),
7320T(1)^4*T(2)^2-T(2)^2*T(3)+T(1)*T(4),
7321T(1)^7+T(1)^3*T(2)^3-T(1)^3*T(3)+T(2)*T(4),
7322T(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;
7323//normalC: char 2,32003: 0  sec (isPrim)
7324//normalP (isPrim) char 2: 0sec, char 11 2se, char 19: 13sec
7325//norTest 48sec in char11
7326//### interred verkuerzt
7327//char 29: haengt in K = preimage(Q,phi,L);
7328
7329//Theo3, irred, 2-dim, 1-dim sing, < 1sec
7330ring r=11,(x,y,z),wp(3,5,15);
7331ideal i=z*(y3-x5)+x10;
7332//normalC: char 2,0: 0  sec (withRing)
7333//normalP (withRing) char 2,11: 0sec, char 19: 13sec norTest 12sec(char 11)
7334
7335//Theo4 reducible, delta (0,0,0) -1
7336ring r=29,(x,y,z),dp;
7337ideal i=(x-y)*(x-z)*(y-z);
7338//normalC: char 2,32003: 0  sec
7339//normalP char withRing 2, 29: 0sec, 6sec
7340
7341//Theo6
7342ring r=32003,(x,y,z),dp;
7343ideal i=x2y2+x2z2+y2z2;
7344//normalC: char 2,32003: 0  sec
7345//normalP char withRing 2, 29: 0sec, 4sec
7346
7347//Sturmfels, CM, 15 componenten, alle glatt
7348ring r=0,(b,s,t,u,v,w,x,y,z),dp;
7349ideal i= bv+su, bw+tu, sw+tv, by+sx, bz+tx, sz+ty,uy+vx,uz+wx,vz+wy,bvz;
7350//normalC car 11, 0: 1sec, normalP 0 sec
7351
7352//riemenschneider, , dim 3, 5 Komp. delta (0,0,0,0,0), -1
7353ring r=2,(p,q,s,t,u,v,w,x,y,z),wp(1,1,1,1,1,1,2,1,1,1);
7354ideal i=xz,vx,ux,su,qu,txy,stx,qtx,uv2z-uwz,uv3-uvw,puv2-puw;
7355//alles 0 sec in char 2
7356
7357//4 Komponenten, alle glatt, 0sec
7358ring r=11,(x,y,z,t),dp;
7359ideal i=x2z+xzt,xyz,xy2-xyt,x2y+xyt;
7360
7361//dim 3, 2 Komponenten delta (-1,0), -1
7362ring r=2,(u,v,w,x,y,z),wp(1,1,1,3,2,1);
7363ideal i=wx,wy,wz,vx,vy,vz,ux,uy,uz,y3-x2;
7364//alles 0 sec in char 2
7365//---------------------------------------------------------
7366int tt = timer;
7367list nor=normalP(i,"normalC","withRing");nor;
7368timer-tt;
7369
7370//St_S/Y, 3 Komponenten, 2 glatt, 1 normal
7371//charp haengt (in char 20) in K=preimage(R,phi,L);
7372//ring r=32003,(b,s,t,u,v,w,x,y,z),dp;
7373ring r=11,(b,s,t,u,v,w,x,y,z),dp;
7374ideal i=wy-vz,vx-uy,tv-sw,su-bv,tuy-bvz;
7375//normalC: char 2,32003: 0  sec
7376//normalP char withRing 2: 1sec, char 11: 40sec
7377
7378//Horrocks: cahr 0: 17 (8 in char 11) Komponenten alle normal, delta 1
7379//char 11: 8 Komponenten alle normal, delta -1
7380ring r=0,(a,b,c,d,e,f),dp;
7381//ring r=11,(a,b,c,d,e,f),dp; //Charp bis p = 200 ca 3sec
7382ideal i=
7383adef-16000be2f+16001cef2, ad2f+8002bdef+8001cdf2, abdf-16000b2ef+16001bcf2,
7384a2df+8002abef+8001acf2, ad2e-8000bde2-7999cdef, acde-16000bce2+16001c2ef,
7385a2de-8000abe2-7999acef, acd2+8002bcde+8001c2df, abd2-8000b2de-7999bcdf,
7386a2d2+9603abde-10800b2e2-9601acdf+800bcef+11601c2f2,
7387abde-8000b2e2-acdf-16001bcef-8001c2f2, abcd-16000b2ce+16001bc2f,
7388a2cd+8002abce+8001ac2f, a2bd-8000ab2e-7999abcf, ab3f-3bdf3,
7389a2b2f-2adf3-16000bef3+16001cf4, a3bf+4aef3, ac3e-10668cde3,
7390a2c2e+10667ade3+16001be4+5334ce3f, a3ce+10669ae3f, bc3d+8001cd3e,
7391ac3d+8000bc3e+16001cd2e2+8001c4f, b2c2d+16001ad4+4000bd3e+12001cd3f,
7392b2c2e-10668bc3f-10667cd2ef, abc2e-cde2f, b3cd-8000bd3f, b3ce-10668b2c2f-10667bd2ef, abc2f-cdef2, a2bce-16000be3f+16001ce2f2,
7393ab3d-8000b4e-8001b3cf+16000bd2f2, ab2cf-bdef2,
7394a2bcf-16000be2f2+16001cef3, a4d-8000a3be+8001a3cf-2ae2f2;
7395//normalC: char 0: 1sec char 11: 0sec
7396//normalP: char 11: 0sec
7397
7398//2sec mit normalC, in char 2 ebenfalls (char 20 mit charp >1 min)
7399//4 Komp. in char 2, delta (0,0,0,0) -1, char 11:delta (-1,0,0,0) -1
7400ring r=32003,(b,s,t,u,v,w,x,y,z),dp;
7401ideal i=
7402wx2y3-vx2y2z+wx2yz2+wy3z2-vx2z3-vy2z3,
7403vx3y2-ux2y3+vx3z2-ux2yz2+vxy2z2-uy3z2,
7404tvx2y2-swx2y2+tvx2z2-swx2z2+tvy2z2-swy2z2,
7405sux2y2-bvx2y2+sux2z2-bvx2z2+suy2z2-bvy2z2,
7406tux2y3-bvx2y2z+tux2yz2+tuy3z2-bvx2z3-bvy2z3;
7407//normalC: char 2,32003: 1 sec
7408//normalP char withRing 2: 1sec, char 11: 40sec
7409
7410//---------------------------------------------------------
7411//genus:
7412int tt = timer;
7413list nor=normal(i, "noFac");nor;
7414timer-tt;
7415
7416//Yoshihiko Sakai, irred, 0sec, delta = 8
7417ring r=0,(x,y),dp;                    //genus 0 4 nodes and 6 cusps im P2
7418//ring r=7,(x,y),dp;                  //charp haengt in K = preimage(Q,phi,L)
7419ideal i=(x2+y^2-1)^3 +27x2y2;
7420
7421ring r=0,(x,y),dp;   //genus 0
7422ideal i=(x-y^2)^2 - y*x^3;
7423
7424ring r=0,(x,y),dp;  //genus 4
7425ideal i=y3-x6+1;
7426
7427int m=9;           // q=9: genus 0
7428int p=2;
7429int q=9;//2,...,9
7430ring r=0,(x,y),dp;
7431ideal i=y^m - x^p*(x - 1)^q;
7432
7433ring r=0,(x,y),dp;  //genus 19
7434ideal 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;
7435
7436ring r=23,(x,y),dp;  //genus 34, delta 2
7437ideal i=y10+(-2494x2+474)*y8+(84366+2042158x4-660492)*y6
7438        +(128361096x4-47970216x2+6697080-761328152x6)*y4
7439        +(-12024807786x4-506101284x2+15052058268x6+202172841-3212x8)*y2
7440        +34263110700x4-228715574724x6+5431439286x2+201803238
7441        -9127158539954x10-3212722859346x8;
7442//normalC, normalP 0 sec
7443
7444//Rob Koelman
7445//ring r=0,(x,y,z),dp;      //dim sing = 1 (nach ca 15 min abgebrochen)
7446ring r=32003,(x,y,z),dp;
7447ideal i=
7448761328152*x^6*z^4-5431439286*x^2*y^8+2494*x^2*z^8+228715574724*x^6*y^4+
7449 9127158539954*x^10-15052058268*x^6*y^2*z^2+3212722859346*x^8*y^2-
7450 134266087241*x^8*z^2-202172841*y^8*z^2-34263110700*x^4*y^6-6697080*y^6*z^4-
7451 2042158*x^4*z^6-201803238*y^10+12024807786*x^4*y^4*z^2-128361096*x^4*y^2*z^4+
7452 506101284*x^2*z^2*y^6+47970216*x^2*z^4*y^4+660492*x^2*z^6*y^2-
7453 z^10-474*z^8*y^2-84366*z^6*y^4;
7454//normalC char 32003: 10 sec, char 0 :
7455
7456//ring r=0,(x,y),dp;//genus 10  with 26 cusps (nach ca 4 min abgebrochen)
7457ring r=32003,(x,y),dp;    //24 sing, delta 24
7458ideal i=9127158539954x10+3212722859346x8y2+228715574724x6y4-34263110700x4y6
7459-5431439286x2y8-201803238y10-134266087241x8-15052058268x6y2+12024807786x4y4
7460+506101284x2y6-202172841y8+761328152x6-128361096x4y2+47970216x2y4-6697080y6
7461-2042158x4+660492x2y2-84366y4+2494x2-474y2-1;
7462//normalC 32003: 4 sec, char 0: abgebrochen bei pr = facstd(i); ###
7463
7464ring r=0,(x,y),dp;   //irred, genus 1  with 5 cusps, delta 5
7465ideal i=57y5+516x4y-320x4+66y4-340x2y3+73y3+128x2-84x2y2-96x2y;
7466//normalC 0 sec
7467
7468ring r=2,(x,y),dp;  //genus 4, 2 Zweige, delta (13,9) 89
7469ideal i=((x2+y3)^2+xy6)*((x3+y2)^2+x10y);
7470//normalC: char 2 : 1sec, char 0: lange
7471//normalP char 2 withRing: 0sec
7472
7473ring r=2,(y,z,w,u),dp; //2 Komp. genus -5
7474ideal i=y2+z2+w2+u2,w4-u4;
7475//normalC: char 2 : 0sec, char 0: 1sec
7476//normalP char 2 withRing: 0sec
7477
7478ring r=0,(y,z,w,u),dp; //irred. genus 9
7479ideal i=y2+z2+w2+u2,z4+w4+u4;
7480//char 0: 0sec
7481
7482ring r=0,(x,y,t),dp;  //irred, delta -1
7483ideal i= 25x8+200x7y+720x6y2+1520x5y3+2064x4y4+1856x3y5+1088x2y6+384xy7+64y8-12x6t2-72x5yt2-184x4y2t2-256x3y3t2-192x2y4t2-64xy5t2-2x4t4-8x3yt4+16xy3t4+16y4t4+4x2t6+8xyt6+8y2t6+t8;
7484//char 0: 0sec
7485
7486ring r=0,(x,y,z,w,u),dp;
7487ideal i=x2+y2+z2+w2+u2,x3+y3+z3,z4+w4+u4;
7488//char 0: 0sec
7489
7490//---------------------------------------------------------
7491//Probleme mit normalC in char 2 und char 0
7492
7493int tt = timer;
7494list nor=normalC(i,"withRing");nor;
7495timer-tt;
7496
7497//Mark van Hoeij
7498ring r=3,(x,y),dp;  //genus 19, delta 21
7499ideal i=y20+y13x+x4y5+x3*(x+1)^2;
7500//normalC: char 2 > 10 min   bei list SM = mstd(i);###
7501//normalP char 2 withRing: 0sec, char 11: haengt bei K = preimage(Q,phi,L);
7502
7503ring r=2,(x,y),dp;  //genus 35
7504ideal i=y30+y13x+x4y5+x3*(x+1)^2;
7505//char 0 abgebrochen bei list SM = mstd(i); ###
7506//char 2 nach ca 30 min
7507//normalC: char 2: abgebr. bei list SM = mstd(i);  //Now the work starts'
7508//normalC, withGens, char 2: abgebrochen bei Q=mstd(Q)[2];
7509//normalP char 2 withRing: 0sec
7510
7511ring r=0,(x,y),dp;   //irred, genus 55, delta 21
7512ideal i=y40+y13x+x4y5+x3*(x+1)^2;
7513//normalC: char 2 lange
7514//normalP char 2 withRing: 0sec
7515
7516ring r=29,(x,y,t),dp; //char 0: genus -5, 4 Komp, delta (-1,-1,0,0), -1
7517ideal 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;
7518//normalC: char 29 : 0sec, char 0: 0sec  //char 29 6 Komponenten
7519//normalP char 29 withRing: 1sec
7520
7521//-------------------------- problematic examples ------------------------
7522//ring r=0,(x,y,t),dp;
7523ring r=32003,(x,y,t),dp;
7524ideal i=
752532761x8+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;
7526//char 0: lange (es liegt an den grossen Zahlen), char 32003: 0 sec
7527
7528//dasselbe Beipiel in char 19: irred
7529ring r=0,(x,y,t),dp;
7530ideal i=
75315x8+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;
7532//normalP: char 2,3: 0sec, norTest 0,2 sec, char 11 haengt bei peimage
7533//normalC: char 3: 0 sec, char 0: 1sec
7534
7535//ring r=0,(x,y),dp;
7536ring r=32003,(x,y),dp;
7537ideal i=
7538x30y21+21x29y20+210x28y19+10x27y19+1330x27y18+190x26y18+5985x26y17
7539+1710x25y17+20349x25y16+45x24y17+9690x24y16+54264x24y15+765x23y16
7540+38760x23y15+116280x23y14+6120x22y15+116280x22y14+120x21y15
7541+203490x22y13+30600x21y14+271320x21y13+1799x20y14+293930x21y12+107100x20y13
7542+503880x20y12+12586x19y13+352716x20y11+278460x19y12+210x18y13+755820x19y11
7543+54509x18y12+352716x19y10+556920x18y11+2723x17y12+923780x18y10+163436x17y11
7544+293930x18y9+875160x17y10+16296x16y11+923780x17y9+359359x16y10+252x15y11
7545+203490x17y8+1093950x16y9+59598x15y10+755820x16y8+598598x15y9+2751x14y10
7546+116280x16y7+1093950x15y8+148610x14y9+503880x15y7+769197x14y8+13650x13y9
7547+54264x15y6+875160x14y7+266805x13y8+210x12y9+271320x14y6+768768x13y7
7548+40635x12y8+20349x14y5+556920x13y6+354816x12y7+1855x11y8+116280x13y5
7549+597597x12y6+80640x11y7+5985x13y4+278460x12y5+353892x11y6+7280x10y7+38760x12y4
7550+358358x11y5+112014x10y6+120x9y7+1330x12y3+107100x11y4+264726x10y5+16660x9y6
7551+9690x11y3+162799x10y4+111132x9y5+805x8y6+210x11y2+30600x10y3+146685x9y4
7552+24500x8y5+1710x10y2+54236x9y3+78750x8y4+2310x7y5+21x10y+6120x9y2+58520x8y3
7553+24010x7y4+45x6y5+190x9y+12509x8y2+39060x7y3+3675x6y4+x9+765x8y+15918x7y2
7554+15680x6y3+204x5y4+10x8+1786x7y+12915x6y2+3500x5y3+45x7+2646x6y+6580x5y2
7555+366x4y3+119x6+2562x5y+1995x4y2+10x3y3+203x5+1610x4y+324x3y2+231x4+630x3y
7556+23x2y2+175x3+141x2y+85x2+16xy+24x+y+4;
7557list nor = normal(i);
7558//normalC: char 0: ### haengt in SB of singular locus JM = mstd(J);
7559//normalC: char 32003,"noFac","equidim": 0sec, "noFac": 1sec
7560// ev neues interred
7561genus(i);         // haengt bei int mu=vdim(std(jacob(f)));
7562                  //### ist das noetig?
7563
7564//Singular rechnet genus richtig, auch im Fall, dass Kurve irreduzibel,
7565//aber nicht absolut irreduzibel ist:
7566ring r = 0,(x,y),dp;
7567ideal i = x2+y2;      //irreduzibel /Q aber reduzibel /C (x-iy)*(x+iy)
7568factorize( x2+y2);    //liefert irreduzibel
7569genus(i);             //sollte 0+0-2+1= -1 sein
7570genus(i,1);           //beides ist korrekt in Singular
7571
7572*/
Note: See TracBrowser for help on using the repository browser.