Changeset 3a8cca9 in git


Ignore:
Timestamp:
Nov 7, 2016, 11:26:35 AM (8 years ago)
Author:
Christian Eder
Branches:
(u'fieker-DuVal', '117eb8c30fc9e991c4decca4832b1d19036c4c65')(u'spielwiese', 'b4f17ed1d25f93d46dbe29e4b499baecc2fd51bb')
Children:
9c2e7c6be4f1e6f9a434d4e9a5ed429dd8a0d784
Parents:
9d19c1d4a135d687509d2236de8887bb26d4c9b3
Message:
Fixes bugs in classify_aeq.lib; changes done by Gerhard Pfister
File:
1 edited

Legend:

Unmodified
Added
Removed

  • Singular/LIB/classify_aeq.lib

    r9d19c1 r3a8cca9  
    11///////////////////////////////////////////////////////////////////////////////
    2 version="version classify_aeq.lib 4.0.3.2 Sep_2016 "; // $Id$
     2version="version classify_aeq.lib 4.0.0.0 Jun_2013 "; // $Id$
    33category="Singularities";
    44info="
    … …  
    2525  [5] Ishikawa,G; Janeczko,S.: The Complex Symplectic Moduli Spaces of Unimodal Parametric Plane Curve  NEU Singularities. Insitute of Mathematics of the Polish Academy of Sciences,Preprint 664(2006)
    2626PROCEDURES:
    27   sagbiAlg(G);    Compute the Sagbi-basis of the Algebra.
    28   sagbiMod(I,A);  Compute the Sagbi- basis of the Module.
    29   semiGroup(G);   Compute the Semi-Group of the Algebra provided the input is Sagbi Bases of the Algebra.
    30   semiMod(I,A);   Compute the Semi-Module provided that the input are the Sagbi Bases of the Algebra resp.Module.
    31   planeCur(I);    Compute the type of the Simple Plane Curve singularity.
    32   spaceCur(I);    Compute the type of the simple Space Curve singularity.
    33   inVar(I);       computes for the parametrization defined by Is
    34                   semi group, semi module of differentials,
    35                   Zariski number and moduli
    36   HHnormalForm(I);  computes for the parametrization defined by I
    37                   normal form, semi group, semi module of differentials,
    38                   Zariski number and moduli
     27          sagbiAlg(G);    Compute the Sagbi-basis of the Algebra.
     28          sagbiMod(I,A);  Compute the Sagbi- basis of the Module.
     29          semiGroup(G);   Compute the Semi-Group of the Algebra provided the input is Sagbi Bases of the Algebra.
     30          semiMod(I,A);   Compute the Semi-Module provided that the input are the Sagbi Bases of the Algebra resp.Module.
     31          planeCur(I);    Compute the type of the Simple Plane Curve singularity.
     32          spaceCur(I);    Compute the type of the simple Space Curve singularity.
    3933";
    4034LIB "algebra.lib";
    … …  
    669663
    670664////////////////////////////////////////////////////////////////////////////////
    671 proc sagbiAlg(ideal I,list #)
     665proc sagbiAlg(ideal I,list #)             //AENDERUNG
    672666"USAGE":  sagbiAlg(I);  I ideal
    673667RETURN: An ideal.The sagbi bases of I.
    674668EXAMPLE: example sagbiAlg;  shows an example
    675669{
    676   def R=basering;
    677   def O=changeord(list(list("Ds",nvars(R))));
    678   setring O;
    679   ideal I=imap(R,I);
    680   ideal L,S;
    681   poly h;
    682   int z,n;
    683 
    684   if(size(I)==0){return(I);}
    685   if(size(#)==0)
    686   {
    687     int b=ConductorBound(I);
    688     S=interReduceSagbi(I,b) ;
    689     b=ConductorBound(S);
     670    def R=basering;
     671    def O=changeord(list(list("Ds",nvars(R))));
     672    setring O;
     673    ideal I=imap(R,I);
     674    ideal L;
     675    poly h;
     676    int z,n;
     677
     678    if(size(I)==0){return(I);}
     679    if(size(#)==0)              // AENDERUNG ANFANG
     680    {
     681       int b=ConductorBound(I);
    690682    // int b=200;
    691     // b=correctBound(I,b);
    692   }
    693   else
    694   {
    695     int b=#[1];
    696   }
    697   S=interReduceSagbi(I,b) ;
     683  //   b=correctBound(I,b);
     684    }
     685    else
     686    {
     687       int b=#[1];
     688    }
     689                          //AENERUNG ENDE
     690   ideal S=interReduceSagbi(I,b) ;
    698691  // b=correctBound(S,b);
    699   while(size(S)!=n)
    700   {
    701     n=size(S);
    702     L=sagbiSP(S);
    703     for (z=1;z<=size(L);z++)
    704     {
    705       h=sagbiNF(L[z],S,b);
    706       if(h!=0)
    707       {
    708         S=insertOne(h,S,b);
    709       }
    710     }
    711   }
    712   setring R;
    713   ideal S=imap(O,S);
    714   return(S);
     692   while(size(S)!=n)
     693   {
     694       n=size(S);
     695       L=sagbiSP(S);
     696       for (z=1;z<=size(L);z++)
     697       {
     698             h=sagbiNF(L[z],S,b);
     699             if(h!=0)
     700             {
     701                  S=insertOne(h,S,b);
     702             }
     703        }
     704   }
     705   b=semiGroup(S)[2]+1;
     706   S=jet(S,b);
     707   setring R;
     708   ideal S=imap(O,S);
     709   return(S);
    715710}
    716711example
    717712{
    718713  "EXAMPLE:"; echo=2;
    719   ring R=0,t,ds;
    720   ideal I=t8,t10+t13,t12+t15;
    721   sagbiAlg(I);
    722   I=t8,t10+t13,t12+2t15;
    723   sagbiAlg(I);
    724 }
    725 
     714ring R=0,t,ds;
     715ideal I=t8,t10+t13,t12+t15;
     716sagbiAlg(I);
     717I=t8,t10+t13,t12+2t15;
     718sagbiAlg(I);
     719}
    726720//////////////////////////////////////////////////////////////////////////////// NEU
    727721proc reducedSagbiAlg(ideal I,list #)
    728722{
    729 
     723   
    730724   I=sagbiAlg(I,#);
    731725   intvec L=semiGroup(I)[3];
    … …  
    822816          }
    823817          G[2]=sagbiNF(G[2],ideal(G[1]),15);
    824           //arrange the coefficient of t10 to become 1
     818          //arrange the coefficient of t10 to become 1 
    825819          number m=leadcoef(G[2]-lead(G[2]));
    826820          G[2]=m^9*subst(G[2],t,1/m*t);
    827821          J=G;
     822         
     823         
    828824       }
    829825       if(K[4]==intvec(3,8,13,18))
    … …  
    866862          }
    867863          G[2]=sagbiNF(G[2],ideal(G[1]),21);
    868           //arrange the coefficient of t14 to become 1
     864          //arrange the coefficient of t14 to become 1 
    869865          number m=leadcoef(G[2]-lead(G[2]));
    870866          number l=leadcoef(G[2][4]);
    871867          //lambda^2=l^3/m^10
    872868          J=G;
    873 
     869         
    874870
    875871       }
    … …  
    914910          }
    915911          G[2]=sagbiNF(G[2],ideal(G[1]),9);
    916           //arrange the coefficient of t8 to become 1
     912          //arrange the coefficient of t8 to become 1 
    917913          number m=leadcoef(G[2]-lead(G[2]));
    918914          number l=leadcoef(G[2][3]);
    … …  
    944940          }
    945941          G[2]=sagbiNF(G[2],ideal(G[1]),11);
    946           //arrange the coefficient of t8 to become 1
     942          //arrange the coefficient of t8 to become 1 
    947943          number m=leadcoef(G[2]-lead(G[2]));
    948944          G[2]=m^7*subst(G[2],t,1/m*t);
    … …  
    966962          }
    967963          G[2]=sagbiNF(G[2],ideal(G[1]),14);
    968           //arrange the coefficient of t11 to become 1
     964          //arrange the coefficient of t11 to become 1 
    969965          number m=leadcoef(G[2]-lead(G[2]));
    970966          number l=leadcoef(G[2][3]);
    … …  
    996992          }
    997993          G[2]=sagbiNF(G[2],ideal(G[1]),12);
    998           //arrange the coefficient of t9 to become 1
     994          //arrange the coefficient of t9 to become 1 
    999995          number m=leadcoef(G[2]-lead(G[2]));
    1000996          G[2]=m^8*subst(G[2],t,1/m*t);
    … …  
    10191015          }
    10201016          G[2]=sagbiNF(G[2],ideal(G[1]),14);
    1021           //arrange the coefficient of t12 to become 1
     1017          //arrange the coefficient of t12 to become 1 
    10221018          number m=leadcoef(G[2]-lead(G[2]));
    10231019          number l=leadcoef(G[2][3]);
    … …  
    10431039          }
    10441040          G[2]=sagbiNF(G[2],ideal(G[1]),17);
    1045           //arrange the coefficient of t12 to become 1
     1041          //arrange the coefficient of t12 to become 1 
    10461042          number m=leadcoef(G[2]-lead(G[2]));
    10471043          number l=leadcoef(G[2][3]);
    … …  
    11651161  { setring R;
    11661162    return(imap(O,I));}
    1167   int b=ConductorBound(lead(G))+deg(lead(I[1]));
     1163  int b=semiGroup(lead(G))[2]+deg(lead(I[1]));  //AENDERUNG11.16
    11681164  list P;int i;
    11691165  P=createP(I);
    11701166  while(size(P)!=0)
    11711167  {
     1168//size(P);
    11721169      J=P[1][1],P[1][2];
    11731170      P=delete(P,1);
    … …  
    11831180         }
    11841181      }
     1182      //I=sortMOD(I);
     1183      //b=semiMod(I,G)[5]+1;
     1184//"clean";
     1185//      I=cleanI(I,G,b);
     1186//lead(I);
    11851187  }
    11861188  I=sortMOD(I);
    … …  
    11981200}
    11991201
     1202static proc cleanI(ideal I, ideal G, int b)
     1203{
     1204   int i;
     1205   ideal J;
     1206   I=jet(I,b);
     1207   I=simplify(I,2);
     1208   int n=size(I);
     1209   for(i=n;i>1;i--)
     1210   {
     1211      J=I[1..i-1];
     1212      I[i]=sagbiNFMOD(I[i],G,J,b);
     1213   }
     1214   I=simplify(I,2);
     1215   return(I);
     1216}
    12001217////////////////////////////////////////////////////////////////////////////////
    12011218proc semiGroup(ideal I)
    … …  
    17031720sortSagbi(SpolyMOD(I,J));
    17041721*/
     1722
     1723
    17051724////////////////////////////////////////////////////////////////////////////////
    17061725static proc sagbiNFMODO(poly p, ideal G, ideal I,int b)
    … …  
    17111730    p=jet(p,b);
    17121731    if(p==0){return(p);}
     1732    int i;
     1733    for(i=1;i<=size(I);i++)
     1734    {
     1735       if(leadmonom(p)==leadmonom(I[i]))
     1736       {
     1737          return(p-leadcoef(p)/leadcoef(I[i])*I[i]);
     1738       }
     1739    }
    17131740    int n=ncols(G);
    17141741    int m=ncols(I);
    17151742    ideal G1=lead(G);
    17161743    ideal I1=lead(I);
    1717     poly p1=lead(p);
     1744     poly p1=lead(p);
    17181745    //create new ring with extra variables -
    17191746    execute
    17201747    ("ring T=("+charstr(br)+",x(1),z(1..n)),(x(2),y(1..m)),dp;");
    1721     execute
    1722     ("ring R=("+charstr(br)+"),(x(1..2),y(1..m),z(1..n)),(lp(2),dp(m),dp(n));");
    1723 
    1724     map phi = br,x(1);
    1725     ideal P = phi(G1);
    1726     ideal S = phi(I1);
    1727     poly check = phi(p1);
    1728     poly keep=S[1];
    1729     S=S/keep;
    1730 
    1731     check=check/keep;
    1732     ideal M;
    1733     poly q;
    1734     for (int i=1;i<=m;i=i+1)
    1735     {
     1748     execute
     1749    ("ring R=("+charstr(br)+"),(x(1..2),y(1..m),z(1..n)),(lp(2),dp(m),dp(n));");  //AENDERUNG
     1750 
     1751     map phi = br,x(1);
     1752     ideal G = phi(G);
     1753     ideal I = phi(I);
     1754     ideal P = phi(G1);
     1755     ideal S = phi(I1);
     1756     poly p=phi(p);
     1757     ideal J=var(1),p,I,G;
     1758     poly check = phi(p1);
     1759     poly keep=S[1];
     1760     S=S/keep;
     1761
     1762     check=check/keep;
     1763     ideal M;
     1764     poly q;
     1765     for ( i=1;i<=m;i=i+1)
     1766     {
    17361767         M[i]=S[i]-y(i);
    1737     }
    1738     for (i=1;i<=n;i=i+1)
    1739     {
     1768     }
     1769     for (i=1;i<=n;i=i+1)
     1770     {
    17401771        M[m+i]=P[i]-z(i);
    1741     }
    1742     M[size(M)+1]=check-x(2);
    1743     check=check*keep;
    1744 
    1745     option(redSB);
    1746     M=std(M);
    1747     int j,s;
    1748 
    1749     for(i=1;i<=size(M);i++)
    1750     {
     1772     }
     1773     M[size(M)+1]=check-x(2);
     1774     check=check*keep;
     1775     option(redSB);
     1776     M=std(M);
     1777     int j,s;
     1778     for(i=1;i<=size(M);i++)
     1779     {
    17511780         if((deg(M[i]/x(2))==0)&&(M[i]/x(1)==0))
    17521781         {
    … …  
    17571786               }
    17581787               M[i]=M[i]-q+q*y(1);
    1759                q=M[i];
     1788             q=M[i];
    17601789               setring T;
    17611790               poly q=imap(R,q);
    1762                s=deg(q);
     1791             s=deg(q);
    17631792               setring R;
    17641793               if(s==1){check=simplify(q,1);break;}
    17651794         }
    1766     }
    1767     setring br;
    1768     map psi=R,maxideal(1),p,I,G;
    1769     return(psi(check));
    1770 }
    1771 ////////////////////////////////////////////////////////////////////////////////
    1772 
    1773 static proc sagbiNFMOD(poly p, ideal G, ideal I, int b)
     1795     }
     1796     poly check1=specialSubst(check,J,b);
     1797     setring br;
     1798//     map psi=R,maxideal(1),p,I,G;
     1799     map psi1=R,var(1);
     1800     return(psi1(check1));
     1801}
     1802////////////////////////////////////////////////////////////////////////////////
     1803static proc specialSubst(poly check,ideal J,int b)
     1804{
     1805   poly resu,mon,r;
     1806   int i,j,k;
     1807   intvec v;
     1808   for(i=1;i<=size(check);i++)
     1809   {
     1810      mon=check[i];
     1811      v=leadexp(mon);
     1812      r=1;
     1813      for(j=1;j<=nvars(basering);j++)
     1814      {
     1815         for(k=1;k<=v[j];k++)
     1816         {
     1817            r=jet(r*J[j],b);
     1818         }
     1819      }
     1820      resu=resu+r*leadcoef(mon);
     1821   }
     1822   return(jet(resu,b));
     1823}
     1824////////////////////////////////////////////////////////////////////////////////
     1825proc sagbiNFMOD(poly p, ideal G, ideal I, int b)
    17741826{
    17751827    poly f=jet(p,b);
    17761828    if(f==0){return(f);}
    17771829    poly h;
    1778     while(f!=h)
     1830    while(leadmonom(f)!=leadmonom(h))
    17791831    {
    17801832         h=f;
    17811833         f=sagbiNFMODO(f,G,I,b);
    17821834    }
    1783     return(lead(f)+sagbiNFMOD(f-lead(f),G,I,b));
     1835    return(lead(h)+sagbiNFMOD(h-lead(h),G,I,b));  //AENDERUNG
    17841836}
    17851837////////////////////////////////////////////////////////////////////////////////
    … …  
    18171869sagbiMod(I,G,18);
    18181870*/
    1819 
    18201871////////////////////////////////////////////////////////////////////////////////
    18211872static proc sortIntvec(intvec L)
    … …  
    19271978   return(K);
    19281979}
     1980////////////////////////////////////////////////////////////////////////////////
    19291981
    19301982proc inVar(ideal I)
    1931 "USAGE:   inVar(I);  I=ideal, I=<x(t),y(t)>, ord(x(t))=n<ord(y(t))=m,
    1932           n does not divide m
    1933 COMPUTE:  for the parametrization defined by I semi group, semi module
    1934           of differentials, Zariski number and moduli
    1935 RETURN:  a list L with 5 entries
    1936    L[1] the semi group Gamma
    1937    L[2] the semi module Lambda
    1938    L[3] 0 if Lambda=Gamma or lambda=min(Lambda-Gamma) -n, the Zariski number
    1939    L[4] the integers i, i>lambda, i+n not in Lambda, 0 if this set is empty
    1940    L[5] 0 or the smallest integer i, i not in Gamma, i+m-n not in Gamma
    1941         i-lambda not in Gamma but i+n in Lambda
    1942 EXAMPLE:  example inVar; shows an example"
    1943 {
     1983{
     1984// I=<x(t),y(t)>, ord(x(t))=n<ord(y(t))=m, n does not divide m
     1985// returns a list L with 5 entries
     1986// L[1] the semi group Gamma
     1987// L[2] the semi module Lambda
     1988// L[3] 0 if Lambda=Gamma or lambda=min(Lambda-Gamma) -n
     1989// L[4] the integers i, i>lambda, i+n not in Lambda, 0 if this set is empty
     1990// L[5] 0 or the smallest integer i, i not in Gamma, i+m-n not in Gamma
     1991//      i-lambda not in Gamma but i+n in Lambda
     1992
    19441993   ideal G=sagbiAlg(I);
    19451994   ideal M=diff(I,t);
    … …  
    19481997   intvec v=L[3];   //semi group Gamma
    19491998   intvec w=L[6]+1;
    1950    w=0,w;           //semin module Lambda
     1999   w=0,w;           //semi module Lambda
    19512000   intvec mo;
    19522001   int i,l,k;
    … …  
    19922041   return(list(v,w,l,mo,0));
    19932042}
    1994 example
    1995 {
    1996  "EXAMPLE"; echo=2;
    1997   ring r=0,t,Ds;
    1998   ideal I=t6+3t7,t8+t13+t19;
    1999   inVar(I);
    2000 }
    2001 
     2043////////////////////////////////////////////////////////////////////////////////
    20022044static proc ivec(int a, intvec v)
    20032045{
    … …  
    20102052   return(0);
    20112053}
    2012 
    2013 proc normalMap(ideal I, int bound)
     2054////////////////////////////////////////////////////////////////////////////////
     2055static proc normalMap(ideal I, int bound)
    20142056{
    20152057// returns (t^n,h) A-equivalent to I modulo <t>^bound+1
    … …  
    20212063   if(ord(I[1])>ord(I[2])){p=I[1];I[1]=I[2];I[2]=p;}
    20222064   I[1]=simplify(I[1],1);
    2023    int n=ord(I[1]);
     2065   int n=ord(I[1]); 
    20242066   phi=R,var(1)-1/number(n)*I[1][2]/var(1)^(n-1);
    20252067   I=phi(I);
     2068   I=jet(I,bound);
    20262069   while(size(I[1])>1)
    20272070   {
    20282071      phi=R,var(1)-1/number(n)*I[1][2]/var(1)^(n-1);
    2029 
    2030       I=jet(phi(I),bound);
     2072      I=phi(I);
     2073      I=jet(I,bound);
    20312074   }
    20322075   I[2]=simplify(I[2],1);
    … …  
    20352078   return(I);
    20362079}
    2037 
     2080////////////////////////////////////////////////////////////////////////////////
    20382081static proc reduc(poly f,ideal I, int b)
    20392082{
    … …  
    20562099   return (lead(f)+reduc(f-lead(f),I,b));
    20572100}
    2058 
    2059 proc HHnormalForm(ideal I, list #)
    2060 "USAGE:   HHnormalForm(I), I=<x(t),y(t)> an ideal, # optional, a bound for the
    2061           conductor
    2062 COMPUTE:  computes the Hefez-Hernandez normal form of the ideal I=<x(t),y(t)>
    2063 RETURN:  a list L with 5 entries
    2064    L[1] the Hefei-Hernandez normal form of the ideal I=<x(t),y(t)>
    2065    L[2] the semi group Gamma
    2066    L[3] the semi module Lambda
    2067    L[4] 0 if Lambda=Gamma or lambda=min(Lambda-Gamma) -n, the Zariski number
    2068    L[5] the integers i, i>lambda, i+n not in Lambda, 0 if this set is empty
    2069 EXAMPLE:  example HHnormalForm; shows an example"
    2070 {
     2101////////////////////////////////////////////////////////////////////////////////
     2102proc normalForm(ideal I, list #)
     2103{
     2104//computes the Hefez-Hernandez normal form of the ideal I=<x(t),y(t)>
     2105//returns a list with the normal form, the semi group Gamma, the semi module
     2106//Lambda, the Zariski number lambda, the moduli
     2107//(the integers i, i>lambda, i+n not in Lambda, 0 if this set is empty)
     2108
    20712109   int b,i,l,k;
    20722110   poly p;
    … …  
    21442182            phi=R,var(1)-1/number(m)*I[2][i]/var(1)^(m-1);
    21452183            I=phi(I);
    2146             G=sagbiAlg(I,b);
     2184            G=sagbiAlg(I);  //Aenderung
    21472185            I[1]=lead(I[1])+reduc(I[1]-lead(I[1]),G,b);
    21482186            I=normalMap(I,b);
    … …  
    21552193               g=findTrafo(I,i);
    21562194               g=jet(g,b-m+1);
    2157                phi=R,g;
     2195               phi=R,g;       
    21582196               I=phi(I);
    2159                G=sagbiAlg(I,b);
     2197               G=sagbiAlg(I);  //AENDERUNG
    21602198               I[1]=lead(I[1])+reduc(I[1]-lead(I[1]),G,b);
    21612199               I[2]=lead(I[2])+reduc(I[2]-lead(I[2]),G,b);
    … …  
    21682206   return(list(I,v,w,l,moduli));
    21692207}
    2170 example
    2171 {
    2172  "EXAMPLE"; echo=2;
    2173   ring r=0,t,Ds;
    2174   ideal I=t6+3t7,t8+t13+t19;
    2175   HHnormalForm(I);
    2176 }
    2177 
     2208////////////////////////////////////////////////////////////////////////////////
    21782209static proc findTrafo(ideal I, int i)
    21792210{
    … …  
    21822213//find g,h such that a*t^k*x'(t)=h(x(t),y(t))*x'(t)-g(x(t),y(t))*y'(t) mod t^(k+n)
    21832214//return the map t---> t+g(x(t),y(t))/x'(t) mod t^(k+1)
    2184 
    21852215   def R0=basering;
    21862216   int p=char(R0);
    … …  
    22092239      {
    22102240         poly f=J[i]/(-diff(J[i],@z)); //the element is in the standard basis
    2211          break;
     2241         break; 
    22122242      }
    22132243   }
    … …  
    22222252      {
    22232253          g=lead(J[i]);
    2224           if(((g==diff(g,@u)*@u)&&(diff(g,@v)==0))||((g==diff(g,@v)*@v)&&(diff(g,@u)==0)))
     2254          if(((g==diff(g,@u)*@u)&&(diff(g,@v)==0))||((g==diff(g,@v)*@v)&&(diff(g,@u)==0))||
     2255             (g==subst(g,@u,0,@v,0)))
    22252256          {
    22262257             K[size(K)+1]=J[i];
    … …  
    22292260      ring S1=p,(@z,@u,@v,@x,@y),(a(-1,-1,-1,0,0),dp(1),dp(2),dp(2));
    22302261      ideal K=imap(S,K);
    2231       attrib(K,"isSB",1);
     2262      K=specialInterred(K);
    22322263      poly f=imap(S,f);
    2233       f=reduce(f,K);
     2264      f=specialReduce(f,K);
    22342265      setring S;
    22352266      f=imap(S1,f);
    … …  
    22452276   return(var(1)-g);
    22462277}
    2247 
     2278////////////////////////////////////////////////////////////////////////////////
     2279static proc specialInterred(ideal K)
     2280{
     2281   int i,j;
     2282   int d=1;
     2283   poly p;
     2284   while(d)
     2285   {
     2286      d=0;
     2287      K=simplify(K,3);
     2288      K=sort(K)[1];
     2289      for(i=ncols(K);i>1;i--)
     2290      {
     2291         for(j=1;j<i;j++)
     2292         {
     2293            p=lead(K[i])/lead(K[j]);
     2294            if((p!=0)&&(p==subst(p,var(1),0,var(2),0)))
     2295            {
     2296               K[i]=K[i]-p*K[j];
     2297               d=1;
     2298               break;
     2299            }
     2300         }
     2301         if(d==1){break;}
     2302      }
     2303   }
     2304   return(K);
     2305}
     2306////////////////////////////////////////////////////////////////////////////////
     2307static proc specialReduce(poly f, ideal K)
     2308{
     2309   int i;
     2310   int d=1;
     2311   poly p;
     2312   while(d)
     2313   {
     2314      d=0;
     2315      for(i=1;i<=size(K);i++)
     2316      {
     2317         p=lead(f)/lead(K[i]);
     2318         if((p!=0)&&(p==subst(p,var(1),0,var(2),0)))
     2319         {
     2320            f=f-p*K[i];
     2321            d=1;
     2322            break;
     2323         }
     2324      }
     2325   }
     2326   return(f);
     2327}
     2328////////////////////////////////////////////////////////////////////////////////
    22482329//============================ Examples========================
    22492330/*
    22502331  ring r=0,t,(c,ds);
    22512332  ideal I=t4+t7,t6+t7;
    2252   HHnormalForm(I);
     2333  normalForm(I);
    22532334
    22542335  ring r=0,t,(c,ds);
    22552336  ideal I=t4+t7+t9,t6+t11;
    2256   HHnormalForm(I);
     2337  normalForm(I);
    22572338
    22582339  ring r=0,t,(c,ds);
    22592340  ideal I=t4+t5,t9+t10;
    2260   HHnormalForm(I);
     2341  normalForm(I);
    22612342
    22622343  ring r=0,t,Ds;
    22632344  ideal I=t6+3t7,t8+t13+t19;
    2264   HHnormalForm(I);
     2345  normalForm(I);
    22652346
    22662347  ring r=32003,t,Ds;
    22672348  ideal I=t8,t12+3t15+7t19;
    2268   HHnormalForm(I);
     2349  normalForm(I);
     2350
     2351  ring r=32003,t,Ds;
     2352  ideal I=t16,t24+t28+t30+t31;
     2353  normalForm(I);
     2354
    22692355*/
    2270 ////////////////////////////////////////////////////////////////////////////////
     2356
    22712357/*
    22722358===============================   Examples==========================================
Note: See TracChangeset for help on using the changeset viewer.