[5480da] | 1 | // $Id: primitiv.lib,v 1.3 1998-04-03 22:47:11 krueger Exp $ |
---|
[cf29809] | 2 | // This library requires Singular 1.0 |
---|
| 3 | |
---|
[5480da] | 4 | version="$Id: primitiv.lib,v 1.3 1998-04-03 22:47:11 krueger Exp $"; |
---|
| 5 | info=" |
---|
[cf29809] | 6 | LIBRARY: primitiv.lib PROCEDURES FOR FINDING A PRIMITIVE ELEMENT |
---|
| 7 | |
---|
| 8 | primitivE(ideal i); finds minimal polynomial for a primitive element |
---|
| 9 | |
---|
[190bf0b] | 10 | splitring(poly f,string R[,list L]); define ring extension with name R |
---|
[cf29809] | 11 | and switch to it |
---|
| 12 | randomLast(int b); random transformation of the last variable |
---|
[5480da] | 13 | "; |
---|
[cf29809] | 14 | |
---|
| 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 | NOTE: |
---|
| 24 | EXAMPLE: example randomLast; shows an example |
---|
| 25 | { |
---|
| 26 | ideal i=maxideal(1); |
---|
| 27 | int k=size(i); |
---|
| 28 | i[k]=0; |
---|
| 29 | i=randomid(i,size(i),b); |
---|
| 30 | ideal ires=maxideal(1); |
---|
| 31 | ires[k]=i[1]+var(k); |
---|
| 32 | return(ires); |
---|
| 33 | } |
---|
| 34 | example |
---|
| 35 | { "EXAMPLE:"; echo = 2; |
---|
| 36 | ring r = 0,(x,y,z),lp; |
---|
| 37 | ideal i = randomLast(10); |
---|
| 38 | i; |
---|
| 39 | } |
---|
[190bf0b] | 40 | /////////////////////////////////////////////////////////////////////////////// |
---|
[cf29809] | 41 | |
---|
| 42 | proc primitivE(ideal i) |
---|
| 43 | USAGE: primitivE(i); i ideal of the following form: |
---|
| 44 | Let k be the ground field of your basering, a_1,...,a_n algebraic over k, |
---|
| 45 | m_1(x1), m_2(x_1,x_2),...,m_n(x_1,...,x_n) polynomials in k such that |
---|
| 46 | m_j(a_1,...,a_(j-1),x_j) is minimal polynomial for a_j over k(a_1,...,a_(j-1)) |
---|
| 47 | for all j=1,...,n. |
---|
| 48 | Then i has to be generated by m_1,...,m_n. |
---|
| 49 | |
---|
| 50 | RETURN: ideal j in k[x_n] such that |
---|
| 51 | j[1] is minimal polynomial for a primitive element b of k(a_1,...,a_n)=k(b) |
---|
| 52 | over k |
---|
| 53 | 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 of |
---|
| 55 | given algebraic elements (and minimal polynomials) |
---|
| 56 | EXAMPLE: example primitivE; shows an example |
---|
| 57 | { |
---|
| 58 | def altring=basering; |
---|
| 59 | execute("ring deglexring=("+charstr(altring)+"),("+varstr(altring)+"),dp;"); |
---|
| 60 | ideal j; |
---|
| 61 | execute("ring lexring=("+charstr(altring)+"),("+varstr(altring)+"),lp;"); |
---|
| 62 | ideal i=fetch(altring,i); |
---|
| 63 | |
---|
| 64 | int k,schlecht; |
---|
| 65 | int nva = nvars(basering); |
---|
| 66 | ideal jmap,j; |
---|
| 67 | map phi; |
---|
| 68 | option(redSB); |
---|
| 69 | int Fehlversuche; |
---|
[190bf0b] | 70 | //-------- Mache so lange Random-Koord.wechsel, bis letztes Poly ------------- |
---|
| 71 | //--------------- das Minpoly eines primitiven Elements ist : ---------------- |
---|
[cf29809] | 72 | for (Fehlversuche=0; 1; Fehlversuche++) { |
---|
| 73 | schlecht=0; |
---|
| 74 | if (Fehlversuche==0) { jmap=maxideal(1);} |
---|
| 75 | else { |
---|
| 76 | if (Fehlversuche<3) { jmap=randomLast(10);} |
---|
| 77 | else { jmap=randomLast(100);} |
---|
| 78 | } |
---|
| 79 | phi=lexring,jmap; |
---|
| 80 | j=phi(i); |
---|
| 81 | setring deglexring; |
---|
[190bf0b] | 82 | //--------------- Berechne reduzierte Standardbasis mit fglm: ---------------- |
---|
[cf29809] | 83 | j=std(fetch(lexring,j)); |
---|
| 84 | setring lexring; |
---|
| 85 | j=fglm(deglexring,j); |
---|
[190bf0b] | 86 | //-- teste, ob SB n Elemente enthaelt (falls ja, ob lead(Fi)=xi i=1... n-1): - |
---|
[cf29809] | 87 | if (size(j)==nva) { |
---|
| 88 | for (k=1; k<nva; k++) { |
---|
[190bf0b] | 89 | j[k+1]=j[k+1]/leadcoef(j[k+1]); // normiere die Erzeuger |
---|
| 90 | if (lead(j[k+1]) != var(nva-k)) { schlecht=1;} |
---|
[cf29809] | 91 | } |
---|
| 92 | if (schlecht==0) { |
---|
[190bf0b] | 93 | //--- Random-Koord.wechsel war gut: Berechne das zurueckzugebende Ideal: ----- |
---|
[cf29809] | 94 | ideal erg; |
---|
| 95 | for (k=1; k<nva; k++) { erg[k]=var(k)-j[nva-k+1]; } |
---|
| 96 | // =g_k(x_n) mit a_k=g_k(a_n) |
---|
| 97 | erg[nva]=var(nva); |
---|
| 98 | map chi=lexring,erg; |
---|
[190bf0b] | 99 | ideal extra=maxideal(1);extra=phi(extra); |
---|
| 100 | // sonst: "argument of a map must have a name" |
---|
| 101 | erg=j[1]+chi(extra); // j[1] = Minimalpolynom |
---|
[cf29809] | 102 | setring altring; |
---|
| 103 | return(fetch(lexring,erg)); |
---|
| 104 | } |
---|
| 105 | } |
---|
| 106 | "The random coordinate change was bad!"; |
---|
| 107 | } |
---|
| 108 | } |
---|
| 109 | example |
---|
| 110 | { "EXAMPLE:"; echo = 2; |
---|
| 111 | ring exring=0,(x,y),dp; |
---|
| 112 | ideal i=x2+1,y2-x; // compute Q(i,i^(1/2))=:L |
---|
| 113 | ideal j=primitivE(i); // -> we have L=Q(a): |
---|
| 114 | "minimal polynomial of a:",j[1]; // => a=(-1)^(1/4) |
---|
| 115 | "polynomial for i: ",j[2]; // => i=a^2 |
---|
| 116 | "polynomial for i^(1/2): ",j[3]; // => i^(1/2)=a |
---|
| 117 | // ==> the 2nd element was already primitive! |
---|
| 118 | j=primitivE(ideal(x2-2,y2-3)); // compute Q(sqrt(2),sqrt(3)) |
---|
| 119 | "minimal polynomial:",j[1]; |
---|
| 120 | "polynomial p s.t. p(a)=sqrt(2):",j[2]; |
---|
| 121 | "polynomial r s.t. r(a)=sqrt(3):",j[3]; |
---|
| 122 | // ==> no element was primitive -- the calculation of a is based on a random |
---|
| 123 | // choice. |
---|
| 124 | } |
---|
[190bf0b] | 125 | /////////////////////////////////////////////////////////////////////////////// |
---|
[cf29809] | 126 | |
---|
| 127 | proc splitring |
---|
| 128 | USAGE: splitring(f,R[,L]); f poly, univariate, irreducible(!), R string, |
---|
| 129 | L list of polys and/or ideals (optional) |
---|
| 130 | ACTION: defines a ring with name R, in which f is reducible, and changes to it |
---|
| 131 | 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. |
---|
| 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 | |
---|
| 140 | RETURNs: list L mapped into the new ring R, if L is given; else nothing |
---|
[190bf0b] | 141 | ASSUME : the active ring must be bivariate and allow an algebraic extension |
---|
| 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; |
---|
[190bf0b] | 164 | //--------------- Fall 1: Bisheriger Ring hatte kein Minimalpolynom ---------- |
---|
[cf29809] | 165 | if (minp=="0") { |
---|
| 166 | if (find(varnames,"a")==0) { algname="a";} |
---|
| 167 | else { if (find(varnames,"b")==0) { algname="b";} |
---|
| 168 | else { algname="c";} |
---|
[190bf0b] | 169 | //----------- nur ZWEI Variablen erlaubt ==> c ist kein Variablenname -------- |
---|
| 170 | } |
---|
| 171 | //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: -- |
---|
[cf29809] | 172 | execute("ring splt1="+charakt+","+algname+",dp;"); |
---|
| 173 | map nach_splt1=altring,var(1),var(1); |
---|
| 174 | execute("poly mipol="+string(nach_splt1(f))+";"); |
---|
| 175 | string Rminp=string(mipol); |
---|
[190bf0b] | 176 | //--------------------- definiere den neuen Ring: ---------------------------- |
---|
| 177 | execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),(" |
---|
| 178 | +ordstr(altring)+");"); |
---|
[cf29809] | 179 | execute("minpoly="+Rminp+";"); |
---|
| 180 | execute("export "+@R+";"); |
---|
| 181 | def neuring=basering; |
---|
[190bf0b] | 182 | //---------------------- Berechne die zurueckzugebende Liste: ---------------- |
---|
[cf29809] | 183 | list erg; |
---|
[190bf0b] | 184 | if (L_groesse>0) { |
---|
| 185 | // L ist ja nicht in 'neuring' def., daher merke man sich die Groesse als int |
---|
| 186 | map take=altring,maxideal(1); |
---|
[cf29809] | 187 | erg=take(L); |
---|
| 188 | } // take(empty list) gibt nicht empty list, sondern Fehlermeldung |
---|
| 189 | } |
---|
| 190 | else { |
---|
[190bf0b] | 191 | //------------- Fall 2: Bisheriger Ring hatte ein Minimalpolynom: ------------ |
---|
| 192 | algname=parstr(altring); // Name des algebraischen Elements |
---|
[cf29809] | 193 | if (size(algname)>1) {"only one Parameter is allowed!!"; return();} |
---|
[190bf0b] | 194 | //---------------- Minimalpolynom in ein Polynom umwandeln: ------------------ |
---|
[cf29809] | 195 | execute("ring splt2="+charakt+","+algname+",dp;"); |
---|
| 196 | execute("poly mipol="+minp+";"); |
---|
[190bf0b] | 197 | // f ist Polynom in algname und einer weiteren Variablen --> mache f bivariat: |
---|
[cf29809] | 198 | execute("ring splt3="+charakt+",("+algname+","+varnames+"),dp;"); |
---|
[190bf0b] | 199 | poly f=imap(altring,f); |
---|
| 200 | //-------------- Vorbereitung des Aufrufes von primitivE: -------------------- |
---|
[cf29809] | 201 | execute("ring splt1="+charakt+",(x,y),dp;"); |
---|
| 202 | map nach_splt1_3=splt3,x,y,y; |
---|
| 203 | map nach_splt1_2=splt2,x; |
---|
| 204 | ideal maxid=nach_splt1_2(mipol),nach_splt1_3(f); |
---|
| 205 | ideal primit=primitivE(maxid); |
---|
| 206 | "new minimal polynomial:",primit[1]; |
---|
[190bf0b] | 207 | //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: -- |
---|
[cf29809] | 208 | setring splt2; |
---|
| 209 | map nach_splt2=splt1,0,var(1); // x->0, y->a |
---|
| 210 | minp=string(nach_splt2(primit)[1]); |
---|
[190bf0b] | 211 | //--------------------- definiere den neuen Ring: ---------------------------- |
---|
[cf29809] | 212 | execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("+ordstr(altring)+");"); |
---|
| 213 | execute("minpoly="+minp+";"); |
---|
| 214 | execute("export "+@R+";"); |
---|
| 215 | def neuring=basering; |
---|
| 216 | |
---|
[190bf0b] | 217 | //--------------- Uebersicht: wenn altring=(p,a),(x,y),dp; dann: ------------- |
---|
| 218 | //------------ splt1=p,(x,y),dp; splt2=p,a,dp; splt3=p,(a,x,y),dp; --------- |
---|
| 219 | |
---|
| 220 | list erg; |
---|
[cf29809] | 221 | if (L_groesse>0) { |
---|
[190bf0b] | 222 | //---------------------- Berechne die zurueckzugebende Liste: ---------------- |
---|
[cf29809] | 223 | setring splt3; |
---|
| 224 | list zwi=imap(altring,L); |
---|
| 225 | map nach_splt3_1=splt1,0,var(1); // x->0, y->a |
---|
[190bf0b] | 226 | //----- rechne das primitive Element von altring in das von neuring um: ------ |
---|
[cf29809] | 227 | map convert=splt3,nach_splt3_1(primit)[2],var(2),var(3); |
---|
| 228 | zwi=convert(zwi); |
---|
| 229 | setring neuring; |
---|
[190bf0b] | 230 | erg=imap(splt3,zwi); |
---|
[cf29809] | 231 | } |
---|
| 232 | } |
---|
| 233 | if (defined(altrname)) { |
---|
| 234 | execute("kill "+altrname+";"); |
---|
| 235 | execute("def "+altrname+" = splt_temp;"); |
---|
| 236 | @R=altrname; |
---|
| 237 | execute("export "+altrname+";"); |
---|
| 238 | kill splt_temp; |
---|
| 239 | } |
---|
| 240 | |
---|
| 241 | execute("keepring "+@R+";"); |
---|
| 242 | if (L_groesse >= 0) {return(erg);} |
---|
| 243 | } |
---|
| 244 | example |
---|
| 245 | { "EXAMPLE:"; echo = 2; |
---|
| 246 | ring r=0,(x,y),dp; |
---|
| 247 | splitring(x2-2,"r1"); // change to Q(sqrt(2)) |
---|
| 248 | splitring(x2-a,"r2",a); // change to Q(sqrt(2),sqrt(sqrt(2)))=Q(a) |
---|
| 249 | // and return the transformed old parameter |
---|
| 250 | // the result is (a2) == (sqrt(sqrt(2)))^2 |
---|
| 251 | nameof(basering); |
---|
| 252 | r2; |
---|
| 253 | kill r1; kill r2; |
---|
| 254 | } |
---|