[380a17b] | 1 | ////////////////////////////////////////////////////////////////////////////// |
---|
[3686937] | 2 | version="version hnoether.lib 4.0.0.0 Jun_2013 "; // $Id$ |
---|
[a2c96e] | 3 | |
---|
[765857] | 4 | category="Singularities"; |
---|
[5480da] | 5 | info=" |
---|
[2761f3] | 6 | LIBRARY: hnoether.lib Hamburger-Noether (Puiseux) Expansion |
---|
[7fa60f] | 7 | AUTHORS: Martin Lamm, lamm@mathematik.uni-kl.de |
---|
| 8 | Christoph Lossen, lossen@mathematik.uni-kl.de |
---|
[f34c37c] | 9 | |
---|
[0b59f5] | 10 | OVERVIEW: |
---|
[3c4dcc] | 11 | A library for computing the Hamburger-Noether expansion (analogue of |
---|
| 12 | Puiseux expansion over fields of arbitrary characteristic) of a reduced |
---|
[7fa60f] | 13 | plane curve singularity following [Campillo, A.: Algebroid curves in |
---|
| 14 | positive characteristic, Springer LNM 813 (1980)]. @* |
---|
[803c5a1] | 15 | The library contains also procedures for computing the (topological) |
---|
| 16 | numerical invariants of plane curve singularities. |
---|
[baaef9] | 17 | |
---|
[bf42f0] | 18 | PROCEDURES: |
---|
[7fa60f] | 19 | hnexpansion(f [,\"ess\"]); Hamburger-Noether (HN) expansion of f |
---|
| 20 | develop(f [,n]); HN expansion of irreducible plane curve germs |
---|
[2761f3] | 21 | extdevelop(hne,n); extension of the H-N expansion hne of f |
---|
| 22 | param(hne [,s]); parametrization of branches described by HN data |
---|
| 23 | displayHNE(hne); display HN expansion as an ideal |
---|
[7fa60f] | 24 | invariants(hne); invariants of f, e.g. the characteristic exponents |
---|
| 25 | displayInvariants(hne); display invariants of f |
---|
| 26 | multsequence(hne); sequence of multiplicities |
---|
| 27 | displayMultsequence(hne); display sequence of multiplicities |
---|
[2761f3] | 28 | intersection(hne1,hne2); intersection multiplicity of two local branches |
---|
| 29 | is_irred(f); test whether f is irreducible as power series |
---|
[dcb500] | 30 | delta(f); delta invariant of f |
---|
[dd8844] | 31 | newtonpoly(f); (local) Newton polygon of f |
---|
[2761f3] | 32 | is_NND(f); test whether f is Newton non-degenerate |
---|
[dd8844] | 33 | |
---|
[81fb58d] | 34 | |
---|
[7fa60f] | 35 | stripHNE(hne); reduce amount of memory consumed by hne |
---|
[803c5a1] | 36 | puiseux2generators(m,n); convert Puiseux pairs to generators of semigroup |
---|
| 37 | separateHNE(hne1,hne2); number of quadratic transf. needed for separation |
---|
[3754ca] | 38 | squarefree(f); a squarefree divisor of the polynomial f |
---|
| 39 | allsquarefree(f,l); the maximal squarefree divisor of the polynomial f |
---|
[803c5a1] | 40 | further_hn_proc(); show further procedures useful for interactive use |
---|
| 41 | |
---|
| 42 | KEYWORDS: Hamburger-Noether expansion; Puiseux expansion; curve singularities |
---|
[5480da] | 43 | "; |
---|
[dcb500] | 44 | |
---|
[7fa60f] | 45 | // essdevelop(f); HN expansion of essential branches |
---|
[dcb500] | 46 | // multiplicities(hne); multiplicities of blowed up curves |
---|
| 47 | |
---|
[81fb58d] | 48 | /////////////////////////////////////////////////////////////////////////////// |
---|
[74b737] | 49 | LIB "primitiv.lib"; |
---|
| 50 | LIB "inout.lib"; |
---|
[dd8844] | 51 | LIB "sing.lib"; |
---|
[74b737] | 52 | |
---|
| 53 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 54 | |
---|
| 55 | proc further_hn_proc() |
---|
| 56 | "USAGE: further_hn_proc(); |
---|
[50cbdc] | 57 | NOTE: The library @code{hnoether.lib} contains some more procedures which |
---|
| 58 | are not shown when typing @code{help hnoether.lib;}. They may be useful |
---|
[7b3971] | 59 | for interactive use (e.g. if you want to do the calculation of an HN |
---|
[50cbdc] | 60 | development \"by hand\" to see the intermediate results), and they |
---|
[7b3971] | 61 | can be enumerated by calling @code{further_hn_proc()}. @* |
---|
[50cbdc] | 62 | Use @code{help <procedure>;} for detailed information about each of |
---|
[7b3971] | 63 | them. |
---|
[74b737] | 64 | " |
---|
| 65 | { |
---|
| 66 | " |
---|
[7b3971] | 67 | The following procedures are also part of `hnoether.lib': |
---|
[74b737] | 68 | |
---|
[7b3971] | 69 | getnm(f); intersection pts. of Newton polygon with axes |
---|
[74b737] | 70 | T_Transform(f,Q,N); returns f(y,xy^Q)/y^NQ (f: poly, Q,N: int) |
---|
| 71 | T1_Transform(f,d,M); returns f(x,y+d*x^M) (f: poly,d:number,M:int) |
---|
| 72 | T2_Transform(f,d,M,N,ref); a composition of T1 & T |
---|
[3754ca] | 73 | koeff(f,I,J); gets coefficient of indicated monomial of polynomial f |
---|
[74b737] | 74 | redleit(f,S,E); restriction of monomials of f to line (S-E) |
---|
| 75 | leit(f,n,m); special case of redleit (for irred. polynomials) |
---|
| 76 | testreducible(f,n,m); tests whether f is reducible |
---|
| 77 | charPoly(f,M,N); characteristic polynomial of f |
---|
| 78 | find_in_list(L,p); find int p in list L |
---|
| 79 | get_last_divisor(M,N); last divisor in Euclid's algorithm |
---|
[7b3971] | 80 | factorfirst(f,M,N); try to factor f without `factorize' |
---|
[74b737] | 81 | factorlist(L); factorize a list L of polynomials |
---|
| 82 | referencepoly(D); a polynomial f s.t. D is the Newton diagram of f"; |
---|
| 83 | |
---|
| 84 | // static procedures not useful for interactive use: |
---|
[3754ca] | 85 | // polytest(f); tests coefficients and exponents of polynomial f |
---|
[7fa60f] | 86 | // extractHNEs(H,t); extracts output H of HN to output of hnexpansion |
---|
| 87 | // HN(f,grenze); recursive subroutine for hnexpansion |
---|
[fff61a7] | 88 | // constructHNEs(...); subroutine for HN |
---|
[74b737] | 89 | } |
---|
| 90 | example |
---|
| 91 | { echo=2; |
---|
| 92 | further_hn_proc(); |
---|
| 93 | } |
---|
[190bf0b] | 94 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 95 | |
---|
| 96 | proc getnm (poly f) |
---|
[a848f8] | 97 | "USAGE: getnm(f); f bivariate polynomial |
---|
[190bf0b] | 98 | RETURN: intvec(n,m) : (0,n) is the intersection point of the Newton |
---|
| 99 | polygon of f with the y-axis, n=-1 if it doesn't exist |
---|
| 100 | (m,0) is its intersection point with the x-axis, |
---|
| 101 | m=-1 if this point doesn't exist |
---|
[a848f8] | 102 | ASSUME: ring has ordering `ls' or `ds' |
---|
[190bf0b] | 103 | EXAMPLE: example getnm; shows an example |
---|
[d2b2a7] | 104 | " |
---|
[190bf0b] | 105 | { |
---|
[a848f8] | 106 | // assume being called by develop ==> ring ordering is ls (ds would also work) |
---|
| 107 | return(ord(subst(f,var(1),0)),ord(subst(f,var(2),0))); |
---|
[190bf0b] | 108 | } |
---|
| 109 | example |
---|
| 110 | { "EXAMPLE:"; echo = 2; |
---|
| 111 | ring r = 0,(x,y),ds; |
---|
| 112 | poly f = x5+x4y3-y2+y4; |
---|
| 113 | getnm(f); |
---|
| 114 | } |
---|
| 115 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 116 | |
---|
| 117 | proc leit (poly f, int n, int m) |
---|
[81fb58d] | 118 | "USAGE: leit(f,n,m); poly f, int n,m |
---|
| 119 | RETURN: all monomials on the line from (0,n) to (m,0) in the Newton diagram |
---|
| 120 | EXAMPLE: example leit; shows an example |
---|
[d2b2a7] | 121 | " |
---|
[190bf0b] | 122 | { |
---|
| 123 | return(jet(f,m*n,intvec(n,m))-jet(f,m*n-1,intvec(n,m))) |
---|
| 124 | } |
---|
[81fb58d] | 125 | example |
---|
| 126 | { "EXAMPLE:"; echo = 2; |
---|
| 127 | ring r = 0,(x,y),ds; |
---|
| 128 | poly f = x5+x4y3-y2+y4; |
---|
| 129 | leit(f,2,5); |
---|
| 130 | } |
---|
[190bf0b] | 131 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 132 | proc testreducible (poly f, int n, int m) |
---|
[a848f8] | 133 | "USAGE: testreducible(f,n,m); f poly, n,m int |
---|
| 134 | RETURN: 1 if there are points in the Newton diagram below the line (0,n)-(m,0) |
---|
| 135 | 0 else |
---|
| 136 | EXAMPLE: example testreducible; shows an example |
---|
| 137 | " |
---|
[190bf0b] | 138 | { |
---|
| 139 | return(size(jet(f,m*n-1,intvec(n,m))) != 0) |
---|
| 140 | } |
---|
[a848f8] | 141 | example |
---|
| 142 | { "EXAMPLE:"; echo = 2; |
---|
| 143 | ring rg=0,(x,y),ls; |
---|
| 144 | testreducible(x2+y3-xy4,3,2); |
---|
| 145 | } |
---|
[190bf0b] | 146 | /////////////////////////////////////////////////////////////////////////////// |
---|
[82716e] | 147 | proc T_Transform (poly f, int Q, int N) |
---|
[a848f8] | 148 | "USAGE: T_Transform(f,Q,N); f poly, Q,N int |
---|
| 149 | RETURN: f(y,xy^Q)/y^NQ if x,y are the ring variables |
---|
| 150 | NOTE: this is intended for irreducible power series f |
---|
| 151 | EXAMPLE: example T_Transform; shows an example |
---|
| 152 | " |
---|
[190bf0b] | 153 | { |
---|
[a848f8] | 154 | map T = basering,var(2),var(1)*var(2)^Q; |
---|
| 155 | return(T(f)/var(2)^(N*Q)); |
---|
| 156 | } |
---|
| 157 | example |
---|
| 158 | { "EXAMPLE:"; echo = 2; |
---|
| 159 | ring exrg=0,(x,y),ls; |
---|
| 160 | export exrg; |
---|
| 161 | T_Transform(x3+y2-xy3,1,2); |
---|
| 162 | kill exrg; |
---|
[190bf0b] | 163 | } |
---|
| 164 | /////////////////////////////////////////////////////////////////////////////// |
---|
[81fb58d] | 165 | proc T1_Transform (poly f, number d, int Q) |
---|
[a848f8] | 166 | "USAGE: T1_Transform(f,d,Q); f poly, d number, Q int |
---|
| 167 | RETURN: f(x,y+d*x^Q) if x,y are the ring variables |
---|
| 168 | EXAMPLE: example T1_Transform; shows an example |
---|
| 169 | " |
---|
[190bf0b] | 170 | { |
---|
[a848f8] | 171 | map T1 = basering,var(1),var(2)+d*var(1)^Q; |
---|
[190bf0b] | 172 | return(T1(f)); |
---|
| 173 | } |
---|
[a848f8] | 174 | example |
---|
| 175 | { "EXAMPLE:"; echo = 2; |
---|
| 176 | ring exrg=0,(x,y),ls; |
---|
| 177 | export exrg; |
---|
| 178 | T1_Transform(y2-2xy+x2+x2y,1,1); |
---|
| 179 | kill exrg; |
---|
| 180 | } |
---|
[190bf0b] | 181 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 182 | |
---|
[7fa60f] | 183 | proc T2_Transform (poly f_neu, number d, int M, int N, poly refpoly) |
---|
[81fb58d] | 184 | "USAGE: T2_Transform(f,d,M,N,ref); f poly, d number; M,N int; ref poly |
---|
[a848f8] | 185 | RETURN: list: poly T2(f,d',M,N), number d' in \{ d, 1/d \} |
---|
[81fb58d] | 186 | ASSUME: ref has the same Newton polygon as f (but can be simpler) |
---|
| 187 | for this you can e.g. use the proc `referencepoly' or simply f again |
---|
[a848f8] | 188 | COMMENT: T2 is a composition of T_Transform and T1_Transform; the exact |
---|
| 189 | definition can be found in Rybowicz: `Sur le calcul des places ...' |
---|
| 190 | or in Lamm: `Hamburger-Noether-Entwicklung von Kurvensingularitaeten' |
---|
| 191 | SEE ALSO: T_Transform, T1_Transform, referencepoly |
---|
[81fb58d] | 192 | EXAMPLE: example T2_Transform; shows an example |
---|
[d2b2a7] | 193 | " |
---|
[190bf0b] | 194 | { |
---|
| 195 | //---------------------- compute gcd and extgcd of N,M ----------------------- |
---|
| 196 | int ggt=gcd(M,N); |
---|
[4173c7] | 197 | M=M div ggt; N=N div ggt; |
---|
[82716e] | 198 | list ts=extgcd(M,N); |
---|
[190bf0b] | 199 | int tau,sigma=ts[2],-ts[3]; |
---|
[81fb58d] | 200 | int s,t; |
---|
[a848f8] | 201 | poly xp=var(1); |
---|
| 202 | poly yp=var(2); |
---|
[81fb58d] | 203 | poly hilf; |
---|
[190bf0b] | 204 | if (sigma<0) { tau=-tau; sigma=-sigma;} |
---|
| 205 | // es gilt: 0<=tau<=N, 0<=sigma<=M, |N*sigma-M*tau| = 1 = ggT(M,N) |
---|
| 206 | if (N*sigma < M*tau) { d = 1/d; } |
---|
| 207 | //--------------------------- euklid. Algorithmus ---------------------------- |
---|
| 208 | int R; |
---|
| 209 | int M1,N1=M,N; |
---|
| 210 | for ( R=M1%N1; R!=0; ) { M1=N1; N1=R; R=M1%N1;} |
---|
[4173c7] | 211 | int Q=M1 div N1; |
---|
[a848f8] | 212 | map T1 = basering,xp,yp+d*xp^Q; |
---|
| 213 | map Tstar=basering,xp^(N-Q*tau)*yp^tau,xp^(M-sigma*Q)*yp^sigma; |
---|
[81fb58d] | 214 | if (defined(HNDebugOn)) { |
---|
[190bf0b] | 215 | "Trafo. T2: x->x^"+string(N-Q*tau)+"*y^"+string(tau)+", y->x^" |
---|
| 216 | +string(M-sigma*Q)+"*y^"+string(sigma); |
---|
[dcb500] | 217 | "delt =",d,"Q =",Q,"tau,sigma =",tau,sigma; |
---|
[190bf0b] | 218 | } |
---|
| 219 | //------------------- Durchfuehrung der Transformation T2 -------------------- |
---|
[7fa60f] | 220 | f_neu=Tstar(f_neu); |
---|
[81fb58d] | 221 | refpoly=Tstar(refpoly); |
---|
[3c4dcc] | 222 | //--- dividiere f_neu so lange durch x & y, wie die Division aufgeht, |
---|
| 223 | // benutze ein Referenzpolynom mit gleichem Newtonpolynom wie f_neu zur |
---|
[7fa60f] | 224 | // Beschleunigung: --- |
---|
[a848f8] | 225 | for (hilf=refpoly/xp; hilf*xp==refpoly; hilf=refpoly/xp) {refpoly=hilf; s++;} |
---|
| 226 | for (hilf=refpoly/yp; hilf*yp==refpoly; hilf=refpoly/yp) {refpoly=hilf; t++;} |
---|
[7fa60f] | 227 | f_neu=f_neu/(xp^s*yp^t); |
---|
| 228 | return(list(T1(f_neu),d)); |
---|
[190bf0b] | 229 | } |
---|
[81fb58d] | 230 | example |
---|
| 231 | { "EXAMPLE:"; echo = 2; |
---|
| 232 | ring exrg=0,(x,y),ds; |
---|
| 233 | export exrg; |
---|
| 234 | poly f=y2-2x2y+x6-x5y+x4y2; |
---|
| 235 | T2_Transform(f,1/2,4,1,f); |
---|
[dd8844] | 236 | T2_Transform(f,1/2,4,1,referencepoly(newtonpoly(f,1))); |
---|
[81fb58d] | 237 | // if size(referencepoly) << size(f) the 2nd example would be faster |
---|
[dd8844] | 238 | referencepoly(newtonpoly(f,1)); |
---|
[81fb58d] | 239 | kill exrg; |
---|
| 240 | } |
---|
[190bf0b] | 241 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 242 | |
---|
| 243 | proc koeff (poly f, int I, int J) |
---|
[a848f8] | 244 | "USAGE: koeff(f,I,J); f bivariate polynomial, I,J integers |
---|
[81fb58d] | 245 | RETURN: if f = sum(a(i,j)*x^i*y^j), then koeff(f,I,J)= a(I,J) (of type number) |
---|
[a848f8] | 246 | NOTE: J must be in the range of the exponents of the 2nd ring variable |
---|
[190bf0b] | 247 | EXAMPLE: example koeff; shows an example |
---|
[81fb58d] | 248 | " |
---|
| 249 | { |
---|
[a848f8] | 250 | matrix mat = coeffs(coeffs(f,var(2))[J+1,1],var(1)); |
---|
[82716e] | 251 | if (size(mat) <= I) { return(0);} |
---|
[190bf0b] | 252 | else { return(leadcoef(mat[I+1,1]));} |
---|
| 253 | } |
---|
| 254 | example |
---|
| 255 | { "EXAMPLE:"; echo = 2; |
---|
| 256 | ring r=0,(x,y),dp; |
---|
| 257 | koeff(x2+2xy+3xy2-x2y-2y3,1,2); |
---|
| 258 | } |
---|
| 259 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 260 | |
---|
| 261 | proc squarefree (poly f) |
---|
[7b3971] | 262 | "USAGE: squarefree(f); f poly |
---|
| 263 | ASSUME: f is a bivariate polynomial (in the first 2 ring variables). |
---|
| 264 | RETURN: poly, a squarefree divisor of f. |
---|
[50cbdc] | 265 | NOTE: Usually, the return value is the greatest squarefree divisor, but |
---|
| 266 | there is one exception: factors with a p-th root, p the |
---|
[7b3971] | 267 | characteristic of the basering, are lost. |
---|
[a848f8] | 268 | SEE ALSO: allsquarefree |
---|
[190bf0b] | 269 | EXAMPLE: example squarefree; shows some examples. |
---|
[81fb58d] | 270 | " |
---|
| 271 | { |
---|
[190bf0b] | 272 | //----------------- Wechsel in geeigneten Ring & Variablendefinition --------- |
---|
[a2c96e] | 273 | if (nvars(basering)!=2) |
---|
| 274 | { ERROR("basering must have exactly 2 variables for Hnoether::squarefree"); } |
---|
[190bf0b] | 275 | def altring = basering; |
---|
[bb17e8] | 276 | int e; |
---|
| 277 | int gcd_ok=1; |
---|
| 278 | string mipl="0"; |
---|
[81fb58d] | 279 | if (size(parstr(altring))==1) { mipl=string(minpoly); } |
---|
[bb17e8] | 280 | //---- test: char = (p^k,a) (-> gcd not implemented) or (p,a) (gcd works) ---- |
---|
[b24fe3] | 281 | //if ((char(basering)!=0) and (charstr(basering)!=string(char(basering)))) |
---|
| 282 | gcd_ok= ! hasGFCoefficient(basering); |
---|
[190bf0b] | 283 | execute("ring rsqrf = ("+charstr(altring)+"),(x,y),dp;"); |
---|
[034ce1] | 284 | if ((gcd_ok!=0) && (mipl!="0")) { execute("minpoly="+mipl+";"); } |
---|
[190bf0b] | 285 | poly f=fetch(altring,f); |
---|
| 286 | poly dif,g,l; |
---|
[81fb58d] | 287 | if ((char(basering)==0) and (charstr(basering)!=string(char(basering))) |
---|
| 288 | and (mipl!="0")) { |
---|
| 289 | gcd_ok=0; // since Singular 1.2 gcd no longer implemented |
---|
| 290 | } |
---|
[bb17e8] | 291 | if (gcd_ok!=0) { |
---|
[81fb58d] | 292 | //--------------------- Berechne f/ggT(f,df/dx,df/dy) ------------------------ |
---|
[bb17e8] | 293 | dif=diff(f,x); |
---|
| 294 | if (dif==0) { g=f; } // zur Beschleunigung |
---|
| 295 | else { g=gcd(f,dif); } |
---|
| 296 | if (g!=1) { // sonst schon sicher, dass f quadratfrei |
---|
| 297 | dif=diff(f,y); |
---|
| 298 | if (dif!=0) { g=gcd(g,dif); } |
---|
| 299 | } |
---|
| 300 | if (g!=1) { |
---|
| 301 | e=0; |
---|
| 302 | if (g==f) { l=1; } // zur Beschleunigung |
---|
| 303 | else { |
---|
| 304 | module m=syz(ideal(g,f)); |
---|
| 305 | if (deg(m[2,1])>0) { |
---|
| 306 | "!! The Singular command 'syz' has returned a wrong result !!"; |
---|
| 307 | l=1; // Division f/g muss aufgehen |
---|
| 308 | } |
---|
| 309 | else { l=m[1,1]; } |
---|
[190bf0b] | 310 | } |
---|
[bb17e8] | 311 | } |
---|
| 312 | else { e=1; } |
---|
| 313 | } |
---|
| 314 | else { |
---|
| 315 | //------------------- Berechne syz(f,df/dx) oder syz(f,df/dy) ---------------- |
---|
| 316 | //-- Achtung: Ist f reduzibel, koennen Faktoren mit Ableitung Null verloren -- |
---|
| 317 | //-- gehen! Ist aber nicht weiter schlimm, weil char (p^k,a) nur im irred. -- |
---|
| 318 | //-- Fall vorkommen kann. Wenn f nicht g^p ist, wird auf jeden Fall -- |
---|
| 319 | //------------------------ ein Faktor gefunden. ------------------------------ |
---|
| 320 | dif=diff(f,x); |
---|
| 321 | if (dif == 0) { |
---|
| 322 | dif=diff(f,y); |
---|
| 323 | if (dif==0) { e=2; l=1; } // f is of power divisible by char of basefield |
---|
| 324 | else { l=syz(ideal(dif,f))[1,1]; // x^p+y^(p-1) abgedeckt |
---|
[81fb58d] | 325 | if (subst(f,x,0)==0) { l=l*x; } |
---|
| 326 | if (deg(l)==deg(f)) { e=1;} |
---|
[bb17e8] | 327 | else {e=0;} |
---|
| 328 | } |
---|
| 329 | } |
---|
| 330 | else { l=syz(ideal(dif,f))[1,1]; |
---|
[81fb58d] | 331 | if (subst(f,y,0)==0) { l=l*y; } |
---|
| 332 | if (deg(l)==deg(f)) { e=1;} |
---|
[bb17e8] | 333 | else {e=0;} |
---|
| 334 | } |
---|
[190bf0b] | 335 | } |
---|
| 336 | //--------------- Wechsel in alten Ring und Rueckgabe des Ergebnisses -------- |
---|
| 337 | setring altring; |
---|
| 338 | if (e==1) { return(f); } // zur Beschleunigung |
---|
| 339 | else { |
---|
| 340 | poly l=fetch(rsqrf,l); |
---|
| 341 | return(l); |
---|
| 342 | } |
---|
| 343 | } |
---|
| 344 | example |
---|
| 345 | { "EXAMPLE:"; echo = 2; |
---|
| 346 | ring exring=3,(x,y),dp; |
---|
[7b3971] | 347 | squarefree((x3+y)^2); |
---|
| 348 | squarefree((x+y)^3*(x-y)^2); // Warning: (x+y)^3 is lost |
---|
[190bf0b] | 349 | squarefree((x+y)^4*(x-y)^2); // result is (x+y)*(x-y) |
---|
| 350 | } |
---|
| 351 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 352 | |
---|
| 353 | proc allsquarefree (poly f, poly l) |
---|
[7b3971] | 354 | "USAGE : allsquarefree(f,g); f,g poly |
---|
| 355 | ASSUME: g is the output of @code{squarefree(f)}. |
---|
| 356 | RETURN: the greatest squarefree divisor of f. |
---|
| 357 | NOTE : This proc uses factorize to get the missing factors of f not in g and, |
---|
| 358 | therefore, may be slow. |
---|
[a848f8] | 359 | SEE ALSO: squarefree |
---|
[190bf0b] | 360 | EXAMPLE: example allsquarefree; shows an example |
---|
[81fb58d] | 361 | " |
---|
| 362 | { |
---|
| 363 | //------------------------ Wechsel in geeigneten Ring ------------------------ |
---|
| 364 | def altring = basering; |
---|
| 365 | string mipl="0"; |
---|
| 366 | if (size(parstr(altring))==1) { mipl=string(minpoly); } |
---|
| 367 | if ((char(basering)!=0) and (charstr(basering)!=string(char(basering)))) { |
---|
| 368 | string tststr=charstr(basering); |
---|
| 369 | tststr=tststr[1..find(tststr,",")-1]; //-> "p^k" bzw. "p" |
---|
| 370 | if (tststr!=string(char(basering))) { |
---|
| 371 | " Sorry -- not implemented for this ring (gcd doesn't work)"; |
---|
| 372 | return(l); |
---|
| 373 | } |
---|
| 374 | } |
---|
| 375 | execute("ring rsqrf = ("+charstr(altring)+"),(x,y),dp;"); |
---|
[034ce1] | 376 | if (mipl!="0") { execute("minpoly="+mipl+";"); } |
---|
[81fb58d] | 377 | poly f=fetch(altring,f); |
---|
| 378 | poly l=fetch(altring,l); |
---|
[190bf0b] | 379 | //---------- eliminiere bereits mit squarefree gefundene Faktoren ------------ |
---|
[81fb58d] | 380 | poly g=l; |
---|
[190bf0b] | 381 | while (deg(g)!=0) { |
---|
[81fb58d] | 382 | f=syz(ideal(g,f))[1,1]; // f=f/g; |
---|
| 383 | g=gcd(f,l); |
---|
| 384 | } // jetzt f=h^p |
---|
[190bf0b] | 385 | //--------------- Berechne uebrige Faktoren mit factorize -------------------- |
---|
| 386 | if (deg(f)>0) { |
---|
| 387 | g=1; |
---|
[dd8844] | 388 | //*CL old: ideal factf=factorize(f,1); |
---|
| 389 | //* for (int i=1; i<=size(factf); i++) { g=g*factf[i]; } |
---|
| 390 | ideal factf=factorize(f)[1]; |
---|
| 391 | for (int i=2; i<=size(factf); i++) { g=g*factf[i]; } |
---|
[190bf0b] | 392 | poly testp=squarefree(g); |
---|
| 393 | if (deg(testp)<deg(g)) { |
---|
| 394 | "!! factorize has not worked correctly !!"; |
---|
| 395 | if (testp==1) {" We cannot proceed ..."; g=1;} |
---|
[81fb58d] | 396 | else {" But we could recover some factors..."; g=testp;} |
---|
[190bf0b] | 397 | } |
---|
| 398 | l=l*g; |
---|
| 399 | } |
---|
[81fb58d] | 400 | //--------------- Wechsel in alten Ring und Rueckgabe des Ergebnisses -------- |
---|
| 401 | setring altring; |
---|
| 402 | l=fetch(rsqrf,l); |
---|
[190bf0b] | 403 | return(l); |
---|
| 404 | } |
---|
| 405 | example |
---|
| 406 | { "EXAMPLE:"; echo = 2; |
---|
| 407 | ring exring=7,(x,y),dp; |
---|
| 408 | poly f=(x+y)^7*(x-y)^8; |
---|
[7b3971] | 409 | poly g=squarefree(f); |
---|
| 410 | g; // factor x+y lost, since characteristic=7 |
---|
| 411 | allsquarefree(f,g); // all factors (x+y)*(x-y) found |
---|
[190bf0b] | 412 | } |
---|
| 413 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 414 | |
---|
[a848f8] | 415 | proc is_irred (poly f) |
---|
[7b3971] | 416 | "USAGE: is_irred(f); f poly |
---|
[50cbdc] | 417 | ASSUME: f is a squarefree bivariate polynomial (in the first 2 ring |
---|
[7b3971] | 418 | variables). |
---|
[50cbdc] | 419 | RETURN: int (0 or 1): @* |
---|
| 420 | - @code{is_irred(f)=1} if f is irreducible as a formal power |
---|
| 421 | series over the algebraic closure of its coefficient field (f |
---|
[7b3971] | 422 | defines an analytically irreducible curve at zero), @* |
---|
| 423 | - @code{is_irred(f)=0} otherwise. |
---|
[50cbdc] | 424 | NOTE: 0 and units in the ring of formal power series are considered to be |
---|
[7b3971] | 425 | not irreducible. |
---|
[a848f8] | 426 | KEYWORDS: irreducible power series |
---|
| 427 | EXAMPLE: example is_irred; shows an example |
---|
| 428 | " |
---|
| 429 | { |
---|
| 430 | int pl=printlevel; |
---|
| 431 | printlevel=-1; |
---|
| 432 | list hnl=develop(f,-1); |
---|
| 433 | printlevel=pl; |
---|
| 434 | return(hnl[5]); |
---|
| 435 | } |
---|
| 436 | example |
---|
| 437 | { "EXAMPLE:"; echo = 2; |
---|
| 438 | ring exring=0,(x,y),ls; |
---|
| 439 | is_irred(x2+y3); |
---|
| 440 | is_irred(x2+y2); |
---|
| 441 | is_irred(x2+y3+1); |
---|
| 442 | } |
---|
| 443 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 444 | |
---|
| 445 | static proc polytest(poly f) |
---|
[d2b2a7] | 446 | "USAGE : polytest(f); f poly in x and y |
---|
[190bf0b] | 447 | RETURN: a monomial of f with |coefficient| > 16001 |
---|
| 448 | or exponent divisible by 32003, if there is one |
---|
| 449 | 0 else (in this case computing a squarefree divisor |
---|
| 450 | in characteristic 32003 could make sense) |
---|
| 451 | NOTE: this procedure is only useful in characteristic zero, because otherwise |
---|
| 452 | there is no appropriate ordering of the leading coefficients |
---|
[81fb58d] | 453 | " |
---|
| 454 | { |
---|
[190bf0b] | 455 | poly verbrecher=0; |
---|
| 456 | intvec leitexp; |
---|
| 457 | for (; (f<>0) and (verbrecher==0); f=f-lead(f)) { |
---|
| 458 | if ((leadcoef(f)<-16001) or (leadcoef(f)>16001)) {verbrecher=lead(f);} |
---|
| 459 | leitexp=leadexp(f); |
---|
[82716e] | 460 | if (( ((leitexp[1] % 32003) == 0) and (leitexp[1]<>0)) |
---|
[190bf0b] | 461 | or ( ((leitexp[2] % 32003) == 0) and (leitexp[2]<>0)) ) |
---|
| 462 | {verbrecher=lead(f);} |
---|
| 463 | } |
---|
| 464 | return(verbrecher); |
---|
| 465 | } |
---|
| 466 | |
---|
| 467 | ////////////////////////////////////////////////////////////////////////////// |
---|
| 468 | |
---|
| 469 | |
---|
[4f3359] | 470 | proc develop(list #) |
---|
[7b3971] | 471 | "USAGE: develop(f [,n]); f poly, n int |
---|
[50cbdc] | 472 | ASSUME: f is a bivariate polynomial (in the first 2 ring variables) and |
---|
[dcb500] | 473 | irreducible as power series (for reducible f use @code{hnexpansion}). |
---|
[7b3971] | 474 | RETURN: list @code{L} with: |
---|
| 475 | @texinfo |
---|
| 476 | @table @asis |
---|
| 477 | @item @code{L[1]}; matrix: |
---|
| 478 | Each row contains the coefficients of the corresponding line of the |
---|
| 479 | Hamburger-Noether expansion (HNE). The end of the line is marked in |
---|
| 480 | the matrix by the first ring variable (usually x). |
---|
[50cbdc] | 481 | @item @code{L[2]}; intvec: |
---|
[7b3971] | 482 | indicating the length of lines of the HNE |
---|
| 483 | @item @code{L[3]}; int: |
---|
| 484 | 0 if the 1st ring variable was transversal (with respect to f), @* |
---|
[50cbdc] | 485 | 1 if the variables were changed at the beginning of the |
---|
[7b3971] | 486 | computation, @* |
---|
[50cbdc] | 487 | -1 if an error has occurred. |
---|
| 488 | @item @code{L[4]}; poly: |
---|
| 489 | the transformed polynomial of f to make it possible to extend the |
---|
[7b3971] | 490 | Hamburger-Noether development a posteriori without having to do |
---|
| 491 | all the previous calculation once again (0 if not needed) |
---|
| 492 | @item @code{L[5]}; int: |
---|
| 493 | 1 if the curve has exactly one branch (i.e., is irreducible), @* |
---|
[50cbdc] | 494 | 0 else (i.e., the curve has more than one HNE, or f is not valid). |
---|
[7b3971] | 495 | @end table |
---|
| 496 | @end texinfo |
---|
[a848f8] | 497 | DISPLAY: The (non zero) elements of the HNE (if not called by another proc). |
---|
[7b3971] | 498 | NOTE: The optional parameter @code{n} affects only the computation of |
---|
| 499 | the LAST line of the HNE. If it is given, the HN-matrix @code{L[1]} |
---|
| 500 | will have at least @code{n} columns. @* |
---|
[50cbdc] | 501 | Otherwise, the number of columns will be chosen minimal such that the |
---|
| 502 | matrix contains all necessary information (i.e., all lines of the HNE |
---|
[7b3971] | 503 | but the last (which is in general infinite) have place). @* |
---|
[50cbdc] | 504 | If @code{n} is negative, the algorithm is stopped as soon as the |
---|
| 505 | computed information is sufficient for @code{invariants(L)}, but the |
---|
| 506 | HN-matrix @code{L[1]} may still contain undetermined elements, which |
---|
[7b3971] | 507 | are marked with the 2nd variable (of the basering). @* |
---|
| 508 | For time critical computations it is recommended to use |
---|
| 509 | @code{ring ...,(x,y),ls} as basering - it increases the algorithm's |
---|
| 510 | speed. @* |
---|
[50cbdc] | 511 | If @code{printlevel>=0} comments are displayed (default is |
---|
| 512 | @code{printlevel=0}). |
---|
[dcb500] | 513 | SEE ALSO: hnexpansion, extdevelop, displayHNE |
---|
| 514 | EXAMPLES: example develop; shows an example |
---|
[0dbfec] | 515 | example parametrize; shows an example for using the 2nd parameter |
---|
[81fb58d] | 516 | " |
---|
| 517 | { |
---|
[190bf0b] | 518 | //--------- Abfangen unzulaessiger Ringe: 1) nur eine Unbestimmte ------------ |
---|
| 519 | poly f=#[1]; |
---|
| 520 | if (size(#) > 1) {int maxspalte=#[2];} |
---|
| 521 | else {int maxspalte= 1 ; } |
---|
| 522 | if (nvars(basering) < 2) { |
---|
| 523 | " Sorry. I need two variables in the ring."; |
---|
[a848f8] | 524 | return(list(matrix(maxideal(1)[1]),intvec(0),-1,poly(0),0));} |
---|
[190bf0b] | 525 | if (nvars(basering) > 2) { |
---|
[dcb500] | 526 | dbprint(printlevel-voice+2, |
---|
| 527 | " Warning! You have defined too many variables! |
---|
| 528 | All variables except the first two will be ignored!" |
---|
| 529 | ); |
---|
| 530 | } |
---|
[3c4dcc] | 531 | |
---|
[190bf0b] | 532 | string namex=varstr(1); string namey=varstr(2); |
---|
[a848f8] | 533 | list return_error=matrix(maxideal(1)[2]),intvec(0),int(-1),poly(0),int(0); |
---|
[190bf0b] | 534 | |
---|
| 535 | //------------- 2) mehrere Unbestimmte, weitere unzulaessige Ringe ----------- |
---|
| 536 | // Wir koennen einheitlichen Rueckgabewert benutzen, aus dem ersichtlich ist, |
---|
| 537 | // dass ein Fehler aufgetreten ist: return_error. |
---|
| 538 | //---------------------------------------------------------------------------- |
---|
| 539 | |
---|
[bb17e8] | 540 | if (charstr(basering)=="real") { |
---|
[81fb58d] | 541 | " The algorithm doesn't work with 'real' as coefficient field."; |
---|
[190bf0b] | 542 | // denn : map from characteristic -1 to -1 not implemented |
---|
| 543 | return(return_error); |
---|
| 544 | } |
---|
| 545 | if ((char(basering)!=0) and (charstr(basering)!=string(char(basering)))) { |
---|
| 546 | //-- teste, ob char = (p^k,a) (-> a primitiv; erlaubt) oder (p,a[,b,...]) ---- |
---|
| 547 | string tststr=charstr(basering); |
---|
| 548 | tststr=tststr[1..find(tststr,",")-1]; //-> "p^k" bzw. "p" |
---|
| 549 | int primit=(tststr==string(char(basering))); |
---|
| 550 | if (primit!=0) { |
---|
[81fb58d] | 551 | " Such extensions of Z/p are not implemented."; |
---|
[dcb500] | 552 | " Please try (p^k,a) as ground field or use `hnexpansion'."; |
---|
[190bf0b] | 553 | return(return_error); |
---|
| 554 | } |
---|
| 555 | } |
---|
| 556 | //---- Ende der unzulaessigen Ringe; Ringwechsel in einen guenstigen Ring: --- |
---|
| 557 | |
---|
[bb17e8] | 558 | int ringwechsel=(varstr(basering)!="x,y") or (ordstr(basering)!="ls(2),C"); |
---|
| 559 | |
---|
[190bf0b] | 560 | def altring = basering; |
---|
[bb17e8] | 561 | if (ringwechsel) { |
---|
| 562 | string mipl=string(minpoly); |
---|
| 563 | execute("ring guenstig = ("+charstr(altring)+"),(x,y),ls;"); |
---|
| 564 | if ((char(basering)==0) && (mipl!="0")) { |
---|
[034ce1] | 565 | execute("minpoly="+mipl+";"); |
---|
[bb17e8] | 566 | }} |
---|
| 567 | else { def guenstig=basering; } |
---|
[190bf0b] | 568 | export guenstig; |
---|
| 569 | |
---|
| 570 | //-------------------------- Initialisierungen ------------------------------- |
---|
| 571 | map m=altring,x,y; |
---|
[bb17e8] | 572 | if (ringwechsel) { poly f=m(f); } |
---|
[81fb58d] | 573 | if (defined(HNDebugOn)) |
---|
[dcb500] | 574 | {"received polynomial: ",f,", where x =",namex,", y =",namey;} |
---|
[e182c8] | 575 | kill m; |
---|
[190bf0b] | 576 | int M,N,Q,R,l,e,hilf,eps,getauscht,Abbruch,zeile,exponent,Ausgabe; |
---|
| 577 | |
---|
| 578 | // Werte von Ausgabe: 0 : normale HNE-Matrix, |
---|
| 579 | // 1 : Fehler aufgetreten - Matrix (namey) zurueck |
---|
| 580 | // 2 : Die HNE ist eine Nullzeile - Matrix (0) zurueck |
---|
| 581 | // int maxspalte=1; geaendert: wird jetzt am Anfang gesetzt |
---|
| 582 | |
---|
| 583 | int minimalHNE=0; // Flag fuer minimale HNE-Berechnung |
---|
[a848f8] | 584 | int einzweig=1; // Flag fuer Irreduzibilit"at |
---|
[190bf0b] | 585 | intvec hqs; // erhaelt die Werte von h(zeile)=Q; |
---|
| 586 | |
---|
| 587 | if (maxspalte<0) { |
---|
| 588 | minimalHNE=1; |
---|
| 589 | maxspalte=1; |
---|
| 590 | } |
---|
| 591 | |
---|
[dcb500] | 592 | number c,delt; |
---|
[190bf0b] | 593 | int p = char(basering); |
---|
| 594 | string ringchar=charstr(basering); |
---|
| 595 | map xytausch = basering,y,x; |
---|
[82716e] | 596 | if ((p!=0) and (ringchar != string(p))) { |
---|
[190bf0b] | 597 | // coefficient field is extension of Z/pZ |
---|
[1b36de3] | 598 | execute("int n_elements="+ |
---|
| 599 | ringchar[1,size(ringchar)-size(parstr(basering))-1]+";"); |
---|
[190bf0b] | 600 | // number of elements of actual ring |
---|
| 601 | number generat=par(1); // generator of the coefficient field of the ring |
---|
| 602 | } |
---|
| 603 | |
---|
| 604 | |
---|
| 605 | //========= Abfangen von unzulaessigen oder trivialen Eingaben =============== |
---|
| 606 | //------------ Nullpolynom oder Einheit im Potenzreihenring: ----------------- |
---|
[a848f8] | 607 | if (f == 0) { |
---|
[dcb500] | 608 | dbprint(printlevel+1,"The given polynomial is the zero-polynomial !"); |
---|
[a848f8] | 609 | Abbruch=1; Ausgabe=1; |
---|
| 610 | } |
---|
[190bf0b] | 611 | else { |
---|
| 612 | intvec nm = getnm(f); |
---|
[a848f8] | 613 | N = nm[1]; M = nm[2]; // Berechne Schnittpunkte Newtonpolygon mit Achsen |
---|
| 614 | if (N == 0) { |
---|
| 615 | dbprint(printlevel+1,"The given polynomial is a unit as power series !"); |
---|
| 616 | Abbruch=1; Ausgabe=1; |
---|
| 617 | } |
---|
[190bf0b] | 618 | else { |
---|
[a848f8] | 619 | if (N == -1) { |
---|
| 620 | if ((voice==2) && (printlevel > -1)) { "The HNE is x = 0"; } |
---|
| 621 | Abbruch=1; Ausgabe=2; getauscht=1; |
---|
| 622 | if (M <> 1) { einzweig=0; } |
---|
| 623 | } |
---|
[190bf0b] | 624 | else { |
---|
[a848f8] | 625 | if (M == -1) { |
---|
| 626 | if ((voice==2) && (printlevel > -1)) { "The HNE is y = 0"; } |
---|
| 627 | Abbruch=1; Ausgabe=2; |
---|
| 628 | if (N <> 1) { einzweig=0; } |
---|
| 629 | }}} |
---|
[190bf0b] | 630 | } |
---|
| 631 | //--------------------- Test auf Quadratfreiheit ----------------------------- |
---|
| 632 | if (Abbruch==0) { |
---|
| 633 | |
---|
| 634 | //-------- Fall basering==0,... : Wechsel in Ring mit char >0 ---------------- |
---|
| 635 | // weil squarefree eine Standardbasis berechnen muss (verwendet Syzygien) |
---|
| 636 | // -- wenn f in diesem Ring quadratfrei ist, dann erst recht im Ring guenstig |
---|
| 637 | //---------------------------------------------------------------------------- |
---|
| 638 | |
---|
| 639 | if ((p==0) and (size(charstr(basering))==1)) { |
---|
| 640 | int testerg=(polytest(f)==0); |
---|
| 641 | ring zweitring = 32003,(x,y),dp; |
---|
| 642 | map polyhinueber=guenstig,x,y; // fetch geht nicht |
---|
| 643 | poly f=polyhinueber(f); |
---|
| 644 | poly test_sqr=squarefree(f); |
---|
| 645 | if (test_sqr != f) { |
---|
[a848f8] | 646 | if (printlevel>0) { |
---|
| 647 | "Most probably the given polynomial is not squarefree. But the test was"; |
---|
| 648 | "made in characteristic 32003 and not 0 to improve speed. You can"; |
---|
| 649 | "(r) redo the test in char 0 (but this may take some time)"; |
---|
| 650 | "(c) continue the development, if you're sure that the polynomial", |
---|
| 651 | "IS squarefree"; |
---|
| 652 | if (testerg==1) { |
---|
| 653 | "(s) continue the development with a squarefree factor (*)";} |
---|
| 654 | "(q) or just quit the algorithm (default action)"; |
---|
| 655 | "";"Please enter the letter of your choice:"; |
---|
| 656 | string str=read("")[1]; |
---|
| 657 | } |
---|
| 658 | else { string str="r"; } // printlevel <= 0: non-interactive behaviour |
---|
[190bf0b] | 659 | setring guenstig; |
---|
| 660 | map polyhinueber=zweitring,x,y; |
---|
| 661 | if (str=="r") { |
---|
| 662 | poly test_sqr=squarefree(f); |
---|
| 663 | if (test_sqr != f) { |
---|
[a848f8] | 664 | if (printlevel>0) { "The given polynomial is in fact not squarefree."; } |
---|
| 665 | else { "The given polynomial is not squarefree!"; } |
---|
[bb17e8] | 666 | "I'll continue with the radical."; |
---|
[a848f8] | 667 | if (printlevel>0) { pause("Hit RETURN to continue:"); } |
---|
[190bf0b] | 668 | f=test_sqr; |
---|
| 669 | } |
---|
[a848f8] | 670 | else { |
---|
| 671 | dbprint(printlevel, |
---|
| 672 | "everything is ok -- the polynomial is squarefree in char(k)=0"); |
---|
| 673 | } |
---|
[190bf0b] | 674 | } |
---|
| 675 | else { |
---|
[82716e] | 676 | if ((str=="s") and (testerg==1)) { |
---|
[190bf0b] | 677 | "(*) attention: it could be that the factor is only one in char 32003!"; |
---|
| 678 | f=polyhinueber(test_sqr); |
---|
| 679 | } |
---|
| 680 | else { |
---|
| 681 | if (str<>"c") { |
---|
| 682 | setring altring;kill guenstig;kill zweitring; |
---|
| 683 | return(return_error);} |
---|
| 684 | else { "if the algorithm doesn't terminate, you were wrong...";} |
---|
| 685 | }} |
---|
| 686 | kill zweitring; |
---|
| 687 | nm = getnm(f); // N,M haben sich evtl. veraendert |
---|
[3754ca] | 688 | N = nm[1]; M = nm[2]; // Berechne Schnittpunkte Newtonpolynom mit Achsen |
---|
[dcb500] | 689 | if (defined(HNDebugOn)) {"I continue with the polynomial",f; } |
---|
[190bf0b] | 690 | } |
---|
| 691 | else { |
---|
| 692 | setring guenstig; |
---|
| 693 | kill zweitring; |
---|
| 694 | } |
---|
| 695 | } |
---|
| 696 | // ------------------- Fall Charakteristik > 0 ------------------------------- |
---|
| 697 | else { |
---|
| 698 | poly test_sqr=squarefree(f); |
---|
| 699 | if (test_sqr == 1) { |
---|
| 700 | "The given polynomial is of the form g^"+string(p)+", therefore", |
---|
| 701 | "reducible.";"Please try again."; |
---|
| 702 | setring altring; |
---|
| 703 | kill guenstig; |
---|
| 704 | return(return_error);} |
---|
| 705 | if (test_sqr != f) { |
---|
| 706 | "The given polynomial is not squarefree. I'll continue with the radical."; |
---|
| 707 | if (p != 0) |
---|
| 708 | {"But if the polynomial contains a factor of the form g^"+string(p)+","; |
---|
[bb17e8] | 709 | "this factor will be lost.";} |
---|
[a848f8] | 710 | if (printlevel>0) { pause("Hit RETURN to continue:"); } |
---|
[190bf0b] | 711 | f=test_sqr; |
---|
| 712 | nm = getnm(f); // N,M haben sich veraendert |
---|
[3754ca] | 713 | N = nm[1]; M = nm[2]; // Berechne Schnittpunkte Newtonpolynom mit Achsen |
---|
[dcb500] | 714 | if (defined(HNDebugOn)) {"I continue with the polynomial",f; } |
---|
[190bf0b] | 715 | } |
---|
| 716 | |
---|
| 717 | } // endelse(p==0) |
---|
| 718 | |
---|
| 719 | if (N==0) { |
---|
[bb17e8] | 720 | " Sorry. The remaining polynomial is a unit in the power series ring..."; |
---|
[190bf0b] | 721 | setring altring;kill guenstig;return(return_error); |
---|
| 722 | } |
---|
| 723 | //---------------------- gewaehrleiste, dass x transvers ist ----------------- |
---|
| 724 | if (M < N) |
---|
| 725 | { f = xytausch(f); // Variablentausch : x jetzt transvers |
---|
| 726 | getauscht = 1; // den Tausch merken |
---|
| 727 | M = M+N; N = M-N; M = M-N; // M, N auch vertauschen |
---|
| 728 | } |
---|
[81fb58d] | 729 | if (defined(HNDebugOn)) { |
---|
[3754ca] | 730 | if (getauscht) {"x<->y were exchanged; polynomial is now ",f;} |
---|
[190bf0b] | 731 | else {"x , y were not exchanged";} |
---|
| 732 | "M resp. N are now",M,N; |
---|
| 733 | } |
---|
| 734 | } // end(if Abbruch==0) |
---|
| 735 | |
---|
| 736 | ideal a(0); |
---|
| 737 | while (Abbruch==0) { |
---|
| 738 | |
---|
| 739 | //================= Beginn der Schleife (eigentliche Entwicklung) ============ |
---|
| 740 | |
---|
| 741 | //------------------- ist das Newtonpolygon eine gerade Linie? --------------- |
---|
| 742 | if (testreducible(f,N,M)) { |
---|
[a848f8] | 743 | dbprint(printlevel+1," The given polynomial is not irreducible"); |
---|
[190bf0b] | 744 | kill guenstig; |
---|
| 745 | setring altring; |
---|
| 746 | return(return_error); // Abbruch der Prozedur! |
---|
| 747 | } |
---|
| 748 | R = M%N; |
---|
[4173c7] | 749 | Q = M div N; |
---|
[190bf0b] | 750 | |
---|
| 751 | //-------------------- Fall Rest der Division R = 0 : ------------------------ |
---|
| 752 | if (R == 0) { |
---|
| 753 | c = koeff(f,0,N); |
---|
| 754 | if (c == 0) {"Something has gone wrong! I didn't get N correctly!"; exit;} |
---|
| 755 | e = gcd(M,N); |
---|
| 756 | //----------------- Test, ob leitf = c*(y^N - delta*x^(m/e))^e ist ----------- |
---|
| 757 | if (p==0) { |
---|
[4173c7] | 758 | delt = koeff(f,M div e,N - N div e) / (-1*e*c); |
---|
[81fb58d] | 759 | if (defined(HNDebugOn)) {"quasihomogeneous leading form:", |
---|
[4173c7] | 760 | leit(f,N,M)," = ",c,"* (y -",delt,"* x^"+string(M div e)+")^",e," ?";} |
---|
| 761 | if (leit(f,N,M) != c*(y^(N div e) - delt*x^(M div e))^e) { |
---|
[a848f8] | 762 | dbprint(printlevel+1," The given polynomial is reducible !"); |
---|
| 763 | Abbruch=1; Ausgabe=1; } |
---|
[190bf0b] | 764 | } |
---|
| 765 | else { // p!=0 |
---|
| 766 | if (e%p != 0) { |
---|
[4173c7] | 767 | delt = koeff(f,M div e,N - N div e) / (-1*e*c); |
---|
[81fb58d] | 768 | if (defined(HNDebugOn)) {"quasihomogeneous leading form:", |
---|
[4173c7] | 769 | leit(f,N,M)," = ",c,"* (y -",delt,"* x^"+string(M div e)+")^",e," ?";} |
---|
| 770 | if (leit(f,N,M) != c*(y^(N div e) - delt*x^(M div e))^e) { |
---|
[a848f8] | 771 | dbprint(printlevel+1," The given polynomial is reducible !"); |
---|
| 772 | Abbruch=1; Ausgabe=1; } |
---|
[190bf0b] | 773 | } |
---|
| 774 | |
---|
| 775 | else { // e%p == 0 |
---|
| 776 | eps = e; |
---|
[62c2b0] | 777 | for (l = 0; eps%p == 0; l=l+1) { eps=eps div p;} |
---|
[dcb500] | 778 | if (defined(HNDebugOn)) {e," -> ",eps,"*",p,"^",l;} |
---|
[4173c7] | 779 | delt = koeff(f,(M div e)*p^l,(N div e)*p^l*(eps-1)) / (-1*eps*c); |
---|
[190bf0b] | 780 | |
---|
[dcb500] | 781 | if ((ringchar != string(p)) and (delt != 0)) { |
---|
[190bf0b] | 782 | //- coeff. field is not Z/pZ => we`ve to correct delta by taking (p^l)th root- |
---|
[dcb500] | 783 | if (delt == generat) {exponent=1;} |
---|
[190bf0b] | 784 | else { |
---|
[dcb500] | 785 | if (delt == 1) {exponent=0;} |
---|
[190bf0b] | 786 | else { |
---|
[dcb500] | 787 | exponent=pardeg(delt); |
---|
[190bf0b] | 788 | |
---|
| 789 | //-- an dieser Stelle kann ein Fehler auftreten, wenn wir eine transzendente - |
---|
[0132b0] | 790 | //-- Erweiterung von Z/pZ haben: dann ist das hinzuadjungierte Element kein - |
---|
| 791 | //-- Erzeuger der mult. Gruppe, d.h. in Z/pZ (a) gibt es i.allg. keinen - |
---|
| 792 | //-- Exponenten mit z.B. a2+a = a^exp - |
---|
[190bf0b] | 793 | //---------------------------------------------------------------------------- |
---|
| 794 | }} |
---|
[dcb500] | 795 | delt = generat^(extgcd(n_elements-1,p^l)[3]*exponent); |
---|
[190bf0b] | 796 | } |
---|
| 797 | |
---|
[81fb58d] | 798 | if (defined(HNDebugOn)) {"quasihomogeneous leading form:", |
---|
[4173c7] | 799 | leit(f,N,M)," = ",c,"* (y^"+string(N div e),"-",delt,"* x^" |
---|
| 800 | +string(M div e)+")^",e," ?";} |
---|
| 801 | if (leit(f,N,M) != c*(y^(N div e) - delt*x^(M div e))^e) { |
---|
[a848f8] | 802 | dbprint(printlevel+1," The given polynomial is reducible !"); |
---|
| 803 | Abbruch=1; Ausgabe=1; } |
---|
[190bf0b] | 804 | } |
---|
| 805 | } |
---|
| 806 | if (Abbruch == 0) { |
---|
[4173c7] | 807 | f = T1_Transform(f,delt,M div e); |
---|
[7fa60f] | 808 | dbprint(printlevel-voice+2,"a("+string(zeile)+","+string(Q)+") = " |
---|
[3c4dcc] | 809 | +string(delt)); |
---|
[dcb500] | 810 | a(zeile)[Q]=delt; |
---|
| 811 | if (defined(HNDebugOn)) {"transformed polynomial: ",f;}} |
---|
[190bf0b] | 812 | |
---|
| 813 | nm=getnm(f); N=nm[1]; M=nm[2]; // Neuberechnung des Newtonpolygons |
---|
| 814 | } |
---|
| 815 | //--------------------------- Fall R > 0 : ----------------------------------- |
---|
| 816 | else { |
---|
[3c4dcc] | 817 | dbprint(printlevel-voice+2, "h("+string(zeile)+ ") ="+string(Q)); |
---|
[190bf0b] | 818 | hqs[zeile+1]=Q; // denn zeile beginnt mit dem Wert 0 |
---|
| 819 | a(zeile)[Q+1]=x; // Markierung des Zeilenendes der HNE |
---|
| 820 | maxspalte=maxspalte*((Q+1) < maxspalte) + (Q+1)*((Q+1) >= maxspalte); |
---|
| 821 | // Anpassung der Sp.zahl der HNE-Matrix |
---|
| 822 | f = T_Transform(f,Q,N); |
---|
[dcb500] | 823 | if (defined(HNDebugOn)) {"transformed polynomial: ",f;} |
---|
[190bf0b] | 824 | zeile=zeile+1; |
---|
| 825 | //------------ Bereitstellung von Speicherplatz fuer eine neue Zeile: -------- |
---|
| 826 | ideal a(zeile); |
---|
| 827 | M=N;N=R; |
---|
| 828 | } |
---|
| 829 | |
---|
| 830 | //--------------- schneidet das Newtonpolygon beide Achsen? ------------------ |
---|
| 831 | if (M==-1) { |
---|
[3c4dcc] | 832 | dbprint(printlevel-voice+2,"The HNE is finite!"); |
---|
[190bf0b] | 833 | a(zeile)[Q+1]=x; // Markiere das Ende der Zeile |
---|
| 834 | hqs[zeile+1]=Q; |
---|
| 835 | maxspalte=maxspalte*((Q+1) < maxspalte) + (Q+1)*((Q+1) >= maxspalte); |
---|
[3c1c6a] | 836 | if (N <> 1) { einzweig=0; } |
---|
[190bf0b] | 837 | f=0; // transformiertes Polynom wird nicht mehr gebraucht |
---|
| 838 | Abbruch=1; |
---|
| 839 | } |
---|
| 840 | else {if (M<N) {"Something has gone wrong: M<N";}} |
---|
[dcb500] | 841 | if(defined(HNDebugOn)) {"new M,N:",M,N;} |
---|
[190bf0b] | 842 | |
---|
| 843 | //----------------- Abbruchbedingungen fuer die Schleife: -------------------- |
---|
| 844 | if ((N==1) and (Abbruch!=1) and ((M > maxspalte) or (minimalHNE==1)) |
---|
| 845 | and (size(a(zeile))>0)) |
---|
| 846 | //---------------------------------------------------------------------------- |
---|
| 847 | // Abbruch, wenn die Matrix so voll ist, dass eine neue Spalte angefangen |
---|
| 848 | // werden muesste und die letzte Zeile nicht nur Nullen enthaelt |
---|
| 849 | // oder wenn die Matrix nicht voll gemacht werden soll (minimale Information) |
---|
| 850 | //---------------------------------------------------------------------------- |
---|
| 851 | { Abbruch=1; hqs[zeile+1]=-1; |
---|
| 852 | if (maxspalte < ncols(a(zeile))) { maxspalte=ncols(a(zeile));} |
---|
| 853 | if ((minimalHNE==1) and (M <= maxspalte)) { |
---|
| 854 | // teile param mit, dass Eintraege der letzten Zeile nur teilw. richtig sind:- |
---|
| 855 | hqs[zeile+1]=-M; |
---|
| 856 | //------------- markiere den Rest der Zeile als unbekannt: ------------------- |
---|
| 857 | for (R=M; R <= maxspalte; R++) { a(zeile)[R]=y;} |
---|
| 858 | } // R wird nicht mehr gebraucht |
---|
| 859 | } |
---|
| 860 | //========================= Ende der Schleife ================================ |
---|
| 861 | |
---|
| 862 | } |
---|
| 863 | setring altring; |
---|
| 864 | if (Ausgabe == 0) { |
---|
| 865 | //-------------------- Ergebnis in den alten Ring transferieren: ------------- |
---|
| 866 | map zurueck=guenstig,maxideal(1)[1],maxideal(1)[2]; |
---|
[bb17e8] | 867 | matrix amat[zeile+1][maxspalte]; |
---|
[190bf0b] | 868 | ideal uebergabe; |
---|
| 869 | for (e=0; e<=zeile; e=e+1) { |
---|
| 870 | uebergabe=zurueck(a(e)); |
---|
| 871 | if (ncols(uebergabe) > 1) { |
---|
[bb17e8] | 872 | amat[e+1,1..ncols(uebergabe)]=uebergabe;} |
---|
| 873 | else {amat[e+1,1]=uebergabe[1];} |
---|
[190bf0b] | 874 | } |
---|
[a848f8] | 875 | if (ringwechsel) { |
---|
| 876 | if (nvars(altring)==2) { f=fetch(guenstig,f); } |
---|
| 877 | else { f=zurueck(f); } |
---|
| 878 | } |
---|
[190bf0b] | 879 | } |
---|
| 880 | |
---|
| 881 | kill guenstig; |
---|
[a848f8] | 882 | if ((einzweig==0) && (voice==2) && (printlevel > -1)) { |
---|
| 883 | "// Note: The curve is reducible, but we were able to compute a HNE."; |
---|
| 884 | "// This means the result is only one of several existing HNE's."; |
---|
| 885 | } |
---|
| 886 | if (Ausgabe == 0) { return(list(amat,hqs,getauscht,f,einzweig));} |
---|
[190bf0b] | 887 | if (Ausgabe == 1) { return(return_error);} // error has occurred |
---|
[bb17e8] | 888 | if (Ausgabe == 2) { return(list(matrix(ideal(0,x)),intvec(1),getauscht, |
---|
[a848f8] | 889 | poly(0),einzweig));} // HNE is x=0 or y=0 |
---|
[bb17e8] | 890 | } |
---|
[190bf0b] | 891 | example |
---|
| 892 | { "EXAMPLE:"; echo = 2; |
---|
| 893 | ring exring = 7,(x,y),ds; |
---|
[712167] | 894 | list Hne=develop(4x98+2x49y7+x11y14+2y14); |
---|
| 895 | print(Hne[1]); |
---|
[190bf0b] | 896 | // therefore the HNE is: |
---|
| 897 | // z(-1)= 3*z(0)^7 + z(0)^7*z(1), |
---|
[7b3971] | 898 | // z(0) = z(1)*z(2), (there is 1 zero in the 2nd row before x) |
---|
| 899 | // z(1) = z(2)^3*z(3), (there are 3 zeroes in the 3rd row) |
---|
[190bf0b] | 900 | // z(2) = z(3)*z(4), |
---|
| 901 | // z(3) = -z(4)^2 + 0*z(4)^3 +...+ 0*z(4)^8 + ?*z(4)^9 + ... |
---|
[7b3971] | 902 | // (the missing x in the last line indicates that it is not complete.) |
---|
[90ee8d] | 903 | Hne[2]; |
---|
[712167] | 904 | param(Hne); |
---|
[7b3971] | 905 | // parametrization: x(t)= -t^14+O(t^21), y(t)= -3t^98+O(t^105) |
---|
[a848f8] | 906 | // (the term -t^109 in y may have a wrong coefficient) |
---|
[712167] | 907 | displayHNE(Hne); |
---|
[190bf0b] | 908 | } |
---|
| 909 | |
---|
[81fb58d] | 910 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 911 | // procedures to extract information out of HNE // |
---|
[190bf0b] | 912 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 913 | |
---|
[7fa60f] | 914 | proc param (list L, list #) |
---|
| 915 | "USAGE: param(L [,s]); L list, s any type (optional) |
---|
[50cbdc] | 916 | ASSUME: L is the output of @code{develop(f)}, or of |
---|
[3c4dcc] | 917 | @code{extdevelop(develop(f),n)}, or (one entry in) the list of HN |
---|
[7fa60f] | 918 | data created by @code{hnexpansion(f[,\"ess\"])}. |
---|
[3c4dcc] | 919 | RETURN: If L are the HN data of an irreducible plane curve singularity f: a |
---|
[2761f3] | 920 | parametrization for f in the following format: @* |
---|
[50cbdc] | 921 | - if only the list L is given, the result is an ideal of two |
---|
[7b3971] | 922 | polynomials p[1],p[2]: if the HNE was finite then f(p[1],p[2])=0}; |
---|
[3c4dcc] | 923 | if not, the true parametrization will be given by two power series, |
---|
[7fa60f] | 924 | and p[1],p[2] are truncations of these series.@* |
---|
[0dbfec] | 925 | - if the optional parameter s is given, the result is a list l: |
---|
[50cbdc] | 926 | l[1]=param(L) (ideal) and l[2]=intvec with two entries indicating |
---|
| 927 | the highest degree up to which the coefficients of the monomials in |
---|
[7b3971] | 928 | l[1] are exact (entry -1 means that the corresponding parametrization |
---|
| 929 | is exact). |
---|
[3c4dcc] | 930 | If L collects the HN data of a reducible plane curve singularity f, |
---|
| 931 | the return value is a list of parametrizations in the respective |
---|
| 932 | format. |
---|
[50cbdc] | 933 | NOTE: If the basering has only 2 variables, the first variable is chosen |
---|
| 934 | as indefinite. Otherwise, the 3rd variable is chosen. |
---|
[7fa60f] | 935 | SEE ALSO: develop, extdevelop |
---|
[a848f8] | 936 | KEYWORDS: parametrization |
---|
[81fb58d] | 937 | EXAMPLE: example param; shows an example |
---|
[0132b0] | 938 | example develop; shows another example |
---|
[81fb58d] | 939 | " |
---|
| 940 | { |
---|
[190bf0b] | 941 | //-------------------------- Initialisierungen ------------------------------- |
---|
[7fa60f] | 942 | int return_list; |
---|
| 943 | if (size(#)>0) { return_list=1; } |
---|
| 944 | |
---|
| 945 | if (typeof(L[1])=="list") { // output of hnexpansion (> 1 branch) |
---|
| 946 | list Ergebnis; |
---|
| 947 | for (int i=1; i<=size(L); i++) { |
---|
| 948 | dbprint(printlevel-voice+4,"// Parametrization of branch number " |
---|
[3c4dcc] | 949 | +string(i)+" computed."); |
---|
[7fa60f] | 950 | printlevel=printlevel+1; |
---|
| 951 | if (return_list==1) { Ergebnis[i]=param(L[i],1); } |
---|
| 952 | else { Ergebnis[i]=param(L[i]); } |
---|
| 953 | printlevel=printlevel-1; |
---|
| 954 | } |
---|
| 955 | return(Ergebnis); |
---|
[baaef9] | 956 | } |
---|
| 957 | else { |
---|
[7fa60f] | 958 | matrix m=L[1]; |
---|
| 959 | intvec v=L[2]; |
---|
| 960 | int switch=L[3]; |
---|
[baaef9] | 961 | } |
---|
[190bf0b] | 962 | if (switch==-1) { |
---|
| 963 | "An error has occurred in develop, so there is no HNE."; |
---|
| 964 | return(ideal(0,0)); |
---|
| 965 | } |
---|
| 966 | int fehler,fehlervor,untergrad,untervor,beginn,i,zeile,hilf; |
---|
| 967 | |
---|
| 968 | if (nvars(basering) > 2) { poly z(size(v)+1)=var(3); } |
---|
| 969 | else { poly z(size(v)+1)=var(1); } |
---|
| 970 | poly z(size(v)); |
---|
| 971 | zeile=size(v); |
---|
| 972 | //------------- Parametrisierung der untersten Zeile der HNE ----------------- |
---|
| 973 | if (v[zeile] > 0) { |
---|
| 974 | fehler=0; // die Parametrisierung wird exakt werden |
---|
| 975 | for (i=1; i<=v[zeile]; i++) { |
---|
| 976 | z(zeile)=z(zeile)+m[zeile,i]*z(zeile+1)^i; |
---|
[7fa60f] | 977 | } |
---|
| 978 | } |
---|
[190bf0b] | 979 | else { |
---|
| 980 | untervor=1; // = Untergrad der vorhergehenden Zeile |
---|
| 981 | if (v[zeile]==-1) { |
---|
| 982 | fehler=ncols(m)+1; |
---|
| 983 | for (i=1; i<=ncols(m); i++) { |
---|
| 984 | z(zeile)=z(zeile)+m[zeile,i]*z(zeile+1)^i; |
---|
| 985 | if ((untergrad==0) and (m[zeile,i]!=0)) {untergrad=i;} |
---|
| 986 | // = Untergrad der aktuellen Zeile |
---|
[7fa60f] | 987 | } |
---|
| 988 | } |
---|
[190bf0b] | 989 | else { |
---|
| 990 | fehler= -v[zeile]; |
---|
| 991 | for (i=1; i<-v[zeile]; i++) { |
---|
| 992 | z(zeile)=z(zeile)+m[zeile,i]*z(zeile+1)^i; |
---|
| 993 | if ((untergrad==0) and (m[zeile,i]!=0)) {untergrad=i;} |
---|
[7fa60f] | 994 | } |
---|
| 995 | } |
---|
[190bf0b] | 996 | } |
---|
| 997 | //------------- Parametrisierung der restlichen Zeilen der HNE --------------- |
---|
| 998 | for (zeile=size(v)-1; zeile>0; zeile--) { |
---|
| 999 | poly z(zeile); |
---|
| 1000 | beginn=0; // Beginn der aktuellen Zeile |
---|
| 1001 | for (i=1; i<=v[zeile]; i++) { |
---|
| 1002 | z(zeile)=z(zeile)+m[zeile,i]*z(zeile+1)^i; |
---|
| 1003 | if ((beginn==0) and (m[zeile,i]!=0)) { beginn=i;} |
---|
| 1004 | } |
---|
| 1005 | z(zeile)=z(zeile) + z(zeile+1)^v[zeile] * z(zeile+2); |
---|
| 1006 | if (beginn==0) { |
---|
| 1007 | if (fehler>0) { // damit fehler=0 bleibt bei exakter Param. |
---|
| 1008 | fehlervor=fehler; // Fehler der letzten Zeile |
---|
| 1009 | fehler=fehler+untergrad*(v[zeile]-1)+untervor; // Fehler dieser Zeile |
---|
| 1010 | hilf=untergrad; |
---|
| 1011 | untergrad=untergrad*v[zeile]+untervor; |
---|
[7fa60f] | 1012 | untervor=hilf;} // untervor = altes untergrad |
---|
| 1013 | } |
---|
[190bf0b] | 1014 | else { |
---|
| 1015 | fehlervor=fehler; |
---|
| 1016 | fehler=fehler+untergrad*(beginn-1); |
---|
| 1017 | untervor=untergrad; |
---|
| 1018 | untergrad=untergrad*beginn; |
---|
[7fa60f] | 1019 | } |
---|
| 1020 | } |
---|
[190bf0b] | 1021 | //--------------------- Ausgabe der Fehlerabschaetzung ----------------------- |
---|
| 1022 | if (switch==0) { |
---|
| 1023 | if (fehler>0) { |
---|
[baaef9] | 1024 | if (fehlervor>0) { |
---|
[7fa60f] | 1025 | dbprint(printlevel-voice+4,""+ |
---|
| 1026 | "// ** Warning: result is exact up to order "+string(fehlervor-1)+ |
---|
| 1027 | " in "+ string(var(1))+" and "+string(fehler-1)+" in " + |
---|
[3c4dcc] | 1028 | string(var(2))+" !"); |
---|
[7fa60f] | 1029 | } |
---|
[baaef9] | 1030 | else { |
---|
[7fa60f] | 1031 | dbprint(printlevel-voice+4,""+ |
---|
| 1032 | "// ** Warning: result is exact up to order "+ string(fehler-1)+ |
---|
| 1033 | " in "+string(var(2))+" !"); |
---|
| 1034 | } |
---|
[baaef9] | 1035 | } |
---|
| 1036 | if (return_list==0) { return(ideal(z(2),z(1))); } |
---|
| 1037 | else { return(list(ideal(z(2),z(1)),intvec(fehlervor-1,fehler-1))); } |
---|
| 1038 | } |
---|
[190bf0b] | 1039 | else { |
---|
| 1040 | if (fehler>0) { |
---|
[baaef9] | 1041 | if (fehlervor>0) { |
---|
[7fa60f] | 1042 | dbprint(printlevel-voice+4,""+ |
---|
| 1043 | "// ** Warning: result is exact up to order "+string(fehler-1)+ |
---|
| 1044 | " in "+ string(var(1))+" and "+string(fehlervor-1)+" in " + |
---|
[3c4dcc] | 1045 | string(var(2))+" !"); |
---|
[7fa60f] | 1046 | } |
---|
[baaef9] | 1047 | else { |
---|
[7fa60f] | 1048 | dbprint(printlevel-voice+4,""+ |
---|
| 1049 | "// ** Warning: result is exact up to order "+ string(fehler-1)+ |
---|
| 1050 | " in "+string(var(1))+" !"); |
---|
| 1051 | } |
---|
[baaef9] | 1052 | } |
---|
| 1053 | if (return_list==0) { return(ideal(z(1),z(2))); } |
---|
| 1054 | else { return(list(ideal(z(1),z(2)),intvec(fehler-1,fehlervor-1))); } |
---|
| 1055 | } |
---|
[190bf0b] | 1056 | } |
---|
| 1057 | example |
---|
| 1058 | { "EXAMPLE:"; echo = 2; |
---|
| 1059 | ring exring=0,(x,y,t),ds; |
---|
| 1060 | poly f=x3+2xy2+y2; |
---|
[712167] | 1061 | list Hne=develop(f); |
---|
| 1062 | list hne_extended=extdevelop(Hne,10); |
---|
[7fa60f] | 1063 | // compare the HNE matrices ... |
---|
[712167] | 1064 | print(Hne[1]); |
---|
[90ee8d] | 1065 | print(hne_extended[1]); |
---|
[e174a1] | 1066 | // ... and the resulting parametrizations: |
---|
[712167] | 1067 | param(Hne); |
---|
[7b3971] | 1068 | param(hne_extended); |
---|
| 1069 | param(hne_extended,0); |
---|
[7fa60f] | 1070 | |
---|
| 1071 | // An example with more than one branch: |
---|
| 1072 | list L=hnexpansion(f*(x2+y4)); |
---|
| 1073 | def HNring = L[1]; setring HNring; |
---|
| 1074 | param(hne); |
---|
[190bf0b] | 1075 | } |
---|
[7fa60f] | 1076 | |
---|
[190bf0b] | 1077 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1078 | |
---|
| 1079 | proc invariants |
---|
[dcb500] | 1080 | "USAGE: invariants(INPUT); INPUT list or poly |
---|
[7fa60f] | 1081 | ASSUME: @code{INPUT} is the output of @code{develop(f)}, or of |
---|
[3c4dcc] | 1082 | @code{extdevelop(develop(f),n)}, or one entry of the list of HN data |
---|
[7fa60f] | 1083 | computed by @code{hnexpansion(f[,\"ess\"])}. |
---|
| 1084 | RETURN: list @code{INV} of the following format: |
---|
[dcb500] | 1085 | @format |
---|
[7fa60f] | 1086 | INV[1]: intvec (characteristic exponents) |
---|
| 1087 | INV[2]: intvec (generators of the semigroup) |
---|
| 1088 | INV[3]: intvec (Puiseux pairs, 1st components) |
---|
| 1089 | INV[4]: intvec (Puiseux pairs, 2nd components) |
---|
| 1090 | INV[5]: int (degree of the conductor) |
---|
| 1091 | INV[6]: intvec (sequence of multiplicities) |
---|
[dcb500] | 1092 | @end format |
---|
[3c4dcc] | 1093 | If @code{INPUT} contains no valid HN expansion, the empty list is |
---|
[7fa60f] | 1094 | returned. |
---|
[3c4dcc] | 1095 | ASSUME: @code{INPUT} is a bivariate polynomial f, or the output of |
---|
| 1096 | @code{hnexpansion(f)}, or the list of HN data computed by |
---|
[7fa60f] | 1097 | @code{hnexpansion(f [,\"ess\"])}. |
---|
[3c4dcc] | 1098 | RETURN: list @code{INV}, such that @code{INV[i]} coincides with the output of |
---|
| 1099 | @code{invariants(develop(f[i]))}, where f[i] is the i-th branch of |
---|
| 1100 | f, and the last entry of @code{INV} contains further invariants of |
---|
[7fa60f] | 1101 | f in the format: |
---|
[7b3971] | 1102 | @format |
---|
[dcb500] | 1103 | INV[last][1] : intmat (contact matrix of the branches) |
---|
| 1104 | INV[last][2] : intmat (intersection multiplicities of the branches) |
---|
| 1105 | INV[last][3] : int (delta invariant of f) |
---|
[7b3971] | 1106 | @end format |
---|
[dcb500] | 1107 | NOTE: In case the Hamburger-Noether expansion of the curve f is needed |
---|
| 1108 | for other purposes as well it is better to calculate this first |
---|
| 1109 | with the aid of @code{hnexpansion} and use it as input instead of |
---|
| 1110 | the polynomial itself. |
---|
[7fa60f] | 1111 | SEE ALSO: hnexpansion, develop, displayInvariants, multsequence, intersection |
---|
[a848f8] | 1112 | KEYWORDS: characteristic exponents; semigroup of values; Puiseux pairs; |
---|
| 1113 | conductor, degree; multiplicities, sequence of |
---|
| 1114 | EXAMPLE: example invariants; shows an example |
---|
[81fb58d] | 1115 | " |
---|
| 1116 | { |
---|
[7fa60f] | 1117 | //---- INPUT = poly, or HNEring, or hne of reducible curve ----------------- |
---|
| 1118 | if (typeof(#[1])!="matrix") { |
---|
| 1119 | if (typeof(#[1])=="poly") { |
---|
| 1120 | list L=hnexpansion(#[1]); |
---|
| 1121 | if (typeof(L[1])=="ring") { |
---|
| 1122 | def altring = basering; |
---|
| 1123 | def HNring = L[1]; setring HNring; |
---|
| 1124 | list Ergebnis = invariants(hne); |
---|
| 1125 | setring altring; |
---|
| 1126 | kill HNring; |
---|
| 1127 | return(Ergebnis); |
---|
[dcb500] | 1128 | } |
---|
[7fa60f] | 1129 | else { |
---|
| 1130 | return(invariants(L)); |
---|
[3c4dcc] | 1131 | } |
---|
[7fa60f] | 1132 | } |
---|
| 1133 | if (typeof(#[1])=="ring") { |
---|
| 1134 | def altring = basering; |
---|
| 1135 | def HNring = #[1]; setring HNring; |
---|
| 1136 | list Ergebnis = invariants(hne); |
---|
| 1137 | setring altring; |
---|
| 1138 | kill HNring; |
---|
[3c4dcc] | 1139 | return(Ergebnis); |
---|
[7fa60f] | 1140 | } |
---|
| 1141 | if (typeof(#[1])=="list") { |
---|
| 1142 | list hne=#; |
---|
| 1143 | list Ergebnis; |
---|
| 1144 | for (int lauf=1;lauf<=size(hne);lauf++) { |
---|
| 1145 | Ergebnis[lauf]=invariants(hne[lauf]); |
---|
| 1146 | } |
---|
| 1147 | // Calculate the intersection matrix and the intersection multiplicities. |
---|
| 1148 | intmat contact[size(hne)][size(hne)]; |
---|
| 1149 | intmat intersectionmatrix[size(hne)][size(hne)]; |
---|
| 1150 | int Lauf; |
---|
| 1151 | for (lauf=1;lauf<=size(hne);lauf++) { |
---|
| 1152 | for (Lauf=lauf+1;Lauf<=size(hne);Lauf++) { |
---|
| 1153 | contact[lauf,Lauf]=separateHNE(hne[lauf],hne[Lauf]); |
---|
| 1154 | contact[Lauf,lauf]=contact[lauf,Lauf]; |
---|
| 1155 | intersectionmatrix[lauf,Lauf]=intersection(hne[lauf],hne[Lauf]); |
---|
| 1156 | intersectionmatrix[Lauf,lauf]=intersectionmatrix[lauf,Lauf]; |
---|
| 1157 | } |
---|
| 1158 | } |
---|
| 1159 | // Calculate the delta invariant. |
---|
| 1160 | int inters; |
---|
[4173c7] | 1161 | int del=Ergebnis[size(hne)][5] div 2; |
---|
[7fa60f] | 1162 | for(lauf=1;lauf<=size(hne)-1;lauf++) { |
---|
[4173c7] | 1163 | del=del+Ergebnis[lauf][5] div 2; |
---|
[7fa60f] | 1164 | for(Lauf=lauf+1;Lauf<=size(hne);Lauf++) { |
---|
[dcb500] | 1165 | inters=inters+intersectionmatrix[lauf,Lauf]; |
---|
[7fa60f] | 1166 | } |
---|
| 1167 | } |
---|
| 1168 | del=del+inters; |
---|
| 1169 | list LAST=contact,intersectionmatrix,del; |
---|
| 1170 | Ergebnis[size(hne)+1]=LAST; |
---|
| 1171 | return(Ergebnis); |
---|
| 1172 | } |
---|
| 1173 | } |
---|
[190bf0b] | 1174 | //-------------------------- Initialisierungen ------------------------------- |
---|
| 1175 | matrix m=#[1]; |
---|
| 1176 | intvec v=#[2]; |
---|
| 1177 | int switch=#[3]; |
---|
| 1178 | list ergebnis; |
---|
| 1179 | if (switch==-1) { |
---|
| 1180 | "An error has occurred in develop, so there is no HNE."; |
---|
| 1181 | return(ergebnis); |
---|
| 1182 | } |
---|
[81fb58d] | 1183 | intvec beta,s,svorl,ordnung,multseq,mpuiseux,npuiseux,halbgr; |
---|
[bb17e8] | 1184 | int genus,zeile,i,j,k,summe,conductor,ggT; |
---|
[190bf0b] | 1185 | string Ausgabe; |
---|
| 1186 | int nc=ncols(m); int nr=nrows(m); |
---|
| 1187 | ordnung[nr]=1; |
---|
| 1188 | // alle Indizes muessen (gegenueber [Ca]) um 1 erhoeht werden, |
---|
| 1189 | // weil 0..r nicht als Wertebereich erlaubt ist (aber nrows(m)==r+1) |
---|
| 1190 | |
---|
| 1191 | //---------------- Bestimme den Untergrad der einzelnen Zeilen --------------- |
---|
| 1192 | for (zeile=nr; zeile>1; zeile--) { |
---|
| 1193 | if ((size(ideal(m[zeile,1..nc])) > 1) or (zeile==nr)) { // keine Nullzeile |
---|
| 1194 | k=1; |
---|
| 1195 | while (m[zeile,k]==0) {k++;} |
---|
| 1196 | ordnung[zeile-1]=k*ordnung[zeile]; // vgl. auch Def. von untergrad in |
---|
| 1197 | genus++; // proc param |
---|
| 1198 | svorl[genus]=zeile;} // werden gerade in umgekehrter Reihenfolge abgelegt |
---|
| 1199 | else { |
---|
| 1200 | ordnung[zeile-1]=v[zeile]*ordnung[zeile]+ordnung[zeile+1]; |
---|
| 1201 | }} |
---|
| 1202 | //----------------- charakteristische Exponenten (beta) ---------------------- |
---|
| 1203 | s[1]=1; |
---|
| 1204 | for (k=1; k <= genus; k++) { s[k+1]=svorl[genus-k+1];} // s[2]==s(1), u.s.w. |
---|
| 1205 | beta[1]=ordnung[1]; //charakt. Exponenten: Index wieder verschoben |
---|
| 1206 | for (k=1; k <= genus; k++) { |
---|
| 1207 | summe=0; |
---|
| 1208 | for (i=1; i <= s[k]; i++) {summe=summe+v[i]*ordnung[i];} |
---|
| 1209 | beta[k+1]=summe+ordnung[s[k]]+ordnung[s[k]+1]-ordnung[1]; |
---|
| 1210 | } |
---|
| 1211 | //--------------------------- Puiseuxpaare ----------------------------------- |
---|
| 1212 | int produkt=1; |
---|
| 1213 | for (i=1; i<=genus; i++) { |
---|
| 1214 | ggT=gcd(beta[1],beta[i+1]*produkt); |
---|
[4173c7] | 1215 | mpuiseux[i]=beta[i+1]*produkt div ggT; |
---|
| 1216 | npuiseux[i]=beta[1] div ggT; |
---|
[190bf0b] | 1217 | produkt=produkt*npuiseux[i]; |
---|
| 1218 | } |
---|
| 1219 | //---------------------- Grad des Konduktors --------------------------------- |
---|
| 1220 | summe=1-ordnung[1]; |
---|
| 1221 | if (genus > 0) { |
---|
| 1222 | for (i=2; i <= genus+1; i++) { |
---|
| 1223 | summe=summe + beta[i] * (ordnung[s[i-1]] - ordnung[s[i]]); |
---|
| 1224 | } // n.b.: Indizierung wieder um 1 verschoben |
---|
| 1225 | } |
---|
| 1226 | conductor=summe; |
---|
[81fb58d] | 1227 | //------------------- Erzeuger der Halbgruppe: ------------------------------- |
---|
| 1228 | halbgr=puiseux2generators(mpuiseux,npuiseux); |
---|
| 1229 | |
---|
[bb17e8] | 1230 | //------------------- Multiplizitaetensequenz: ------------------------------- |
---|
| 1231 | k=1; |
---|
| 1232 | for (i=1; i<size(v); i++) { |
---|
| 1233 | for (j=1; j<=v[i]; j++) { |
---|
[81fb58d] | 1234 | multseq[k]=ordnung[i]; |
---|
[bb17e8] | 1235 | k++; |
---|
| 1236 | }} |
---|
| 1237 | multseq[k]=1; |
---|
[dcb500] | 1238 | //--- fuelle die Multipl.seq. mit den notwendigen Einsen auf -- T.Keilen ---- |
---|
| 1239 | int tester=k; |
---|
| 1240 | while((multseq[tester]==1) and (tester>1)) |
---|
| 1241 | { |
---|
| 1242 | tester=tester-1; |
---|
[3c4dcc] | 1243 | } |
---|
[dcb500] | 1244 | if ((multseq[tester]!=1) and (multseq[tester]!=k-tester)) |
---|
| 1245 | { |
---|
| 1246 | for (i=k+1; i<=tester+multseq[tester]; i++) |
---|
| 1247 | { |
---|
| 1248 | multseq[i]=1; |
---|
[3c4dcc] | 1249 | } |
---|
[dcb500] | 1250 | } |
---|
| 1251 | //--- Ende T.Keilen --- 06.05.02 |
---|
[190bf0b] | 1252 | //------------------------- Rueckgabe ---------------------------------------- |
---|
[81fb58d] | 1253 | ergebnis=beta,halbgr,mpuiseux,npuiseux,conductor,multseq; |
---|
[190bf0b] | 1254 | return(ergebnis); |
---|
| 1255 | } |
---|
| 1256 | example |
---|
| 1257 | { "EXAMPLE:"; echo = 2; |
---|
| 1258 | ring exring=0,(x,y),dp; |
---|
[712167] | 1259 | list Hne=develop(y4+2x3y2+x6+x5y); |
---|
| 1260 | list INV=invariants(Hne); |
---|
[dcb500] | 1261 | INV[1]; // the characteristic exponents |
---|
| 1262 | INV[2]; // the generators of the semigroup of values |
---|
| 1263 | INV[3],INV[4]; // the Puiseux pairs in packed form |
---|
[62c2b0] | 1264 | INV[5] div 2; // the delta-invariant |
---|
[dcb500] | 1265 | INV[6]; // the sequence of multiplicities |
---|
| 1266 | // To display the invariants more 'nicely': |
---|
[712167] | 1267 | displayInvariants(Hne); |
---|
[dcb500] | 1268 | ///////////////////////////// |
---|
| 1269 | INV=invariants((x2-y3)*(x3-y5)); |
---|
| 1270 | INV[1][1]; // the characteristic exponents of the first branch |
---|
| 1271 | INV[2][6]; // the sequence of multiplicities of the second branch |
---|
| 1272 | print(INV[size(INV)][1]); // the contact matrix of the branches |
---|
| 1273 | print(INV[size(INV)][2]); // the intersection numbers of the branches |
---|
| 1274 | INV[size(INV)][3]; // the delta invariant of the curve |
---|
| 1275 | } |
---|
| 1276 | |
---|
| 1277 | /////////////////////////////////////////////////////////////////////////////// |
---|
[190bf0b] | 1278 | |
---|
| 1279 | proc displayInvariants |
---|
[dcb500] | 1280 | "USAGE: displayInvariants(INPUT); INPUT list or poly |
---|
[3c4dcc] | 1281 | ASSUME: @code{INPUT} is a bivariate polynomial, or the output of |
---|
| 1282 | @code{develop(f)}, resp. of @code{extdevelop(develop(f),n)}, or (one |
---|
| 1283 | entry of) the list of HN data computed by |
---|
[7fa60f] | 1284 | @code{hnexpansion(f[,\"ess\"])}. |
---|
[7b3971] | 1285 | RETURN: none |
---|
[a848f8] | 1286 | DISPLAY: invariants of the corresponding branch, resp. of all branches, |
---|
| 1287 | in a better readable form. |
---|
[7fa60f] | 1288 | NOTE: If the Hamburger-Noether expansion of the curve f is needed |
---|
[dcb500] | 1289 | for other purposes as well it is better to calculate this first |
---|
| 1290 | with the aid of @code{hnexpansion} and use it as input instead of |
---|
| 1291 | the polynomial itself. |
---|
| 1292 | SEE ALSO: invariants, intersection, develop, hnexpansion |
---|
[bb17e8] | 1293 | EXAMPLE: example displayInvariants; shows an example |
---|
[81fb58d] | 1294 | " |
---|
| 1295 | { |
---|
[3754ca] | 1296 | // INPUT = polynomial or ring |
---|
[7fa60f] | 1297 | if (typeof(#[1])=="poly") { |
---|
| 1298 | list L=hnexpansion(#[1]); |
---|
| 1299 | if (typeof(L[1])=="ring") { |
---|
| 1300 | def HNring = L[1]; setring HNring; |
---|
| 1301 | displayInvariants(hne); |
---|
| 1302 | return(); |
---|
| 1303 | } |
---|
| 1304 | else { |
---|
| 1305 | displayInvariants(L); |
---|
| 1306 | return(); |
---|
| 1307 | } |
---|
| 1308 | } |
---|
| 1309 | if (typeof(#[1])=="ring") |
---|
| 1310 | { |
---|
| 1311 | def HNring = #[1]; setring HNring; |
---|
| 1312 | displayInvariants(hne); |
---|
| 1313 | return(); |
---|
| 1314 | } |
---|
| 1315 | // INPUT = hne of a plane curve |
---|
[bb17e8] | 1316 | int i,j,k,mul; |
---|
[190bf0b] | 1317 | string Ausgabe; |
---|
| 1318 | list ergebnis; |
---|
[bb17e8] | 1319 | //-- entferne ueberfluessige Daten zur Erhoehung der Rechengeschwindigkeit: -- |
---|
| 1320 | #=stripHNE(#); |
---|
[190bf0b] | 1321 | //-------------------- Ausgabe eines Zweiges --------------------------------- |
---|
| 1322 | if (typeof(#[1])=="matrix") { |
---|
| 1323 | ergebnis=invariants(#); |
---|
| 1324 | if (size(ergebnis)!=0) { |
---|
[bb17e8] | 1325 | " characteristic exponents :",ergebnis[1]; |
---|
[81fb58d] | 1326 | " generators of semigroup :",ergebnis[2]; |
---|
[190bf0b] | 1327 | if (size(ergebnis[1])>1) { |
---|
[81fb58d] | 1328 | for (i=1; i<=size(ergebnis[3]); i++) { |
---|
| 1329 | Ausgabe=Ausgabe+"("+string(ergebnis[3][i])+"," |
---|
| 1330 | +string(ergebnis[4][i])+")"; |
---|
[190bf0b] | 1331 | }} |
---|
[81fb58d] | 1332 | " Puiseux pairs :",Ausgabe; |
---|
| 1333 | " degree of the conductor :",ergebnis[5]; |
---|
[4173c7] | 1334 | " delta invariant :",ergebnis[5] div 2; |
---|
[81fb58d] | 1335 | " sequence of multiplicities:",ergebnis[6]; |
---|
[190bf0b] | 1336 | }} |
---|
| 1337 | //-------------------- Ausgabe aller Zweige ---------------------------------- |
---|
| 1338 | else { |
---|
[dcb500] | 1339 | ergebnis=invariants(#); |
---|
| 1340 | intmat contact=ergebnis[size(#)+1][1]; |
---|
| 1341 | intmat intersectionmatrix=ergebnis[size(#)+1][2]; |
---|
[bb17e8] | 1342 | for (j=1; j<=size(#); j++) { |
---|
[190bf0b] | 1343 | " --- invariants of branch number",j,": ---"; |
---|
[dcb500] | 1344 | " characteristic exponents :",ergebnis[j][1]; |
---|
| 1345 | " generators of semigroup :",ergebnis[j][2]; |
---|
[190bf0b] | 1346 | Ausgabe=""; |
---|
[dcb500] | 1347 | if (size(ergebnis[j][1])>1) { |
---|
| 1348 | for (i=1; i<=size(ergebnis[j][3]); i++) { |
---|
| 1349 | Ausgabe=Ausgabe+"("+string(ergebnis[j][3][i])+"," |
---|
| 1350 | +string(ergebnis[j][4][i])+")"; |
---|
[190bf0b] | 1351 | }} |
---|
[81fb58d] | 1352 | " Puiseux pairs :",Ausgabe; |
---|
[dcb500] | 1353 | " degree of the conductor :",ergebnis[j][5]; |
---|
[4173c7] | 1354 | " delta invariant :",ergebnis[j][5] div 2; |
---|
[dcb500] | 1355 | " sequence of multiplicities:",ergebnis[j][6]; |
---|
[190bf0b] | 1356 | ""; |
---|
| 1357 | } |
---|
[3c4dcc] | 1358 | if (size(#)>1) |
---|
[dcb500] | 1359 | { |
---|
| 1360 | " -------------- contact numbers : -------------- ";""; |
---|
[bb17e8] | 1361 | Ausgabe="branch | "; |
---|
[3c4dcc] | 1362 | for (j=size(#); j>1; j--) |
---|
[dcb500] | 1363 | { |
---|
[bb17e8] | 1364 | if (size(string(j))==1) { Ausgabe=Ausgabe+" "+string(j)+" "; } |
---|
| 1365 | else { Ausgabe=Ausgabe+string(j)+" "; } |
---|
[3c4dcc] | 1366 | } |
---|
[bb17e8] | 1367 | Ausgabe; |
---|
| 1368 | Ausgabe="-------+"; |
---|
| 1369 | for (j=2; j<size(#); j++) { Ausgabe=Ausgabe+"------"; } |
---|
| 1370 | Ausgabe=Ausgabe+"-----"; |
---|
| 1371 | Ausgabe; |
---|
[3c4dcc] | 1372 | } |
---|
| 1373 | for (j=1; j<size(#); j++) |
---|
[dcb500] | 1374 | { |
---|
| 1375 | if (size(string(j))==1) { Ausgabe=" "+string(j)+" |"; } |
---|
| 1376 | else { Ausgabe=" " +string(j)+" |"; } |
---|
[3c4dcc] | 1377 | for (k=size(#); k>j; k--) |
---|
[dcb500] | 1378 | { |
---|
| 1379 | mul=contact[j,k];//separateHNE(#[j],#[k]); |
---|
| 1380 | for (i=1; i<=5-size(string(mul)); i++) { Ausgabe=Ausgabe+" "; } |
---|
| 1381 | Ausgabe=Ausgabe+string(mul); |
---|
| 1382 | if (k>j+1) { Ausgabe=Ausgabe+","; } |
---|
| 1383 | } |
---|
| 1384 | Ausgabe; |
---|
[bb17e8] | 1385 | } |
---|
[dcb500] | 1386 | ""; |
---|
[3c4dcc] | 1387 | if (size(#)>1) |
---|
[dcb500] | 1388 | { |
---|
| 1389 | " -------------- intersection multiplicities : -------------- ";""; |
---|
| 1390 | Ausgabe="branch | "; |
---|
[3c4dcc] | 1391 | for (j=size(#); j>1; j--) |
---|
[dcb500] | 1392 | { |
---|
| 1393 | if (size(string(j))==1) { Ausgabe=Ausgabe+" "+string(j)+" "; } |
---|
| 1394 | else { Ausgabe=Ausgabe+string(j)+" "; } |
---|
[3c4dcc] | 1395 | } |
---|
[dcb500] | 1396 | Ausgabe; |
---|
| 1397 | Ausgabe="-------+"; |
---|
| 1398 | for (j=2; j<size(#); j++) { Ausgabe=Ausgabe+"------"; } |
---|
| 1399 | Ausgabe=Ausgabe+"-----"; |
---|
| 1400 | Ausgabe; |
---|
[3c4dcc] | 1401 | } |
---|
| 1402 | for (j=1; j<size(#); j++) |
---|
[dcb500] | 1403 | { |
---|
[bb17e8] | 1404 | if (size(string(j))==1) { Ausgabe=" "+string(j)+" |"; } |
---|
| 1405 | else { Ausgabe=" " +string(j)+" |"; } |
---|
[3c4dcc] | 1406 | for (k=size(#); k>j; k--) |
---|
[dcb500] | 1407 | { |
---|
| 1408 | mul=intersectionmatrix[j,k];//intersection(#[j],#[k]); |
---|
[bb17e8] | 1409 | for (i=1; i<=5-size(string(mul)); i++) { Ausgabe=Ausgabe+" "; } |
---|
| 1410 | Ausgabe=Ausgabe+string(mul); |
---|
| 1411 | if (k>j+1) { Ausgabe=Ausgabe+","; } |
---|
| 1412 | } |
---|
| 1413 | Ausgabe; |
---|
| 1414 | } |
---|
[dcb500] | 1415 | ""; |
---|
| 1416 | " -------------- delta invariant of the curve : ",ergebnis[size(#)+1][3]; |
---|
[3c4dcc] | 1417 | |
---|
[190bf0b] | 1418 | } |
---|
| 1419 | return(); |
---|
| 1420 | } |
---|
[bb17e8] | 1421 | example |
---|
| 1422 | { "EXAMPLE:"; echo = 2; |
---|
| 1423 | ring exring=0,(x,y),dp; |
---|
[712167] | 1424 | list Hne=develop(y4+2x3y2+x6+x5y); |
---|
| 1425 | displayInvariants(Hne); |
---|
[bb17e8] | 1426 | } |
---|
| 1427 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1428 | |
---|
| 1429 | proc multiplicities |
---|
[7b3971] | 1430 | "USAGE: multiplicities(L); L list |
---|
[50cbdc] | 1431 | ASSUME: L is the output of @code{develop(f)}, or of |
---|
[dcb500] | 1432 | @code{extdevelop(develop(f),n)}, or one entry in the list @code{hne} |
---|
| 1433 | in the ring created by @code{hnexpansion(f[,\"ess\"])}. |
---|
[7b3971] | 1434 | RETURN: intvec of the different multiplicities that occur when successively |
---|
| 1435 | blowing-up the curve singularity corresponding to f. |
---|
[dd8844] | 1436 | SEE ALSO: multsequence, develop |
---|
[bb17e8] | 1437 | EXAMPLE: example multiplicities; shows an example |
---|
[81fb58d] | 1438 | " |
---|
| 1439 | { |
---|
[bb17e8] | 1440 | matrix m=#[1]; |
---|
| 1441 | intvec v=#[2]; |
---|
| 1442 | int switch=#[3]; |
---|
| 1443 | list ergebnis; |
---|
| 1444 | if (switch==-1) { |
---|
| 1445 | "An error has occurred in develop, so there is no HNE."; |
---|
| 1446 | return(intvec(0)); |
---|
| 1447 | } |
---|
| 1448 | intvec ordnung; |
---|
| 1449 | int zeile,k; |
---|
| 1450 | int nc=ncols(m); int nr=nrows(m); |
---|
| 1451 | ordnung[nr]=1; |
---|
| 1452 | //---------------- Bestimme den Untergrad der einzelnen Zeilen --------------- |
---|
| 1453 | for (zeile=nr; zeile>1; zeile--) { |
---|
| 1454 | if ((size(ideal(m[zeile,1..nc])) > 1) or (zeile==nr)) { // keine Nullzeile |
---|
| 1455 | k=1; |
---|
| 1456 | while (m[zeile,k]==0) {k++;} |
---|
| 1457 | ordnung[zeile-1]=k*ordnung[zeile]; |
---|
| 1458 | } |
---|
| 1459 | else { |
---|
| 1460 | ordnung[zeile-1]=v[zeile]*ordnung[zeile]+ordnung[zeile+1]; |
---|
| 1461 | }} |
---|
| 1462 | return(ordnung); |
---|
| 1463 | } |
---|
| 1464 | example |
---|
| 1465 | { "EXAMPLE:"; echo = 2; |
---|
[a848f8] | 1466 | int p=printlevel; printlevel=-1; |
---|
[bb17e8] | 1467 | ring r=0,(x,y),dp; |
---|
| 1468 | multiplicities(develop(x5+y7)); |
---|
| 1469 | // The first value is the multiplicity of the curve itself, here it's 5 |
---|
[a848f8] | 1470 | printlevel=p; |
---|
[bb17e8] | 1471 | } |
---|
[190bf0b] | 1472 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1473 | |
---|
| 1474 | proc puiseux2generators (intvec m, intvec n) |
---|
[50cbdc] | 1475 | "USAGE: puiseux2generators(m,n); m,n intvec |
---|
[7b3971] | 1476 | ASSUME: m, resp. n, represent the 1st, resp. 2nd, components of Puiseux pairs |
---|
[50cbdc] | 1477 | (e.g., @code{m=invariants(L)[3]}, @code{n=invariants(L)[4]}). |
---|
[7b3971] | 1478 | RETURN: intvec of the generators of the semigroup of values. |
---|
[a848f8] | 1479 | SEE ALSO: invariants |
---|
[190bf0b] | 1480 | EXAMPLE: example puiseux2generators; shows an example |
---|
[81fb58d] | 1481 | " |
---|
| 1482 | { |
---|
[190bf0b] | 1483 | intvec beta; |
---|
| 1484 | int q=1; |
---|
| 1485 | //------------ glatte Kurve (eigentl. waeren m,n leer): ---------------------- |
---|
| 1486 | if (m==0) { return(intvec(1)); } |
---|
| 1487 | //------------------- singulaere Kurve: -------------------------------------- |
---|
| 1488 | for (int i=1; i<=size(n); i++) { q=q*n[i]; } |
---|
| 1489 | beta[1]=q; // == q_0 |
---|
| 1490 | m=1,m; n=1,n; // m[1] ist damit m_0 usw., genau wie beta[1]==beta_0 |
---|
| 1491 | for (i=2; i<=size(n); i++) { |
---|
[4173c7] | 1492 | beta[i]=m[i]*q div n[i] - m[i-1]*q + n[i-1]*beta[i-1]; |
---|
| 1493 | q=q div n[i]; // == q_i |
---|
[190bf0b] | 1494 | } |
---|
| 1495 | return(beta); |
---|
| 1496 | } |
---|
| 1497 | example |
---|
| 1498 | { "EXAMPLE:"; echo = 2; |
---|
[81fb58d] | 1499 | // take (3,2),(7,2),(15,2),(31,2),(63,2),(127,2) as Puiseux pairs: |
---|
[190bf0b] | 1500 | puiseux2generators(intvec(3,7,15,31,63,127),intvec(2,2,2,2,2,2)); |
---|
| 1501 | } |
---|
| 1502 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1503 | |
---|
[bb17e8] | 1504 | proc intersection (list hn1, list hn2) |
---|
[7b3971] | 1505 | "USAGE: intersection(hne1,hne2); hne1, hne2 lists |
---|
[3c4dcc] | 1506 | ASSUME: @code{hne1, hne2} represent an HN expansion of an irreducible plane |
---|
[2761f3] | 1507 | curve singularity (that is, are the output of @code{develop(f)}, or of |
---|
| 1508 | @code{extdevelop(develop(f),n)}, or one entry of the list of HN data |
---|
| 1509 | computed by @code{hnexpansion(f[,\"ess\"])}). |
---|
[3c4dcc] | 1510 | RETURN: int, the intersection multiplicity of the irreducible plane curve |
---|
[2761f3] | 1511 | singularities corresponding to @code{hne1} and @code{hne2}. |
---|
[dcb500] | 1512 | SEE ALSO: hnexpansion, displayInvariants |
---|
[a848f8] | 1513 | KEYWORDS: intersection multiplicity |
---|
[bb17e8] | 1514 | EXAMPLE: example intersection; shows an example |
---|
[d2b2a7] | 1515 | " |
---|
[bb17e8] | 1516 | { |
---|
| 1517 | //------------------ `intersect' ist schon reserviert ... -------------------- |
---|
| 1518 | int i,j,s,sum,schnitt,unterschied; |
---|
| 1519 | matrix a1=hn1[1]; |
---|
| 1520 | matrix a2=hn2[1]; |
---|
| 1521 | intvec h1=hn1[2]; |
---|
| 1522 | intvec h2=hn2[2]; |
---|
| 1523 | intvec n1=multiplicities(hn1); |
---|
| 1524 | intvec n2=multiplicities(hn2); |
---|
| 1525 | if (hn1[3]!=hn2[3]) { |
---|
| 1526 | //-- die jeweils erste Zeile von hn1,hn2 gehoert zu verschiedenen Parametern - |
---|
| 1527 | //---------------- d.h. beide Kurven schneiden sich transversal -------------- |
---|
| 1528 | schnitt=n1[1]*n2[1]; // = mult(hn1)*mult(hn2) |
---|
| 1529 | } |
---|
| 1530 | else { |
---|
| 1531 | //--------- die jeweils erste Zeile gehoert zum gleichen Parameter ----------- |
---|
| 1532 | unterschied=0; |
---|
| 1533 | for (s=1; (h1[s]==h2[s]) && (s<size(h1)) && (s<size(h2)) |
---|
| 1534 | && (unterschied==0); s++) { |
---|
| 1535 | for (i=1; (a1[s,i]==a2[s,i]) && (i<=h1[s]); i++) {;} |
---|
| 1536 | if (i<=h1[s]) { |
---|
| 1537 | unterschied=1; |
---|
| 1538 | s--; // um s++ am Schleifenende wieder auszugleichen |
---|
| 1539 | } |
---|
| 1540 | } |
---|
| 1541 | if (unterschied==0) { |
---|
| 1542 | if ((s<size(h1)) && (s<size(h2))) { |
---|
| 1543 | for (i=1; (a1[s,i]==a2[s,i]) && (i<=h1[s]) && (i<=h2[s]); i++) {;} |
---|
| 1544 | } |
---|
| 1545 | else { |
---|
| 1546 | //-------------- Sonderfall: Unterschied in letzter Zeile suchen ------------- |
---|
| 1547 | // Beachte: Es koennen undefinierte Stellen auftreten, bei abbrechender HNE |
---|
| 1548 | // muss die Ende-Markierung weg, h_[r] ist unendlich, die Matrix muss mit |
---|
| 1549 | // Nullen fortgesetzt gedacht werden |
---|
| 1550 | //---------------------------------------------------------------------------- |
---|
| 1551 | if (ncols(a1)>ncols(a2)) { j=ncols(a1); } |
---|
| 1552 | else { j=ncols(a2); } |
---|
| 1553 | unterschied=0; |
---|
| 1554 | if ((h1[s]>0) && (s==size(h1))) { |
---|
| 1555 | a1[s,h1[s]+1]=0; |
---|
| 1556 | if (ncols(a1)<=ncols(a2)) { unterschied=1; } |
---|
| 1557 | } |
---|
| 1558 | if ((h2[s]>0) && (s==size(h2))) { |
---|
| 1559 | a2[s,h2[s]+1]=0; |
---|
| 1560 | if (ncols(a2)<=ncols(a1)) { unterschied=1; } |
---|
| 1561 | } |
---|
| 1562 | if (unterschied==1) { // mind. eine HNE war endlich |
---|
| 1563 | matrix ma1[1][j]=a1[s,1..ncols(a1)]; // und bedarf der Fortsetzung |
---|
| 1564 | matrix ma2[1][j]=a2[s,1..ncols(a2)]; // mit Nullen |
---|
| 1565 | } |
---|
| 1566 | else { |
---|
| 1567 | if (ncols(a1)>ncols(a2)) { j=ncols(a2); } |
---|
| 1568 | else { j=ncols(a1); } |
---|
| 1569 | matrix ma1[1][j]=a1[s,1..j]; // Beschr. auf vergleichbaren |
---|
| 1570 | matrix ma2[1][j]=a2[s,1..j]; // Teil (der evtl. y's enth.) |
---|
| 1571 | } |
---|
| 1572 | for (i=1; (ma1[1,i]==ma2[1,i]) && (i<j) && (ma1[1,i]!=var(2)); i++) {;} |
---|
| 1573 | if (ma1[1,i]==ma2[1,i]) { |
---|
| 1574 | "//** The two HNE's are identical!"; |
---|
| 1575 | "//** You have either tried to intersect a branch with itself,"; |
---|
| 1576 | "//** or the two branches have been developed separately."; |
---|
| 1577 | "// In the latter case use `extdevelop' to extend the HNE's until", |
---|
| 1578 | "they differ."; |
---|
| 1579 | return(-1); |
---|
| 1580 | } |
---|
| 1581 | if ((ma1[1,i]==var(2)) || (ma2[1,i]==var(2))) { |
---|
| 1582 | "//** The two HNE's are (so far) identical. This is because they", |
---|
| 1583 | "have been"; |
---|
| 1584 | "//** computed separately. I need more data; use `extdevelop' to", |
---|
| 1585 | "extend them,"; |
---|
| 1586 | if (ma1[1,i]==var(2)) {"//** at least the first one.";} |
---|
| 1587 | else {"//** at least the second one.";} |
---|
| 1588 | return(-1); |
---|
| 1589 | } |
---|
| 1590 | } |
---|
| 1591 | } |
---|
| 1592 | sum=0; |
---|
| 1593 | h1[size(h1)]=ncols(a1)+42; // Ersatz fuer h1[r]=infinity |
---|
| 1594 | h2[size(h2)]=ncols(a2)+42; |
---|
| 1595 | for (j=1; j<s; j++) {sum=sum+h1[j]*n1[j]*n2[j];} |
---|
| 1596 | if ((i<=h1[s]) && (i<=h2[s])) { schnitt=sum+i*n1[s]*n2[s]; } |
---|
| 1597 | if (i==h2[s]+1) { schnitt=sum+h2[s]*n1[s]*n2[s]+n2[s+1]*n1[s]; } |
---|
| 1598 | if (i==h1[s]+1) { schnitt=sum+h1[s]*n2[s]*n1[s]+n1[s+1]*n2[s]; } |
---|
| 1599 | // "s:",s-1,"i:",i,"S:",sum; |
---|
| 1600 | } |
---|
| 1601 | return(schnitt); |
---|
| 1602 | } |
---|
| 1603 | example |
---|
[a848f8] | 1604 | { |
---|
| 1605 | "EXAMPLE:"; echo = 2; |
---|
[bb17e8] | 1606 | ring r=0,(x,y),dp; |
---|
[712167] | 1607 | list Hne=hnexpansion((x2-y3)*(x2+y3)); |
---|
| 1608 | intersection(Hne[1],Hne[2]); |
---|
[bb17e8] | 1609 | } |
---|
| 1610 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1611 | |
---|
[81fb58d] | 1612 | proc multsequence |
---|
[3c4dcc] | 1613 | "USAGE: multsequence(INPUT); INPUT list or poly |
---|
[7fa60f] | 1614 | ASSUME: @code{INPUT} is the output of @code{develop(f)}, or of |
---|
[3c4dcc] | 1615 | @code{extdevelop(develop(f),n)}, or one entry of the list of HN data |
---|
[7fa60f] | 1616 | computed by @code{hnexpansion(f[,\"ess\"])}. |
---|
| 1617 | RETURN: intvec corresponding to the multiplicity sequence of the irreducible |
---|
| 1618 | plane curve singularity described by the HN data (return value |
---|
| 1619 | coincides with @code{invariants(INPUT)[6]}). |
---|
| 1620 | |
---|
[3c4dcc] | 1621 | ASSUME: @code{INPUT} is a bivariate polynomial f, or the output of |
---|
| 1622 | @code{hnexpansion(f)}, or the list of HN data computed by |
---|
[7fa60f] | 1623 | @code{hnexpansion(f [,\"ess\"])}. |
---|
[7b3971] | 1624 | RETURN: list of two integer matrices: |
---|
| 1625 | @texinfo |
---|
| 1626 | @table @asis |
---|
[dcb500] | 1627 | @item @code{multsequence(INPUT)[1][i,*]} |
---|
[50cbdc] | 1628 | contains the multiplicities of the branches at their infinitely near point |
---|
| 1629 | of 0 in its (i-1) order neighbourhood (i.e., i=1: multiplicity of the |
---|
[fd5013] | 1630 | branches themselves, i=2: multiplicity of their 1st quadratic transform, |
---|
[7b3971] | 1631 | etc., @* |
---|
[dcb500] | 1632 | Hence, @code{multsequence(INPUT)[1][*,j]} is the multiplicity sequence |
---|
[7b3971] | 1633 | of branch j. |
---|
[dcb500] | 1634 | @item @code{multsequence(INPUT)[2][i,*]}: |
---|
[7b3971] | 1635 | contains the information which of these infinitely near points coincide. |
---|
| 1636 | @end table |
---|
| 1637 | @end texinfo |
---|
[3c4dcc] | 1638 | NOTE: The order of the elements of the list of HN data obtained from |
---|
[7fa60f] | 1639 | @code{hnexpansion(f [,\"ess\"])} must not be changed (because otherwise |
---|
[3c4dcc] | 1640 | the coincident infinitely near points couldn't be grouped together, |
---|
[7fa60f] | 1641 | see the meaning of the 2nd intmat in the example). |
---|
| 1642 | Hence, it is not wise to compute the HN expansion of polynomial factors |
---|
[3c4dcc] | 1643 | separately, put them into a list INPUT and call |
---|
[7fa60f] | 1644 | @code{multsequence(INPUT)}. @* |
---|
[a848f8] | 1645 | Use @code{displayMultsequence} to produce a better readable output for |
---|
[dcb500] | 1646 | reducible curves on the screen. @* |
---|
| 1647 | In case the Hamburger-Noether expansion of the curve f is needed |
---|
| 1648 | for other purposes as well it is better to calculate this first |
---|
| 1649 | with the aid of @code{hnexpansion} and use it as input instead of |
---|
| 1650 | the polynomial itself. |
---|
| 1651 | SEE ALSO: displayMultsequence, develop, hnexpansion, separateHNE |
---|
[dd8844] | 1652 | KEYWORDS: multiplicity sequence |
---|
[81fb58d] | 1653 | EXAMPLE: example multsequence; shows an example |
---|
| 1654 | " |
---|
| 1655 | { |
---|
[dcb500] | 1656 | //---- INPUT = poly, or HNEring -------------------- |
---|
[7fa60f] | 1657 | if (typeof(#[1])=="poly") { |
---|
| 1658 | list L=hnexpansion(#[1]); |
---|
| 1659 | if (typeof(L[1])=="ring") { |
---|
| 1660 | def altring = basering; |
---|
| 1661 | def HNring = L[1]; setring HNring; |
---|
| 1662 | list Ergebnis = multsequence(hne); |
---|
| 1663 | setring altring; |
---|
| 1664 | kill HNring; |
---|
| 1665 | return(Ergebnis); |
---|
| 1666 | } |
---|
| 1667 | else { |
---|
| 1668 | return(multsequence(L)); |
---|
[3c4dcc] | 1669 | } |
---|
[7fa60f] | 1670 | } |
---|
| 1671 | if (typeof(#[1])=="ring") { |
---|
| 1672 | def altring = basering; |
---|
| 1673 | def HNring = #[1]; setring HNring; |
---|
| 1674 | list Ergebnis = multsequence(hne); |
---|
| 1675 | setring altring; |
---|
| 1676 | kill HNring; |
---|
[3c4dcc] | 1677 | return(Ergebnis); |
---|
[7fa60f] | 1678 | } |
---|
[81fb58d] | 1679 | //-- entferne ueberfluessige Daten zur Erhoehung der Rechengeschwindigkeit: -- |
---|
| 1680 | #=stripHNE(#); |
---|
| 1681 | int k,i,j; |
---|
| 1682 | //----------------- Multiplizitaetensequenz eines Zweiges -------------------- |
---|
| 1683 | if (typeof(#[1])=="matrix") { |
---|
| 1684 | intvec v=#[2]; |
---|
| 1685 | list ergebnis; |
---|
| 1686 | if (#[3]==-1) { |
---|
| 1687 | "An error has occurred in develop, so there is no HNE."; |
---|
| 1688 | return(intvec(0)); |
---|
| 1689 | } |
---|
| 1690 | intvec multips,multseq; |
---|
| 1691 | multips=multiplicities(#); |
---|
| 1692 | k=1; |
---|
| 1693 | for (i=1; i<size(v); i++) { |
---|
| 1694 | for (j=1; j<=v[i]; j++) { |
---|
| 1695 | multseq[k]=multips[i]; |
---|
| 1696 | k++; |
---|
| 1697 | }} |
---|
| 1698 | multseq[k]=1; |
---|
[dcb500] | 1699 | //--- fuelle die Multipl.seq. mit den notwendigen Einsen auf -- T.Keilen ---- |
---|
| 1700 | int tester=k; |
---|
| 1701 | while((multseq[tester]==1) and (tester>1)) |
---|
| 1702 | { |
---|
| 1703 | tester=tester-1; |
---|
| 1704 | } |
---|
| 1705 | if((multseq[tester]!=1) and (multseq[tester]!=k-tester)) |
---|
| 1706 | { |
---|
| 1707 | for (i=k+1; i<=tester+multseq[tester]; i++) |
---|
| 1708 | { |
---|
| 1709 | multseq[i]=1; |
---|
| 1710 | } |
---|
| 1711 | } |
---|
[3c4dcc] | 1712 | //--- Ende T.Keilen --- 06.05.02 |
---|
[81fb58d] | 1713 | return(multseq); |
---|
| 1714 | } |
---|
| 1715 | //---------------------------- mehrere Zweige -------------------------------- |
---|
| 1716 | else { |
---|
| 1717 | list HNEs=#; |
---|
| 1718 | int anzahl=size(HNEs); |
---|
| 1719 | int maxlength=0; |
---|
| 1720 | int bisher; |
---|
| 1721 | intvec schnitt,ones; |
---|
| 1722 | ones[anzahl]=0; |
---|
| 1723 | ones=ones+1; // = 1,1,...,1 |
---|
| 1724 | for (i=1; i<anzahl; i++) { |
---|
| 1725 | schnitt[i]=separateHNE(HNEs[i],HNEs[i+1]); |
---|
| 1726 | j=size(multsequence(HNEs[i])); |
---|
| 1727 | maxlength=maxlength*(j < maxlength) + j*(j >= maxlength); |
---|
| 1728 | maxlength=maxlength*(schnitt[i]+1 < maxlength) |
---|
| 1729 | + (schnitt[i]+1)*(schnitt[i]+1 >= maxlength); |
---|
| 1730 | } |
---|
| 1731 | j=size(multsequence(HNEs[anzahl])); |
---|
| 1732 | maxlength=maxlength*(j < maxlength) + j*(j >= maxlength); |
---|
| 1733 | |
---|
| 1734 | //-------------- Konstruktion der ersten zu berechnenden Matrix --------------- |
---|
| 1735 | intmat allmults[maxlength][anzahl]; |
---|
| 1736 | for (i=1; i<=maxlength; i++) { allmults[i,1..anzahl]=ones[1..anzahl]; } |
---|
| 1737 | for (i=1; i<=anzahl; i++) { |
---|
| 1738 | ones=multsequence(HNEs[i]); |
---|
| 1739 | allmults[1..size(ones),i]=ones[1..size(ones)]; |
---|
| 1740 | } |
---|
| 1741 | //---------------------- Konstruktion der zweiten Matrix ---------------------- |
---|
| 1742 | intmat separate[maxlength][anzahl]; |
---|
| 1743 | for (i=1; i<=maxlength; i++) { |
---|
| 1744 | k=1; |
---|
| 1745 | bisher=0; |
---|
| 1746 | if (anzahl==1) { separate[i,1]=1; } |
---|
| 1747 | for (j=1; j<anzahl; j++) { |
---|
| 1748 | if (schnitt[j]<i) { |
---|
| 1749 | separate[i,k]=j-bisher; |
---|
| 1750 | bisher=j; |
---|
| 1751 | k++; |
---|
| 1752 | } |
---|
| 1753 | separate[i,k]=anzahl-bisher; |
---|
| 1754 | } |
---|
| 1755 | } |
---|
| 1756 | return(list(allmults,separate)); |
---|
| 1757 | } |
---|
| 1758 | } |
---|
| 1759 | example |
---|
[a848f8] | 1760 | { |
---|
[50cbdc] | 1761 | "EXAMPLE:"; echo = 2; |
---|
[81fb58d] | 1762 | ring r=0,(x,y),dp; |
---|
[712167] | 1763 | list Hne=hnexpansion((x6-y10)*(x+y2-y3)*(x+y2+y3)); |
---|
| 1764 | multsequence(Hne[1])," | ",multsequence(Hne[2])," | ", |
---|
| 1765 | multsequence(Hne[3])," | ",multsequence(Hne[4]); |
---|
| 1766 | multsequence(Hne); |
---|
[81fb58d] | 1767 | // The meaning of the entries of the 2nd matrix is as follows: |
---|
[712167] | 1768 | displayMultsequence(Hne); |
---|
[81fb58d] | 1769 | } |
---|
| 1770 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1771 | |
---|
| 1772 | proc displayMultsequence |
---|
[dcb500] | 1773 | "USAGE: displayMultsequence(INPUT); INPUT list or poly |
---|
[3c4dcc] | 1774 | ASSUME: @code{INPUT} is a bivariate polynomial, or the output of |
---|
| 1775 | @code{develop(f)}, resp. of @code{extdevelop(develop(f),n)}, or (one |
---|
| 1776 | entry of) the list of HN data computed by @code{hnexpansion(f[,\"ess\"])}, |
---|
[7fa60f] | 1777 | or the output of @code{hnexpansion(f)}. |
---|
[81fb58d] | 1778 | RETURN: nothing |
---|
| 1779 | DISPLAY: the sequence of multiplicities: |
---|
[7b3971] | 1780 | @format |
---|
[dd8844] | 1781 | - if @code{INPUT=develop(f)} or @code{INPUT=extdevelop(develop(f),n)} or @code{INPUT=hne[i]}: |
---|
[50cbdc] | 1782 | @code{a , b , c , ....... , 1} |
---|
[7fa60f] | 1783 | - if @code{INPUT=f} or @code{INPUT=hnexpansion(f)} or @code{INPUT=hne}: |
---|
[7b3971] | 1784 | @code{[(a_1, .... , b_1 , .... , c_1)],} |
---|
| 1785 | @code{[(a_2, ... ), ... , (... , c_2)],} |
---|
| 1786 | @code{ ........................................ ,} |
---|
| 1787 | @code{[(a_n),(b_n), ....., (c_n)]} |
---|
[50cbdc] | 1788 | with: |
---|
[7b3971] | 1789 | @code{a_1 , ... , a_n} the sequence of multiplicities of the 1st branch, |
---|
[fd5013] | 1790 | @code{[...]} the multiplicities of the j-th transform of all branches, |
---|
[7b3971] | 1791 | @code{(...)} indicating branches meeting in an infinitely near point. |
---|
| 1792 | @end format |
---|
[7fa60f] | 1793 | NOTE: The Same restrictions as in @code{multsequence} apply for the input.@* |
---|
[dcb500] | 1794 | In case the Hamburger-Noether expansion of the curve f is needed |
---|
| 1795 | for other purposes as well it is better to calculate this first |
---|
| 1796 | with the aid of @code{hnexpansion} and use it as input instead of |
---|
| 1797 | the polynomial itself. |
---|
| 1798 | SEE ALSO: multsequence, develop, hnexpansion, separateHNE |
---|
[81fb58d] | 1799 | EXAMPLE: example displayMultsequence; shows an example |
---|
| 1800 | " |
---|
| 1801 | { |
---|
[dcb500] | 1802 | //---- INPUT = poly, or HNEring -------------------- |
---|
[7fa60f] | 1803 | if (typeof(#[1])=="poly") { |
---|
| 1804 | list L=hnexpansion(#[1]); |
---|
| 1805 | if (typeof(L[1])=="ring") { |
---|
| 1806 | def HNring = L[1]; setring HNring; |
---|
| 1807 | displayMultsequence(hne); |
---|
| 1808 | return(); |
---|
| 1809 | } |
---|
| 1810 | else { |
---|
| 1811 | displayMultsequence(L); |
---|
| 1812 | return(); |
---|
[3c4dcc] | 1813 | } |
---|
[7fa60f] | 1814 | } |
---|
| 1815 | if (typeof(#[1])=="ring") { |
---|
| 1816 | def HNring = #[1]; setring HNring; |
---|
| 1817 | displayMultsequence(hne); |
---|
[3c4dcc] | 1818 | return(); |
---|
[7fa60f] | 1819 | } |
---|
| 1820 | |
---|
[81fb58d] | 1821 | //-- entferne ueberfluessige Daten zur Erhoehung der Rechengeschwindigkeit: -- |
---|
| 1822 | #=stripHNE(#); |
---|
| 1823 | //----------------- Multiplizitaetensequenz eines Zweiges -------------------- |
---|
| 1824 | if (typeof(#[1])=="matrix") { |
---|
| 1825 | if (#[3]==-1) { |
---|
| 1826 | "An error has occurred in develop, so there is no HNE."; |
---|
| 1827 | } |
---|
| 1828 | else { |
---|
[dcb500] | 1829 | "The sequence of multiplicities is ",multsequence(#); |
---|
[81fb58d] | 1830 | }} |
---|
| 1831 | //---------------------------- mehrere Zweige -------------------------------- |
---|
| 1832 | else { |
---|
| 1833 | list multips=multsequence(#); |
---|
| 1834 | int i,j,k,l; |
---|
| 1835 | string output; |
---|
| 1836 | for (i=1; i<=nrows(multips[1]); i++) { |
---|
| 1837 | output="["; |
---|
| 1838 | k=1; |
---|
| 1839 | for (l=1; k<=ncols(multips[1]); l++) { |
---|
| 1840 | output=output+"("; |
---|
| 1841 | for (j=1; j<=multips[2][i,l]; j++) { |
---|
| 1842 | output=output+string(multips[1][i,k]); |
---|
| 1843 | k++; |
---|
| 1844 | if (j<multips[2][i,l]) { output=output+","; } |
---|
| 1845 | } |
---|
| 1846 | output=output+")"; |
---|
| 1847 | if ((k-1) < ncols(multips[1])) { output=output+","; } |
---|
| 1848 | } |
---|
| 1849 | output=output+"]"; |
---|
| 1850 | if (i<nrows(multips[1])) { output=output+","; } |
---|
| 1851 | output; |
---|
| 1852 | } |
---|
| 1853 | } |
---|
[3c4dcc] | 1854 | } |
---|
[81fb58d] | 1855 | example |
---|
[a848f8] | 1856 | { |
---|
| 1857 | "EXAMPLE:"; echo = 2; |
---|
[81fb58d] | 1858 | ring r=0,(x,y),dp; |
---|
[7fa60f] | 1859 | // Example 1: Input = output of develop |
---|
[dcb500] | 1860 | displayMultsequence(develop(x3-y5)); |
---|
[7fa60f] | 1861 | |
---|
| 1862 | // Example 2: Input = bivariate polynomial |
---|
[dcb500] | 1863 | displayMultsequence((x6-y10)*(x+y2-y3)*(x+y2+y3)); |
---|
[81fb58d] | 1864 | } |
---|
[7fa60f] | 1865 | |
---|
[81fb58d] | 1866 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1867 | |
---|
| 1868 | proc separateHNE (list hn1,list hn2) |
---|
[7b3971] | 1869 | "USAGE: separateHNE(hne1,hne2); hne1, hne2 lists |
---|
[50cbdc] | 1870 | ASSUME: hne1, hne2 are HNEs (=output of |
---|
| 1871 | @code{develop(f)}, @code{extdevelop(develop(f),n)}, or |
---|
[dcb500] | 1872 | one entry in the list @code{hne} in the ring created by |
---|
| 1873 | @code{hnexpansion(f[,\"ess\"])}. |
---|
[50cbdc] | 1874 | RETURN: number of quadratic transformations needed to separate both curves |
---|
[7b3971] | 1875 | (branches). |
---|
[dcb500] | 1876 | SEE ALSO: develop, hnexpansion, multsequence, displayMultsequence |
---|
[81fb58d] | 1877 | EXAMPLE: example separateHNE; shows an example |
---|
| 1878 | " |
---|
| 1879 | { |
---|
| 1880 | int i,j,s,unterschied,separated; |
---|
| 1881 | matrix a1=hn1[1]; |
---|
| 1882 | matrix a2=hn2[1]; |
---|
| 1883 | intvec h1=hn1[2]; |
---|
| 1884 | intvec h2=hn2[2]; |
---|
| 1885 | if (hn1[3]!=hn2[3]) { |
---|
| 1886 | //-- die jeweils erste Zeile von hn1,hn2 gehoert zu verschiedenen Parametern - |
---|
| 1887 | //---------------- d.h. beide Kurven schneiden sich transversal -------------- |
---|
| 1888 | separated=1; |
---|
| 1889 | } |
---|
| 1890 | else { |
---|
| 1891 | //--------- die jeweils erste Zeile gehoert zum gleichen Parameter ----------- |
---|
| 1892 | unterschied=0; |
---|
| 1893 | for (s=1; (h1[s]==h2[s]) && (s<size(h1)) && (s<size(h2)) |
---|
| 1894 | && (unterschied==0); s++) { |
---|
| 1895 | for (i=1; (a1[s,i]==a2[s,i]) && (i<=h1[s]); i++) {;} |
---|
| 1896 | if (i<=h1[s]) { |
---|
| 1897 | unterschied=1; |
---|
| 1898 | s--; // um s++ am Schleifenende wieder auszugleichen |
---|
| 1899 | } |
---|
| 1900 | } |
---|
| 1901 | if (unterschied==0) { |
---|
| 1902 | if ((s<size(h1)) && (s<size(h2))) { |
---|
| 1903 | for (i=1; (a1[s,i]==a2[s,i]) && (i<=h1[s]) && (i<=h2[s]); i++) {;} |
---|
| 1904 | } |
---|
| 1905 | else { |
---|
| 1906 | //-------------- Sonderfall: Unterschied in letzter Zeile suchen ------------- |
---|
| 1907 | // Beachte: Es koennen undefinierte Stellen auftreten, bei abbrechender HNE |
---|
| 1908 | // muss die Ende-Markierung weg, h_[r] ist unendlich, die Matrix muss mit |
---|
| 1909 | // Nullen fortgesetzt gedacht werden |
---|
| 1910 | //---------------------------------------------------------------------------- |
---|
| 1911 | if (ncols(a1)>ncols(a2)) { j=ncols(a1); } |
---|
| 1912 | else { j=ncols(a2); } |
---|
| 1913 | unterschied=0; |
---|
| 1914 | if ((h1[s]>0) && (s==size(h1))) { |
---|
| 1915 | a1[s,h1[s]+1]=0; |
---|
| 1916 | if (ncols(a1)<=ncols(a2)) { unterschied=1; } |
---|
| 1917 | } |
---|
| 1918 | if ((h2[s]>0) && (s==size(h2))) { |
---|
| 1919 | a2[s,h2[s]+1]=0; |
---|
| 1920 | if (ncols(a2)<=ncols(a1)) { unterschied=1; } |
---|
| 1921 | } |
---|
| 1922 | if (unterschied==1) { // mind. eine HNE war endlich |
---|
| 1923 | matrix ma1[1][j]=a1[s,1..ncols(a1)]; // und bedarf der Fortsetzung |
---|
| 1924 | matrix ma2[1][j]=a2[s,1..ncols(a2)]; // mit Nullen |
---|
| 1925 | } |
---|
| 1926 | else { |
---|
| 1927 | if (ncols(a1)>ncols(a2)) { j=ncols(a2); } |
---|
| 1928 | else { j=ncols(a1); } |
---|
| 1929 | matrix ma1[1][j]=a1[s,1..j]; // Beschr. auf vergleichbaren |
---|
| 1930 | matrix ma2[1][j]=a2[s,1..j]; // Teil (der evtl. y's enth.) |
---|
| 1931 | } |
---|
| 1932 | for (i=1; (ma1[1,i]==ma2[1,i]) && (i<j) && (ma1[1,i]!=var(2)); i++) {;} |
---|
| 1933 | if (ma1[1,i]==ma2[1,i]) { |
---|
| 1934 | "//** The two HNE's are identical!"; |
---|
| 1935 | "//** You have either tried to compare a branch with itself,"; |
---|
| 1936 | "//** or the two branches have been developed separately."; |
---|
| 1937 | "// In the latter case use `extdevelop' to extend the HNE's until", |
---|
| 1938 | "they differ."; |
---|
| 1939 | return(-1); |
---|
| 1940 | } |
---|
| 1941 | if ((ma1[1,i]==var(2)) || (ma2[1,i]==var(2))) { |
---|
| 1942 | "//** The two HNE's are (so far) identical. This is because they", |
---|
| 1943 | "have been"; |
---|
| 1944 | "//** computed separately. I need more data; use `extdevelop' to", |
---|
| 1945 | "extend them,"; |
---|
| 1946 | if (ma1[1,i]==var(2)) {"//** at least the first one.";} |
---|
| 1947 | else {"//** at least the second one.";} |
---|
| 1948 | return(-1); |
---|
| 1949 | } |
---|
| 1950 | } |
---|
| 1951 | } |
---|
| 1952 | separated=i; |
---|
| 1953 | for (j=1; j<s; j++) { separated=separated+h1[j]; } |
---|
| 1954 | } |
---|
| 1955 | return(separated); |
---|
| 1956 | } |
---|
| 1957 | example |
---|
| 1958 | { "EXAMPLE:"; echo = 2; |
---|
[a848f8] | 1959 | int p=printlevel; printlevel=-1; |
---|
[81fb58d] | 1960 | ring r=0,(x,y),dp; |
---|
| 1961 | list hne1=develop(x); |
---|
| 1962 | list hne2=develop(x+y); |
---|
| 1963 | list hne3=develop(x+y2); |
---|
| 1964 | separateHNE(hne1,hne2); // two transversal lines |
---|
[a848f8] | 1965 | separateHNE(hne1,hne3); // one quadratic transform. gives 1st example |
---|
| 1966 | printlevel=p; |
---|
[81fb58d] | 1967 | } |
---|
| 1968 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 1969 | |
---|
[bb17e8] | 1970 | proc displayHNE(list ldev,list #) |
---|
[7b3971] | 1971 | "USAGE: displayHNE(L[,n]); L list, n int |
---|
[dcb500] | 1972 | ASSUME: L is the output of @code{develop(f)}, or of @code{exdevelop(f,n)}, |
---|
[3c4dcc] | 1973 | or of @code{hnexpansion(f[,\"ess\"])}, or (one entry in) the list |
---|
[dcb500] | 1974 | @code{hne} in the ring created by @code{hnexpansion(f[,\"ess\"])}. |
---|
[2761f3] | 1975 | RETURN: - if only one argument is given and if the input are the HN data |
---|
| 1976 | of an irreducible plane curve singularity, no return value, but |
---|
[bb17e8] | 1977 | display an ideal HNE of the following form: |
---|
[a848f8] | 1978 | @example |
---|
[8912ce] | 1979 | y = []*x^1+[]*x^2 +...+x^<>*z(1) |
---|
| 1980 | x = []*z(1)^2+...+z(1)^<>*z(2) |
---|
| 1981 | z(1) = []*z(2)^2+...+z(2)^<>*z(3) |
---|
| 1982 | ....... .......................... |
---|
| 1983 | z(r-1) = []*z(r)^2+[]*z(r)^3+...... |
---|
[a848f8] | 1984 | @end example |
---|
[2761f3] | 1985 | where @code{x},@code{y} are the first 2 variables of the basering. |
---|
| 1986 | The values of @code{[]} are the coefficients of the Hamburger-Noether |
---|
| 1987 | matrix, the values of @code{<>} are represented by @code{x} in the |
---|
| 1988 | HN matrix.@* |
---|
| 1989 | - if a second argument is given and if the input are the HN data |
---|
[3c4dcc] | 1990 | of an irreducible plane curve singularity, return a ring containing |
---|
[2761f3] | 1991 | an ideal @code{HNE} as described above.@* |
---|
| 1992 | - if L corresponds to the output of @code{hnexpansion(f)} |
---|
| 1993 | or to the list of HN data computed by @code{hnexpansion(f[,\"ess\"])}, |
---|
[3c4dcc] | 1994 | @code{displayHNE(L[,n])} shows the HNE's of all branches of f in the |
---|
[2761f3] | 1995 | format described above. The optional parameter is then ignored. |
---|
[7b3971] | 1996 | NOTE: The 1st line of the above ideal (i.e., @code{HNE[1]}) means that |
---|
| 1997 | @code{y=[]*z(0)^1+...}, the 2nd line (@code{HNE[2]}) means that |
---|
[50cbdc] | 1998 | @code{x=[]*z(1)^2+...}, so you can see which indeterminate |
---|
| 1999 | corresponds to which line (it's also possible that @code{x} corresponds |
---|
[7b3971] | 2000 | to the 1st line and @code{y} to the 2nd). |
---|
[50cbdc] | 2001 | |
---|
[dcb500] | 2002 | SEE ALSO: develop, hnexpansion |
---|
[bb17e8] | 2003 | EXAMPLE: example displayHNE; shows an example |
---|
[d2b2a7] | 2004 | " |
---|
[190bf0b] | 2005 | { |
---|
[bb17e8] | 2006 | if ((typeof(ldev[1])=="list") || (typeof(ldev[1])=="none")) { |
---|
| 2007 | for (int i=1; i<=size(ldev); i++) { |
---|
| 2008 | "// Hamburger-Noether development of branch nr."+string(i)+":"; |
---|
| 2009 | displayHNE(ldev[i]);""; |
---|
| 2010 | } |
---|
| 2011 | return(); |
---|
| 2012 | } |
---|
[190bf0b] | 2013 | //--------------------- Initialisierungen und Ringwechsel -------------------- |
---|
[bb17e8] | 2014 | matrix m=ldev[1]; |
---|
| 2015 | intvec v=ldev[2]; |
---|
| 2016 | int switch=ldev[3]; |
---|
[190bf0b] | 2017 | if (switch==-1) { |
---|
[dcb500] | 2018 | "An error has occurred throughout the expansion, so there is no HNE."; |
---|
[190bf0b] | 2019 | return(ideal(0)); |
---|
| 2020 | } |
---|
[81fb58d] | 2021 | def altring=basering; |
---|
[dcb500] | 2022 | ///////////////////////////////////////////////////////// |
---|
| 2023 | // Change by T. Keilen 08.06.2002 |
---|
| 2024 | // ring + ring does not work if one ring is an algebraic extension |
---|
| 2025 | /* |
---|
[bb17e8] | 2026 | if (parstr(basering)!="") { |
---|
| 2027 | if (charstr(basering)!=string(char(basering))+","+parstr(basering)) { |
---|
[81fb58d] | 2028 | execute |
---|
[034ce1] | 2029 | ("ring dazu=("+charstr(basering)+"),z(0.."+string(size(v)-1)+"),ls;"); |
---|
[bb17e8] | 2030 | } |
---|
[81fb58d] | 2031 | else { ring dazu=char(altring),z(0..size(v)-1),ls; } |
---|
[bb17e8] | 2032 | } |
---|
[81fb58d] | 2033 | else { ring dazu=char(altring),z(0..size(v)-1),ls; } |
---|
[190bf0b] | 2034 | def displayring=dazu+altring; |
---|
[dcb500] | 2035 | */ |
---|
| 2036 | execute("ring displayring=("+charstr(basering)+"),(z(0.."+string(size(v)-1)+"),"+varstr(basering)+"),(ls("+string(size(v))+"),"+ordstr(basering)+");"); |
---|
| 2037 | // End change by T. Keilen |
---|
| 2038 | ////////////////////////////////////////////////////////////// |
---|
[190bf0b] | 2039 | setring displayring; |
---|
| 2040 | map holematrix=altring,0; // mappt nur die Monome vom Grad Null |
---|
| 2041 | matrix m=holematrix(m); |
---|
[8912ce] | 2042 | int i,j; |
---|
| 2043 | |
---|
| 2044 | // lossen: check the last row for finiteness (06/2004) |
---|
| 2045 | int rowM=nrows(m); |
---|
| 2046 | int colM=ncols(m); |
---|
| 2047 | int undef_bd=v[size(v)]; |
---|
| 2048 | if ( undef_bd<-1 ){ |
---|
| 2049 | for (j=-undef_bd; j<=colM; j++) { m[rowM,j]=0; } |
---|
| 2050 | } |
---|
| 2051 | |
---|
[190bf0b] | 2052 | //--------------------- Erzeuge Matrix n mit n[i,j]=z(j-1)^i ----------------- |
---|
[8912ce] | 2053 | matrix n[colM][rowM]; |
---|
| 2054 | for (j=1; j<=rowM; j++) { |
---|
| 2055 | for (i=1; i<=colM; i++) { n[i,j]=z(j-1)^i; } |
---|
[190bf0b] | 2056 | } |
---|
| 2057 | matrix displaymat=m*n; |
---|
[bb17e8] | 2058 | ideal HNE; |
---|
[8912ce] | 2059 | for (i=1; i<rowM; i++) { HNE[i]=displaymat[i,i]+z(i)*z(i-1)^v[i]; } |
---|
| 2060 | HNE[rowM]=displaymat[rowM,rowM]; |
---|
| 2061 | |
---|
| 2062 | // lossen: output modified (06/2004) |
---|
[3c4dcc] | 2063 | if (size(#) == 0) |
---|
[8912ce] | 2064 | { |
---|
| 2065 | if (switch==0) { |
---|
| 2066 | HNE=subst(HNE,z(0),var(size(v)+1)); |
---|
| 2067 | } |
---|
| 2068 | else { |
---|
| 2069 | HNE=subst(HNE,z(0),var(size(v)+2)); |
---|
| 2070 | } |
---|
| 2071 | |
---|
| 2072 | for (j=1; j<=ncols(HNE); j++){ |
---|
[3c4dcc] | 2073 | string stHNE(j)=string(HNE[j]); |
---|
[8912ce] | 2074 | } |
---|
| 2075 | if (undef_bd<-1) |
---|
[3c4dcc] | 2076 | { |
---|
[8912ce] | 2077 | stHNE(size(v))=stHNE(size(v))+" + ..... (terms of degree >=" |
---|
| 2078 | +string(-undef_bd)+")"; |
---|
| 2079 | } |
---|
| 2080 | if (undef_bd==-1) |
---|
[3c4dcc] | 2081 | { |
---|
[8912ce] | 2082 | stHNE(size(v))=stHNE(size(v))+" + ..... (terms of degree >=" |
---|
| 2083 | +string(colM+1)+")"; |
---|
| 2084 | } |
---|
| 2085 | |
---|
| 2086 | if (switch==0) { |
---|
| 2087 | stHNE(1) = " "+string(var(size(v)+2))+" = "+stHNE(1); |
---|
[3c4dcc] | 2088 | } |
---|
[8912ce] | 2089 | else { |
---|
| 2090 | stHNE(1) = " "+string(var(size(v)+1))+" = "+stHNE(1); |
---|
[3c4dcc] | 2091 | } |
---|
[8912ce] | 2092 | stHNE(1); |
---|
| 2093 | if (ncols(HNE)==1) {return();} |
---|
| 2094 | |
---|
| 2095 | if (switch==0) { |
---|
[3c4dcc] | 2096 | stHNE(2) = " "+string(var(size(v)+1))+" = "+stHNE(2); |
---|
| 2097 | } |
---|
[8912ce] | 2098 | else { |
---|
[3c4dcc] | 2099 | stHNE(2) = " "+string(var(size(v)+2))+" = "+stHNE(2); |
---|
| 2100 | } |
---|
[8912ce] | 2101 | stHNE(2); |
---|
| 2102 | |
---|
| 2103 | for (j=3; j<=ncols(HNE); j++){ |
---|
[3c4dcc] | 2104 | stHNE(j)= " "+"z(" +string(j-2)+ ") = "+stHNE(j); |
---|
[8912ce] | 2105 | stHNE(j); |
---|
| 2106 | } |
---|
| 2107 | return(); |
---|
| 2108 | } |
---|
| 2109 | |
---|
| 2110 | if (rowM<2) { HNE[2]=z(0); } |
---|
| 2111 | |
---|
[190bf0b] | 2112 | if (switch==0) { |
---|
[bb17e8] | 2113 | HNE[1] = HNE[1]-var(size(v)+2); |
---|
| 2114 | HNE[2] = HNE[2]-var(size(v)+1); |
---|
[190bf0b] | 2115 | } |
---|
| 2116 | else { |
---|
[bb17e8] | 2117 | HNE[1] = HNE[1]-var(size(v)+1); |
---|
| 2118 | HNE[2] = HNE[2]-var(size(v)+2); |
---|
| 2119 | } |
---|
| 2120 | if (size(#) == 0) { |
---|
| 2121 | HNE; |
---|
| 2122 | return(); |
---|
| 2123 | } |
---|
| 2124 | if (size(#) != 0) { |
---|
[2761f3] | 2125 | HNE; |
---|
[bb17e8] | 2126 | export(HNE); |
---|
[2761f3] | 2127 | return(displayring); |
---|
[190bf0b] | 2128 | } |
---|
| 2129 | } |
---|
[bb17e8] | 2130 | example |
---|
| 2131 | { "EXAMPLE:"; echo = 2; |
---|
| 2132 | ring r=0,(x,y),dp; |
---|
| 2133 | poly f=x3+2xy2+y2; |
---|
| 2134 | list hn=develop(f); |
---|
| 2135 | displayHNE(hn); |
---|
| 2136 | } |
---|
[190bf0b] | 2137 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2138 | // procedures for reducible curves // |
---|
| 2139 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2140 | |
---|
[81fb58d] | 2141 | // proc newtonhoehne (poly f) |
---|
| 2142 | // USAGE: newtonhoehne(f); f poly |
---|
| 2143 | // ASSUME: basering = ...,(x,y),ds or ls |
---|
| 2144 | // RETURN: list of intvec(x,y) of coordinates of the newtonpolygon of f |
---|
| 2145 | // NOTE: This proc is only available in versions of Singular that know the |
---|
| 2146 | // command system("newton",f); f poly |
---|
| 2147 | // { |
---|
| 2148 | // intvec nm = getnm(f); |
---|
| 2149 | // if ((nm[1]>0) && (nm[2]>0)) { f=jet(f,nm[1]*nm[2],nm); } |
---|
| 2150 | // list erg=system("newton",f); |
---|
| 2151 | // int i; list Ausgabe; |
---|
| 2152 | // for (i=1; i<=size(erg); i++) { Ausgabe[i]=leadexp(erg[i]); } |
---|
| 2153 | // return(Ausgabe); |
---|
| 2154 | // } |
---|
[190bf0b] | 2155 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2156 | |
---|
[dd8844] | 2157 | proc newtonpoly (poly f, int #) |
---|
[d2b2a7] | 2158 | "USAGE: newtonpoly(f); f poly |
---|
[dd8844] | 2159 | ASSUME: basering has exactly two variables; @* |
---|
| 2160 | f is convenient, that is, f(x,0) != 0 != f(0,y). |
---|
| 2161 | RETURN: list of intvecs (= coordinates x,y of the Newton polygon of f). |
---|
| 2162 | NOTE: Procedure uses @code{execute}; this can be avoided by calling |
---|
[3c4dcc] | 2163 | @code{newtonpoly(f,1)} if the ordering of the basering is @code{ls}. |
---|
[dd8844] | 2164 | KEYWORDS: Newton polygon |
---|
[190bf0b] | 2165 | EXAMPLE: example newtonpoly; shows an example |
---|
[d2b2a7] | 2166 | " |
---|
[190bf0b] | 2167 | { |
---|
[dd8844] | 2168 | if (size(#)>=1) |
---|
| 2169 | { |
---|
| 2170 | if (typeof(#[1])=="int") |
---|
| 2171 | { |
---|
| 2172 | // this is done to avoid the "execute" command for procedures in |
---|
| 2173 | // hnoether.lib |
---|
| 2174 | def is_ls=#[1]; |
---|
| 2175 | } |
---|
| 2176 | } |
---|
| 2177 | if (defined(is_ls)<=0) |
---|
| 2178 | { |
---|
| 2179 | def @Rold=basering; |
---|
| 2180 | execute("ring @RR=("+charstr(basering)+"),("+varstr(basering)+"),ls;"); |
---|
| 2181 | poly f=imap(@Rold,f); |
---|
| 2182 | } |
---|
| 2183 | intvec A=(0,ord(subst(f,var(1),0))); |
---|
| 2184 | intvec B=(ord(subst(f,var(2),0)),0); |
---|
| 2185 | intvec C,H; list L; |
---|
| 2186 | int abbruch,i; |
---|
| 2187 | poly hilf; |
---|
| 2188 | L[1]=A; |
---|
| 2189 | f=jet(f,A[2]*B[1]-1,intvec(A[2],B[1])); |
---|
| 2190 | if (defined(is_ls)) |
---|
| 2191 | { |
---|
| 2192 | map xytausch=basering,var(2),var(1); |
---|
| 2193 | } |
---|
| 2194 | else |
---|
| 2195 | { |
---|
[3c4dcc] | 2196 | map xytausch=@RR,var(2),var(1); |
---|
[dd8844] | 2197 | } |
---|
[3c4dcc] | 2198 | for (i=2; f!=0; i++) |
---|
[dd8844] | 2199 | { |
---|
| 2200 | abbruch=0; |
---|
[3c4dcc] | 2201 | while (abbruch==0) |
---|
[dd8844] | 2202 | { |
---|
[3c4dcc] | 2203 | C=leadexp(f); |
---|
[dd8844] | 2204 | if(jet(f,A[2]*C[1]-A[1]*C[2]-1,intvec(A[2]-C[2],C[1]-A[1]))==0) |
---|
[3c4dcc] | 2205 | { |
---|
| 2206 | abbruch=1; |
---|
| 2207 | } |
---|
| 2208 | else |
---|
| 2209 | { |
---|
| 2210 | f=jet(f,-C[1]-1,intvec(-1,0)); |
---|
[dd8844] | 2211 | } |
---|
| 2212 | } |
---|
| 2213 | hilf=jet(f,A[2]*C[1]-A[1]*C[2],intvec(A[2]-C[2],C[1]-A[1])); |
---|
| 2214 | H=leadexp(xytausch(hilf)); |
---|
[3c4dcc] | 2215 | A=H[2],H[1]; |
---|
[dd8844] | 2216 | L[i]=A; |
---|
| 2217 | f=jet(f,A[2]*B[1]-1,intvec(A[2],B[1]-A[1])); |
---|
| 2218 | } |
---|
| 2219 | L[i]=B; |
---|
| 2220 | if (defined(is_ls)) |
---|
| 2221 | { |
---|
| 2222 | return(L); |
---|
| 2223 | } |
---|
| 2224 | else |
---|
| 2225 | { |
---|
| 2226 | setring @Rold; |
---|
| 2227 | return(L); |
---|
| 2228 | } |
---|
| 2229 | } |
---|
| 2230 | example |
---|
| 2231 | { |
---|
| 2232 | "EXAMPLE:"; echo = 2; |
---|
| 2233 | ring r=0,(x,y),ls; |
---|
| 2234 | poly f=x5+2x3y-x2y2+3xy5+y6-y7; |
---|
| 2235 | newtonpoly(f); |
---|
| 2236 | } |
---|
| 2237 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2238 | |
---|
| 2239 | proc is_NND (poly f, list #) |
---|
| 2240 | "USAGE: is_NND(f[,mu,NP]); f poly, mu int, NP list of intvecs |
---|
| 2241 | ASSUME: f is convenient, that is, f(x,0) != 0 != f(0,y);@* |
---|
| 2242 | mu (optional) is Milnor number of f.@* |
---|
[3c4dcc] | 2243 | NP (optional) is output of @code{newtonpoly(f)}. |
---|
[fd5013] | 2244 | RETURN: int: 1 if f is Newton non-degenerate, 0 otherwise. |
---|
[dd8844] | 2245 | SEE ALSO: newtonpoly |
---|
| 2246 | KEYWORDS: Newton non-degenerate; Newton polygon |
---|
| 2247 | EXAMPLE: example is_NND; shows examples |
---|
| 2248 | " |
---|
| 2249 | { |
---|
| 2250 | int i; |
---|
| 2251 | int i_print=printlevel-voice+2; |
---|
[82716e] | 2252 | |
---|
[dd8844] | 2253 | if (size(#)==0) |
---|
| 2254 | { |
---|
| 2255 | int mu=milnor(f); |
---|
| 2256 | list NP=newtonpoly(f); |
---|
| 2257 | } |
---|
| 2258 | else |
---|
| 2259 | { |
---|
| 2260 | if (typeof(#[1])=="int") |
---|
| 2261 | { |
---|
| 2262 | def mu=#[1]; |
---|
| 2263 | def NP=#[2]; |
---|
| 2264 | for (i=1;i<=size(NP);i++) |
---|
| 2265 | { |
---|
| 2266 | if (typeof(NP[i])!="intvec") |
---|
| 2267 | { |
---|
| 2268 | print("third input cannot be Newton polygon ==> ignored ") |
---|
| 2269 | NP=newtonpoly(f); |
---|
| 2270 | i=size(NP)+1; |
---|
[3c4dcc] | 2271 | } |
---|
[dd8844] | 2272 | } |
---|
| 2273 | } |
---|
| 2274 | else |
---|
| 2275 | { |
---|
| 2276 | print("second input cannot be Milnor number ==> ignored ") |
---|
| 2277 | int mu=milnor(f); |
---|
| 2278 | NP=newtonpoly(f); |
---|
| 2279 | } |
---|
| 2280 | } |
---|
[190bf0b] | 2281 | |
---|
[dd8844] | 2282 | // computation of the Newton number: |
---|
| 2283 | int s=size(NP); |
---|
| 2284 | int nN=-NP[1][2]-NP[s][1]+1; |
---|
| 2285 | intmat m[2][2]; |
---|
| 2286 | for(i=1;i<=s-1;i++) |
---|
| 2287 | { |
---|
| 2288 | m=NP[i+1],NP[i]; |
---|
| 2289 | nN=nN+det(m); |
---|
| 2290 | } |
---|
[190bf0b] | 2291 | |
---|
[3c4dcc] | 2292 | if(mu==nN) |
---|
[dd8844] | 2293 | { // the Newton-polygon is non-degenerate |
---|
[a2c96e] | 2294 | // REFERENCE? (tfuer mehr als 2 Variable gilt nicht, dass mu=nu impliziert, |
---|
| 2295 | // dass NP nicht ausgeartet ist!, Siehe KOMMENTAR in equising.lib in esIdeal) |
---|
[dd8844] | 2296 | return(1); |
---|
| 2297 | } |
---|
| 2298 | else |
---|
| 2299 | { |
---|
| 2300 | return(0); |
---|
| 2301 | } |
---|
[190bf0b] | 2302 | } |
---|
| 2303 | example |
---|
[dd8844] | 2304 | { |
---|
| 2305 | "EXAMPLE:"; echo = 2; |
---|
| 2306 | ring r=0,(x,y),ls; |
---|
| 2307 | poly f=x5+y3; |
---|
| 2308 | is_NND(f); |
---|
| 2309 | poly g=(x-y)^5+3xy5+y6-y7; |
---|
| 2310 | is_NND(g); |
---|
| 2311 | |
---|
| 2312 | // if already computed, one should give the Minor number and Newton polygon |
---|
[3c4dcc] | 2313 | // as second and third input: |
---|
[dd8844] | 2314 | int mu=milnor(g); |
---|
| 2315 | list NP=newtonpoly(g); |
---|
| 2316 | is_NND(g,mu,NP); |
---|
[190bf0b] | 2317 | } |
---|
[dd8844] | 2318 | |
---|
| 2319 | |
---|
[190bf0b] | 2320 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2321 | |
---|
| 2322 | proc charPoly(poly f, int M, int N) |
---|
[a848f8] | 2323 | "USAGE: charPoly(f,M,N); f bivariate poly, M,N int: length and height |
---|
[81fb58d] | 2324 | of Newton polygon of f, which has to be only one line |
---|
[190bf0b] | 2325 | RETURN: the characteristic polynomial of f |
---|
| 2326 | EXAMPLE: example charPoly; shows an example |
---|
[d2b2a7] | 2327 | " |
---|
[190bf0b] | 2328 | { |
---|
| 2329 | poly charp; |
---|
[4173c7] | 2330 | int Np=N div gcd(M,N); |
---|
[a848f8] | 2331 | f=subst(f,var(1),1); |
---|
[190bf0b] | 2332 | for(charp=0; f<>0; f=f-lead(f)) |
---|
[4173c7] | 2333 | { charp=charp+leadcoef(f)*var(2)^(leadexp(f)[2] div Np);} |
---|
[190bf0b] | 2334 | return(charp); |
---|
| 2335 | } |
---|
| 2336 | example |
---|
| 2337 | { "EXAMPLE:"; echo = 2; |
---|
| 2338 | ring exring=0,(x,y),dp; |
---|
| 2339 | charPoly(y4+2y3x2-yx6+x8,8,4); |
---|
| 2340 | charPoly(y6+3y3x2-x4,4,6); |
---|
| 2341 | } |
---|
| 2342 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2343 | |
---|
| 2344 | proc find_in_list(list L,int p) |
---|
[a848f8] | 2345 | "USAGE: find_in_list(L,p); L: list of intvec(x,y) |
---|
| 2346 | (sorted in y: L[1][2]>=L[2][2]), int p >= 0 |
---|
| 2347 | RETURN: int i: L[i][2]=p if existent; otherwise i with L[i][2]<p if existent; |
---|
| 2348 | otherwise i = size(L)+1; |
---|
| 2349 | EXAMPLE: example find_in_list; shows an example |
---|
[d2b2a7] | 2350 | " |
---|
[190bf0b] | 2351 | { |
---|
| 2352 | int i; |
---|
| 2353 | L[size(L)+1]=intvec(0,-1); // falls p nicht in L[.][2] vorkommt |
---|
| 2354 | for (i=1; L[i][2]>p; i++) {;} |
---|
| 2355 | return(i); |
---|
| 2356 | } |
---|
[a848f8] | 2357 | example |
---|
| 2358 | { "EXAMPLE:"; echo = 2; |
---|
| 2359 | list L = intvec(0,4), intvec(1,2), intvec(2,1), intvec(4,0); |
---|
| 2360 | find_in_list(L,1); |
---|
| 2361 | L[find_in_list(L,2)]; |
---|
[190bf0b] | 2362 | } |
---|
| 2363 | /////////////////////////////////////////////////////////////////////////////// |
---|
[a848f8] | 2364 | |
---|
[190bf0b] | 2365 | proc get_last_divisor(int M, int N) |
---|
[d2b2a7] | 2366 | "USAGE: get_last_divisor(M,N); int M,N |
---|
[190bf0b] | 2367 | RETURN: int Q: M=q1*N+r1, N=q2*r1+r2, ..., ri=Q*r(i+1) (Euclidean alg.) |
---|
| 2368 | EXAMPLE: example get_last_divisor; shows an example |
---|
[d2b2a7] | 2369 | " |
---|
[190bf0b] | 2370 | { |
---|
[4173c7] | 2371 | int R=M%N; int Q=M div N; |
---|
| 2372 | while (R!=0) {M=N; N=R; R=M%N; Q=M div N;} |
---|
[190bf0b] | 2373 | return(Q) |
---|
| 2374 | } |
---|
| 2375 | example |
---|
| 2376 | { "EXAMPLE"; echo = 2; |
---|
| 2377 | ring r=0,(x,y),dp; |
---|
| 2378 | get_last_divisor(12,10); |
---|
| 2379 | } |
---|
| 2380 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2381 | proc redleit (poly f,intvec S, intvec E) |
---|
[81fb58d] | 2382 | "USAGE: redleit(f,S,E); f poly, S,E intvec(x,y) |
---|
| 2383 | S,E are two different points on a line in the Newton diagram of f |
---|
| 2384 | RETURN: poly g: all monomials of f which lie on or below that line |
---|
| 2385 | NOTE: The main purpose is that if the line defined by S and E is part of the |
---|
| 2386 | Newton polygon, the result is the quasihomogeneous leading form of f |
---|
[3754ca] | 2387 | w.r.t. that line. |
---|
[a848f8] | 2388 | SEE ALSO: newtonpoly |
---|
[190bf0b] | 2389 | EXAMPLE: example redleit; shows an example |
---|
[d2b2a7] | 2390 | " |
---|
[190bf0b] | 2391 | { |
---|
| 2392 | if (E[1]<S[1]) { intvec H=E; E=S; S=H; } // S,E verkehrt herum eingegeben |
---|
| 2393 | return(jet(f,E[1]*S[2]-E[2]*S[1],intvec(S[2]-E[2],E[1]-S[1]))); |
---|
| 2394 | } |
---|
| 2395 | example |
---|
| 2396 | { "EXAMPLE"; echo = 2; |
---|
| 2397 | ring exring=0,(x,y),dp; |
---|
| 2398 | redleit(y6+xy4-2x3y2+x4y+x6,intvec(3,2),intvec(4,1)); |
---|
| 2399 | } |
---|
| 2400 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2401 | |
---|
| 2402 | |
---|
| 2403 | proc extdevelop (list l, int Exaktheit) |
---|
[50cbdc] | 2404 | "USAGE: extdevelop(L,N); list L, int N |
---|
[7b3971] | 2405 | ASSUME: L is the output of @code{develop(f)}, or of @code{extdevelop(l,n)}, |
---|
[dcb500] | 2406 | or one entry in the list @code{hne} in the ring created by |
---|
| 2407 | @code{hnexpansion(f[,\"ess\"])}. |
---|
[50cbdc] | 2408 | RETURN: an extension of the Hamburger-Noether development of f as a list |
---|
[7b3971] | 2409 | in the same format as L has (up to the last entry in the output |
---|
| 2410 | of @code{develop(f)}).@* |
---|
[dcb500] | 2411 | Type @code{help develop;}, resp. @code{help hnexpansion;} for more |
---|
[7b3971] | 2412 | details. |
---|
| 2413 | NOTE: The new HN-matrix will have at least N columns (if the HNE is not |
---|
| 2414 | finite). In particular, if f is irreducible then (in most cases) |
---|
[50cbdc] | 2415 | @code{extdevelop(develop(f),N)} will produce the same result as |
---|
[7b3971] | 2416 | @code{develop(f,N)}.@* |
---|
[50cbdc] | 2417 | If the matrix M of L has n columns then, compared with |
---|
[7fa60f] | 2418 | @code{parametrization(L)}, @code{paramametrize(extdevelop(L,N))} will increase the |
---|
[7b3971] | 2419 | exactness by at least (N-n) more significant monomials. |
---|
[bc80a9] | 2420 | SEE ALSO: develop, hnexpansion, param |
---|
[190bf0b] | 2421 | EXAMPLE: example extdevelop; shows an example |
---|
[d2b2a7] | 2422 | " |
---|
[190bf0b] | 2423 | { |
---|
| 2424 | //------------ Initialisierungen und Abfangen unzulaessiger Aufrufe ---------- |
---|
| 2425 | matrix m=l[1]; |
---|
| 2426 | intvec v=l[2]; |
---|
| 2427 | int switch=l[3]; |
---|
| 2428 | if (nvars(basering) < 2) { |
---|
| 2429 | " Sorry. I need two variables in the ring."; |
---|
| 2430 | return(list(matrix(maxideal(1)[1]),intvec(0),-1,poly(0)));} |
---|
| 2431 | if (switch==-1) { |
---|
| 2432 | "An error has occurred in develop, so there is no HNE and no extension."; |
---|
| 2433 | return(l); |
---|
| 2434 | } |
---|
| 2435 | poly f=l[4]; |
---|
| 2436 | if (f==0) { |
---|
| 2437 | " No extension is possible"; |
---|
| 2438 | return(l); |
---|
| 2439 | } |
---|
| 2440 | int Q=v[size(v)]; |
---|
| 2441 | if (Q>0) { |
---|
| 2442 | " The HNE was already exact"; |
---|
| 2443 | return(l); |
---|
| 2444 | } |
---|
| 2445 | else { |
---|
| 2446 | if (Q==-1) { Q=ncols(m); } |
---|
| 2447 | else { Q=-Q-1; } |
---|
| 2448 | } |
---|
| 2449 | int zeile=nrows(m); |
---|
[81fb58d] | 2450 | int spalten,i,M; |
---|
[190bf0b] | 2451 | ideal lastrow=m[zeile,1..Q]; |
---|
| 2452 | int ringwechsel=(varstr(basering)!="x,y") or (ordstr(basering)!="ls(2),C"); |
---|
| 2453 | |
---|
| 2454 | //------------------------- Ringwechsel, falls noetig ------------------------ |
---|
| 2455 | if (ringwechsel) { |
---|
| 2456 | def altring = basering; |
---|
[81fb58d] | 2457 | int p = char(basering); |
---|
[190bf0b] | 2458 | if (charstr(basering)!=string(p)) { |
---|
| 2459 | string tststr=charstr(basering); |
---|
| 2460 | tststr=tststr[1..find(tststr,",")-1]; //-> "p^k" bzw. "p" |
---|
| 2461 | if (tststr==string(p)) { |
---|
| 2462 | if (size(parstr(basering))>1) { // ring (p,a,..),... |
---|
[034ce1] | 2463 | execute("ring extdguenstig=("+charstr(basering)+"),(x,y),ls;"); |
---|
[190bf0b] | 2464 | } |
---|
| 2465 | else { // ring (p,a),... |
---|
| 2466 | string mipl=string(minpoly); |
---|
| 2467 | ring extdguenstig=(p,`parstr(basering)`),(x,y),ls; |
---|
[034ce1] | 2468 | if (mipl!="0") { execute("minpoly="+mipl+";"); } |
---|
[190bf0b] | 2469 | } |
---|
| 2470 | } |
---|
| 2471 | else { |
---|
[034ce1] | 2472 | execute("ring extdguenstig=("+charstr(basering)+"),(x,y),ls;"); |
---|
[190bf0b] | 2473 | } |
---|
| 2474 | } |
---|
| 2475 | else { // charstr(basering)== p : no parameter |
---|
| 2476 | ring extdguenstig=p,(x,y),ls; |
---|
| 2477 | } |
---|
| 2478 | export extdguenstig; |
---|
| 2479 | map hole=altring,x,y; |
---|
[a848f8] | 2480 | //----- map kann sehr zeitaufwendig sein, daher Vermeidung, wo moeglich: ----- |
---|
| 2481 | if (nvars(altring)==2) { poly f=fetch(altring,f); } |
---|
| 2482 | else { poly f=hole(f); } |
---|
[190bf0b] | 2483 | ideal a=hole(lastrow); |
---|
| 2484 | } |
---|
| 2485 | else { ideal a=lastrow; } |
---|
[dd8844] | 2486 | list Newton=newtonpoly(f,1); |
---|
[81fb58d] | 2487 | int M1=Newton[size(Newton)-1][1]; // konstant |
---|
[dcb500] | 2488 | number delt; |
---|
[81fb58d] | 2489 | if (Newton[size(Newton)-1][2]!=1) { |
---|
[190bf0b] | 2490 | " *** The transformed polynomial was not valid!!";} |
---|
[81fb58d] | 2491 | else { |
---|
| 2492 | //--------------------- Fortsetzung der HNE ---------------------------------- |
---|
| 2493 | while (Q<Exaktheit) { |
---|
| 2494 | M=ord(subst(f,y,0)); |
---|
| 2495 | Q=M-M1; |
---|
| 2496 | //------ quasihomogene Leitform ist c*x^M1*y+d*x^(M1+Q) => delta=-d/c: ------- |
---|
[dcb500] | 2497 | delt=-koeff(f,M,0)/koeff(f,M1,1); |
---|
| 2498 | a[Q]=delt; |
---|
[3c4dcc] | 2499 | dbprint(printlevel-voice+2,"a("+string(zeile-1)+","+string(Q)+") = "+string(delt)); |
---|
[81fb58d] | 2500 | if (Q<Exaktheit) { |
---|
[dcb500] | 2501 | f=T1_Transform(f,delt,Q); |
---|
| 2502 | if (defined(HNDebugOn)) { "transformed polynomial:",f; } |
---|
[81fb58d] | 2503 | if (subst(f,y,0)==0) { |
---|
[3c4dcc] | 2504 | dbprint(printlevel-voice+2,"The HNE is finite!"); |
---|
[81fb58d] | 2505 | a[Q+1]=x; Exaktheit=Q; |
---|
| 2506 | f=0; // Speicherersparnis: f nicht mehr gebraucht |
---|
| 2507 | } |
---|
| 2508 | } |
---|
[190bf0b] | 2509 | } |
---|
| 2510 | } |
---|
| 2511 | //------- Wechsel in alten Ring, Zusammensetzung alte HNE + Erweiterung ------ |
---|
| 2512 | if (ringwechsel) { |
---|
| 2513 | setring altring; |
---|
| 2514 | map zurueck=extdguenstig,var(1),var(2); |
---|
[a848f8] | 2515 | if (nvars(altring)==2) { f=fetch(extdguenstig,f); } |
---|
| 2516 | else { f=zurueck(f); } |
---|
[190bf0b] | 2517 | lastrow=zurueck(a); |
---|
| 2518 | } |
---|
| 2519 | else { lastrow=a; } |
---|
| 2520 | if (ncols(lastrow)>ncols(m)) { spalten=ncols(lastrow); } |
---|
| 2521 | else { spalten=ncols(m); } |
---|
| 2522 | matrix mneu[zeile][spalten]; |
---|
| 2523 | for (i=1; i<nrows(m); i++) { |
---|
| 2524 | mneu[i,1..ncols(m)]=m[i,1..ncols(m)]; |
---|
| 2525 | } |
---|
| 2526 | mneu[zeile,1..ncols(lastrow)]=lastrow; |
---|
| 2527 | if (lastrow[ncols(lastrow)]!=var(1)) { |
---|
| 2528 | if (ncols(lastrow)==spalten) { v[zeile]=-1; } // keine undefinierten Stellen |
---|
| 2529 | else { |
---|
| 2530 | v[zeile]=-Q-1; |
---|
| 2531 | for (i=ncols(lastrow)+1; i<=spalten; i++) { |
---|
| 2532 | mneu[zeile,i]=var(2); // fuelle nicht def. Stellen der Matrix auf |
---|
| 2533 | }}} |
---|
| 2534 | else { v[zeile]=Q; } // HNE war exakt |
---|
[81fb58d] | 2535 | if (ringwechsel) |
---|
| 2536 | { |
---|
[731e67e] | 2537 | kill extdguenstig; |
---|
[c67136] | 2538 | } |
---|
[190bf0b] | 2539 | |
---|
| 2540 | return(list(mneu,v,switch,f)); |
---|
| 2541 | } |
---|
| 2542 | example |
---|
[a848f8] | 2543 | { |
---|
[50cbdc] | 2544 | "EXAMPLE:"; echo = 2; |
---|
[190bf0b] | 2545 | ring exring=0,(x,y),dp; |
---|
[712167] | 2546 | list Hne=hnexpansion(x14-3y2x11-y3x10-y2x9+3y4x8+y5x7+3y4x6+x5*(-y6+y5) |
---|
[ee118e] | 2547 | -3y6x3-y7x2+y8); |
---|
[712167] | 2548 | displayHNE(Hne); // HNE of 1st,3rd branch is finite |
---|
| 2549 | print(extdevelop(Hne[1],5)[1]); |
---|
| 2550 | list ehne=extdevelop(Hne[2],5); |
---|
[7fa60f] | 2551 | displayHNE(ehne); |
---|
[712167] | 2552 | param(Hne[2]); |
---|
[7fa60f] | 2553 | param(ehne); |
---|
| 2554 | |
---|
[bb17e8] | 2555 | } |
---|
| 2556 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2557 | |
---|
| 2558 | proc stripHNE (list l) |
---|
[7b3971] | 2559 | "USAGE: stripHNE(L); L list |
---|
[50cbdc] | 2560 | ASSUME: L is the output of @code{develop(f)}, or of |
---|
[dcb500] | 2561 | @code{extdevelop(develop(f),n)}, or (one entry of) the list |
---|
| 2562 | @code{hne} in the ring created by @code{hnexpansion(f[,\"ess\"])}. |
---|
[7b3971] | 2563 | RETURN: list in the same format as L, but all polynomials L[4], resp. |
---|
| 2564 | L[i][4], are set to zero. |
---|
[bb17e8] | 2565 | NOTE: The purpose of this procedure is to remove huge amounts of data |
---|
| 2566 | no longer needed. It is useful, if one or more of the polynomials |
---|
[7b3971] | 2567 | in L consume much memory. It is still possible to compute invariants, |
---|
[bb17e8] | 2568 | parametrizations etc. with the stripped HNE(s), but it is not possible |
---|
[7b3971] | 2569 | to use @code{extdevelop} with them. |
---|
[dcb500] | 2570 | SEE ALSO: develop, hnexpansion, extdevelop |
---|
[bb17e8] | 2571 | EXAMPLE: example stripHNE; shows an example |
---|
[d2b2a7] | 2572 | " |
---|
[bb17e8] | 2573 | { |
---|
| 2574 | list h; |
---|
| 2575 | if (typeof(l[1])=="matrix") { l[4]=poly(0); } |
---|
| 2576 | else { |
---|
| 2577 | for (int i=1; i<=size(l); i++) { |
---|
| 2578 | h=l[i]; |
---|
| 2579 | h[4]=poly(0); |
---|
| 2580 | l[i]=h; |
---|
| 2581 | } |
---|
| 2582 | } |
---|
| 2583 | return(l); |
---|
| 2584 | } |
---|
| 2585 | example |
---|
[50cbdc] | 2586 | { |
---|
[7b3971] | 2587 | "EXAMPLE:"; echo = 2; |
---|
[bb17e8] | 2588 | ring r=0,(x,y),dp; |
---|
[712167] | 2589 | list Hne=develop(x2+y3+y4); |
---|
| 2590 | Hne; |
---|
| 2591 | stripHNE(Hne); |
---|
[190bf0b] | 2592 | } |
---|
| 2593 | /////////////////////////////////////////////////////////////////////////////// |
---|
[3c1c6a] | 2594 | static proc extractHNEs(list HNEs, int transvers) |
---|
[d2b2a7] | 2595 | "USAGE: extractHNEs(HNEs,transvers); list HNEs (output from HN), |
---|
[190bf0b] | 2596 | int transvers: 1 if x,y were exchanged, 0 else |
---|
[dcb500] | 2597 | RETURN: list of Hamburger-Noether-Extensions in the form of hne in hnexpansion |
---|
[190bf0b] | 2598 | NOTE: This procedure is only for internal purpose; examples don't make sense |
---|
[d2b2a7] | 2599 | " |
---|
[190bf0b] | 2600 | { |
---|
| 2601 | int i,maxspalte,hspalte,hnezaehler; |
---|
| 2602 | list HNEaktu,Ergebnis; |
---|
| 2603 | for (hnezaehler=1; hnezaehler<=size(HNEs); hnezaehler++) { |
---|
| 2604 | maxspalte=0; |
---|
| 2605 | HNEaktu=HNEs[hnezaehler]; |
---|
[dcb500] | 2606 | if (defined(HNDebugOn)) {"To process:";HNEaktu;} |
---|
[a848f8] | 2607 | if (size(HNEaktu)!=size(HNEaktu[1])+2) { |
---|
[190bf0b] | 2608 | "The ideals and the hqs in HNEs[",hnezaehler,"] don't match!!"; |
---|
| 2609 | HNEs[hnezaehler]; |
---|
| 2610 | } |
---|
| 2611 | //------------ ermittle maximale Anzahl benoetigter Spalten: ---------------- |
---|
| 2612 | for (i=2; i<size(HNEaktu); i++) { |
---|
| 2613 | hspalte=ncols(HNEaktu[i]); |
---|
| 2614 | maxspalte=maxspalte*(hspalte < maxspalte)+hspalte*(hspalte >= maxspalte); |
---|
| 2615 | } |
---|
| 2616 | //------------- schreibe Ausgabe fuer hnezaehler-ten Zweig: ------------------ |
---|
| 2617 | matrix ma[size(HNEaktu)-2][maxspalte]; |
---|
| 2618 | for (i=1; i<=(size(HNEaktu)-2); i++) { |
---|
| 2619 | if (ncols(HNEaktu[i+1]) > 1) { |
---|
| 2620 | ma[i,1..ncols(HNEaktu[i+1])]=HNEaktu[i+1]; } |
---|
| 2621 | else { ma[i,1]=HNEaktu[i+1][1];} |
---|
| 2622 | } |
---|
| 2623 | Ergebnis[hnezaehler]=list(ma,HNEaktu[1],transvers,HNEaktu[size(HNEaktu)]); |
---|
| 2624 | kill ma; |
---|
| 2625 | } |
---|
| 2626 | return(Ergebnis); |
---|
| 2627 | } |
---|
| 2628 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2629 | |
---|
| 2630 | proc factorfirst(poly f, int M, int N) |
---|
[d2b2a7] | 2631 | "USAGE : factorfirst(f,M,N); f poly, M,N int |
---|
[3c4dcc] | 2632 | RETURN: number d such that f=const*(y^(N/e) - d*x^(M/e))^e, where e=gcd(M,N), |
---|
[7fa60f] | 2633 | 0 if such a d does not exist |
---|
[190bf0b] | 2634 | EXAMPLE: example factorfirst; shows an example |
---|
[d2b2a7] | 2635 | " |
---|
[190bf0b] | 2636 | { |
---|
| 2637 | number c = koeff(f,0,N); |
---|
[dcb500] | 2638 | number delt; |
---|
[190bf0b] | 2639 | int eps,l; |
---|
| 2640 | int p=char(basering); |
---|
| 2641 | string ringchar=charstr(basering); |
---|
| 2642 | |
---|
| 2643 | if (c == 0) {"Something has gone wrong! I didn't get N correctly!"; exit;} |
---|
| 2644 | int e = gcd(M,N); |
---|
| 2645 | |
---|
[4173c7] | 2646 | if (p==0) { delt = koeff(f,M div e,N - N div e) / (-1*e*c); } |
---|
[190bf0b] | 2647 | else { |
---|
[4173c7] | 2648 | if (e%p != 0) { delt = koeff(f,M div e,N - N div e) / (-1*e*c); } |
---|
[190bf0b] | 2649 | else { |
---|
| 2650 | eps = e; |
---|
[62c2b0] | 2651 | for (l = 0; eps%p == 0; l=l+1) { eps=eps div p;} |
---|
[dcb500] | 2652 | if (defined(HNDebugOn)) {e," -> ",eps,"*",p,"^",l;} |
---|
[4173c7] | 2653 | delt = koeff(f,(M div e)*p^l,(N div e)*p^l*(eps-1)) / (-1*eps*c); |
---|
[190bf0b] | 2654 | |
---|
[dcb500] | 2655 | if ((charstr(basering) != string(p)) and (delt != 0)) { |
---|
[190bf0b] | 2656 | //------ coefficient field is not Z/pZ => (p^l)th root is not identity ------- |
---|
[dcb500] | 2657 | delt=0; |
---|
[81fb58d] | 2658 | if (defined(HNDebugOn)) { |
---|
[190bf0b] | 2659 | "trivial factorization not implemented for", |
---|
| 2660 | "parameters---I've to use 'factorize'"; |
---|
[dcb500] | 2661 | } |
---|
[190bf0b] | 2662 | } |
---|
| 2663 | } |
---|
| 2664 | } |
---|
[81fb58d] | 2665 | if (defined(HNDebugOn)) {"quasihomogeneous leading form:",f," = ",c, |
---|
[4173c7] | 2666 | "* (y^"+string(N div e),"-",delt,"* x^"+string(M div e)+")^",e," ?";} |
---|
| 2667 | if (f != c*(var(2)^(N div e) - delt*var(1)^(M div e))^e) {return(0);} |
---|
[dcb500] | 2668 | else {return(delt);} |
---|
[190bf0b] | 2669 | } |
---|
| 2670 | example |
---|
| 2671 | { "EXAMPLE:"; echo = 2; |
---|
| 2672 | ring exring=7,(x,y),dp; |
---|
| 2673 | factorfirst(2*(y3-3x4)^5,20,15); |
---|
| 2674 | factorfirst(x14+y7,14,7); |
---|
| 2675 | factorfirst(x14+x8y3+y7,14,7); |
---|
| 2676 | } |
---|
| 2677 | |
---|
[7fa60f] | 2678 | /////////////////////////////////////////////////////////////////////////// |
---|
| 2679 | |
---|
| 2680 | proc hnexpansion(poly f,list #) |
---|
| 2681 | "USAGE: hnexpansion(f[,\"ess\"]); f poly |
---|
| 2682 | ASSUME: f is a bivariate polynomial (in the first 2 ring variables) |
---|
| 2683 | RETURN: list @code{L}, containing Hamburger-Noether data of @code{f}: |
---|
[3c4dcc] | 2684 | If the computation of the HNE required no field extension, @code{L} |
---|
| 2685 | is a list of lists @code{L[i]} (corresponding to the output of |
---|
[7fa60f] | 2686 | @code{develop}, applied to a branch of @code{f}, but the last entry |
---|
| 2687 | being omitted): |
---|
| 2688 | @texinfo |
---|
| 2689 | @table @asis |
---|
| 2690 | @item @code{L[i][1]}; matrix: |
---|
| 2691 | Each row contains the coefficients of the corresponding line of the |
---|
[3c4dcc] | 2692 | Hamburger-Noether expansion (HNE) for the i-th branch. The end of |
---|
| 2693 | the line is marked in the matrix by the first ring variable |
---|
[7fa60f] | 2694 | (usually x). |
---|
| 2695 | @item @code{L[i][2]}; intvec: |
---|
| 2696 | indicating the length of lines of the HNE |
---|
| 2697 | @item @code{L[i][3]}; int: |
---|
[3c4dcc] | 2698 | 0 if the 1st ring variable was transversal (with respect to the |
---|
[7fa60f] | 2699 | i-th branch), @* |
---|
| 2700 | 1 if the variables were changed at the beginning of the |
---|
| 2701 | computation, @* |
---|
| 2702 | -1 if an error has occurred. |
---|
| 2703 | @item @code{L[i][4]}; poly: |
---|
[3c4dcc] | 2704 | the transformed equation of the i-th branch to make it possible |
---|
| 2705 | to extend the Hamburger-Noether data a posteriori without having |
---|
[7fa60f] | 2706 | to do all the previous calculation once again (0 if not needed). |
---|
| 2707 | @end table |
---|
| 2708 | @end texinfo |
---|
| 2709 | If the computation of the HNE required a field extension, the first |
---|
| 2710 | entry @code{L[1]} of the list is a ring, in which a list @code{hne} |
---|
[3754ca] | 2711 | of lists (the HN data, as above) and a polynomial @code{f} (image of |
---|
[3c4dcc] | 2712 | @code{f} over the new field) are stored. |
---|
[7fa60f] | 2713 | @* |
---|
[3c4dcc] | 2714 | If called with an additional input parameter, @code{hnexpansion} |
---|
| 2715 | computes only one representative for each class of conjugate |
---|
| 2716 | branches (over the ground field active when calling the procedure). |
---|
| 2717 | In this case, the returned list @code{L} always has only two |
---|
| 2718 | entries: @code{L[1]} is either a list of lists (the HN data) or a |
---|
[7fa60f] | 2719 | ring (as above), and @code{L[2]} is an integer vector (the number |
---|
| 2720 | of branches in the respective conjugacy classes). |
---|
| 2721 | |
---|
| 2722 | NOTE: If f is known to be irreducible as a power series, @code{develop(f)} |
---|
[3c4dcc] | 2723 | could be chosen instead to avoid a change of basering during the |
---|
[7fa60f] | 2724 | computations. @* |
---|
| 2725 | Increasing @code{printlevel} leads to more and more comments. @* |
---|
| 2726 | Having defined a variable @code{HNDebugOn} leads to a maximum |
---|
| 2727 | number of comments. |
---|
| 2728 | |
---|
[bc80a9] | 2729 | SEE ALSO: develop, extdevelop, param, displayHNE |
---|
[7fa60f] | 2730 | EXAMPLE: example hnexpansion; shows an example |
---|
[a848f8] | 2731 | " |
---|
| 2732 | { |
---|
[3c4dcc] | 2733 | int essential; |
---|
[7fa60f] | 2734 | if (size(#)==1) { essential=1; } |
---|
| 2735 | int field_ext; |
---|
| 2736 | def altring=basering; |
---|
| 2737 | |
---|
[a848f8] | 2738 | //--------- Falls Ring (p^k,a),...: Wechsel in (p,a),... + minpoly ----------- |
---|
[b24fe3] | 2739 | if ( hasGFCoefficient(basering) ) |
---|
| 2740 | { |
---|
[a848f8] | 2741 | string strmip=string(minpoly); |
---|
| 2742 | string strf=string(f); |
---|
[034ce1] | 2743 | execute("ring tempr=("+string(char(basering))+","+parstr(basering)+"),(" |
---|
| 2744 | +varstr(basering)+"),dp;"); |
---|
| 2745 | execute("minpoly="+strmip+";"); |
---|
| 2746 | execute("poly f="+strf+";"); |
---|
[7fa60f] | 2747 | field_ext=1; |
---|
| 2748 | def L=pre_HN(f,essential); |
---|
| 2749 | if (size(L)==0) { return(list()); } |
---|
| 2750 | def HNEring=L[1]; |
---|
| 2751 | setring HNEring; |
---|
| 2752 | if ((typeof(hne[1])=="ideal")) { return(list()); } |
---|
[a848f8] | 2753 | if ((voice==2) && (printlevel > -1)) { |
---|
[7fa60f] | 2754 | "// Attention: The parameter",par(1),"may have changed its meaning!"; |
---|
| 2755 | "// It needs no longer be a generator of the cyclic group of unities!"; |
---|
[a848f8] | 2756 | } |
---|
[7fa60f] | 2757 | dbprint(printlevel-voice+2, |
---|
| 2758 | "// result: "+string(size(hne))+" branch(es) successfully computed."); |
---|
[a848f8] | 2759 | } |
---|
| 2760 | else { |
---|
[7fa60f] | 2761 | def L=pre_HN(f,essential); |
---|
| 2762 | if (size(L)==0) { return(list()); } |
---|
| 2763 | if (L[2]==1) { field_ext=1; } |
---|
| 2764 | intvec hne_conj=L[3]; |
---|
| 2765 | def HNEring=L[1]; |
---|
| 2766 | setring HNEring; |
---|
| 2767 | if ((typeof(hne[1])=="ideal")) { return(list()); } |
---|
| 2768 | dbprint(printlevel-voice+2, |
---|
| 2769 | "// result: "+string(size(hne))+" branch(es) successfully computed."); |
---|
| 2770 | } |
---|
[e182c8] | 2771 | |
---|
| 2772 | // ----- Lossen 10/02 : the branches have to be resorted to be able to |
---|
| 2773 | // ----- display the multsequence in a nice way |
---|
| 2774 | if (size(hne)>2) |
---|
[3c4dcc] | 2775 | { |
---|
[e182c8] | 2776 | int i,j,k,m; |
---|
| 2777 | list dummy; |
---|
| 2778 | int nbsave; |
---|
| 2779 | int no_br = size(hne); |
---|
| 2780 | intmat nbhd[no_br][no_br]; |
---|
| 2781 | for (i=1;i<no_br;i++) |
---|
| 2782 | { |
---|
[3c4dcc] | 2783 | for (j=i+1;j<=no_br;j++) |
---|
| 2784 | { |
---|
[e182c8] | 2785 | nbhd[i,j]=separateHNE(hne[i],hne[j]); |
---|
| 2786 | k=i+1; |
---|
| 2787 | while ( (nbhd[i,k] >= nbhd[i,j]) and (k<j) ) |
---|
| 2788 | { |
---|
| 2789 | k++; |
---|
| 2790 | } |
---|
[3c4dcc] | 2791 | if (k<j) // branches have to be resorted |
---|
[e182c8] | 2792 | { |
---|
| 2793 | dummy=hne[j]; |
---|
| 2794 | nbsave=nbhd[i,j]; |
---|
| 2795 | for (m=k; m<j; m++) |
---|
| 2796 | { |
---|
| 2797 | hne[m+1]=hne[m]; |
---|
| 2798 | nbhd[i,m+1]=nbhd[i,m]; |
---|
| 2799 | } |
---|
| 2800 | hne[k]=dummy; |
---|
| 2801 | nbhd[i,k]=nbsave; |
---|
| 2802 | } |
---|
| 2803 | } |
---|
| 2804 | } |
---|
| 2805 | } |
---|
| 2806 | // ----- |
---|
[3c4dcc] | 2807 | |
---|
[7fa60f] | 2808 | if (field_ext==1) { |
---|
| 2809 | dbprint(printlevel-voice+3," |
---|
| 2810 | // 'hnexpansion' created a list of one ring. |
---|
[3c4dcc] | 2811 | // To see the ring and the data stored in the ring, type (if you assigned |
---|
| 2812 | // the name L to the list): |
---|
[7fa60f] | 2813 | show(L); |
---|
[3c4dcc] | 2814 | // To display the computed HN expansion, type |
---|
[7fa60f] | 2815 | def HNring = L[1]; setring HNring; displayHNE(hne); "); |
---|
| 2816 | if (essential==1) { |
---|
| 2817 | dbprint(printlevel-voice+3,""+ |
---|
[3c4dcc] | 2818 | "// As second entry of the returned list L, you obtain an integer vector, |
---|
[7fa60f] | 2819 | // indicating the number of conjugates for each of the computed branches."); |
---|
| 2820 | return(list(HNEring,hne_conj)); |
---|
[3c4dcc] | 2821 | } |
---|
[7fa60f] | 2822 | return(list(HNEring)); |
---|
| 2823 | } |
---|
| 2824 | else { // no change of basering necessary --> map data to original ring |
---|
| 2825 | setring altring; |
---|
| 2826 | if ((npars(altring)==1) and (minpoly!=0)) { |
---|
| 2827 | ring HNhelpring=char(altring),(a,x,y),ls; |
---|
| 2828 | list hne=imap(HNEring,hne); |
---|
| 2829 | setring altring; |
---|
[e182c8] | 2830 | map mmm=HNhelpring,par(1),var(1),var(2); |
---|
| 2831 | list hne=mmm(hne); |
---|
| 2832 | kill mmm,HNhelpring; |
---|
[7fa60f] | 2833 | } |
---|
[3c4dcc] | 2834 | else { |
---|
[7fa60f] | 2835 | list hne=fetch(HNEring,hne); |
---|
| 2836 | } |
---|
| 2837 | kill HNEring; |
---|
| 2838 | if (essential==1) { |
---|
[2761f3] | 2839 | dbprint(printlevel-voice+3,""+ |
---|
| 2840 | "// No change of ring necessary, return value is a list: |
---|
[7fa60f] | 2841 | // first entry = list : HN expansion of essential branches. |
---|
[2761f3] | 2842 | // second entry = intvec: numbers of conjugated branches "); |
---|
[7fa60f] | 2843 | return(list(hne,hne_conj)); |
---|
[a848f8] | 2844 | } |
---|
| 2845 | else { |
---|
[2761f3] | 2846 | dbprint(printlevel-voice+3,""+ |
---|
| 2847 | "// No change of ring necessary, return value is HN expansion."); |
---|
[7fa60f] | 2848 | return(hne); |
---|
[a848f8] | 2849 | } |
---|
| 2850 | } |
---|
| 2851 | } |
---|
| 2852 | example |
---|
| 2853 | { |
---|
| 2854 | "EXAMPLE:"; echo = 2; |
---|
| 2855 | ring r=0,(x,y),dp; |
---|
[7fa60f] | 2856 | // First, an example which requires no field extension: |
---|
[712167] | 2857 | list Hne=hnexpansion(x4-y6); |
---|
| 2858 | size(Hne); // number of branches |
---|
| 2859 | displayHNE(Hne); // HN expansion of branches |
---|
| 2860 | param(Hne[1]); // parametrization of 1st branch |
---|
| 2861 | param(Hne[2]); // parametrization of 2nd branch |
---|
[190bf0b] | 2862 | |
---|
[7fa60f] | 2863 | // An example which requires a field extension: |
---|
| 2864 | list L=hnexpansion((x4-y6)*(y2+x4)); |
---|
| 2865 | def R=L[1]; setring R; displayHNE(hne); |
---|
| 2866 | basering; |
---|
| 2867 | setring r; kill R; |
---|
[3c4dcc] | 2868 | |
---|
[7fa60f] | 2869 | // Computing only one representative per conjugacy class: |
---|
| 2870 | L=hnexpansion((x4-y6)*(y2+x4),"ess"); |
---|
| 2871 | def R=L[1]; setring R; displayHNE(hne); |
---|
| 2872 | L[2]; // number of branches in respective conjugacy classes |
---|
[baaef9] | 2873 | } |
---|
[7fa60f] | 2874 | |
---|
[baaef9] | 2875 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 2876 | |
---|
| 2877 | static proc pre_HN (poly f, int essential) |
---|
| 2878 | "NOTE: This procedure is only for internal use, it is called via |
---|
[7fa60f] | 2879 | hnexpansion |
---|
| 2880 | RETURN: list: first entry = HNEring (containing list hne, poly f) |
---|
| 2881 | second entry = 0 if no change of base ring necessary |
---|
| 2882 | 1 if change of base ring necessary |
---|
[3c4dcc] | 2883 | third entry = numbers of conjugates ( if essential = 1 ) |
---|
[80f8f6c] | 2884 | if some error has occurred, the empty list is returned |
---|
[3c4dcc] | 2885 | " |
---|
[190bf0b] | 2886 | { |
---|
| 2887 | def altring = basering; |
---|
[7fa60f] | 2888 | int p = char(basering); |
---|
| 2889 | int field_ext; |
---|
| 2890 | intvec hne_conj; |
---|
[190bf0b] | 2891 | |
---|
| 2892 | //-------------------- Tests auf Zulaessigkeit von basering ------------------ |
---|
| 2893 | if (charstr(basering)=="real") { |
---|
| 2894 | " Singular cannot factorize over 'real' as ground field"; |
---|
| 2895 | return(list()); |
---|
| 2896 | } |
---|
| 2897 | if (size(maxideal(1))<2) { |
---|
| 2898 | " A univariate polynomial ring makes no sense !"; |
---|
| 2899 | return(list()); |
---|
| 2900 | } |
---|
[dcb500] | 2901 | if (size(maxideal(1))>2) { |
---|
| 2902 | dbprint(printlevel-voice+2, |
---|
| 2903 | " Warning: all variables except the first two will be ignored!"); |
---|
[190bf0b] | 2904 | } |
---|
[b24fe3] | 2905 | if (hasGFCoefficient(basering)) |
---|
| 2906 | { |
---|
| 2907 | ERROR(" ring of type (p^k,a) not implemented"); |
---|
[190bf0b] | 2908 | //---------------------------------------------------------------------------- |
---|
| 2909 | // weder primitives Element noch factorize noch map "char p^k" -> "char -p" |
---|
| 2910 | // [(p^k,a)->(p,a) ground field] noch fetch |
---|
| 2911 | //---------------------------------------------------------------------------- |
---|
| 2912 | } |
---|
| 2913 | //----------------- Definition eines neuen Ringes: HNEring ------------------- |
---|
| 2914 | string namex=varstr(1); string namey=varstr(2); |
---|
[b24fe3] | 2915 | if ((npars(altring)==0)&&(find(charstr(altring),"real")==0)) { // kein Parameter, nicht 'real' |
---|
[190bf0b] | 2916 | ring HNEring = char(altring),(x,y),ls; |
---|
| 2917 | map m=altring,x,y; |
---|
| 2918 | poly f=m(f); |
---|
[7fa60f] | 2919 | export f; |
---|
[190bf0b] | 2920 | kill m; |
---|
| 2921 | } |
---|
| 2922 | else { |
---|
| 2923 | string mipl=string(minpoly); |
---|
| 2924 | if (mipl=="0") { |
---|
[7fa60f] | 2925 | "// ** WARNING: Algebraic extension of given ground field not possible!"; |
---|
| 2926 | "// ** We try to develop this polynomial, but if the need for a field"; |
---|
[3c4dcc] | 2927 | "// ** extension occurs during the calculation, we cannot proceed with"; |
---|
[7fa60f] | 2928 | "// ** the corresponding branches."; |
---|
[034ce1] | 2929 | execute("ring HNEring=("+charstr(basering)+"),(x,y),ls;"); |
---|
[190bf0b] | 2930 | } |
---|
| 2931 | else { |
---|
| 2932 | string pa=parstr(altring); |
---|
| 2933 | ring HNhelpring=p,`pa`,dp; |
---|
[034ce1] | 2934 | execute("poly mipo="+mipl+";"); // Minimalpolynom in Polynom umgewandelt |
---|
[190bf0b] | 2935 | ring HNEring=(p,a),(x,y),ls; |
---|
| 2936 | map getminpol=HNhelpring,a; |
---|
| 2937 | mipl=string(getminpol(mipo)); // String umgewandelt mit 'a' als Param. |
---|
[7fa60f] | 2938 | execute("minpoly="+mipl+";"); // "minpoly=poly is not supported" |
---|
[e820b2] | 2939 | kill HNhelpring; if(defined(getminpol)){ kill getminpol; } |
---|
[190bf0b] | 2940 | } |
---|
[7fa60f] | 2941 | if (nvars(altring)==2) { |
---|
| 2942 | poly f=fetch(altring,f); |
---|
| 2943 | export f; |
---|
| 2944 | } |
---|
[bb17e8] | 2945 | else { |
---|
[7fa60f] | 2946 | if (defined(pa)) { // Parameter hatte vorher anderen Namen als 'a' |
---|
| 2947 | ring HNhelpring=p,(`pa`,x,y),ls; |
---|
| 2948 | poly f=imap(altring,f); |
---|
| 2949 | setring HNEring; |
---|
| 2950 | map m=HNhelpring,a,x,y; |
---|
| 2951 | poly f=m(f); |
---|
| 2952 | kill HNhelpring; |
---|
| 2953 | } |
---|
| 2954 | else { |
---|
| 2955 | map m=altring,x,y; |
---|
| 2956 | poly f=m(f); |
---|
| 2957 | } |
---|
| 2958 | export f; |
---|
[bb17e8] | 2959 | kill m; |
---|
| 2960 | } |
---|
[190bf0b] | 2961 | } |
---|
[3c4dcc] | 2962 | |
---|
[81fb58d] | 2963 | if (defined(HNDebugOn)) |
---|
[dcb500] | 2964 | {"received polynomial: ",f,", with x =",namex,", y =",namey;} |
---|
[190bf0b] | 2965 | |
---|
| 2966 | //----------------------- Variablendefinitionen ------------------------------ |
---|
| 2967 | int Abbruch,i,NullHNEx,NullHNEy; |
---|
| 2968 | string str; |
---|
[3c4dcc] | 2969 | list Newton,hne; |
---|
[7fa60f] | 2970 | |
---|
| 2971 | // --- changed for SINGULAR 3: --- |
---|
| 2972 | hne=ideal(0); |
---|
| 2973 | export hne; |
---|
[190bf0b] | 2974 | |
---|
| 2975 | //====================== Tests auf Zulaessigkeit des Polynoms ================ |
---|
| 2976 | |
---|
| 2977 | //-------------------------- Test, ob Einheit oder Null ---------------------- |
---|
| 2978 | if (subst(subst(f,x,0),y,0)!=0) { |
---|
[a848f8] | 2979 | dbprint(printlevel+1, |
---|
| 2980 | "The given polynomial is a unit in the power series ring!"); |
---|
[7fa60f] | 2981 | setring altring; kill HNEring; |
---|
[190bf0b] | 2982 | return(list()); // there are no HNEs |
---|
| 2983 | } |
---|
| 2984 | if (f==0) { |
---|
[a848f8] | 2985 | dbprint(printlevel+1,"The given polynomial is zero!"); |
---|
[7fa60f] | 2986 | setring altring; kill HNEring; |
---|
[190bf0b] | 2987 | return(list()); // there are no HNEs |
---|
| 2988 | } |
---|
| 2989 | |
---|
| 2990 | //----------------------- Test auf Quadratfreiheit -------------------------- |
---|
| 2991 | |
---|
| 2992 | if ((p==0) and (size(charstr(basering))==1)) { |
---|
| 2993 | |
---|
| 2994 | //-------- Fall basering==0,... : Wechsel in Ring mit char >0 ---------------- |
---|
| 2995 | // weil squarefree eine Standardbasis berechnen muss (verwendet Syzygien) |
---|
[bb17e8] | 2996 | // -- wenn f in diesem Ring quadratfrei ist, dann erst recht im Ring HNEring |
---|
[190bf0b] | 2997 | //---------------------------------------------------------------------------- |
---|
| 2998 | int testerg=(polytest(f)==0); |
---|
| 2999 | ring zweitring = 32003,(x,y),dp; |
---|
| 3000 | |
---|
| 3001 | map polyhinueber=HNEring,x,y; // fetch geht nicht |
---|
| 3002 | poly f=polyhinueber(f); |
---|
| 3003 | poly test_sqr=squarefree(f); |
---|
| 3004 | if (test_sqr != f) { |
---|
[a848f8] | 3005 | if (printlevel>0) { |
---|
| 3006 | "Most probably the given polynomial is not squarefree. But the test was"; |
---|
| 3007 | "made in characteristic 32003 and not 0 to improve speed. You can"; |
---|
| 3008 | "(r) redo the test in char 0 (but this may take some time)"; |
---|
| 3009 | "(c) continue the development, if you're sure that the polynomial IS", |
---|
| 3010 | "squarefree"; |
---|
| 3011 | if (testerg==1) { |
---|
| 3012 | "(s) continue the development with a squarefree factor (*)";} |
---|
| 3013 | "(q) or just quit the algorithm (default action)"; |
---|
| 3014 | "";"Please enter the letter of your choice:"; |
---|
| 3015 | str=read("")[1]; // reads one character |
---|
| 3016 | } |
---|
| 3017 | else { str="r"; } // printlevel <= 0: non-interactive behaviour |
---|
[190bf0b] | 3018 | setring HNEring; |
---|
| 3019 | map polyhinueber=zweitring,x,y; |
---|
| 3020 | if (str=="r") { |
---|
| 3021 | poly test_sqr=squarefree(f); |
---|
| 3022 | if (test_sqr != f) { |
---|
[a848f8] | 3023 | if (printlevel>0) { "The given polynomial is in fact not squarefree."; } |
---|
| 3024 | else { "The given polynomial is not squarefree!"; } |
---|
[190bf0b] | 3025 | "I'll continue with the radical."; |
---|
| 3026 | f=test_sqr; |
---|
| 3027 | } |
---|
[a848f8] | 3028 | else { |
---|
| 3029 | dbprint(printlevel, |
---|
| 3030 | "everything is ok -- the polynomial is squarefree in characteristic 0"); |
---|
| 3031 | } |
---|
[190bf0b] | 3032 | } |
---|
| 3033 | else { |
---|
[82716e] | 3034 | if ((str=="s") and (testerg==1)) { |
---|
[190bf0b] | 3035 | "(*)attention: it could be that the factor is only one in char 32003!"; |
---|
| 3036 | f=polyhinueber(test_sqr); |
---|
| 3037 | } |
---|
| 3038 | else { |
---|
| 3039 | if (str<>"c") { |
---|
[81fb58d] | 3040 | setring altring; |
---|
| 3041 | kill HNEring;kill zweitring; |
---|
[190bf0b] | 3042 | return(list());} |
---|
| 3043 | else { "if the algorithm doesn't terminate, you were wrong...";} |
---|
| 3044 | }} |
---|
| 3045 | kill zweitring; |
---|
[dcb500] | 3046 | if (defined(HNDebugOn)) {"I continue with the polynomial",f; } |
---|
[190bf0b] | 3047 | } |
---|
| 3048 | else { |
---|
| 3049 | setring HNEring; |
---|
| 3050 | kill zweitring; |
---|
| 3051 | } |
---|
| 3052 | } |
---|
| 3053 | //------------------ Fall Char > 0 oder Ring hat Parameter ------------------- |
---|
| 3054 | else { |
---|
| 3055 | poly test_sqr=squarefree(f); |
---|
| 3056 | if (test_sqr != f) { |
---|
[a848f8] | 3057 | if (printlevel>0) { |
---|
| 3058 | if (test_sqr == 1) { |
---|
| 3059 | "The given polynomial is of the form g^"+string(p)+","; |
---|
| 3060 | "therefore not squarefree. You can:"; |
---|
| 3061 | " (q) quit the algorithm (recommended) or"; |
---|
| 3062 | " (f) continue with the full radical (using a factorization of the"; |
---|
| 3063 | " pure power part; this could take much time)"; |
---|
| 3064 | "";"Please enter the letter of your choice:"; |
---|
| 3065 | str=read("")[1]; |
---|
| 3066 | if (str<>"f") { str="q"; } |
---|
| 3067 | } |
---|
| 3068 | else { |
---|
| 3069 | "The given polynomial is not squarefree."; |
---|
| 3070 | if (p != 0) |
---|
| 3071 | { |
---|
| 3072 | " You can:"; |
---|
| 3073 | " (c) continue with a squarefree divisor (but factors of the form g^" |
---|
| 3074 | +string(p); |
---|
[7fa60f] | 3075 | " are lost; this is recommended, takes no extra time)"; |
---|
[a848f8] | 3076 | " (f) continue with the full radical (using a factorization of the"; |
---|
[7fa60f] | 3077 | " pure power part; this could take some time)"; |
---|
[a848f8] | 3078 | " (q) quit the algorithm"; |
---|
| 3079 | "";"Please enter the letter of your choice:"; |
---|
| 3080 | str=read("")[1]; |
---|
| 3081 | if ((str<>"f") && (str<>"q")) { str="c"; } |
---|
| 3082 | } |
---|
| 3083 | else { "I'll continue with the radical."; str="c"; } |
---|
| 3084 | } // endelse (test_sqr!=1) |
---|
[190bf0b] | 3085 | } |
---|
| 3086 | else { |
---|
[a848f8] | 3087 | "//** Error: The given polynomial is not squarefree!"; |
---|
| 3088 | "//** Since the global variable `printlevel' has the value",printlevel, |
---|
| 3089 | "we stop here."; |
---|
| 3090 | "// Either call me again with a squarefree polynomial f or assign"; |
---|
| 3091 | " printlevel=1;"; |
---|
| 3092 | "// before calling me with a non-squarefree f."; |
---|
[7fa60f] | 3093 | "// If printlevel > 0, I present some possibilities how to proceed."; |
---|
[a848f8] | 3094 | str="q"; |
---|
| 3095 | } |
---|
[190bf0b] | 3096 | if (str=="q") { |
---|
| 3097 | setring altring;kill HNEring; |
---|
| 3098 | return(list()); |
---|
| 3099 | } |
---|
| 3100 | if (str=="c") { f=test_sqr; } |
---|
| 3101 | if (str=="f") { f=allsquarefree(f,test_sqr); } |
---|
| 3102 | } |
---|
[dcb500] | 3103 | if (defined(HNDebugOn)) {"I continue with the polynomial",f; } |
---|
[190bf0b] | 3104 | |
---|
| 3105 | } |
---|
| 3106 | //====================== Ende Test auf Quadratfreiheit ======================= |
---|
| 3107 | if (subst(subst(f,x,0),y,0)!=0) { |
---|
[7fa60f] | 3108 | "The polynomial is a unit in the power series ring. No HNE computed."; |
---|
| 3109 | setring altring;kill HNEring; |
---|
[190bf0b] | 3110 | return(list()); |
---|
| 3111 | } |
---|
| 3112 | //---------------------- Test, ob f teilbar durch x oder y ------------------- |
---|
[82716e] | 3113 | if (subst(f,y,0)==0) { |
---|
[190bf0b] | 3114 | f=f/y; NullHNEy=1; } // y=0 is a solution |
---|
[82716e] | 3115 | if (subst(f,x,0)==0) { |
---|
[190bf0b] | 3116 | f=f/x; NullHNEx=1; } // x=0 is a solution |
---|
| 3117 | |
---|
[dd8844] | 3118 | Newton=newtonpoly(f,1); |
---|
[190bf0b] | 3119 | i=1; Abbruch=0; |
---|
| 3120 | //---------------------------------------------------------------------------- |
---|
| 3121 | // finde Eckpkt. des Newtonpolys, der den Teil abgrenzt, fuer den x transvers: |
---|
| 3122 | // Annahme: Newton ist sortiert, s.d. Newton[1]=Punkt auf der y-Achse, |
---|
| 3123 | // Newton[letzt]=Punkt auf der x-Achse |
---|
| 3124 | //---------------------------------------------------------------------------- |
---|
| 3125 | while ((i<size(Newton)) and (Abbruch==0)) { |
---|
| 3126 | if ((Newton[i+1][1]-Newton[i][1])>=(Newton[i][2]-Newton[i+1][2])) |
---|
| 3127 | {Abbruch=1;} |
---|
| 3128 | else {i=i+1;} |
---|
| 3129 | } |
---|
| 3130 | int grenze1=Newton[i][2]; |
---|
| 3131 | int grenze2=Newton[i][1]; |
---|
| 3132 | //---------------------------------------------------------------------------- |
---|
| 3133 | // Stelle Ring bereit zur Uebertragung der Daten im Fall einer Koerperer- |
---|
| 3134 | // weiterung. Definiere Objekte, die spaeter uebertragen werden. |
---|
| 3135 | // Binde die Listen (azeilen,...) an den Ring (um sie nicht zu ueberschreiben |
---|
| 3136 | // bei Def. in einem anderen Ring). |
---|
| 3137 | //---------------------------------------------------------------------------- |
---|
| 3138 | ring HNE_noparam = char(altring),(a,x,y),ls; |
---|
| 3139 | poly f; |
---|
| 3140 | list azeilen=ideal(0); |
---|
| 3141 | list HNEs=ideal(0); |
---|
| 3142 | list aneu=ideal(0); |
---|
[81fb58d] | 3143 | list faktoren=ideal(0); |
---|
[7fa60f] | 3144 | |
---|
[190bf0b] | 3145 | ideal deltais; |
---|
[7fa60f] | 3146 | poly delt; |
---|
| 3147 | |
---|
[190bf0b] | 3148 | //----- hier steht die Anzahl bisher benoetigter Ringerweiterungen drin: ----- |
---|
[3c4dcc] | 3149 | int EXTHNEnumber=0; |
---|
[7fa60f] | 3150 | |
---|
| 3151 | list EXTHNEring; |
---|
| 3152 | list HNE_RingDATA; |
---|
| 3153 | int number_of_letztring; |
---|
[190bf0b] | 3154 | setring HNEring; |
---|
[7fa60f] | 3155 | number_of_letztring=0; |
---|
[190bf0b] | 3156 | |
---|
[a848f8] | 3157 | // ================= Die eigentliche Berechnung der HNE: ===================== |
---|
| 3158 | |
---|
| 3159 | // ------- Berechne HNE von allen Zweigen, fuer die x transversal ist: ------- |
---|
[81fb58d] | 3160 | if (defined(HNDebugOn)) |
---|
[dcb500] | 3161 | {"1st step: Treat Newton polygon until height",grenze1;} |
---|
[190bf0b] | 3162 | if (grenze1>0) { |
---|
[7fa60f] | 3163 | if (EXTHNEnumber>0){ EXTHNEring = EXTHNEring(1..EXTHNEnumber); } |
---|
[3c4dcc] | 3164 | HNE_RingDATA = list(HNEring, HNE_noparam, EXTHNEnumber, EXTHNEring, |
---|
| 3165 | number_of_letztring); |
---|
[7fa60f] | 3166 | |
---|
| 3167 | list hilflist=HN(HNE_RingDATA,f,grenze1,1,essential,0,hne_conj,1); |
---|
| 3168 | kill HNEring, HNE_noparam; |
---|
| 3169 | if (EXTHNEnumber>0) { kill EXTHNEring(1..EXTHNEnumber);} |
---|
| 3170 | def HNEring = hilflist[1][1]; |
---|
| 3171 | def HNE_noparam = hilflist[1][2]; |
---|
| 3172 | EXTHNEnumber = hilflist[1][3]; |
---|
| 3173 | for (i=1; i<=EXTHNEnumber; i++) { def EXTHNEring(i)=hilflist[1][4][i]; } |
---|
| 3174 | if (hilflist[2]==0) { setring HNEring; number_of_letztring=0; } |
---|
| 3175 | else { setring EXTHNEring(hilflist[2]);} |
---|
| 3176 | if (hilflist[3]==1){field_ext=1;} |
---|
| 3177 | hne_conj=hilflist[5]; |
---|
| 3178 | |
---|
| 3179 | if (number_of_letztring != hilflist[2]) |
---|
| 3180 | { // Ringwechsel in Prozedur HN |
---|
| 3181 | map hole=HNE_noparam,transfproc,x,y; |
---|
| 3182 | setring HNE_noparam; |
---|
| 3183 | if (not(defined(f))) {poly f;} |
---|
| 3184 | f=imap(HNEring,f); |
---|
| 3185 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3186 | if (not(defined(f))) {poly f; f=hole(f); export f;} |
---|
| 3187 | else {f=hole(f);} |
---|
[3c4dcc] | 3188 | } |
---|
[7fa60f] | 3189 | number_of_letztring = hilflist[2]; |
---|
[3c4dcc] | 3190 | kill hilflist; |
---|
[190bf0b] | 3191 | } |
---|
[7fa60f] | 3192 | |
---|
[190bf0b] | 3193 | if (NullHNEy==1) { |
---|
[7fa60f] | 3194 | if ((typeof(hne[1])=="ideal")) { hne=list(); } |
---|
| 3195 | hne=hne+list(list(matrix(ideal(0,x)),intvec(1),int(0),poly(0))); |
---|
| 3196 | if (hne_conj==0) { hne_conj=1; } |
---|
| 3197 | else { hne_conj = hne_conj, 1; } |
---|
[190bf0b] | 3198 | } |
---|
| 3199 | // --------------- Berechne HNE von allen verbliebenen Zweigen: -------------- |
---|
[81fb58d] | 3200 | if (defined(HNDebugOn)) |
---|
[dcb500] | 3201 | {"2nd step: Treat Newton polygon until height",grenze2;} |
---|
[190bf0b] | 3202 | if (grenze2>0) { |
---|
[7fa60f] | 3203 | |
---|
| 3204 | if (EXTHNEnumber>0){ EXTHNEring = EXTHNEring(1..EXTHNEnumber); } |
---|
| 3205 | |
---|
| 3206 | if (essential==1) { number_of_letztring=0; } |
---|
| 3207 | if (number_of_letztring==0) { setring HNEring; } |
---|
| 3208 | else { setring EXTHNEring(number_of_letztring); } |
---|
[190bf0b] | 3209 | map xytausch=basering,y,x; |
---|
[7fa60f] | 3210 | |
---|
| 3211 | HNE_RingDATA = list(HNEring, HNE_noparam, EXTHNEnumber, EXTHNEring, |
---|
[3c4dcc] | 3212 | number_of_letztring); |
---|
[7fa60f] | 3213 | list hilflist=HN(HNE_RingDATA,xytausch(f),grenze2,1,essential,1,hne_conj,1); |
---|
| 3214 | kill HNEring, HNE_noparam; |
---|
| 3215 | if (EXTHNEnumber>0){ kill EXTHNEring(1..EXTHNEnumber); } |
---|
| 3216 | def HNEring = hilflist[1][1]; |
---|
| 3217 | def HNE_noparam = hilflist[1][2]; |
---|
| 3218 | EXTHNEnumber = hilflist[1][3]; |
---|
| 3219 | for (i=1; i<=EXTHNEnumber; i++) { def EXTHNEring(i)=hilflist[1][4][i]; } |
---|
| 3220 | if (hilflist[2]==0) { setring HNEring; number_of_letztring=0; } |
---|
[3c4dcc] | 3221 | else { setring EXTHNEring(hilflist[2]); |
---|
[7fa60f] | 3222 | number_of_letztring=hilflist[2]; } |
---|
| 3223 | if (hilflist[3]==1){field_ext=1;} |
---|
| 3224 | hne_conj=hilflist[5]; |
---|
[190bf0b] | 3225 | kill hilflist; |
---|
| 3226 | } |
---|
| 3227 | if (NullHNEx==1) { |
---|
[7fa60f] | 3228 | if ((typeof(hne[1])=="ideal")) { hne=list(); } |
---|
| 3229 | hne=hne+list(list(matrix(ideal(0,x)),intvec(1),int(1),poly(0))); |
---|
| 3230 | if (hne_conj==0) { hne_conj=1; } |
---|
| 3231 | else { hne_conj = hne_conj, 1; } |
---|
[190bf0b] | 3232 | } |
---|
[dd8844] | 3233 | |
---|
[7fa60f] | 3234 | |
---|
| 3235 | // --- aufraeumen --- |
---|
[3c4dcc] | 3236 | if (defined(HNEakut)){ |
---|
[7fa60f] | 3237 | kill HNEakut,faktoren,deltais,transformiert,teiler,leitf; |
---|
| 3238 | } |
---|
| 3239 | if (defined(hilflist)) {kill hilflist;} |
---|
| 3240 | if (defined(erg)) {kill erg;} |
---|
| 3241 | if (defined(delt)) {kill delt;} |
---|
| 3242 | if (defined(azeilen)) { kill azeilen;} |
---|
| 3243 | if (defined(aneu)) { kill aneu;} |
---|
| 3244 | if (defined(transfproc)) { kill transfproc;} |
---|
| 3245 | if (defined(transf)) { kill transf;} |
---|
| 3246 | if (not(defined(f))) { poly f = imap(HNEring,f); export f; } |
---|
| 3247 | |
---|
| 3248 | return(list(basering,field_ext,hne_conj)); |
---|
[baaef9] | 3249 | } |
---|
| 3250 | |
---|
[7fa60f] | 3251 | ////////////////////////////////////////////////////////////////////////////// |
---|
[baaef9] | 3252 | proc essdevelop (poly f) |
---|
| 3253 | "USAGE: essdevelop(f); f poly |
---|
[dd8844] | 3254 | NOTE: command is obsolete, use hnexpansion(f,\"ess\") instead. |
---|
| 3255 | SEE ALSO: hnexpansion, develop, extdevelop, param |
---|
[baaef9] | 3256 | " |
---|
| 3257 | { |
---|
[7fa60f] | 3258 | printlevel=printlevel+1; |
---|
| 3259 | list Ergebnis=hnexpansion(f,1); |
---|
| 3260 | printlevel=printlevel-1; |
---|
[190bf0b] | 3261 | return(Ergebnis); |
---|
| 3262 | } |
---|
[baaef9] | 3263 | |
---|
[190bf0b] | 3264 | /////////////////////////////////////////////////////////////////////////////// |
---|
[4f3359] | 3265 | static proc HN (list HNE_RingDATA,poly fneu,int grenze,def Aufruf_Ebene, |
---|
| 3266 | def essential,def getauscht,intvec hne_conj,int conj_factor) |
---|
[7fa60f] | 3267 | "NOTE: This procedure is only for internal use, it is called via pre_HN |
---|
[3c4dcc] | 3268 | RETURN: list: first entry = list of HNErings, |
---|
[7fa60f] | 3269 | second entry = number of new base ring (0 for HNEring, |
---|
| 3270 | -1 for HNE_noparam, |
---|
| 3271 | i for EXTHNEring(i)) |
---|
| 3272 | third entry = 0 if no field extension necessary |
---|
| 3273 | 1 if field extension necessary |
---|
| 3274 | forth entry = HNEs (only if no change of basering) |
---|
| 3275 | " |
---|
[190bf0b] | 3276 | { |
---|
| 3277 | //---------- Variablendefinitionen fuer den unverzweigten Teil: -------------- |
---|
[dcb500] | 3278 | if (defined(HNDebugOn)) {"procedure HN",Aufruf_Ebene;} |
---|
[ce8fc7] | 3279 | int Abbruch,ende,i,j,k,e,M,N,Q,R,zeiger,zeile,zeilevorher,dd,ii; |
---|
[190bf0b] | 3280 | intvec hqs; |
---|
[7fa60f] | 3281 | int field_ext; |
---|
| 3282 | int ring_changed, hneshift; |
---|
| 3283 | intvec conjugates,conj2,conj1; |
---|
| 3284 | |
---|
| 3285 | list EXTHNEring; |
---|
| 3286 | def HNEring = HNE_RingDATA[1]; |
---|
| 3287 | def HNE_noparam = HNE_RingDATA[2]; |
---|
| 3288 | int EXTHNEnumber = HNE_RingDATA[3]; |
---|
| 3289 | for (i=1; i<=EXTHNEnumber; i++) { def EXTHNEring(i)=HNE_RingDATA[4][i]; } |
---|
| 3290 | int number_of_letztring = HNE_RingDATA[5]; |
---|
| 3291 | if (defined(basering)) |
---|
[3c4dcc] | 3292 | { |
---|
[7fa60f] | 3293 | if (number_of_letztring==0) { kill HNEring; def HNEring=basering; } |
---|
[3c4dcc] | 3294 | else { kill EXTHNEring(number_of_letztring); |
---|
[7fa60f] | 3295 | def EXTHNEring(number_of_letztring)=basering; } |
---|
| 3296 | } |
---|
| 3297 | else |
---|
| 3298 | { |
---|
| 3299 | if ( number_of_letztring==0) { setring HNEring; } |
---|
[3c4dcc] | 3300 | else { setring EXTHNEring(number_of_letztring); } |
---|
[7fa60f] | 3301 | } |
---|
| 3302 | if (not(defined(hne))) {list hne;} |
---|
[190bf0b] | 3303 | poly fvorher; |
---|
| 3304 | list erg=ideal(0); list HNEs=ideal(0); // um die Listen an den Ring zu binden |
---|
| 3305 | |
---|
| 3306 | //-------------------- Bedeutung von Abbruch: -------------------------------- |
---|
| 3307 | //------- 0:keine Verzweigung | 1:Verzweigung,nicht fertig | 2:fertig -------- |
---|
| 3308 | // |
---|
| 3309 | // Struktur von HNEs : Liste von Listen L (fuer jeden Zweig) der Form |
---|
| 3310 | // L[1]=intvec (hqs), L[2],L[3],... ideal (die Zeilen (0,1,...) der HNE) |
---|
| 3311 | // L[letztes]=poly (transformiertes f) |
---|
| 3312 | //---------------------------------------------------------------------------- |
---|
| 3313 | list Newton; |
---|
[dcb500] | 3314 | number delt; |
---|
[190bf0b] | 3315 | int p = char(basering); // Ringcharakteristik |
---|
| 3316 | list azeilen=ideal(0); |
---|
[7fa60f] | 3317 | |
---|
| 3318 | ideal hilfid; intvec hilfvec; |
---|
[190bf0b] | 3319 | |
---|
| 3320 | // ======================= der unverzweigte Teil: ============================ |
---|
| 3321 | while (Abbruch==0) { |
---|
[7fa60f] | 3322 | Newton=newtonpoly(fneu,1); |
---|
[190bf0b] | 3323 | zeiger=find_in_list(Newton,grenze); |
---|
| 3324 | if (Newton[zeiger][2] != grenze) |
---|
[81fb58d] | 3325 | {"Didn't find an edge in the Newton polygon!";} |
---|
[190bf0b] | 3326 | if (zeiger==size(Newton)-1) { |
---|
[dcb500] | 3327 | if (defined(HNDebugOn)) {"only one relevant side in Newton polygon";} |
---|
[190bf0b] | 3328 | M=Newton[zeiger+1][1]-Newton[zeiger][1]; |
---|
| 3329 | N=Newton[zeiger][2]-Newton[zeiger+1][2]; |
---|
| 3330 | R = M%N; |
---|
[4173c7] | 3331 | Q = M div N; |
---|
[190bf0b] | 3332 | |
---|
[7fa60f] | 3333 | //-------- 1. Versuch: ist der quasihomogene Leitterm reine Potenz ? ------ |
---|
| 3334 | // (dann geht alles wie im irreduziblen Fall) |
---|
| 3335 | //------------------------------------------------------------------------- |
---|
[190bf0b] | 3336 | e = gcd(M,N); |
---|
[7fa60f] | 3337 | delt=factorfirst(redleit(fneu,Newton[zeiger],Newton[zeiger+1]) |
---|
[190bf0b] | 3338 | /x^Newton[zeiger][1],M,N); |
---|
[dcb500] | 3339 | if (delt==0) { |
---|
| 3340 | if (defined(HNDebugOn)) {" The given polynomial is reducible !";} |
---|
[190bf0b] | 3341 | Abbruch=1; |
---|
| 3342 | } |
---|
| 3343 | if (Abbruch==0) { |
---|
[7fa60f] | 3344 | //----------- fneu,zeile retten fuer den Spezialfall (###): ------------- |
---|
| 3345 | fvorher=fneu;zeilevorher=zeile; |
---|
[190bf0b] | 3346 | if (R==0) { |
---|
[7fa60f] | 3347 | //-------- transformiere fneu mit T1, wenn kein Abbruch nachher: ------ |
---|
[4173c7] | 3348 | if (N>1) { fneu = T1_Transform(fneu,delt,M div e); } |
---|
[190bf0b] | 3349 | else { ende=1; } |
---|
[dcb500] | 3350 | if (defined(HNDebugOn)) {"a("+string(zeile)+","+string(Q)+") =",delt;} |
---|
| 3351 | azeilen[zeile+1][Q]=delt; |
---|
[190bf0b] | 3352 | } |
---|
| 3353 | else { |
---|
[7fa60f] | 3354 | //------------- R > 0 : transformiere fneu mit T2 --------------------- |
---|
| 3355 | erg=T2_Transform(fneu,delt,M,N,referencepoly(Newton)); |
---|
| 3356 | fneu=erg[1];delt=erg[2]; |
---|
| 3357 | //----- vollziehe Euklid.Alg. nach, um die HN-Matrix zu berechnen: ---- |
---|
[190bf0b] | 3358 | while (R!=0) { |
---|
[dcb500] | 3359 | if (defined(HNDebugOn)) { "h("+string(zeile)+") =",Q; } |
---|
[a848f8] | 3360 | hqs[zeile+1]=Q; // denn zeile beginnt mit dem Wert 0 |
---|
[7fa60f] | 3361 | //--------------- markiere das Zeilenende der HNE: ------------------- |
---|
[a848f8] | 3362 | azeilen[zeile+1][Q+1]=x; |
---|
[190bf0b] | 3363 | zeile=zeile+1; |
---|
[7fa60f] | 3364 | //-------- Bereitstellung von Speicherplatz fuer eine neue Zeile: ---- |
---|
[190bf0b] | 3365 | azeilen[zeile+1]=ideal(0); |
---|
[4173c7] | 3366 | M=N; N=R; R=M%N; Q=M div N; |
---|
[190bf0b] | 3367 | } |
---|
[dcb500] | 3368 | if (defined(HNDebugOn)) {"a("+string(zeile)+","+string(Q)+") =",delt;} |
---|
| 3369 | azeilen[zeile+1][Q]=delt; |
---|
[190bf0b] | 3370 | } |
---|
[7fa60f] | 3371 | if (defined(HNDebugOn)) {"transformed polynomial: ",fneu;} |
---|
[190bf0b] | 3372 | grenze=e; |
---|
[7fa60f] | 3373 | //----------------------- teste Abbruchbedingungen: --------------------- |
---|
| 3374 | if (subst(fneu,y,0)==0) { // <==> y|fneu |
---|
[dcb500] | 3375 | dbprint(printlevel-voice+3,"finite HNE of one branch found"); |
---|
[a848f8] | 3376 | // voice abzufragen macht bei rekursiven procs keinen Sinn |
---|
| 3377 | azeilen[zeile+1][Q+1]=x; |
---|
[3c4dcc] | 3378 | //----- Q wird nur in hqs eingetragen, wenn der Spezialfall nicht |
---|
[7fa60f] | 3379 | // eintritt (siehe unten) ----- |
---|
[190bf0b] | 3380 | Abbruch=2; |
---|
| 3381 | if (grenze>1) { |
---|
[7fa60f] | 3382 | if (jet(fneu,1,intvec(0,1))==0) { |
---|
| 3383 | //- jet(...)=alle Monome von fneu, die nicht durch y2 teilbar sind - |
---|
| 3384 | "THE TEST FOR SQUAREFREENESS WAS BAD!!"; |
---|
| 3385 | " The polynomial was NOT squarefree!!!";} |
---|
[190bf0b] | 3386 | else { |
---|
[7fa60f] | 3387 | //----------------------- Spezialfall (###): ----------------------- |
---|
| 3388 | // Wir haben das Problem, dass die HNE eines Zweiges hier abbricht, |
---|
| 3389 | // aber ein anderer Zweig bis hierher genau die gleiche HNE hat, die |
---|
[3c4dcc] | 3390 | // noch weiter geht |
---|
| 3391 | // Loesung: mache Transform. rueckgaengig und behandle fneu im |
---|
[7fa60f] | 3392 | // Verzweigungsteil |
---|
| 3393 | //------------------------------------------------------------------ |
---|
[190bf0b] | 3394 | Abbruch=1; |
---|
[7fa60f] | 3395 | fneu=fvorher;zeile=zeilevorher;grenze=Newton[zeiger][2]; |
---|
[190bf0b] | 3396 | }} |
---|
[7fa60f] | 3397 | else {fneu=0;} // fneu nicht mehr gebraucht - spare Speicher |
---|
[190bf0b] | 3398 | if (Abbruch==2) { hqs[zeile+1]=Q; } |
---|
| 3399 | } // Spezialfall nicht eingetreten |
---|
| 3400 | else { |
---|
| 3401 | if (ende==1) { |
---|
[dcb500] | 3402 | dbprint(printlevel-voice+2,"HNE of one branch found"); |
---|
[a848f8] | 3403 | Abbruch=2; hqs[zeile+1]=-Q-1;} |
---|
[190bf0b] | 3404 | } |
---|
| 3405 | } // end(if Abbruch==0) |
---|
| 3406 | } // end(if zeiger...) |
---|
| 3407 | else { Abbruch=1;} |
---|
| 3408 | } // end(while Abbruch==0) |
---|
| 3409 | |
---|
| 3410 | // ===================== der Teil bei Verzweigung: =========================== |
---|
| 3411 | if (Abbruch==1) { |
---|
[7fa60f] | 3412 | //---------- Variablendefinitionen fuer den verzweigten Teil: --------------- |
---|
[190bf0b] | 3413 | poly leitf,teiler,transformiert; |
---|
[81fb58d] | 3414 | list aneu=ideal(0); |
---|
| 3415 | list faktoren; |
---|
[190bf0b] | 3416 | ideal deltais; |
---|
[3c4dcc] | 3417 | list HNEakut=ideal(0); |
---|
[190bf0b] | 3418 | intvec eis; |
---|
| 3419 | int zaehler,hnezaehler,zl,zl1,M1,N1,R1,Q1,needext; |
---|
| 3420 | int numberofRingchanges,lastRingnumber,ringischanged,flag; |
---|
| 3421 | string letztringname; |
---|
| 3422 | |
---|
| 3423 | zeiger=find_in_list(Newton,grenze); |
---|
[81fb58d] | 3424 | if (defined(HNDebugOn)) { |
---|
| 3425 | "Branching part reached---Newton polygon :",Newton; |
---|
[190bf0b] | 3426 | "relevant part until height",grenze,", from",Newton[zeiger],"on"; |
---|
[dcb500] | 3427 | } |
---|
[190bf0b] | 3428 | azeilen=list(hqs)+azeilen; // hat jetzt Struktur von HNEs: hqs in der 1.Zeile |
---|
| 3429 | |
---|
[7fa60f] | 3430 | //======= Schleife fuer jede zu betrachtende Seite des Newtonpolygons: ====== |
---|
[190bf0b] | 3431 | for(i=zeiger; i<size(Newton); i++) { |
---|
[3c4dcc] | 3432 | if ((essential==1) and (EXTHNEnumber>number_of_letztring)) { |
---|
[7fa60f] | 3433 | // ----- setze ring zurueck fuer neue Kante ----- |
---|
| 3434 | // ---- (damit konjugierte Zweige erkennbar) ----- |
---|
| 3435 | hneshift=hneshift+hnezaehler; |
---|
| 3436 | hnezaehler=0; |
---|
| 3437 | ring_changed=0; |
---|
| 3438 | def SaveRing = EXTHNEring(EXTHNEnumber); |
---|
| 3439 | setring SaveRing; |
---|
| 3440 | if (not(defined(HNEs))) { // HN wurde zum 2.Mal von pre_HN aufgerufen |
---|
[3c4dcc] | 3441 | list HNEs=ideal(0); |
---|
[7fa60f] | 3442 | } |
---|
| 3443 | for (k=number_of_letztring+1; k<=EXTHNEnumber; k++) { kill EXTHNEring(k);} |
---|
[3c4dcc] | 3444 | EXTHNEnumber=number_of_letztring; |
---|
[7fa60f] | 3445 | if (EXTHNEnumber==0) { setring HNEring; } |
---|
| 3446 | else { setring EXTHNEring(EXTHNEnumber); } |
---|
| 3447 | if (not(defined(HNEs))) { list HNEs; } |
---|
| 3448 | HNEs=ideal(0); |
---|
| 3449 | deltais=0; |
---|
| 3450 | delt=0; |
---|
| 3451 | if (defined(zerlege)) { kill zerlege; } |
---|
| 3452 | } |
---|
| 3453 | |
---|
[dcb500] | 3454 | if (defined(HNDebugOn)) { "we consider side",Newton[i],Newton[i+1]; } |
---|
[190bf0b] | 3455 | M=Newton[i+1][1]-Newton[i][1]; |
---|
| 3456 | N=Newton[i][2]-Newton[i+1][2]; |
---|
| 3457 | R = M%N; |
---|
[4173c7] | 3458 | Q = M div N; |
---|
[190bf0b] | 3459 | e=gcd(M,N); |
---|
| 3460 | needext=1; |
---|
| 3461 | letztringname=nameof(basering); |
---|
| 3462 | lastRingnumber=EXTHNEnumber; |
---|
[7fa60f] | 3463 | faktoren=list(ideal(charPoly(redleit(fneu,Newton[i],Newton[i+1]) |
---|
[81fb58d] | 3464 | /(x^Newton[i][1]*y^Newton[i+1][2]),M,N) ), |
---|
| 3465 | intvec(1)); // = (zu faktoriserendes Poly, 1) |
---|
[d243d8] | 3466 | conjugates=conj_factor; |
---|
[190bf0b] | 3467 | |
---|
[7fa60f] | 3468 | //-- wechsle so lange in Ringerweiterungen, bis Leitform vollstaendig |
---|
| 3469 | // in Linearfaktoren zerfaellt ----- |
---|
[190bf0b] | 3470 | for (numberofRingchanges=1; needext==1; numberofRingchanges++) { |
---|
[7fa60f] | 3471 | leitf=redleit(fneu,Newton[i],Newton[i+1])/ |
---|
[3c4dcc] | 3472 | (x^Newton[i][1]*y^Newton[i+1][2]); |
---|
[dcb500] | 3473 | delt=factorfirst(leitf,M,N); |
---|
[190bf0b] | 3474 | needext=0; |
---|
[dcb500] | 3475 | if (delt==0) { |
---|
[7fa60f] | 3476 | //---------- Sonderbehandlung: faktorisiere einige Polynome ueber Q(a): -- |
---|
| 3477 | if ((charstr(basering)=="0,a") and (essential==0)) { |
---|
[d243d8] | 3478 | // ==================================================== |
---|
[731e67e] | 3479 | // neu CL: 06.10.05 |
---|
[d243d8] | 3480 | poly CHPOLY=charPoly(leitf,M,N); |
---|
| 3481 | poly tstpoly; |
---|
[731e67e] | 3482 | if (defined(faktoren)!=0) { |
---|
[d243d8] | 3483 | // Test, damit kein Fehler eingebaut (vermutlich nicht notwendig) |
---|
| 3484 | tstpoly = faktoren[1][1]^faktoren[2][1]; |
---|
| 3485 | for (k=2; k<=size(faktoren[1]); k++) { |
---|
| 3486 | tstpoly = tstpoly * faktoren[1][k]^faktoren[2][k]; |
---|
| 3487 | } |
---|
| 3488 | tstpoly = CHPOLY-tstpoly*(CHPOLY/tstpoly); |
---|
| 3489 | kill CHPOLY; |
---|
[731e67e] | 3490 | } |
---|
[d243d8] | 3491 | if ((numberofRingchanges>1) and (defined(faktoren)!=0) and (tstpoly==0)) { |
---|
| 3492 | def L_help=factorlist(faktoren,conjugates); |
---|
| 3493 | faktoren=L_help[1]; |
---|
| 3494 | conjugates=L_help[2]; |
---|
| 3495 | kill L_help; |
---|
| 3496 | } |
---|
| 3497 | else { |
---|
| 3498 | faktoren=factorize(charPoly(leitf,M,N)); |
---|
| 3499 | conjugates=conj_factor; |
---|
| 3500 | for (k=2;k<=size(faktoren[2]);k++) {conjugates=conjugates,conj_factor;} |
---|
| 3501 | } |
---|
| 3502 | kill tstpoly; |
---|
| 3503 | // Ende neu (vorher nur else Fall) |
---|
| 3504 | // ==================================================== |
---|
[190bf0b] | 3505 | } |
---|
[81fb58d] | 3506 | else { |
---|
[7fa60f] | 3507 | //------------------ faktorisiere das charakt. Polynom: ---------------- |
---|
[baaef9] | 3508 | if ((numberofRingchanges==1) or (essential==0)) { |
---|
[7fa60f] | 3509 | def L_help=factorlist(faktoren,conjugates); |
---|
| 3510 | faktoren=L_help[1]; |
---|
[d243d8] | 3511 | conjugates=L_help[2]; |
---|
[7fa60f] | 3512 | kill L_help; |
---|
[baaef9] | 3513 | } |
---|
| 3514 | else { // eliminiere alle konjugierten Nullstellen bis auf eine: |
---|
| 3515 | ideal hilf_id; |
---|
| 3516 | for (zaehler=1; zaehler<=size(faktoren[1]); zaehler++) { |
---|
[731e67e] | 3517 | hilf_id=factorize(faktoren[1][zaehler],1); |
---|
[7fa60f] | 3518 | if (size(hilf_id)>1) { |
---|
| 3519 | poly fac=hilf_id[1]; |
---|
| 3520 | dd=deg(fac); |
---|
| 3521 | // Zur Sicherheit: |
---|
| 3522 | if (deg(fac)==0) { fac=hilf_id[2]; } |
---|
| 3523 | for (k=2;k<=size(hilf_id);k++) { |
---|
| 3524 | dd=dd+deg(hilf_id[k]); |
---|
[3c4dcc] | 3525 | if (deg(hilf_id[k])<deg(fac)) { fac=hilf_id[k]; } |
---|
[7fa60f] | 3526 | } |
---|
| 3527 | faktoren[1][zaehler]=fac; |
---|
[3c4dcc] | 3528 | kill fac; |
---|
[d243d8] | 3529 | if (conjugates[zaehler]==conj_factor) { |
---|
| 3530 | // number of conjugates not yet determined for this factor |
---|
| 3531 | conjugates[zaehler]=conjugates[zaehler]*dd; |
---|
| 3532 | } |
---|
[7fa60f] | 3533 | } |
---|
[3c4dcc] | 3534 | else { |
---|
| 3535 | faktoren[1][zaehler]=hilf_id[1]; |
---|
[7fa60f] | 3536 | } |
---|
[baaef9] | 3537 | } |
---|
| 3538 | } |
---|
[190bf0b] | 3539 | } |
---|
| 3540 | |
---|
| 3541 | zaehler=1; eis=0; |
---|
| 3542 | for (j=1; j<=size(faktoren[2]); j++) { |
---|
| 3543 | teiler=faktoren[1][j]; |
---|
[7fa60f] | 3544 | if (teiler/y != 0) { // sonst war's eine Konstante --> wegwerfen! |
---|
[dcb500] | 3545 | if (defined(HNDebugOn)) {"factor of leading form found:",teiler;} |
---|
[190bf0b] | 3546 | if (teiler/y2 == 0) { // --> Faktor hat die Form cy+d |
---|
| 3547 | deltais[zaehler]=-subst(teiler,y,0)/koeff(teiler,0,1); //=-d/c |
---|
| 3548 | eis[zaehler]=faktoren[2][j]; |
---|
[7fa60f] | 3549 | conj2[zaehler]=conjugates[j]; |
---|
[190bf0b] | 3550 | zaehler++; |
---|
| 3551 | } |
---|
| 3552 | else { |
---|
[dcb500] | 3553 | dbprint(printlevel-voice+2, |
---|
[a848f8] | 3554 | " Change of basering (field extension) necessary!"); |
---|
[7fa60f] | 3555 | if (defined(HNDebugOn)) { teiler,"is not yet properly factorized!"; } |
---|
[3c1c6a] | 3556 | if (needext==0) { poly zerlege=teiler; } |
---|
| 3557 | needext=1; |
---|
[7fa60f] | 3558 | field_ext=1; |
---|
[190bf0b] | 3559 | } |
---|
| 3560 | } |
---|
[7fa60f] | 3561 | } // end(for j) |
---|
[190bf0b] | 3562 | } |
---|
[7fa60f] | 3563 | else { deltais=ideal(delt); eis=e; conj2=conj_factor; } |
---|
[81fb58d] | 3564 | if (defined(HNDebugOn)) {"roots of char. poly:";deltais; |
---|
[dcb500] | 3565 | "with multiplicities:",eis;} |
---|
[190bf0b] | 3566 | if (needext==1) { |
---|
[7fa60f] | 3567 | //--------------------- fuehre den Ringwechsel aus: --------------------- |
---|
[190bf0b] | 3568 | ringischanged=1; |
---|
| 3569 | if ((size(parstr(basering))>0) && string(minpoly)=="0") { |
---|
[7fa60f] | 3570 | " ** We've had bad luck! The HNE cannot be calculated completely!"; |
---|
| 3571 | // HNE in transzendenter Erweiterung fehlgeschlagen |
---|
[bb17e8] | 3572 | kill zerlege; |
---|
[82716e] | 3573 | ringischanged=0; break; // weiter mit gefundenen Faktoren |
---|
[190bf0b] | 3574 | } |
---|
| 3575 | if (parstr(basering)=="") { |
---|
[3c4dcc] | 3576 | EXTHNEnumber++; |
---|
[7fa60f] | 3577 | def EXTHNEring(EXTHNEnumber) = splitring(zerlege); |
---|
| 3578 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3579 | |
---|
[82716e] | 3580 | poly transf=0; |
---|
| 3581 | poly transfproc=0; |
---|
[7fa60f] | 3582 | ring_changed=1; |
---|
[3c4dcc] | 3583 | export transfproc; |
---|
[190bf0b] | 3584 | } |
---|
| 3585 | else { |
---|
[82716e] | 3586 | if (numberofRingchanges>1) { // ein Ringwechsel hat nicht gereicht |
---|
[3c4dcc] | 3587 | def helpring = splitring(zerlege,list(transf,transfproc,faktoren)); |
---|
[7fa60f] | 3588 | kill EXTHNEring(EXTHNEnumber); |
---|
| 3589 | def EXTHNEring(EXTHNEnumber)=helpring; |
---|
| 3590 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3591 | kill helpring; |
---|
| 3592 | |
---|
| 3593 | poly transf=erg[1]; |
---|
| 3594 | poly transfproc=erg[2]; |
---|
| 3595 | ring_changed=1; |
---|
| 3596 | list faktoren=erg[3]; |
---|
| 3597 | export transfproc; |
---|
| 3598 | kill erg; |
---|
[190bf0b] | 3599 | } |
---|
| 3600 | else { |
---|
[7fa60f] | 3601 | if (ring_changed==1) { // in dieser proc geschah schon Ringwechsel |
---|
[82716e] | 3602 | EXTHNEnumber++; |
---|
[7fa60f] | 3603 | def EXTHNEring(EXTHNEnumber) = splitring(zerlege,list(a,transfproc)); |
---|
| 3604 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3605 | poly transf=erg[1]; |
---|
| 3606 | poly transfproc=erg[2]; |
---|
| 3607 | export transfproc; |
---|
| 3608 | kill erg; |
---|
[82716e] | 3609 | } |
---|
[7fa60f] | 3610 | else { // parameter war vorher da |
---|
[82716e] | 3611 | EXTHNEnumber++; |
---|
[7fa60f] | 3612 | def EXTHNEring(EXTHNEnumber) = splitring(zerlege,a); |
---|
| 3613 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3614 | poly transf=erg[1]; |
---|
[82716e] | 3615 | poly transfproc=transf; |
---|
[7fa60f] | 3616 | ring_changed=1; |
---|
| 3617 | export transfproc; |
---|
| 3618 | kill erg; |
---|
[82716e] | 3619 | }} |
---|
[190bf0b] | 3620 | } |
---|
[7fa60f] | 3621 | //----------------------------------------------------------------------- |
---|
[3c4dcc] | 3622 | // transf enthaelt jetzt den alten Parameter des Ringes, der aktiv war |
---|
| 3623 | // vor Beginn der Schleife (evtl. also ueber mehrere Ringwechsel |
---|
| 3624 | // weitergereicht), |
---|
| 3625 | // transfproc enthaelt den alten Parameter des Ringes, der aktiv war zu |
---|
[7fa60f] | 3626 | // Beginn der Prozedur, und der an die aufrufende Prozedur zurueckgegeben |
---|
[3c4dcc] | 3627 | // werden muss |
---|
[7fa60f] | 3628 | // transf ist Null, falls der alte Ring keinen Parameter hatte, |
---|
| 3629 | // das gleiche gilt fuer transfproc |
---|
| 3630 | //----------------------------------------------------------------------- |
---|
| 3631 | |
---|
| 3632 | //---- Neudef. von Variablen, Uebertragung bisher errechneter Daten: ---- |
---|
[190bf0b] | 3633 | poly leitf,teiler,transformiert; |
---|
[81fb58d] | 3634 | list aneu=ideal(0); |
---|
[190bf0b] | 3635 | ideal deltais; |
---|
[dcb500] | 3636 | number delt; |
---|
[190bf0b] | 3637 | setring HNE_noparam; |
---|
| 3638 | if (defined(letztring)) { kill letztring; } |
---|
[7fa60f] | 3639 | if (EXTHNEnumber>1) { def letztring=EXTHNEring(EXTHNEnumber-1); } |
---|
| 3640 | else { def letztring=HNEring; } |
---|
| 3641 | if (not defined(fneu)) {poly fneu;} |
---|
| 3642 | fneu=imap(letztring,fneu); |
---|
| 3643 | if (not defined(f)) {poly f;} |
---|
[190bf0b] | 3644 | f=imap(letztring,f); |
---|
[7fa60f] | 3645 | if (not defined(hne)) {list hne;} |
---|
| 3646 | hne=imap(letztring,hne); |
---|
| 3647 | |
---|
| 3648 | if (not defined(faktoren)) {list faktoren; } |
---|
[81fb58d] | 3649 | faktoren=imap(letztring,faktoren); |
---|
[3c4dcc] | 3650 | |
---|
[7fa60f] | 3651 | if (not(defined(azeilen))){list azeilen,HNEs;} |
---|
| 3652 | azeilen=imap(letztring,azeilen); |
---|
| 3653 | HNEs=imap(letztring,HNEs); |
---|
| 3654 | |
---|
[190bf0b] | 3655 | setring EXTHNEring(EXTHNEnumber); |
---|
[7fa60f] | 3656 | if (not(defined(hole))) { map hole; } |
---|
| 3657 | hole=HNE_noparam,transf,x,y; |
---|
| 3658 | poly fneu=hole(fneu); |
---|
[d243d8] | 3659 | if (not defined(faktoren)) { |
---|
| 3660 | list faktoren; |
---|
| 3661 | faktoren=hole(faktoren); |
---|
| 3662 | } |
---|
[7fa60f] | 3663 | if (not(defined(f))) |
---|
| 3664 | { |
---|
| 3665 | poly f=hole(f); |
---|
| 3666 | list hne=hole(hne); |
---|
[3c4dcc] | 3667 | export f,hne; |
---|
[81fb58d] | 3668 | } |
---|
[190bf0b] | 3669 | } |
---|
| 3670 | } // end (while needext==1) bzw. for (numberofRingchanges) |
---|
| 3671 | |
---|
| 3672 | if (eis==0) { i++; continue; } |
---|
| 3673 | if (ringischanged==1) { |
---|
[7fa60f] | 3674 | list erg,HNEakut; // dienen nur zum Sp. von Zwi.erg. |
---|
| 3675 | |
---|
[190bf0b] | 3676 | ideal hilfid; |
---|
[7fa60f] | 3677 | erg=ideal(0); HNEakut=erg; |
---|
[190bf0b] | 3678 | |
---|
| 3679 | hole=HNE_noparam,transf,x,y; |
---|
| 3680 | setring HNE_noparam; |
---|
[7fa60f] | 3681 | if (not(defined(azeilen))){list azeilen,HNEs;} |
---|
[190bf0b] | 3682 | azeilen=imap(letztring,azeilen); |
---|
| 3683 | HNEs=imap(letztring,HNEs); |
---|
| 3684 | |
---|
| 3685 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3686 | list azeilen=hole(azeilen); |
---|
| 3687 | list HNEs=hole(HNEs); |
---|
| 3688 | kill letztring; |
---|
| 3689 | ringischanged=0; |
---|
| 3690 | } |
---|
| 3691 | |
---|
[7fa60f] | 3692 | //============ Schleife fuer jeden gefundenen Faktor der Leitform: ========= |
---|
[190bf0b] | 3693 | for (j=1; j<=size(eis); j++) { |
---|
[3c4dcc] | 3694 | //---- Mache Transformation T1 oder T2, trage Daten in HNEs ein, |
---|
[7fa60f] | 3695 | // falls HNE abbricht: ---- |
---|
[190bf0b] | 3696 | |
---|
[7fa60f] | 3697 | //------------------------ Fall R==0: ------------------------------------- |
---|
[190bf0b] | 3698 | if (R==0) { |
---|
[4173c7] | 3699 | transformiert = T1_Transform(fneu,number(deltais[j]),M div e); |
---|
[81fb58d] | 3700 | if (defined(HNDebugOn)) { |
---|
[bb17e8] | 3701 | "a("+string(zeile)+","+string(Q)+") =",deltais[j]; |
---|
| 3702 | "transformed polynomial: ",transformiert; |
---|
[dcb500] | 3703 | } |
---|
[190bf0b] | 3704 | if (subst(transformiert,y,0)==0) { |
---|
[dcb500] | 3705 | dbprint(printlevel-voice+3,"finite HNE found"); |
---|
[190bf0b] | 3706 | hnezaehler++; |
---|
[7fa60f] | 3707 | //-------- trage deltais[j],x ein in letzte Zeile, fertig: ------------- |
---|
[81fb58d] | 3708 | HNEakut=azeilen+list(poly(0)); // =HNEs[hnezaehler]; |
---|
| 3709 | hilfid=HNEakut[zeile+2]; hilfid[Q]=deltais[j]; hilfid[Q+1]=x; |
---|
| 3710 | HNEakut[zeile+2]=hilfid; |
---|
[a848f8] | 3711 | HNEakut[1][zeile+1]=Q; // aktualisiere Vektor mit den hqs |
---|
[81fb58d] | 3712 | HNEs[hnezaehler]=HNEakut; |
---|
[7fa60f] | 3713 | conj1[hneshift+hnezaehler]=conj2[j]; |
---|
[190bf0b] | 3714 | if (eis[j]>1) { |
---|
[82716e] | 3715 | transformiert=transformiert/y; |
---|
[7fa60f] | 3716 | if (subst(transformiert,y,0)==0){"THE TEST FOR SQUAREFREENESS WAS BAD!" |
---|
| 3717 | +"! The polynomial was NOT squarefree!!!";} |
---|
[82716e] | 3718 | else { |
---|
[7fa60f] | 3719 | //--- Spezialfall (###) eingetreten: Noch weitere Zweige vorhanden -- |
---|
[190bf0b] | 3720 | eis[j]=eis[j]-1; |
---|
[82716e] | 3721 | } |
---|
[190bf0b] | 3722 | } |
---|
| 3723 | } |
---|
| 3724 | } |
---|
| 3725 | else { |
---|
[7fa60f] | 3726 | //------------------------ Fall R <> 0: --------------------------------- |
---|
| 3727 | erg=T2_Transform(fneu,number(deltais[j]),M,N,referencepoly(Newton)); |
---|
[dcb500] | 3728 | transformiert=erg[1];delt=erg[2]; |
---|
| 3729 | if (defined(HNDebugOn)) {"transformed polynomial: ",transformiert;} |
---|
[190bf0b] | 3730 | if (subst(transformiert,y,0)==0) { |
---|
[dcb500] | 3731 | dbprint(printlevel-voice+3,"finite HNE found"); |
---|
[190bf0b] | 3732 | hnezaehler++; |
---|
[7fa60f] | 3733 | //---------------- trage endliche HNE in HNEs ein: --------------------- |
---|
[a848f8] | 3734 | HNEakut=azeilen; // dupliziere den gemeins. Anfang der HNE's |
---|
| 3735 | zl=2; // (kommt schliesslich nach HNEs[hnezaehler]) |
---|
[7fa60f] | 3736 | //---------------------------------------------------------------------- |
---|
| 3737 | // Werte von: zeile: aktuelle Zeilennummer der HNE (gemeinsamer Teil) |
---|
| 3738 | // zl : die HNE spaltet auf; zeile+zl ist der Index fuer die |
---|
[3c4dcc] | 3739 | // Zeile des aktuellen Zweigs; (zeile+zl-2) ist die |
---|
| 3740 | // tatsaechl. Zeilennr. (bei 0 angefangen) der HNE |
---|
[7fa60f] | 3741 | // ([1] <- intvec(hqs), [2] <- 0. Zeile usw.) |
---|
| 3742 | //---------------------------------------------------------------------- |
---|
| 3743 | |
---|
| 3744 | //----- vollziehe Euklid.Alg. nach, um die HN-Matrix zu berechnen: ----- |
---|
[4173c7] | 3745 | M1=M;N1=N;R1=R;Q1=M1 div N1; |
---|
[190bf0b] | 3746 | while (R1!=0) { |
---|
[dcb500] | 3747 | if (defined(HNDebugOn)) { "h("+string(zeile+zl-2)+") =",Q1; } |
---|
[a848f8] | 3748 | HNEakut[1][zeile+zl-1]=Q1; |
---|
| 3749 | HNEakut[zeile+zl][Q1+1]=x; |
---|
[190bf0b] | 3750 | // markiere das Zeilenende der HNE |
---|
| 3751 | zl=zl+1; |
---|
[7fa60f] | 3752 | //----- Bereitstellung von Speicherplatz fuer eine neue Zeile: -------- |
---|
[81fb58d] | 3753 | HNEakut[zeile+zl]=ideal(0); |
---|
[82716e] | 3754 | |
---|
[4173c7] | 3755 | M1=N1; N1=R1; R1=M1%N1; Q1=M1 div N1; |
---|
[190bf0b] | 3756 | } |
---|
[81fb58d] | 3757 | if (defined(HNDebugOn)) { |
---|
[dcb500] | 3758 | "a("+string(zeile+zl-2)+","+string(Q1)+") =",delt; |
---|
| 3759 | } |
---|
| 3760 | HNEakut[zeile+zl][Q1] =delt; |
---|
[a848f8] | 3761 | HNEakut[zeile+zl][Q1+1]=x; |
---|
| 3762 | HNEakut[1][zeile+zl-1] =Q1; // aktualisiere Vektor mit hqs |
---|
[81fb58d] | 3763 | HNEakut[zeile+zl+1]=poly(0); |
---|
| 3764 | HNEs[hnezaehler]=HNEakut; |
---|
[7fa60f] | 3765 | conj1[hneshift+hnezaehler]=conj2[j]; |
---|
| 3766 | |
---|
| 3767 | //-------------------- Ende der Eintragungen in HNEs ------------------- |
---|
[190bf0b] | 3768 | |
---|
| 3769 | if (eis[j]>1) { |
---|
| 3770 | transformiert=transformiert/y; |
---|
[7fa60f] | 3771 | if (subst(transformiert,y,0)==0){"THE TEST FOR SQUAREFREENESS WAS BAD!" |
---|
| 3772 | +" The polynomial was NOT squarefree!!!";} |
---|
[190bf0b] | 3773 | else { |
---|
[7fa60f] | 3774 | //--- Spezialfall (###) eingetreten: Noch weitere Zweige vorhanden -- |
---|
[190bf0b] | 3775 | eis[j]=eis[j]-1; |
---|
| 3776 | }} |
---|
| 3777 | } // endif (subst()==0) |
---|
| 3778 | } // endelse (R<>0) |
---|
| 3779 | |
---|
[7fa60f] | 3780 | //========== Falls HNE nicht abbricht: Rekursiver Aufruf von HN: ========== |
---|
| 3781 | //------------------- Berechne HNE von transformiert ---------------------- |
---|
[190bf0b] | 3782 | if (subst(transformiert,y,0)!=0) { |
---|
| 3783 | lastRingnumber=EXTHNEnumber; |
---|
[7fa60f] | 3784 | |
---|
| 3785 | if (EXTHNEnumber>0){ EXTHNEring = EXTHNEring(1..EXTHNEnumber); } |
---|
[3c4dcc] | 3786 | HNE_RingDATA = list( HNEring, HNE_noparam, EXTHNEnumber, EXTHNEring, |
---|
| 3787 | lastRingnumber); |
---|
[7fa60f] | 3788 | if (defined(HNerg)) {kill HNerg;} |
---|
| 3789 | list HNerg=HN(HNE_RingDATA,transformiert,eis[j],Aufruf_Ebene+1, |
---|
[3c4dcc] | 3790 | essential,getauscht,hne_conj,conj2[j]); |
---|
[7fa60f] | 3791 | HNE_RingDATA = HNerg[1]; |
---|
| 3792 | if (conj1==0) { conj1=HNerg[5]; } |
---|
| 3793 | else { conj1 = conj1,HNerg[5]; } |
---|
| 3794 | |
---|
| 3795 | if (HNerg[3]==1) { field_ext=1; } |
---|
| 3796 | if (HNerg[2]==lastRingnumber) { // kein Ringwechsel in HN aufgetreten |
---|
| 3797 | if (not(defined(aneu))) { list aneu; } |
---|
| 3798 | aneu = HNerg[4]; |
---|
| 3799 | } |
---|
| 3800 | else { // Ringwechsel aufgetreten |
---|
[81fb58d] | 3801 | if (defined(HNDebugOn)) |
---|
[dcb500] | 3802 | {" ring change in HN(",Aufruf_Ebene+1,") detected";} |
---|
[7fa60f] | 3803 | EXTHNEnumber = HNerg[1][3]; |
---|
[ce8fc7] | 3804 | for (ii=lastRingnumber+1; ii<=EXTHNEnumber; ii++) { |
---|
| 3805 | def EXTHNEring(ii)=HNerg[1][4][ii]; |
---|
[3c4dcc] | 3806 | } |
---|
[7fa60f] | 3807 | if (HNerg[2]==0) { setring HNEring; } |
---|
| 3808 | else { setring EXTHNEring(HNerg[2]); } |
---|
| 3809 | def tempRing=HNerg[4]; |
---|
| 3810 | def aneu=imap(tempRing,HNEs); |
---|
| 3811 | kill tempRing; |
---|
| 3812 | |
---|
[3c4dcc] | 3813 | //--- stelle lokale Variablen im neuen Ring wieder her, und rette |
---|
[7fa60f] | 3814 | // gegebenenfalls ihren Inhalt: ---- |
---|
| 3815 | list erg,faktoren,HNEakut; |
---|
[3c4dcc] | 3816 | ideal hilfid; |
---|
[7fa60f] | 3817 | erg=ideal(0); faktoren=erg; HNEakut=erg; |
---|
[190bf0b] | 3818 | poly leitf,teiler,transformiert; |
---|
| 3819 | map hole=HNE_noparam,transfproc,x,y; |
---|
| 3820 | setring HNE_noparam; |
---|
| 3821 | if (lastRingnumber>0) { def letztring=EXTHNEring(lastRingnumber); } |
---|
| 3822 | else { def letztring=HNEring; } |
---|
[2761f3] | 3823 | if (not defined(HNEs)) {list HNEs;} |
---|
[190bf0b] | 3824 | HNEs=imap(letztring,HNEs); |
---|
[7fa60f] | 3825 | if (not defined(azeilen)) {list azeilen;} |
---|
[190bf0b] | 3826 | azeilen=imap(letztring,azeilen); |
---|
[7fa60f] | 3827 | if (not defined(deltais)) {ideal deltais;} |
---|
[190bf0b] | 3828 | deltais=imap(letztring,deltais); |
---|
[7fa60f] | 3829 | if (not defined(delt)) {poly delt;} |
---|
[dcb500] | 3830 | delt=imap(letztring,delt); |
---|
[7fa60f] | 3831 | if (not defined(fneu)) {poly fneu;} |
---|
| 3832 | fneu=imap(letztring,fneu); |
---|
| 3833 | if (not defined(f)) {poly f;} |
---|
[190bf0b] | 3834 | f=imap(letztring,f); |
---|
[7fa60f] | 3835 | if (not defined(hne)) {list hne;} |
---|
| 3836 | hne=imap(letztring,hne); |
---|
[190bf0b] | 3837 | |
---|
| 3838 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3839 | list HNEs=hole(HNEs); |
---|
| 3840 | list azeilen=hole(azeilen); |
---|
| 3841 | ideal deltais=hole(deltais); |
---|
[dcb500] | 3842 | number delt=number(hole(delt)); |
---|
[7fa60f] | 3843 | poly fneu=hole(fneu); |
---|
| 3844 | if (not(defined(f))) |
---|
[3c4dcc] | 3845 | { |
---|
[7fa60f] | 3846 | poly f=hole(f); |
---|
| 3847 | list hne=hole(hne); |
---|
| 3848 | export f,hne; |
---|
| 3849 | } |
---|
[190bf0b] | 3850 | } |
---|
| 3851 | |
---|
[7fa60f] | 3852 | //========== Verknuepfe bisherige HNE mit von HN gelieferten HNEs: ====== |
---|
[190bf0b] | 3853 | if (R==0) { |
---|
| 3854 | HNEs,hnezaehler=constructHNEs(HNEs,hnezaehler,aneu,azeilen,zeile, |
---|
| 3855 | deltais,Q,j); |
---|
[3c4dcc] | 3856 | kill aneu; |
---|
[190bf0b] | 3857 | } |
---|
| 3858 | else { |
---|
| 3859 | for (zaehler=1; zaehler<=size(aneu); zaehler++) { |
---|
| 3860 | hnezaehler++; |
---|
[a848f8] | 3861 | HNEakut=azeilen; // dupliziere den gemeinsamen Anfang der HNE's |
---|
| 3862 | zl=2; // (kommt schliesslich nach HNEs[hnezaehler]) |
---|
[7fa60f] | 3863 | //------------ Trage Beitrag dieser Transformation T2 ein: ------------- |
---|
| 3864 | //------ Zur Bedeutung von zeile, zl: siehe Kommentar weiter oben ------ |
---|
[190bf0b] | 3865 | |
---|
[7fa60f] | 3866 | //----- vollziehe Euklid.Alg. nach, um die HN-Matrix zu berechnen: ----- |
---|
[4173c7] | 3867 | M1=M;N1=N;R1=R;Q1=M1 div N1; |
---|
[190bf0b] | 3868 | while (R1!=0) { |
---|
[dcb500] | 3869 | if (defined(HNDebugOn)) { "h("+string(zeile+zl-2)+") =",Q1; } |
---|
[a848f8] | 3870 | HNEakut[1][zeile+zl-1]=Q1; |
---|
| 3871 | HNEakut[zeile+zl][Q1+1]=x; // Markierung des Zeilenendes der HNE |
---|
[190bf0b] | 3872 | zl=zl+1; |
---|
[7fa60f] | 3873 | //----- Bereitstellung von Speicherplatz fuer eine neue Zeile: -------- |
---|
[81fb58d] | 3874 | HNEakut[zeile+zl]=ideal(0); |
---|
[4173c7] | 3875 | M1=N1; N1=R1; R1=M1%N1; Q1=M1 div N1; |
---|
[190bf0b] | 3876 | } |
---|
[81fb58d] | 3877 | if (defined(HNDebugOn)) { |
---|
[dcb500] | 3878 | "a("+string(zeile+zl-2)+","+string(Q1)+") =",delt; |
---|
| 3879 | } |
---|
| 3880 | HNEakut[zeile+zl][Q1]=delt; |
---|
[190bf0b] | 3881 | |
---|
[7fa60f] | 3882 | //-- Daten aus T2_Transform sind eingetragen; haenge Daten von HN an: -- |
---|
[81fb58d] | 3883 | hilfid=HNEakut[zeile+zl]; |
---|
[190bf0b] | 3884 | for (zl1=Q1+1; zl1<=ncols(aneu[zaehler][2]); zl1++) { |
---|
| 3885 | hilfid[zl1]=aneu[zaehler][2][zl1]; |
---|
| 3886 | } |
---|
[81fb58d] | 3887 | HNEakut[zeile+zl]=hilfid; |
---|
[3c4dcc] | 3888 | // ------ vorher HNEs[.][zeile+zl]<-aneu[.][2], |
---|
[7fa60f] | 3889 | // jetzt [zeile+zl+1] <- [3] usw.: -------- |
---|
[190bf0b] | 3890 | for (zl1=3; zl1<=size(aneu[zaehler]); zl1++) { |
---|
[81fb58d] | 3891 | HNEakut[zeile+zl+zl1-2]=aneu[zaehler][zl1]; |
---|
[190bf0b] | 3892 | } |
---|
[7fa60f] | 3893 | //--- setze hqs zusammen: HNEs[hnezaehler][1]=HNEs[..][1],aneu[..][1] -- |
---|
[81fb58d] | 3894 | hilfvec=HNEakut[1],aneu[zaehler][1]; |
---|
| 3895 | HNEakut[1]=hilfvec; |
---|
[7fa60f] | 3896 | //-------- weil nicht geht: liste[1]=liste[1],aneu[zaehler][1] --------- |
---|
[81fb58d] | 3897 | HNEs[hnezaehler]=HNEakut; |
---|
[190bf0b] | 3898 | } // end(for zaehler) |
---|
[7fa60f] | 3899 | kill aneu; |
---|
[190bf0b] | 3900 | } // endelse (R<>0) |
---|
| 3901 | } // endif (subst()!=0) (weiteres Aufblasen mit HN) |
---|
| 3902 | |
---|
| 3903 | } // end(for j) (Behandlung der einzelnen delta_i) |
---|
| 3904 | |
---|
[7fa60f] | 3905 | |
---|
| 3906 | // ------------------------- new for essdevelop ---------------------------- |
---|
| 3907 | if ((essential==1) and (defined(SaveRing))) { |
---|
| 3908 | // ----- uebertrage Daten in gemeinsame Koerpererweiterung --------------- |
---|
| 3909 | if (EXTHNEnumber>number_of_letztring) { |
---|
| 3910 | // ----- fuer aktuelle Kante war Koerpererweiterung erforderlich ------- |
---|
| 3911 | EXTHNEnumber++; |
---|
[393c47] | 3912 | string @miniPol_EXTHNEring(EXTHNEnumber-1) = string(minpoly); |
---|
[7fa60f] | 3913 | setring SaveRing; |
---|
[393c47] | 3914 | string @miniPol_SaveRing = string(minpoly); |
---|
[7fa60f] | 3915 | setring HNE_noparam; |
---|
| 3916 | if (not(defined(a_x))){ map a_x,a_y; poly mp_save, mp_new; } |
---|
[393c47] | 3917 | execute("mp_save= " + @miniPol_SaveRing + ";"); |
---|
| 3918 | execute("mp_new = " + @miniPol_EXTHNEring(EXTHNEnumber-1) + ";" );; |
---|
[7fa60f] | 3919 | if (mp_save==mp_new) { // Sonderfall: wieder gleicher Ring |
---|
| 3920 | def EXTHNEring(EXTHNEnumber)=SaveRing; |
---|
| 3921 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3922 | if (not(defined(f))) {poly f; f=hole(f); export f;} |
---|
| 3923 | list dummyL=imap(EXTHNEring(EXTHNEnumber-1),HNEs); |
---|
| 3924 | if (not(defined(HNEs))) { def HNEs=list(); } |
---|
[2761f3] | 3925 | if ((size(HNEs)==1) and (typeof(HNEs[1])=="ideal")) {HNEs=list();} |
---|
[7fa60f] | 3926 | HNEs[size(HNEs)+1..size(HNEs)+size(dummyL)]=dummyL[1..size(dummyL)]; |
---|
| 3927 | kill dummyL,SaveRing; |
---|
[3c4dcc] | 3928 | } |
---|
[7fa60f] | 3929 | else { // verschiedene Ringe |
---|
| 3930 | a_x=HNE_noparam,x,0,0; |
---|
| 3931 | a_y=HNE_noparam,y,0,0; |
---|
| 3932 | mp_save=a_x(mp_save); // minpoly aus SaveRing mit a --> x |
---|
| 3933 | mp_new=a_y(mp_new); // minpoly aus SaveRing mit a --> y |
---|
| 3934 | setring SaveRing; |
---|
| 3935 | poly mp_new=imap(HNE_noparam,mp_new); |
---|
| 3936 | list Lfac=factorize(mp_new,1); |
---|
| 3937 | poly fac=Lfac[1][1]; |
---|
| 3938 | for (k=2;k<=size(Lfac[1]);k++) { |
---|
[3c4dcc] | 3939 | if (deg(Lfac[1][k])<deg(fac)) { fac=Lfac[1][k]; } |
---|
[7fa60f] | 3940 | } |
---|
| 3941 | |
---|
| 3942 | if (deg(fac)==1) { // keine Erweiterung noetig |
---|
| 3943 | def EXTHNEring(EXTHNEnumber)=SaveRing; |
---|
| 3944 | setring HNE_noparam; |
---|
| 3945 | HNEs=imap(EXTHNEring(EXTHNEnumber-1),HNEs); |
---|
| 3946 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3947 | if (not(defined(f))) {poly f; f=hole(f); export f;} |
---|
| 3948 | map phi=HNE_noparam,-subst(fac,y,0)/koeff(fac,0,1),x,y; |
---|
| 3949 | list dummyL=phi(HNEs); |
---|
| 3950 | if (not(defined(HNEs))) { def HNEs=list(); } |
---|
| 3951 | if ((size(HNEs)==1) and (typeof(HNEs[1])=="ideal")) {HNEs=list();} |
---|
| 3952 | HNEs[size(HNEs)+1..size(HNEs)+size(dummyL)]=dummyL[1..size(dummyL)]; |
---|
| 3953 | kill dummyL,phi,SaveRing; |
---|
| 3954 | } |
---|
| 3955 | else { // Koerpererweiterung noetig |
---|
| 3956 | def EXTHNEring(EXTHNEnumber) = splitring(fac,list(a,transfproc)); |
---|
| 3957 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3958 | poly transf=erg[1]; // image of parameter from SaveRing |
---|
| 3959 | poly transfproc=erg[2]; |
---|
| 3960 | poly transb=erg[3]; // image of parameter from EXTHNEring(..) |
---|
| 3961 | export transfproc; |
---|
| 3962 | kill erg; |
---|
| 3963 | setring HNE_noparam; |
---|
[3c4dcc] | 3964 | if (not(defined(HNEs1))) { list HNEs1=ideal(0); } |
---|
[7fa60f] | 3965 | HNEs1=imap(EXTHNEring(EXTHNEnumber-1),HNEs); |
---|
[3c4dcc] | 3966 | if (not(defined(hne))) { list hne=ideal(0); } |
---|
[7fa60f] | 3967 | hne=imap(SaveRing,hne); |
---|
| 3968 | HNEs=imap(SaveRing,HNEs); |
---|
| 3969 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3970 | map hole=HNE_noparam,transf,x,y; |
---|
| 3971 | poly fneu=hole(fneu); |
---|
[3c4dcc] | 3972 | poly f=hole(f); |
---|
[7fa60f] | 3973 | map phi=HNE_noparam,transb,x,y; |
---|
| 3974 | list HNEs=hole(HNEs); |
---|
| 3975 | list hne=hole(hne); |
---|
| 3976 | export f,hne; |
---|
| 3977 | if ((size(HNEs)==1) and (typeof(HNEs[1])=="ideal")) {HNEs=list();} |
---|
| 3978 | list dummyL=phi(HNEs1); |
---|
| 3979 | HNEs[size(HNEs)+1..size(HNEs)+size(dummyL)]=dummyL[1..size(dummyL)]; |
---|
| 3980 | kill dummyL,phi,SaveRing; |
---|
| 3981 | } |
---|
| 3982 | } |
---|
| 3983 | } |
---|
| 3984 | else { // nur bei letzter Kante muss was getan werden |
---|
[3c4dcc] | 3985 | if (i==size(Newton)-1) { |
---|
[7fa60f] | 3986 | EXTHNEnumber++; |
---|
| 3987 | if (number_of_letztring==0) { def letztring=HNEring; } |
---|
| 3988 | else { def letztring=EXTHNEring(EXTHNEnumber); } |
---|
[3c4dcc] | 3989 | if (minpoly==0) { |
---|
[7fa60f] | 3990 | def EXTHNEring(EXTHNEnumber)=SaveRing; |
---|
| 3991 | setring EXTHNEring(EXTHNEnumber); |
---|
| 3992 | if (not(defined(f))) {poly f; f=hole(f); export f;} |
---|
| 3993 | if ((size(HNEs)==1) and (typeof(HNEs[1])=="ideal")) {HNEs=list();} |
---|
| 3994 | list dummyL=imap(letztring,HNEs); |
---|
| 3995 | HNEs[size(HNEs)+1..size(HNEs)+size(dummyL)]=dummyL[1..size(dummyL)]; |
---|
| 3996 | kill dummyL,letztring,SaveRing; |
---|
| 3997 | } |
---|
| 3998 | else { // muessen Daten nach SaveRing uebertragen; |
---|
| 3999 | setring HNE_noparam; |
---|
[3c4dcc] | 4000 | if (not(defined(HNEs))) { list HNEs; } |
---|
[7fa60f] | 4001 | HNEs=imap(letztring,HNEs); |
---|
| 4002 | def EXTHNEring(EXTHNEnumber)=SaveRing; |
---|
| 4003 | setring EXTHNEring(EXTHNEnumber); |
---|
| 4004 | if (not(defined(hole))) { map hole; } |
---|
| 4005 | hole=HNE_noparam,transfproc,x,y; |
---|
| 4006 | list dummyL=hole(HNEs); |
---|
| 4007 | if (not(defined(HNEs))) { def HNEs=list(); } |
---|
| 4008 | if ((size(HNEs)==1) and (typeof(HNEs[1])=="ideal")) {HNEs=list();} |
---|
| 4009 | HNEs[size(HNEs)+1..size(HNEs)+size(dummyL)]=dummyL[1..size(dummyL)]; |
---|
| 4010 | kill dummyL, letztring,SaveRing; |
---|
| 4011 | } |
---|
| 4012 | } |
---|
| 4013 | } |
---|
| 4014 | } |
---|
[3c4dcc] | 4015 | // -----------------end of new part (loop for essential=1) ---------------- |
---|
[7fa60f] | 4016 | } // end (Loop uber Kanten) |
---|
| 4017 | if (defined(SaveRing)) { kill SaveRing; } |
---|
| 4018 | } |
---|
| 4019 | else { |
---|
[3754ca] | 4020 | HNEs[1]=list(hqs)+azeilen+list(fneu); // fneu ist transform. Polynom oder Null |
---|
[7fa60f] | 4021 | conj1[1]=conj_factor; |
---|
[3c4dcc] | 4022 | } |
---|
[7fa60f] | 4023 | |
---|
| 4024 | if (Aufruf_Ebene == 1) |
---|
| 4025 | { |
---|
| 4026 | if ((number_of_letztring!=EXTHNEnumber) and (not(defined(hne)))) |
---|
[3c4dcc] | 4027 | { |
---|
[7fa60f] | 4028 | //----- falls Zweige in transz. Erw. berechnet werden konnten --------- |
---|
[3c4dcc] | 4029 | if (defined(transfproc)) |
---|
[7fa60f] | 4030 | { // --- Ringwechsel hat stattgefunden --- |
---|
| 4031 | if (defined(HNDebugOn)) {" ring change in HN(",1,") detected";} |
---|
| 4032 | if (not(defined(hole))) { map hole; } |
---|
| 4033 | hole=HNE_noparam,transfproc,x,y; |
---|
| 4034 | setring HNE_noparam; |
---|
| 4035 | f=imap(HNEring,f); |
---|
| 4036 | if (number_of_letztring==0) { def letztring=HNEring; } |
---|
| 4037 | else { def letztring=EXTHNEring(EXTHNEnumber); } |
---|
| 4038 | if (not(defined(hne))) { list hne; } |
---|
| 4039 | hne=imap(letztring,hne); |
---|
| 4040 | setring EXTHNEring(EXTHNEnumber); |
---|
| 4041 | if (not(defined(f))) { poly f=hole(f); export f; } |
---|
| 4042 | list hne=hole(hne); |
---|
| 4043 | export hne; |
---|
| 4044 | } |
---|
| 4045 | } |
---|
| 4046 | if (size(HNEs)>0) { |
---|
| 4047 | if ((size(HNEs)>1) or (typeof(HNEs[1])!="ideal") or (size(HNEs[1])>0)) { |
---|
| 4048 | if ((typeof(hne[1])=="ideal")) { hne=list(); } |
---|
| 4049 | hne=hne+extractHNEs(HNEs,getauscht); |
---|
| 4050 | if (hne_conj==0) { hne_conj=conj1; } |
---|
| 4051 | else { hne_conj = hne_conj, conj1; } |
---|
| 4052 | } |
---|
| 4053 | } |
---|
| 4054 | } |
---|
| 4055 | else |
---|
[3c4dcc] | 4056 | { // HN wurde rekursiv aufgerufen |
---|
[7fa60f] | 4057 | if (number_of_letztring!=EXTHNEnumber) |
---|
| 4058 | { // Ringwechsel hatte stattgefunden |
---|
| 4059 | string mipl_alt = string(minpoly); |
---|
| 4060 | execute("ring tempRing = ("+charstr(basering)+"),("+varstr(basering)+ |
---|
[3c4dcc] | 4061 | "),("+ordstr(basering)+");"); |
---|
[7fa60f] | 4062 | execute("minpoly="+ mipl_alt +";"); |
---|
| 4063 | list HNEs=imap(EXTHNEring(EXTHNEnumber),HNEs); |
---|
| 4064 | export HNEs; |
---|
[3c4dcc] | 4065 | if (defined(HNDebugOn)) {" ! tempRing defined ! ";} |
---|
| 4066 | } |
---|
[7fa60f] | 4067 | if (conj1!=0) { hne_conj=conj1; } |
---|
| 4068 | else { hne_conj=conj_factor; } |
---|
| 4069 | } |
---|
| 4070 | if (EXTHNEnumber>0){ EXTHNEring = EXTHNEring(1..EXTHNEnumber); } |
---|
| 4071 | HNE_RingDATA = list(HNEring, HNE_noparam, EXTHNEnumber, EXTHNEring); |
---|
| 4072 | if (number_of_letztring==EXTHNEnumber) { |
---|
| 4073 | return(list(HNE_RingDATA,EXTHNEnumber,field_ext,HNEs,hne_conj)); |
---|
[190bf0b] | 4074 | } |
---|
| 4075 | else { |
---|
[7fa60f] | 4076 | if (defined(tempRing)) { |
---|
| 4077 | return(list(HNE_RingDATA,EXTHNEnumber,field_ext,tempRing,hne_conj)); |
---|
| 4078 | } |
---|
| 4079 | return(list(HNE_RingDATA,EXTHNEnumber,field_ext,0,hne_conj)); |
---|
[190bf0b] | 4080 | } |
---|
| 4081 | } |
---|
[7fa60f] | 4082 | |
---|
[190bf0b] | 4083 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4084 | |
---|
[3c1c6a] | 4085 | static proc constructHNEs (list HNEs,int hnezaehler,list aneu,list azeilen, |
---|
[a848f8] | 4086 | int zeile,ideal deltais,int Q,int j) |
---|
[81fb58d] | 4087 | "NOTE: This procedure is only for internal use, it is called via HN" |
---|
[190bf0b] | 4088 | { |
---|
| 4089 | int zaehler,zl; |
---|
| 4090 | ideal hilfid; |
---|
| 4091 | list hilflist; |
---|
| 4092 | intvec hilfvec; |
---|
| 4093 | for (zaehler=1; zaehler<=size(aneu); zaehler++) { |
---|
| 4094 | hnezaehler++; |
---|
[a848f8] | 4095 | // HNEs[hnezaehler]=azeilen; // dupliziere gemeins. Anfang |
---|
[190bf0b] | 4096 | //----------------------- trage neu berechnete Daten ein --------------------- |
---|
[a848f8] | 4097 | hilfid=azeilen[zeile+2]; |
---|
[190bf0b] | 4098 | hilfid[Q]=deltais[j]; |
---|
| 4099 | for (zl=Q+1; zl<=ncols(aneu[zaehler][2]); zl++) { |
---|
| 4100 | hilfid[zl]=aneu[zaehler][2][zl]; |
---|
| 4101 | } |
---|
[a848f8] | 4102 | hilflist=azeilen; hilflist[zeile+2]=hilfid; |
---|
[190bf0b] | 4103 | //------------------ haenge uebrige Zeilen von aneu[] an: -------------------- |
---|
| 4104 | for (zl=3; zl<=size(aneu[zaehler]); zl++) { |
---|
| 4105 | hilflist[zeile+zl]=aneu[zaehler][zl]; |
---|
| 4106 | } |
---|
| 4107 | //--- setze die hqs zusammen: HNEs[hnezaehler][1]=HNEs[..][1],aneu[..][1] ---- |
---|
| 4108 | if (hilflist[1]==0) { hilflist[1]=aneu[zaehler][1]; } |
---|
[a848f8] | 4109 | else { hilfvec=hilflist[1],aneu[zaehler][1]; hilflist[1]=hilfvec; } |
---|
[190bf0b] | 4110 | HNEs[hnezaehler]=hilflist; |
---|
| 4111 | } |
---|
| 4112 | return(HNEs,hnezaehler); |
---|
| 4113 | } |
---|
| 4114 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4115 | |
---|
[81fb58d] | 4116 | proc referencepoly (list newton) |
---|
| 4117 | "USAGE: referencepoly(newton); |
---|
| 4118 | newton is list of intvec(x,y) which represents points in the Newton |
---|
| 4119 | diagram (e.g. output of the proc newtonpoly) |
---|
| 4120 | RETURN: a polynomial which has newton as Newton diagram |
---|
[a848f8] | 4121 | SEE ALSO: newtonpoly |
---|
[81fb58d] | 4122 | EXAMPLE: example referencepoly; shows an example |
---|
| 4123 | " |
---|
| 4124 | { |
---|
| 4125 | poly f; |
---|
| 4126 | for (int i=1; i<=size(newton); i++) { |
---|
| 4127 | f=f+var(1)^newton[i][1]*var(2)^newton[i][2]; |
---|
| 4128 | } |
---|
| 4129 | return(f); |
---|
| 4130 | } |
---|
| 4131 | example |
---|
| 4132 | { "EXAMPLE:"; echo = 2; |
---|
| 4133 | ring exring=0,(x,y),ds; |
---|
| 4134 | referencepoly(list(intvec(0,4),intvec(2,3),intvec(5,1),intvec(7,0))); |
---|
| 4135 | } |
---|
| 4136 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4137 | |
---|
[7fa60f] | 4138 | proc factorlist (list L, list #) |
---|
[81fb58d] | 4139 | "USAGE: factorlist(L); L a list in the format of `factorize' |
---|
| 4140 | RETURN: the nonconstant irreducible factors of |
---|
| 4141 | L[1][1]^L[2][1] * L[1][2]^L[2][2] *...* L[1][size(L[1])]^... |
---|
| 4142 | with multiplicities (same format as factorize) |
---|
[a848f8] | 4143 | SEE ALSO: factorize |
---|
[81fb58d] | 4144 | EXAMPLE: example factorlist; shows an example |
---|
| 4145 | " |
---|
| 4146 | { |
---|
[7fa60f] | 4147 | int k; |
---|
[3c4dcc] | 4148 | if ((size(#)>=1) and ((typeof(#[1])=="intvec") or (typeof(#[1])=="int"))) { |
---|
| 4149 | int with_conj = 1; intvec C = #[1]; |
---|
| 4150 | } |
---|
| 4151 | else { |
---|
| 4152 | int with_conj = 0; intvec C = L[2]; |
---|
[7fa60f] | 4153 | } |
---|
[81fb58d] | 4154 | // eine Sortierung der Faktoren eruebrigt sich, weil keine zwei versch. |
---|
| 4155 | // red.Fakt. einen gleichen irred. Fakt. haben koennen (I.3.27 Diplarb.) |
---|
| 4156 | int i,gross; |
---|
| 4157 | list faktoren,hilf; |
---|
[7fa60f] | 4158 | intvec conjugates; |
---|
[81fb58d] | 4159 | ideal hil1,hil2; |
---|
[7fa60f] | 4160 | intvec v,w,hilf_conj; |
---|
[81fb58d] | 4161 | for (i=1; (L[1][i] == jet(L[1][i],0)) && (i<size(L[1])); i++) {;} |
---|
| 4162 | if (L[1][i] != jet(L[1][i],0)) { |
---|
| 4163 | hilf=factorize(L[1][i]); |
---|
| 4164 | // Achtung!!! factorize(..,2) wirft entgegen der Beschreibung nicht nur |
---|
| 4165 | // konstante Faktoren raus, sondern alle Einheiten in der LOKALISIERUNG nach |
---|
| 4166 | // der Monomordnung!!! Im Beispiel unten verschwindet der Faktor x+y+1, wenn |
---|
| 4167 | // man ds statt dp als Ordnung nimmt! |
---|
[7fa60f] | 4168 | hilf_conj=C[i]; |
---|
| 4169 | for (k=2;k<=size(hilf[2]);k++){ hilf_conj=hilf_conj,C[i]; } |
---|
[81fb58d] | 4170 | hilf[2]=hilf[2]*L[2][i]; |
---|
| 4171 | hil1=hilf[1]; |
---|
| 4172 | gross=size(hil1); |
---|
| 4173 | if (gross>1) { |
---|
| 4174 | v=hilf[2]; |
---|
| 4175 | faktoren=list(ideal(hil1[2..gross]),intvec(v[2..gross])); |
---|
[7fa60f] | 4176 | conjugates=intvec(hilf_conj[2..gross]); |
---|
[81fb58d] | 4177 | } |
---|
[7fa60f] | 4178 | else { faktoren=hilf; conjugates=hilf_conj; } |
---|
[81fb58d] | 4179 | } |
---|
| 4180 | else { |
---|
| 4181 | faktoren=L; |
---|
[7fa60f] | 4182 | conjugates=C; |
---|
[81fb58d] | 4183 | } |
---|
| 4184 | |
---|
| 4185 | for (i++; i<=size(L[2]); i++) { |
---|
| 4186 | //------------------------- linearer Term -- irreduzibel --------------------- |
---|
| 4187 | if (L[1][i] == jet(L[1][i],1)) { |
---|
| 4188 | if (L[1][i] != jet(L[1][i],0)) { // konst. Faktoren eliminieren |
---|
| 4189 | hil1=faktoren[1]; |
---|
| 4190 | hil1[size(hil1)+1]=L[1][i]; |
---|
| 4191 | faktoren[1]=hil1; |
---|
| 4192 | v=faktoren[2],L[2][i]; |
---|
[7fa60f] | 4193 | conjugates=conjugates,C[i]; |
---|
[81fb58d] | 4194 | faktoren[2]=v; |
---|
| 4195 | } |
---|
| 4196 | } |
---|
| 4197 | //----------------------- nichtlinearer Term -- faktorisiere ----------------- |
---|
| 4198 | else { |
---|
| 4199 | hilf=factorize(L[1][i]); |
---|
[7fa60f] | 4200 | hilf_conj=C[i]; |
---|
| 4201 | for (k=2;k<=size(hilf[2]);k++){ hilf_conj=hilf_conj,C[i]; } |
---|
[81fb58d] | 4202 | hilf[2]=hilf[2]*L[2][i]; |
---|
| 4203 | hil1=faktoren[1]; |
---|
| 4204 | hil2=hilf[1]; |
---|
| 4205 | gross=size(hil2); |
---|
| 4206 | // hil2[1] ist konstant, wird weggelassen: |
---|
| 4207 | hil1[(size(hil1)+1)..(size(hil1)+gross-1)]=hil2[2..gross]; |
---|
| 4208 | // ideal+ideal does not work due to simplification; |
---|
| 4209 | // ideal,ideal not allowed |
---|
| 4210 | faktoren[1]=hil1; |
---|
| 4211 | w=hilf[2]; |
---|
| 4212 | v=faktoren[2],w[2..gross]; |
---|
[7fa60f] | 4213 | conjugates=conjugates,hilf_conj[2..gross]; |
---|
[81fb58d] | 4214 | faktoren[2]=v; |
---|
| 4215 | } |
---|
| 4216 | } |
---|
[7fa60f] | 4217 | if (with_conj==0) { return(faktoren); } |
---|
| 4218 | else { return(list(faktoren,conjugates)); } // for essential development |
---|
[81fb58d] | 4219 | } |
---|
| 4220 | example |
---|
| 4221 | { "EXAMPLE:"; echo = 2; |
---|
| 4222 | ring exring=0,(x,y),ds; |
---|
[7fa60f] | 4223 | list L=list(ideal(x,(x-y)^2*(x+y+1),x+y),intvec(2,2,1)); |
---|
[81fb58d] | 4224 | L; |
---|
| 4225 | factorlist(L); |
---|
| 4226 | } |
---|
[dcb500] | 4227 | |
---|
| 4228 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 4229 | |
---|
| 4230 | proc delta |
---|
[2761f3] | 4231 | "USAGE: delta(INPUT); INPUT a polynomial defining an isolated plane curve |
---|
[dcb500] | 4232 | singularity at 0, or the Hamburger-Noether expansion thereof, i.e. |
---|
[2761f3] | 4233 | the output of @code{develop(f)}, or the output of @code{hnexpansion(f)}, |
---|
| 4234 | or the list of HN data computed by @code{hnexpansion(f)}. |
---|
| 4235 | RETURN: int, the delta invariant of the singularity at 0, that is, the vector |
---|
[3c4dcc] | 4236 | space dimension of R~/R, (R~ the normalization of the local ring of |
---|
[fd5013] | 4237 | the singularity). |
---|
[dcb500] | 4238 | NOTE: In case the Hamburger-Noether expansion of the curve f is needed |
---|
| 4239 | for other purposes as well it is better to calculate this first |
---|
| 4240 | with the aid of @code{hnexpansion} and use it as input instead of |
---|
| 4241 | the polynomial itself. |
---|
[dd8844] | 4242 | SEE ALSO: deltaLoc, invariants |
---|
| 4243 | KEYWORDS: delta invariant |
---|
[dcb500] | 4244 | EXAMPLE: example delta; shows an example |
---|
| 4245 | " |
---|
| 4246 | { |
---|
[2761f3] | 4247 | if (typeof(#[1])=="poly") { // INPUT = polynomial defining the singularity |
---|
| 4248 | list L=hnexpansion(#[1]); |
---|
| 4249 | if (typeof(L[1])=="ring") { |
---|
| 4250 | def altring = basering; |
---|
| 4251 | def HNring = L[1]; setring HNring; |
---|
| 4252 | return(delta(hne)); |
---|
| 4253 | } |
---|
| 4254 | else { |
---|
| 4255 | return(delta(L)); |
---|
[3c4dcc] | 4256 | } |
---|
[dcb500] | 4257 | } |
---|
[2761f3] | 4258 | if (typeof(#[1])=="ring") { // INPUT = HNEring of curve |
---|
| 4259 | def HNring = #[1]; setring HNring; |
---|
| 4260 | return(delta(hne)); |
---|
[dcb500] | 4261 | } |
---|
[3c4dcc] | 4262 | if (typeof(#[1])=="matrix") |
---|
| 4263 | { // INPUT = hne of an irreducible curve |
---|
[4173c7] | 4264 | return(invariants(#)[5] div 2); |
---|
[dcb500] | 4265 | } |
---|
[3c4dcc] | 4266 | else |
---|
[dcb500] | 4267 | { // INPUT = hne of a reducible curve |
---|
| 4268 | list INV=invariants(#); |
---|
| 4269 | return(INV[size(INV)][3]); |
---|
| 4270 | } |
---|
| 4271 | } |
---|
| 4272 | example |
---|
| 4273 | { "EXAMPLE:"; echo = 2; |
---|
| 4274 | ring r = 32003,(x,y),ds; |
---|
| 4275 | poly f = x25+x24-4x23-1x22y+4x22+8x21y-2x21-12x20y-4x19y2+4x20+10x19y |
---|
| 4276 | +12x18y2-24x18y-20x17y2-4x16y3+x18+60x16y2+20x15y3-9x16y |
---|
| 4277 | -80x14y3-10x13y4+36x14y2+60x12y4+2x11y5-84x12y3-24x10y5 |
---|
| 4278 | +126x10y4+4x8y6-126x8y5+84x6y6-36x4y7+9x2y8-1y9; |
---|
| 4279 | delta(f); |
---|
| 4280 | } |
---|
| 4281 | |
---|
| 4282 | /////////////////////////////////////////////////////////////////////////////// |
---|