[cf29809] | 1 | // $Id: primitiv.lib,v 1.1 1997-06-30 12:31:44 Singular Exp $ |
---|
| 2 | // This library requires Singular 1.0 |
---|
| 3 | |
---|
| 4 | LIBRARY: primitiv.lib PROCEDURES FOR FINDING A PRIMITIVE ELEMENT |
---|
| 5 | |
---|
| 6 | primitivE(ideal i); finds minimal polynomial for a primitive element |
---|
| 7 | |
---|
| 8 | splitring(poly f,string R[,list L]); define ringextension with name R |
---|
| 9 | and switch to it |
---|
| 10 | randomLast(int b); random transformation of the last variable |
---|
| 11 | |
---|
| 12 | LIB "random.lib"; |
---|
| 13 | /////////////////////////////////////////////////////////////////////////////// |
---|
| 14 | |
---|
| 15 | proc randomLast(int b) |
---|
| 16 | USAGE: randomLast |
---|
| 17 | RETURN: ideal = maxideal(1) but the last variable exchanged by |
---|
| 18 | a sum of it with a linear random combination of the other |
---|
| 19 | variables |
---|
| 20 | NOTE: |
---|
| 21 | EXAMPLE: example randomLast; shows an example |
---|
| 22 | { |
---|
| 23 | |
---|
| 24 | ideal i=maxideal(1); |
---|
| 25 | int k=size(i); |
---|
| 26 | i[k]=0; |
---|
| 27 | i=randomid(i,size(i),b); |
---|
| 28 | ideal ires=maxideal(1); |
---|
| 29 | ires[k]=i[1]+var(k); |
---|
| 30 | return(ires); |
---|
| 31 | } |
---|
| 32 | example |
---|
| 33 | { "EXAMPLE:"; echo = 2; |
---|
| 34 | ring r = 0,(x,y,z),lp; |
---|
| 35 | ideal i = randomLast(10); |
---|
| 36 | i; |
---|
| 37 | } |
---|
| 38 | |
---|
| 39 | |
---|
| 40 | proc primitivE(ideal i) |
---|
| 41 | USAGE: primitivE(i); i ideal of the following form: |
---|
| 42 | Let k be the ground field of your basering, a_1,...,a_n algebraic over k, |
---|
| 43 | m_1(x1), m_2(x_1,x_2),...,m_n(x_1,...,x_n) polynomials in k such that |
---|
| 44 | m_j(a_1,...,a_(j-1),x_j) is minimal polynomial for a_j over k(a_1,...,a_(j-1)) |
---|
| 45 | for all j=1,...,n. |
---|
| 46 | Then i has to be generated by m_1,...,m_n. |
---|
| 47 | |
---|
| 48 | RETURN: ideal j in k[x_n] such that |
---|
| 49 | j[1] is minimal polynomial for a primitive element b of k(a_1,...,a_n)=k(b) |
---|
| 50 | over k |
---|
| 51 | j[2],...,j[n+1] polynomials in k[x_n] : j[i+1](b)=a_i for i=1,...,n |
---|
| 52 | NOTE: the number of variables in the basering has to be exactly the number n of |
---|
| 53 | given algebraic elements (and minimal polynomials) |
---|
| 54 | EXAMPLE: example primitivE; shows an example |
---|
| 55 | { |
---|
| 56 | def altring=basering; |
---|
| 57 | execute("ring deglexring=("+charstr(altring)+"),("+varstr(altring)+"),dp;"); |
---|
| 58 | ideal j; |
---|
| 59 | execute("ring lexring=("+charstr(altring)+"),("+varstr(altring)+"),lp;"); |
---|
| 60 | ideal i=fetch(altring,i); |
---|
| 61 | |
---|
| 62 | int k,schlecht; |
---|
| 63 | //def P=basering; |
---|
| 64 | int nva = nvars(basering); |
---|
| 65 | ideal jmap,j; |
---|
| 66 | map phi; |
---|
| 67 | option(redSB); |
---|
| 68 | int Fehlversuche; |
---|
| 69 | |
---|
| 70 | for (Fehlversuche=0; 1; Fehlversuche++) { |
---|
| 71 | schlecht=0; |
---|
| 72 | if (Fehlversuche==0) { jmap=maxideal(1);} |
---|
| 73 | else { |
---|
| 74 | if (Fehlversuche<3) { jmap=randomLast(10);} |
---|
| 75 | else { jmap=randomLast(100);} |
---|
| 76 | } |
---|
| 77 | phi=lexring,jmap; |
---|
| 78 | j=phi(i); |
---|
| 79 | setring deglexring; |
---|
| 80 | |
---|
| 81 | // j=std(fetch(lexring,phi(i)));j; will er nicht |
---|
| 82 | j=std(fetch(lexring,j)); |
---|
| 83 | setring lexring; |
---|
| 84 | j=fglm(deglexring,j); |
---|
| 85 | //testen, ob SB n Elemente enthaelt |
---|
| 86 | // falls ja lead(Fi)=xi i=1... n-1 |
---|
| 87 | if (size(j)==nva) { |
---|
| 88 | for (k=1; k<nva; k++) { |
---|
| 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;} // Random-Koord.transf. war schlecht gewaehlt |
---|
| 91 | } |
---|
| 92 | if (schlecht==0) { |
---|
| 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; |
---|
| 98 | ideal extra=maxideal(1);extra=phi(extra); // sonst: "argument of a map must have a name" |
---|
| 99 | erg=j[1]+chi(extra); // j[1] = Minimalpolynom |
---|
| 100 | setring altring; |
---|
| 101 | return(fetch(lexring,erg)); |
---|
| 102 | } |
---|
| 103 | } |
---|
| 104 | "The random coordinate change was bad!"; |
---|
| 105 | } |
---|
| 106 | } |
---|
| 107 | example |
---|
| 108 | { "EXAMPLE:"; echo = 2; |
---|
| 109 | ring exring=0,(x,y),dp; |
---|
| 110 | ideal i=x2+1,y2-x; // compute Q(i,i^(1/2))=:L |
---|
| 111 | ideal j=primitivE(i); // -> we have L=Q(a): |
---|
| 112 | "minimal polynomial of a:",j[1]; // => a=(-1)^(1/4) |
---|
| 113 | "polynomial for i: ",j[2]; // => i=a^2 |
---|
| 114 | "polynomial for i^(1/2): ",j[3]; // => i^(1/2)=a |
---|
| 115 | // ==> the 2nd element was already primitive! |
---|
| 116 | j=primitivE(ideal(x2-2,y2-3)); // compute Q(sqrt(2),sqrt(3)) |
---|
| 117 | "minimal polynomial:",j[1]; |
---|
| 118 | "polynomial p s.t. p(a)=sqrt(2):",j[2]; |
---|
| 119 | "polynomial r s.t. r(a)=sqrt(3):",j[3]; |
---|
| 120 | // ==> no element was primitive -- the calculation of a is based on a random |
---|
| 121 | // choice. |
---|
| 122 | } |
---|
| 123 | |
---|
| 124 | //proc splitring(poly f, string @R, list L) |
---|
| 125 | proc splitring |
---|
| 126 | USAGE: splitring(f,R[,L]); f poly, univariate, irreducible(!), R string, |
---|
| 127 | L list of polys and/or ideals (optional) |
---|
| 128 | ACTION: defines a ring with name R, in which f is reducible, and changes to it |
---|
| 129 | If the old ring has no parameter, the name 'a' is chosen for the |
---|
| 130 | parameter of R (if a is no variable; if it is, the proc takes 'b'; if |
---|
| 131 | this is also impossible, then 'c'), otherwise the name of the parameter |
---|
| 132 | is kept and only the minimal polynomial is changed. |
---|
| 133 | The names of variables and orderings are not affected. |
---|
| 134 | |
---|
| 135 | It is also allowed to call splitring with R=="". Then the old basering |
---|
| 136 | will be REPLACED by the new ring (with the same name as the old ring). |
---|
| 137 | |
---|
| 138 | RETURNs: list L mapped into the new ring R, if L is given; else nothing |
---|
| 139 | NOTE : it is assumed that the active ring is bivariate |
---|
| 140 | EXAMPLE: example splitring; shows an example |
---|
| 141 | { |
---|
| 142 | // split ist bereits eine proc in 'inout.lib' |
---|
| 143 | poly f=#[1]; string @R=#[2]; |
---|
| 144 | if (size(#)>2) { |
---|
| 145 | list L=#[3]; |
---|
| 146 | int L_groesse=size(L); |
---|
| 147 | } |
---|
| 148 | else { int L_groesse=-1; } |
---|
| 149 | // ermittle das Minimalpolynom des aktuellen Rings: |
---|
| 150 | string minp=string(minpoly); |
---|
| 151 | |
---|
| 152 | if (@R=="") { |
---|
| 153 | string altrname=nameof(basering); |
---|
| 154 | @R="splt_temp"; |
---|
| 155 | } |
---|
| 156 | |
---|
| 157 | def altring=basering; |
---|
| 158 | string charakt=string(char(altring)); |
---|
| 159 | string varnames=varstr(altring); |
---|
| 160 | string algname; |
---|
| 161 | |
---|
| 162 | if (minp=="0") { |
---|
| 163 | if (find(varnames,"a")==0) { algname="a";} |
---|
| 164 | else { if (find(varnames,"b")==0) { algname="b";} |
---|
| 165 | else { algname="c";} |
---|
| 166 | } // nur ZWEI Variablen erlaubt ==> c ist kein Variablenname |
---|
| 167 | execute("ring splt1="+charakt+","+algname+",dp;"); |
---|
| 168 | map nach_splt1=altring,var(1),var(1); |
---|
| 169 | execute("poly mipol="+string(nach_splt1(f))+";"); |
---|
| 170 | string Rminp=string(mipol); |
---|
| 171 | execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("+ordstr(altring)+");"); |
---|
| 172 | execute("minpoly="+Rminp+";"); |
---|
| 173 | //execute("def neuring="+@R+";"); |
---|
| 174 | execute("export "+@R+";"); |
---|
| 175 | def neuring=basering; |
---|
| 176 | |
---|
| 177 | list erg; |
---|
| 178 | if (L_groesse>0) { // L ist ja nicht in 'neuring' definiert, daher merke man |
---|
| 179 | map take=altring,maxideal(1); // sich die Groesse als int |
---|
| 180 | erg=take(L); |
---|
| 181 | } // take(empty list) gibt nicht empty list, sondern Fehlermeldung |
---|
| 182 | } |
---|
| 183 | else { |
---|
| 184 | algname=parstr(altring); // Name des algebraischen Elements |
---|
| 185 | //-string fstr=string(f); |
---|
| 186 | if (size(algname)>1) {"only one Parameter is allowed!!"; return();} |
---|
| 187 | // Minimalpolynom in ein Polynom umwandeln: |
---|
| 188 | execute("ring splt2="+charakt+","+algname+",dp;"); |
---|
| 189 | execute("poly mipol="+minp+";"); |
---|
| 190 | // f ist Polynom in algname und einer weiteren Variablen --> mache f bivariat |
---|
| 191 | execute("ring splt3="+charakt+",("+algname+","+varnames+"),dp;"); |
---|
| 192 | //-execute("poly f="+fstr+";"); |
---|
| 193 | poly f=imap(altring,f); // ersetzt //- : fstr & execute |
---|
| 194 | execute("ring splt1="+charakt+",(x,y),dp;"); |
---|
| 195 | map nach_splt1_3=splt3,x,y,y; |
---|
| 196 | map nach_splt1_2=splt2,x; |
---|
| 197 | ideal maxid=nach_splt1_2(mipol),nach_splt1_3(f); |
---|
| 198 | ideal primit=primitivE(maxid); |
---|
| 199 | "new minimal polynomial:",primit[1]; |
---|
| 200 | setring splt2; |
---|
| 201 | map nach_splt2=splt1,0,var(1); // x->0, y->a |
---|
| 202 | minp=string(nach_splt2(primit)[1]); |
---|
| 203 | execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("+ordstr(altring)+");"); |
---|
| 204 | execute("minpoly="+minp+";"); |
---|
| 205 | execute("export "+@R+";"); |
---|
| 206 | def neuring=basering; |
---|
| 207 | // Uebersicht: wenn altring=(p,a),(x,y),dp; dann: |
---|
| 208 | // splt1=p,(x,y),dp; splt2=p,a,dp; splt3=p,(a,x,y),dp; |
---|
| 209 | |
---|
| 210 | if (L_groesse>0) { |
---|
| 211 | setring splt3; |
---|
| 212 | list zwi=imap(altring,L); |
---|
| 213 | map nach_splt3_1=splt1,0,var(1); // x->0, y->a |
---|
| 214 | map convert=splt3,nach_splt3_1(primit)[2],var(2),var(3); |
---|
| 215 | // rechnet das primitive Element von altring in das von neuring um |
---|
| 216 | zwi=convert(zwi); |
---|
| 217 | setring neuring; |
---|
| 218 | list erg=imap(splt3,zwi); |
---|
| 219 | } |
---|
| 220 | } |
---|
| 221 | if (defined(altrname)) { |
---|
| 222 | execute("kill "+altrname+";"); |
---|
| 223 | execute("def "+altrname+" = splt_temp;"); |
---|
| 224 | @R=altrname; |
---|
| 225 | execute("export "+altrname+";"); |
---|
| 226 | kill splt_temp; |
---|
| 227 | } |
---|
| 228 | |
---|
| 229 | execute("keepring "+@R+";"); |
---|
| 230 | if (L_groesse >= 0) {return(erg);} |
---|
| 231 | } |
---|
| 232 | example |
---|
| 233 | { "EXAMPLE:"; echo = 2; |
---|
| 234 | ring r=0,(x,y),dp; |
---|
| 235 | splitring(x2-2,"r1"); // change to Q(sqrt(2)) |
---|
| 236 | splitring(x2-a,"r2",a); // change to Q(sqrt(2),sqrt(sqrt(2)))=Q(a) |
---|
| 237 | // and return the transformed old parameter |
---|
| 238 | // the result is (a2) == (sqrt(sqrt(2)))^2 |
---|
| 239 | nameof(basering); |
---|
| 240 | r2; |
---|
| 241 | kill r1; kill r2; |
---|
| 242 | } |
---|