[0132b0] | 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 $"; |
---|
[5480da] | 6 | info=" |
---|
[cf29809] | 7 | LIBRARY: primitiv.lib PROCEDURES FOR FINDING A PRIMITIVE ELEMENT |
---|
| 8 | |
---|
[0132b0] | 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 |
---|
[5480da] | 12 | "; |
---|
[cf29809] | 13 | |
---|
[0132b0] | 14 | /////////////////////////////////////////////////////////////////////////////// |
---|
[cf29809] | 15 | LIB "random.lib"; |
---|
| 16 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 17 | |
---|
| 18 | proc randomLast(int b) |
---|
| 19 | USAGE: randomLast |
---|
| 20 | RETURN: ideal = maxideal(1) but the last variable exchanged by |
---|
| 21 | a sum of it with a linear random combination of the other |
---|
| 22 | variables |
---|
| 23 | EXAMPLE: example randomLast; shows an example |
---|
| 24 | { |
---|
| 25 | ideal i=maxideal(1); |
---|
| 26 | int k=size(i); |
---|
| 27 | i[k]=0; |
---|
| 28 | i=randomid(i,size(i),b); |
---|
| 29 | ideal ires=maxideal(1); |
---|
| 30 | ires[k]=i[1]+var(k); |
---|
| 31 | return(ires); |
---|
| 32 | } |
---|
| 33 | example |
---|
| 34 | { "EXAMPLE:"; echo = 2; |
---|
| 35 | ring r = 0,(x,y,z),lp; |
---|
| 36 | ideal i = randomLast(10); |
---|
| 37 | i; |
---|
| 38 | } |
---|
[190bf0b] | 39 | /////////////////////////////////////////////////////////////////////////////// |
---|
[cf29809] | 40 | |
---|
[0132b0] | 41 | proc primitive(ideal i) |
---|
| 42 | USAGE: primitive(i); i ideal of the following form: |
---|
[cf29809] | 43 | Let k be the ground field of your basering, a_1,...,a_n algebraic over k, |
---|
| 44 | m_1(x1), m_2(x_1,x_2),...,m_n(x_1,...,x_n) polynomials in k such that |
---|
| 45 | m_j(a_1,...,a_(j-1),x_j) is minimal polynomial for a_j over k(a_1,...,a_(j-1)) |
---|
| 46 | for all j=1,...,n. |
---|
| 47 | Then i has to be generated by m_1,...,m_n. |
---|
| 48 | |
---|
[0132b0] | 49 | RETURN: ideal j in k[x_n] such that |
---|
[cf29809] | 50 | j[1] is minimal polynomial for a primitive element b of k(a_1,...,a_n)=k(b) |
---|
| 51 | over k |
---|
| 52 | j[2],...,j[n+1] polynomials in k[x_n] : j[i+1](b)=a_i for i=1,...,n |
---|
[0132b0] | 53 | 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 |
---|
[cf29809] | 56 | { |
---|
| 57 | def altring=basering; |
---|
| 58 | execute("ring deglexring=("+charstr(altring)+"),("+varstr(altring)+"),dp;"); |
---|
| 59 | ideal j; |
---|
| 60 | execute("ring lexring=("+charstr(altring)+"),("+varstr(altring)+"),lp;"); |
---|
| 61 | ideal i=fetch(altring,i); |
---|
| 62 | |
---|
| 63 | int k,schlecht; |
---|
| 64 | int nva = nvars(basering); |
---|
| 65 | ideal jmap,j; |
---|
| 66 | map phi; |
---|
| 67 | option(redSB); |
---|
| 68 | int Fehlversuche; |
---|
[190bf0b] | 69 | //-------- Mache so lange Random-Koord.wechsel, bis letztes Poly ------------- |
---|
| 70 | //--------------- das Minpoly eines primitiven Elements ist : ---------------- |
---|
[cf29809] | 71 | for (Fehlversuche=0; 1; Fehlversuche++) { |
---|
| 72 | schlecht=0; |
---|
| 73 | if (Fehlversuche==0) { jmap=maxideal(1);} |
---|
| 74 | else { |
---|
| 75 | if (Fehlversuche<3) { jmap=randomLast(10);} |
---|
| 76 | else { jmap=randomLast(100);} |
---|
| 77 | } |
---|
| 78 | phi=lexring,jmap; |
---|
| 79 | j=phi(i); |
---|
| 80 | setring deglexring; |
---|
[190bf0b] | 81 | //--------------- Berechne reduzierte Standardbasis mit fglm: ---------------- |
---|
[cf29809] | 82 | j=std(fetch(lexring,j)); |
---|
| 83 | setring lexring; |
---|
| 84 | j=fglm(deglexring,j); |
---|
[190bf0b] | 85 | //-- teste, ob SB n Elemente enthaelt (falls ja, ob lead(Fi)=xi i=1... n-1): - |
---|
[cf29809] | 86 | if (size(j)==nva) { |
---|
| 87 | for (k=1; k<nva; k++) { |
---|
[190bf0b] | 88 | j[k+1]=j[k+1]/leadcoef(j[k+1]); // normiere die Erzeuger |
---|
| 89 | if (lead(j[k+1]) != var(nva-k)) { schlecht=1;} |
---|
[cf29809] | 90 | } |
---|
| 91 | if (schlecht==0) { |
---|
[190bf0b] | 92 | //--- Random-Koord.wechsel war gut: Berechne das zurueckzugebende Ideal: ----- |
---|
[cf29809] | 93 | ideal erg; |
---|
| 94 | for (k=1; k<nva; k++) { erg[k]=var(k)-j[nva-k+1]; } |
---|
| 95 | // =g_k(x_n) mit a_k=g_k(a_n) |
---|
| 96 | erg[nva]=var(nva); |
---|
| 97 | map chi=lexring,erg; |
---|
[190bf0b] | 98 | ideal extra=maxideal(1);extra=phi(extra); |
---|
| 99 | // sonst: "argument of a map must have a name" |
---|
| 100 | erg=j[1]+chi(extra); // j[1] = Minimalpolynom |
---|
[cf29809] | 101 | setring altring; |
---|
| 102 | return(fetch(lexring,erg)); |
---|
| 103 | } |
---|
| 104 | } |
---|
| 105 | "The random coordinate change was bad!"; |
---|
| 106 | } |
---|
| 107 | } |
---|
| 108 | example |
---|
| 109 | { "EXAMPLE:"; echo = 2; |
---|
| 110 | ring exring=0,(x,y),dp; |
---|
| 111 | ideal i=x2+1,y2-x; // compute Q(i,i^(1/2))=:L |
---|
[0132b0] | 112 | ideal j=primitive(i); // -> we have L=Q(a): |
---|
[cf29809] | 113 | "minimal polynomial of a:",j[1]; // => a=(-1)^(1/4) |
---|
| 114 | "polynomial for i: ",j[2]; // => i=a^2 |
---|
| 115 | "polynomial for i^(1/2): ",j[3]; // => i^(1/2)=a |
---|
| 116 | // ==> the 2nd element was already primitive! |
---|
[0132b0] | 117 | j=primitive(ideal(x2-2,y2-3)); // compute Q(sqrt(2),sqrt(3)) |
---|
[cf29809] | 118 | "minimal polynomial:",j[1]; |
---|
| 119 | "polynomial p s.t. p(a)=sqrt(2):",j[2]; |
---|
| 120 | "polynomial r s.t. r(a)=sqrt(3):",j[3]; |
---|
| 121 | // ==> no element was primitive -- the calculation of a is based on a random |
---|
| 122 | // choice. |
---|
| 123 | } |
---|
[190bf0b] | 124 | /////////////////////////////////////////////////////////////////////////////// |
---|
[cf29809] | 125 | |
---|
| 126 | proc splitring |
---|
| 127 | USAGE: splitring(f,R[,L]); f poly, univariate, irreducible(!), R string, |
---|
| 128 | L list of polys and/or ideals (optional) |
---|
| 129 | ACTION: defines a ring with name R, in which f is reducible, and changes to it |
---|
| 130 | If the old ring has no parameter, the name 'a' is chosen for the |
---|
[0132b0] | 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. |
---|
[cf29809] | 135 | The names of variables and orderings are not affected. |
---|
| 136 | |
---|
| 137 | It is also allowed to call splitring with R=="". Then the old basering |
---|
| 138 | will be REPLACED by the new ring (with the same name as the old ring). |
---|
| 139 | |
---|
[0132b0] | 140 | 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 |
---|
[190bf0b] | 142 | (e.g. it cannot be a transcendent ring extension of Q or Z/p) |
---|
[cf29809] | 143 | EXAMPLE: example splitring; shows an example |
---|
| 144 | { |
---|
[190bf0b] | 145 | //----------------- split ist bereits eine proc in 'inout.lib' ! ------------- |
---|
[cf29809] | 146 | poly f=#[1]; string @R=#[2]; |
---|
| 147 | if (size(#)>2) { |
---|
| 148 | list L=#[3]; |
---|
| 149 | int L_groesse=size(L); |
---|
| 150 | } |
---|
| 151 | else { int L_groesse=-1; } |
---|
[190bf0b] | 152 | //-------------- ermittle das Minimalpolynom des aktuellen Rings: ------------ |
---|
[cf29809] | 153 | string minp=string(minpoly); |
---|
| 154 | |
---|
| 155 | if (@R=="") { |
---|
| 156 | string altrname=nameof(basering); |
---|
| 157 | @R="splt_temp"; |
---|
| 158 | } |
---|
| 159 | |
---|
| 160 | def altring=basering; |
---|
| 161 | string charakt=string(char(altring)); |
---|
| 162 | string varnames=varstr(altring); |
---|
| 163 | string algname; |
---|
[0132b0] | 164 | int i; |
---|
| 165 | int anzvar=size(maxideal(1)); |
---|
[190bf0b] | 166 | //--------------- Fall 1: Bisheriger Ring hatte kein Minimalpolynom ---------- |
---|
[cf29809] | 167 | if (minp=="0") { |
---|
| 168 | if (find(varnames,"a")==0) { algname="a";} |
---|
| 169 | else { if (find(varnames,"b")==0) { algname="b";} |
---|
[0132b0] | 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 | } |
---|
[190bf0b] | 180 | } |
---|
| 181 | //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: -- |
---|
[cf29809] | 182 | execute("ring splt1="+charakt+","+algname+",dp;"); |
---|
[0132b0] | 183 | ideal abbnach=var(1); |
---|
| 184 | for (i=1; i<anzvar; i++) { abbnach=abbnach,var(1); } |
---|
| 185 | map nach_splt1=altring,abbnach; |
---|
[cf29809] | 186 | execute("poly mipol="+string(nach_splt1(f))+";"); |
---|
| 187 | string Rminp=string(mipol); |
---|
[190bf0b] | 188 | //--------------------- definiere den neuen Ring: ---------------------------- |
---|
| 189 | execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),(" |
---|
| 190 | +ordstr(altring)+");"); |
---|
[cf29809] | 191 | execute("minpoly="+Rminp+";"); |
---|
| 192 | execute("export "+@R+";"); |
---|
| 193 | def neuring=basering; |
---|
[190bf0b] | 194 | //---------------------- Berechne die zurueckzugebende Liste: ---------------- |
---|
[cf29809] | 195 | list erg; |
---|
[190bf0b] | 196 | if (L_groesse>0) { |
---|
| 197 | // L ist ja nicht in 'neuring' def., daher merke man sich die Groesse als int |
---|
| 198 | map take=altring,maxideal(1); |
---|
[cf29809] | 199 | erg=take(L); |
---|
| 200 | } // take(empty list) gibt nicht empty list, sondern Fehlermeldung |
---|
| 201 | } |
---|
| 202 | else { |
---|
[190bf0b] | 203 | //------------- Fall 2: Bisheriger Ring hatte ein Minimalpolynom: ------------ |
---|
| 204 | algname=parstr(altring); // Name des algebraischen Elements |
---|
[cf29809] | 205 | if (size(algname)>1) {"only one Parameter is allowed!!"; return();} |
---|
[190bf0b] | 206 | //---------------- Minimalpolynom in ein Polynom umwandeln: ------------------ |
---|
[cf29809] | 207 | execute("ring splt2="+charakt+","+algname+",dp;"); |
---|
| 208 | execute("poly mipol="+minp+";"); |
---|
[190bf0b] | 209 | // f ist Polynom in algname und einer weiteren Variablen --> mache f bivariat: |
---|
[cf29809] | 210 | execute("ring splt3="+charakt+",("+algname+","+varnames+"),dp;"); |
---|
[190bf0b] | 211 | poly f=imap(altring,f); |
---|
[0132b0] | 212 | //-------------- Vorbereitung des Aufrufes von primitive: -------------------- |
---|
[cf29809] | 213 | execute("ring splt1="+charakt+",(x,y),dp;"); |
---|
[0132b0] | 214 | ideal abbnach=x; |
---|
| 215 | for (i=1; i<=anzvar; i++) { abbnach=abbnach,y; } |
---|
| 216 | map nach_splt1_3=splt3,abbnach; |
---|
[cf29809] | 217 | map nach_splt1_2=splt2,x; |
---|
| 218 | ideal maxid=nach_splt1_2(mipol),nach_splt1_3(f); |
---|
[0132b0] | 219 | ideal primit=primitive(maxid); |
---|
[cf29809] | 220 | "new minimal polynomial:",primit[1]; |
---|
[190bf0b] | 221 | //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: -- |
---|
[cf29809] | 222 | setring splt2; |
---|
| 223 | map nach_splt2=splt1,0,var(1); // x->0, y->a |
---|
| 224 | minp=string(nach_splt2(primit)[1]); |
---|
[190bf0b] | 225 | //--------------------- definiere den neuen Ring: ---------------------------- |
---|
[0132b0] | 226 | execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),(" |
---|
| 227 | +ordstr(altring)+");"); |
---|
[cf29809] | 228 | execute("minpoly="+minp+";"); |
---|
| 229 | execute("export "+@R+";"); |
---|
| 230 | def neuring=basering; |
---|
| 231 | |
---|
[190bf0b] | 232 | //--------------- Uebersicht: wenn altring=(p,a),(x,y),dp; dann: ------------- |
---|
| 233 | //------------ splt1=p,(x,y),dp; splt2=p,a,dp; splt3=p,(a,x,y),dp; --------- |
---|
| 234 | |
---|
| 235 | list erg; |
---|
[cf29809] | 236 | if (L_groesse>0) { |
---|
[190bf0b] | 237 | //---------------------- Berechne die zurueckzugebende Liste: ---------------- |
---|
[cf29809] | 238 | setring splt3; |
---|
| 239 | list zwi=imap(altring,L); |
---|
| 240 | map nach_splt3_1=splt1,0,var(1); // x->0, y->a |
---|
[190bf0b] | 241 | //----- rechne das primitive Element von altring in das von neuring um: ------ |
---|
[0132b0] | 242 | ideal convid=maxideal(1); |
---|
| 243 | convid[1]=nach_splt3_1(primit)[2]; |
---|
| 244 | map convert=splt3,convid; |
---|
[cf29809] | 245 | zwi=convert(zwi); |
---|
| 246 | setring neuring; |
---|
[190bf0b] | 247 | erg=imap(splt3,zwi); |
---|
[cf29809] | 248 | } |
---|
| 249 | } |
---|
| 250 | if (defined(altrname)) { |
---|
| 251 | execute("kill "+altrname+";"); |
---|
| 252 | execute("def "+altrname+" = splt_temp;"); |
---|
| 253 | @R=altrname; |
---|
| 254 | execute("export "+altrname+";"); |
---|
| 255 | kill splt_temp; |
---|
| 256 | } |
---|
| 257 | |
---|
| 258 | execute("keepring "+@R+";"); |
---|
| 259 | if (L_groesse >= 0) {return(erg);} |
---|
| 260 | } |
---|
| 261 | example |
---|
| 262 | { "EXAMPLE:"; echo = 2; |
---|
| 263 | ring r=0,(x,y),dp; |
---|
| 264 | splitring(x2-2,"r1"); // change to Q(sqrt(2)) |
---|
| 265 | splitring(x2-a,"r2",a); // change to Q(sqrt(2),sqrt(sqrt(2)))=Q(a) |
---|
| 266 | // and return the transformed old parameter |
---|
| 267 | // the result is (a2) == (sqrt(sqrt(2)))^2 |
---|
| 268 | nameof(basering); |
---|
| 269 | r2; |
---|
| 270 | kill r1; kill r2; |
---|
| 271 | } |
---|