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 | } |
---|