Changeset 0132b0 in git
- Timestamp:
- Apr 23, 1998, 3:23:27 PM (25 years ago)
- Branches:
- (u'jengelh-datetime', 'ceac47cbc86fe4a15902392bdbb9bd2ae0ea02c6')(u'spielwiese', 'a800fe4b3e9d37a38c5a10cc0ae9dfa0c15a4ee6')
- Children:
- e36ae54f25a40adf73b0e8d8180c361742db9def
- Parents:
- e35965573370ae0d1c2c96e458eb1e3bde28c946
- Location:
- Singular/LIB
- Files:
-
- 2 edited
-
hnoether.lib (modified) (28 diffs)
-
primitiv.lib (modified) (11 diffs)
Legend:
- Unmodified
- Added
- Removed
-
Singular/LIB/hnoether.lib
re35965 r0132b0 1 // $Id: hnoether.lib,v 1. 4 1998-04-03 22:47:05 kruegerExp $1 // $Id: hnoether.lib,v 1.5 1998-04-23 13:23:23 obachman Exp $ 2 2 // author: Martin Lamm, email: lamm@mathematik.uni-kl.de 3 // last change: 13.03.984 /////////////////////////////////////////////////////////////////////////////// 5 6 version="$Id: hnoether.lib,v 1. 4 1998-04-03 22:47:05 kruegerExp $";3 // last change: 26.03.98 4 /////////////////////////////////////////////////////////////////////////////// 5 6 version="$Id: hnoether.lib,v 1.5 1998-04-23 13:23:23 obachman Exp $"; 7 7 info=" 8 8 LIBRARY: hnoether.lib PROCEDURES FOR THE HAMBURGER-NOETHER-DEVELOPMENT … … 49 49 "; 50 50 51 /////////////////////////////////////////////////////////////////////////////// 51 52 LIB "primitiv.lib"; 52 53 /////////////////////////////////////////////////////////////////////////////// … … 87 88 } 88 89 /////////////////////////////////////////////////////////////////////////////// 89 proc T_Transform (poly f, int Q, int N) 90 proc T_Transform (poly f, int Q, int N) 90 91 // returns f(y,xy^Q)/y^NQ 91 92 { … … 94 95 } 95 96 /////////////////////////////////////////////////////////////////////////////// 96 proc T1_Transform (poly f, number d, int M) 97 proc T1_Transform (poly f, number d, int M) 97 98 // returns f(x,y+d*x^M) 98 99 { … … 109 110 int ggt=gcd(M,N); 110 111 M=M/ggt; N=N/ggt; 111 list ts=extgcd(M,N); 112 list ts=extgcd(M,N); 112 113 int tau,sigma=ts[2],-ts[3]; 113 114 if (sigma<0) { tau=-tau; sigma=-sigma;} … … 137 138 poly hilf; 138 139 // dividiere f so lange durch x, wie die Div. aufgeht: 139 for (hilf=f/x; hilf*x==f; hilf=f/x) {f=hilf;} 140 for (hilf=f/x; hilf*x==f; hilf=f/x) {f=hilf;} 140 141 for (hilf=f/y; hilf*y==f; hilf=f/y) {f=hilf;} // gleiches fuer y 141 142 return(list(T1(f),d)); … … 149 150 { 150 151 matrix mat = coeffs(coeffs(f,y)[J+1,1],x); 151 if (size(mat) <= I) { return(0);} 152 if (size(mat) <= I) { return(0);} 152 153 else { return(leadcoef(mat[I+1,1]));} 153 154 } … … 191 192 poly dif,g,l; 192 193 if (gcd_ok!=0) { 193 //-------------------- Berechne f/ggT(f,df/dx,df/dy) ------------------------ 194 //-------------------- Berechne f/ggT(f,df/dx,df/dy) ------------------------ 194 195 dif=diff(f,x); 195 196 if (dif==0) { g=f; } // zur Beschleunigung … … 315 316 if ((leadcoef(f)<-16001) or (leadcoef(f)>16001)) {verbrecher=lead(f);} 316 317 leitexp=leadexp(f); 317 if (( ((leitexp[1] % 32003) == 0) and (leitexp[1]<>0)) 318 if (( ((leitexp[1] % 32003) == 0) and (leitexp[1]<>0)) 318 319 or ( ((leitexp[2] % 32003) == 0) and (leitexp[2]<>0)) ) 319 320 {verbrecher=lead(f);} … … 438 439 string ringchar=charstr(basering); 439 440 map xytausch = basering,y,x; 440 if ((p!=0) and (ringchar != string(p))) { 441 if ((p!=0) and (ringchar != string(p))) { 441 442 // coefficient field is extension of Z/pZ 442 execute "int n_elements="+ringchar[1,size(ringchar)-2]+";"; 443 execute "int n_elements="+ringchar[1,size(ringchar)-2]+";"; 443 444 // number of elements of actual ring 444 445 number generat=par(1); // generator of the coefficient field of the ring … … 502 503 } 503 504 else { 504 if ((str=="s") and (testerg==1)) { 505 if ((str=="s") and (testerg==1)) { 505 506 "(*) attention: it could be that the factor is only one in char 32003!"; 506 507 f=polyhinueber(test_sqr); … … 605 606 delta = koeff(f,(M/ e)*p^l,(N/ e)*p^l*(eps-1)) / (-1*eps*c); 606 607 607 if ((ringchar != string(p)) and (delta != 0)) { 608 if ((ringchar != string(p)) and (delta != 0)) { 608 609 //- coeff. field is not Z/pZ => we`ve to correct delta by taking (p^l)th root- 609 610 if (delta == generat) {exponent=1;} … … 614 615 615 616 //-- an dieser Stelle kann ein Fehler auftreten, wenn wir eine transzendente - 616 //-- Erweiterung von Z/pZ haben: dann ist das hinzuadjungierte Element nicht-617 //-- primitiv, d.h. in Z/pZ (a) gibt es i.A. keinen Exponenten mit-618 //-- z.B. a2+a = a^exp-617 //-- Erweiterung von Z/pZ haben: dann ist das hinzuadjungierte Element kein - 618 //-- Erzeuger der mult. Gruppe, d.h. in Z/pZ (a) gibt es i.allg. keinen - 619 //-- Exponenten mit z.B. a2+a = a^exp - 619 620 //---------------------------------------------------------------------------- 620 621 }} … … 738 739 two power series; then param will return a truncation of these series. 739 740 EXAMPLE: example param; shows an example 740 example develop p; shows another example741 example develop; shows another example 741 742 742 743 { … … 1195 1196 } 1196 1197 example 1197 { 1198 { 1198 1199 if (nameof(basering)=="HNEring") { 1199 1200 def rettering=HNEring; … … 1293 1294 } 1294 1295 if (size(#) != 0) { 1295 "// basering is now 'displayring' containing ideal 'HNE'"; 1296 "// basering is now 'displayring' containing ideal 'HNE'"; 1296 1297 keepring(displayring); 1297 1298 export(HNE); … … 1361 1362 //- finde alle Monome auf der Geraden durch A und C (unterhalb gibt's keine) - 1362 1363 hilf=jet(f,A[2]*C[1]-A[1]*C[2],intvec(A[2]-C[2],C[1]-A[1])); 1363 1364 1364 1365 H=leadexp(xytausch(hilf)); 1365 1366 D=H[2],H[1]; … … 1544 1545 } 1545 1546 else { 1546 execute "ring extdguenstig=("+charstr(basering)+"),(x,y),ls;"; 1547 execute "ring extdguenstig=("+charstr(basering)+"),(x,y),ls;"; 1547 1548 } 1548 1549 } … … 1732 1733 delta = koeff(f,(M/ e)*p^l,(N/ e)*p^l*(eps-1)) / (-1*eps*c); 1733 1734 1734 if ((charstr(basering) != string(p)) and (delta != 0)) { 1735 if ((charstr(basering) != string(p)) and (delta != 0)) { 1735 1736 //------ coefficient field is not Z/pZ => (p^l)th root is not identity ------- 1736 1737 delta=0; … … 1760 1761 USAGE: reddevelop(f); f poly 1761 1762 RETURN: Hamburger-Noether development of f : 1762 A list of lists in the form of develop(f); each entry contains the 1763 A list of lists in the form of develop(f); each entry contains the 1763 1764 data for one of the branches of f. 1764 1765 For more details type 'help develop;' … … 1888 1889 } 1889 1890 else { 1890 if ((str=="s") and (testerg==1)) { 1891 if ((str=="s") and (testerg==1)) { 1891 1892 "(*)attention: it could be that the factor is only one in char 32003!"; 1892 1893 f=polyhinueber(test_sqr); … … 1954 1955 } 1955 1956 //---------------------- Test, ob f teilbar durch x oder y ------------------- 1956 if (subst(f,y,0)==0) { 1957 if (subst(f,y,0)==0) { 1957 1958 f=f/y; NullHNEy=1; } // y=0 is a solution 1958 if (subst(f,x,0)==0) { 1959 if (subst(f,x,0)==0) { 1959 1960 f=f/x; NullHNEx=1; } // x=0 is a solution 1960 1961 … … 2055 2056 } 2056 2057 example 2057 { 2058 { 2058 2059 if (nameof(basering)=="HNEring") { 2059 2060 def rettering=HNEring; … … 2260 2261 } 2261 2262 else { 2262 2263 2264 2265 2263 " Change of basering necessary!!"; 2264 if (defined(Protokoll)) { teiler,"is not properly factored!"; } 2265 if (needext==0) { poly zerlege=teiler; } 2266 needext=1; 2266 2267 } 2267 2268 } … … 2270 2271 else { deltais=ideal(delta); eis=e;} 2271 2272 if (defined(Protokoll)) {"roots of char. poly:";deltais; 2272 2273 "with multiplicities:",eis;} 2273 2274 if (needext==1) { 2274 2275 //--------------------- fuehre den Ringwechsel aus: -------------------------- 2275 2276 ringischanged=1; 2276 2277 if ((size(parstr(basering))>0) && string(minpoly)=="0") { 2277 2278 " ** We've had bad luck! The HNE cannot completely be calculated!"; 2278 2279 // HNE in transzendenter Erw. fehlgeschlagen 2279 2280 kill zerlege; 2280 2281 ringischanged=0; break; // weiter mit gefundenen Faktoren 2281 2282 } 2282 2283 if (parstr(basering)=="") { 2283 2284 2285 2286 2284 EXTHNEnumber++; 2285 splitring(zerlege,"EXTHNEring("+string(EXTHNEnumber)+")"); 2286 poly transf=0; 2287 poly transfproc=0; 2287 2288 } 2288 2289 else { 2289 2290 2291 2292 2290 if (defined(translist)) { kill translist; } // Vermeidung einer Warnung 2291 if (numberofRingchanges>1) { // ein Ringwechsel hat nicht gereicht 2292 list translist=splitring(zerlege,"",list(transf,transfproc)); 2293 poly transf=translist[1]; poly transfproc=translist[2]; 2293 2294 } 2294 2295 else { 2295 2296 2297 2296 if (defined(transfproc)) { // in dieser proc geschah schon Ringwechsel 2297 EXTHNEnumber++; 2298 list translist=splitring(zerlege,"EXTHNEring(" 2298 2299 +string(EXTHNEnumber)+")",list(a,transfproc)); 2299 2300 poly transf=translist[1]; 2300 2301 poly transfproc=translist[2]; 2301 2302 2303 2304 2302 } 2303 else { 2304 EXTHNEnumber++; 2305 list translist=splitring(zerlege,"EXTHNEring(" 2305 2306 +string(EXTHNEnumber)+")",a); 2306 2307 2308 2307 poly transf=translist[1]; 2308 poly transfproc=transf; 2309 }} 2309 2310 } 2310 2311 //---------------------------------------------------------------------------- … … 2372 2373 // aktualisiere Vektor mit den hqs 2373 2374 if (eis[j]>1) { 2374 2375 2375 transformiert=transformiert/y; 2376 if (subst(transformiert,y,0)==0) { 2376 2377 "THE TEST FOR SQUAREFREENESS WAS BAD!! The polynomial was NOT squarefree!!!";} 2377 2378 else { 2378 2379 //------ Spezialfall (###) eingetreten: Noch weitere Zweige vorhanden -------- 2379 2380 eis[j]=eis[j]-1; 2380 2381 } 2381 2382 } 2382 2383 } … … 2410 2411 //-------- Bereitstellung von Speicherplatz fuer eine neue Zeile: ------------ 2411 2412 HNEs=set_list(HNEs,intvec(hnezaehler,zeile+zl),ideal(0)); 2412 2413 2413 2414 M1=N1; N1=R1; R1=M1%N1; Q1=M1 / N1; 2414 2415 } … … 2628 2629 if (flag!=0) {factors;} 2629 2630 } 2630 -
Singular/LIB/primitiv.lib
re35965 r0132b0 1 // $Id: primitiv.lib,v 1.3 1998-04-03 22:47:11 krueger Exp $ 2 // This library requires Singular 1.0 3 4 version="$Id: primitiv.lib,v 1.3 1998-04-03 22:47:11 krueger Exp $"; 1 // $Id: primitiv.lib,v 1.4 1998-04-23 13:23:27 obachman Exp $ 2 // author: Martin Lamm, email: lamm@mathematik.uni-kl.de 3 // last change: 11.3.98 4 /////////////////////////////////////////////////////////////////////////////// 5 version="$Id: primitiv.lib,v 1.4 1998-04-23 13:23:27 obachman Exp $"; 5 6 info=" 6 7 LIBRARY: primitiv.lib PROCEDURES FOR FINDING A PRIMITIVE ELEMENT 7 8 8 primitivE(ideal i); finds minimal polynomial for a primitive element 9 10 splitring(poly f,string R[,list L]); define ring extension with name R 11 and switch to it 12 randomLast(int b); random transformation of the last variable 9 primitive(ideal i); finds minimal polynomial for a primitive element 10 splitring(f,R[,L]); define ring extension with name R and switch to it 11 randomLast(b); random transformation of the last variable 13 12 "; 14 13 14 /////////////////////////////////////////////////////////////////////////////// 15 15 LIB "random.lib"; 16 16 /////////////////////////////////////////////////////////////////////////////// … … 21 21 a sum of it with a linear random combination of the other 22 22 variables 23 NOTE:24 23 EXAMPLE: example randomLast; shows an example 25 24 { … … 40 39 /////////////////////////////////////////////////////////////////////////////// 41 40 42 proc primitiv E(ideal i)43 USAGE: primitiv E(i); i ideal of the following form:41 proc primitive(ideal i) 42 USAGE: primitive(i); i ideal of the following form: 44 43 Let k be the ground field of your basering, a_1,...,a_n algebraic over k, 45 44 m_1(x1), m_2(x_1,x_2),...,m_n(x_1,...,x_n) polynomials in k such that … … 48 47 Then i has to be generated by m_1,...,m_n. 49 48 50 RETURN: ideal j in k[x_n] such that49 RETURN: ideal j in k[x_n] such that 51 50 j[1] is minimal polynomial for a primitive element b of k(a_1,...,a_n)=k(b) 52 51 over k 53 52 j[2],...,j[n+1] polynomials in k[x_n] : j[i+1](b)=a_i for i=1,...,n 54 NOTE: the number of variables in the basering has to be exactly the number n of55 given algebraic elements (and minimal polynomials)56 EXAMPLE: example primitivE; shows an example53 NOTE: the number of variables in the basering has to be exactly the number n 54 of given algebraic elements (and minimal polynomials) 55 EXAMPLE: example primitive; shows an example 57 56 { 58 57 def altring=basering; … … 111 110 ring exring=0,(x,y),dp; 112 111 ideal i=x2+1,y2-x; // compute Q(i,i^(1/2))=:L 113 ideal j=primitiv E(i); // -> we have L=Q(a):112 ideal j=primitive(i); // -> we have L=Q(a): 114 113 "minimal polynomial of a:",j[1]; // => a=(-1)^(1/4) 115 114 "polynomial for i: ",j[2]; // => i=a^2 116 115 "polynomial for i^(1/2): ",j[3]; // => i^(1/2)=a 117 116 // ==> the 2nd element was already primitive! 118 j=primitiv E(ideal(x2-2,y2-3)); // compute Q(sqrt(2),sqrt(3))117 j=primitive(ideal(x2-2,y2-3)); // compute Q(sqrt(2),sqrt(3)) 119 118 "minimal polynomial:",j[1]; 120 119 "polynomial p s.t. p(a)=sqrt(2):",j[2]; … … 130 129 ACTION: defines a ring with name R, in which f is reducible, and changes to it 131 130 If the old ring has no parameter, the name 'a' is chosen for the 132 parameter of R (if a is no variable; if it is, the proc takes 'b'; if 133 this is also impossible, then 'c'), otherwise the name of the parameter 134 is kept and only the minimal polynomial is changed. 131 parameter of R (if a is no variable; if it is, the proc takes 'b', 132 etc.; if a,b,c,o are variables of the ring, produce an error message), 133 otherwise the name of the parameter is kept and only the 134 minimal polynomial is changed. 135 135 The names of variables and orderings are not affected. 136 136 … … 138 138 will be REPLACED by the new ring (with the same name as the old ring). 139 139 140 RETURN s: list L mapped into the new ring R, if L is given; else nothing141 ASSUME : the active ring must be bivariate andallow an algebraic extension140 RETURN: list L mapped into the new ring R, if L is given; else nothing 141 ASSUME: the active ring must allow an algebraic extension 142 142 (e.g. it cannot be a transcendent ring extension of Q or Z/p) 143 143 EXAMPLE: example splitring; shows an example … … 162 162 string varnames=varstr(altring); 163 163 string algname; 164 int i; 165 int anzvar=size(maxideal(1)); 164 166 //--------------- Fall 1: Bisheriger Ring hatte kein Minimalpolynom ---------- 165 167 if (minp=="0") { 166 168 if (find(varnames,"a")==0) { algname="a";} 167 169 else { if (find(varnames,"b")==0) { algname="b";} 168 else { algname="c";} 169 //----------- nur ZWEI Variablen erlaubt ==> c ist kein Variablenname -------- 170 else { if (find(varnames,"c")==0) 171 { algname="c";} 172 else { if (find(varnames,"o")==0) 173 { algname="o";} 174 else { 175 "** Sorry -- could not find a free name for the primitive element."; 176 "** Try e.g. a ring without 'a' or 'b' as variable."; 177 return(); 178 }} 179 } 170 180 } 171 181 //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: -- 172 182 execute("ring splt1="+charakt+","+algname+",dp;"); 173 map nach_splt1=altring,var(1),var(1); 183 ideal abbnach=var(1); 184 for (i=1; i<anzvar; i++) { abbnach=abbnach,var(1); } 185 map nach_splt1=altring,abbnach; 174 186 execute("poly mipol="+string(nach_splt1(f))+";"); 175 187 string Rminp=string(mipol); … … 198 210 execute("ring splt3="+charakt+",("+algname+","+varnames+"),dp;"); 199 211 poly f=imap(altring,f); 200 //-------------- Vorbereitung des Aufrufes von primitiv E: --------------------212 //-------------- Vorbereitung des Aufrufes von primitive: -------------------- 201 213 execute("ring splt1="+charakt+",(x,y),dp;"); 202 map nach_splt1_3=splt3,x,y,y; 214 ideal abbnach=x; 215 for (i=1; i<=anzvar; i++) { abbnach=abbnach,y; } 216 map nach_splt1_3=splt3,abbnach; 203 217 map nach_splt1_2=splt2,x; 204 218 ideal maxid=nach_splt1_2(mipol),nach_splt1_3(f); 205 ideal primit=primitiv E(maxid);219 ideal primit=primitive(maxid); 206 220 "new minimal polynomial:",primit[1]; 207 221 //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: -- … … 210 224 minp=string(nach_splt2(primit)[1]); 211 225 //--------------------- definiere den neuen Ring: ---------------------------- 212 execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("+ordstr(altring)+");"); 226 execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),(" 227 +ordstr(altring)+");"); 213 228 execute("minpoly="+minp+";"); 214 229 execute("export "+@R+";"); … … 225 240 map nach_splt3_1=splt1,0,var(1); // x->0, y->a 226 241 //----- rechne das primitive Element von altring in das von neuring um: ------ 227 map convert=splt3,nach_splt3_1(primit)[2],var(2),var(3); 242 ideal convid=maxideal(1); 243 convid[1]=nach_splt3_1(primit)[2]; 244 map convert=splt3,convid; 228 245 zwi=convert(zwi); 229 246 setring neuring;
Note: See TracChangeset
for help on using the changeset viewer.
