1 | // last change ML: 12.08.99 |
---|
2 | /////////////////////////////////////////////////////////////////////////////// |
---|
3 | // This library is for Singular 1.2 or newer |
---|
4 | |
---|
5 | version="$Id: primitiv.lib,v 1.19 2005-04-20 17:28:48 Singular Exp $"; |
---|
6 | category="Commutative Algebra"; |
---|
7 | info=" |
---|
8 | LIBRARY: primitiv.lib Computing a Primitive Element |
---|
9 | AUTHOR: Martin Lamm, email: lamm@mathematik.uni-kl.de |
---|
10 | |
---|
11 | PROCEDURES: |
---|
12 | primitive(ideal i); find minimal polynomial for a primitive element |
---|
13 | primitive_extra(i); find primitive element for two generators |
---|
14 | splitring(f,R[,L]); define ring extension with name R and switch to it |
---|
15 | "; |
---|
16 | |
---|
17 | LIB "random.lib"; |
---|
18 | /////////////////////////////////////////////////////////////////////////////// |
---|
19 | |
---|
20 | proc primitive(ideal i) |
---|
21 | "USAGE: primitive(i); i ideal |
---|
22 | ASSUME: i is given by generators m[1],...,m[n] such that for j=1,...,n @* |
---|
23 | - m[j] is a polynomial in k[x(1),...,x(j)] @* |
---|
24 | - m[j](a[1],...,a[j-1],x(j)) is the minimal polynomial for a[j] over |
---|
25 | k(a[1],...,a[j-1]) @* |
---|
26 | (k the ground field of the current basering and x(1),...,x(n) |
---|
27 | the ring variables). |
---|
28 | RETURN: ideal j in k[x(n)] with |
---|
29 | - j[1] a minimal polynomial for a primitive element b of |
---|
30 | k(a[1],...,a[n]) over k, |
---|
31 | - j[2],...,j[n+1] polynomials in k[x(n)] such that j[i+1](b)=a[i] |
---|
32 | for i=1,...,n. |
---|
33 | NOTE: the number of variables in the basering has to be exactly n, |
---|
34 | the number of given generators (i.e., minimal polynomials).@* |
---|
35 | If the ground field k has only a few elements it may happen that no |
---|
36 | linear combination of a[1],...,a[n] is a primitive element. In this |
---|
37 | case @code{primitive(i)} returns the zero ideal, and one should use |
---|
38 | @code{primitive_extra(i)} instead. |
---|
39 | SEE ALSO: primitive_extra |
---|
40 | KEYWORDS: primitive element |
---|
41 | EXAMPLE: example primitive; shows an example |
---|
42 | " |
---|
43 | { |
---|
44 | def altring=basering; |
---|
45 | execute("ring deglexring=("+charstr(altring)+"),("+varstr(altring)+"),dp;"); |
---|
46 | ideal j; |
---|
47 | execute("ring lexring=("+charstr(altring)+"),("+varstr(altring)+"),lp;"); |
---|
48 | ideal i=fetch(altring,i); |
---|
49 | |
---|
50 | int k,schlecht,Fehlversuche,maxtry; |
---|
51 | int nva = nvars(basering); |
---|
52 | int p=char(basering); |
---|
53 | if (p==0) { |
---|
54 | p=100000; |
---|
55 | if (nva<3) { maxtry= 100000000; } |
---|
56 | else { maxtry=2147483647; } |
---|
57 | } |
---|
58 | else { |
---|
59 | if ((nva<4) || (p<60)) { |
---|
60 | maxtry=p^(nva-1); } |
---|
61 | else { |
---|
62 | maxtry=2147483647; // int overflow(^) vermeiden |
---|
63 | } |
---|
64 | } |
---|
65 | ideal jmap,j; |
---|
66 | map phi; |
---|
67 | option(redSB); |
---|
68 | |
---|
69 | //-------- Mache so lange Random-Koord.wechsel, bis letztes Poly ------------- |
---|
70 | //--------------- das Minpoly eines primitiven Elements ist : ---------------- |
---|
71 | for (Fehlversuche=0; Fehlversuche<maxtry; Fehlversuche++) { |
---|
72 | schlecht=0; |
---|
73 | if ((p<60) && (nva==2)) { // systematische Suche statt random |
---|
74 | jmap=ideal(var(1),var(2)+Fehlversuche*var(1)); |
---|
75 | } |
---|
76 | else { |
---|
77 | if (Fehlversuche==0) { jmap=maxideal(1);} |
---|
78 | else { |
---|
79 | if (Fehlversuche<5) { jmap=randomLast(10);} |
---|
80 | else { |
---|
81 | if (Fehlversuche<20) { jmap=randomLast(100);} |
---|
82 | else { jmap=randomLast(100000000);} |
---|
83 | }} // groessere Werte machen keinen Sinn |
---|
84 | } |
---|
85 | phi=lexring,jmap; |
---|
86 | j=phi(i); |
---|
87 | setring deglexring; |
---|
88 | //--------------- Berechne reduzierte Standardbasis mit fglm: ---------------- |
---|
89 | j=std(fetch(lexring,j)); |
---|
90 | setring lexring; |
---|
91 | j=fglm(deglexring,j); |
---|
92 | //-- teste, ob SB n Elemente enthaelt (falls ja, ob lead(Fi)=xi i=1... n-1): - |
---|
93 | if (size(j)==nva) { |
---|
94 | for (k=1; k<nva; k++) { |
---|
95 | j[k+1]=j[k+1]/leadcoef(j[k+1]); // normiere die Erzeuger |
---|
96 | if (lead(j[k+1]) != var(nva-k)) { schlecht=1;} |
---|
97 | } |
---|
98 | if (schlecht==0) { |
---|
99 | //--- Random-Koord.wechsel war gut: Berechne das zurueckzugebende Ideal: ----- |
---|
100 | ideal erg; |
---|
101 | for (k=1; k<nva; k++) { erg[k]=var(k)-j[nva-k+1]; } |
---|
102 | // =g_k(x_n) mit a_k=g_k(a_n) |
---|
103 | erg[nva]=var(nva); |
---|
104 | map chi=lexring,erg; |
---|
105 | ideal extra=maxideal(1);extra=phi(extra); |
---|
106 | // sonst: "argument of a map must have a name" |
---|
107 | erg=j[1],chi(extra); // j[1] = Minimalpolynom |
---|
108 | setring altring; |
---|
109 | return(fetch(lexring,erg)); |
---|
110 | } |
---|
111 | } |
---|
112 | dbprint("The random coordinate change was bad!"); |
---|
113 | } |
---|
114 | if (voice==2) { |
---|
115 | "// ** Warning: No primitive element could be found."; |
---|
116 | "// If the given ideal really describes the minimal polynomials of"; |
---|
117 | "// a series of algebraic elements (cf. `help primitive;') then"; |
---|
118 | "// try `primitive_extra'."; |
---|
119 | } |
---|
120 | setring altring; |
---|
121 | return(ideal(0)); |
---|
122 | } |
---|
123 | example |
---|
124 | { "EXAMPLE:"; echo = 2; |
---|
125 | ring exring=0,(x,y),dp; |
---|
126 | ideal i=x2+1,y2-x; // compute Q(i,i^(1/2))=:L |
---|
127 | ideal j=primitive(i); |
---|
128 | j[1]; // L=Q(a) with a=(-1)^(1/4) |
---|
129 | j[2]; // i=a^2 |
---|
130 | j[3]; // i^(1/2)=a |
---|
131 | // the 2nd element was already primitive! |
---|
132 | j=primitive(ideal(x2-2,y2-3)); // compute Q(sqrt(2),sqrt(3)) |
---|
133 | j[1]; |
---|
134 | j[2]; |
---|
135 | j[3]; |
---|
136 | // no element was primitive -- the calculation of primitive elements |
---|
137 | // is based on a random choice. |
---|
138 | } |
---|
139 | /////////////////////////////////////////////////////////////////////////////// |
---|
140 | |
---|
141 | proc primitive_extra(ideal i) |
---|
142 | "USAGE: primitive_extra(i); i ideal |
---|
143 | ASSUME: The ground field of the basering is k=Q or k=Z/pZ and the ideal |
---|
144 | i is given by 2 generators f,g with the following properties: |
---|
145 | @format |
---|
146 | f is the minimal polynomial of a in k[x], |
---|
147 | g is a polynomial in k[x,y] s.th. g(a,y) is the minpoly of b in k(a)[y]. |
---|
148 | @end format |
---|
149 | Here, x is the name of the first ring variable, y the name of the |
---|
150 | second. |
---|
151 | RETURN: ideal j in k[y] such that |
---|
152 | @format |
---|
153 | j[1] is the minimal polynomial for a primitive element c of k(a,b) over k, |
---|
154 | j[2] is a polynomial s.th. j[2](c)=a. |
---|
155 | @end format |
---|
156 | NOTE: While @code{primitive(i)} may fail for finite fields, |
---|
157 | @code{primitive_extra(i)} tries all elements of k(a,b) and, hence, |
---|
158 | always finds a primitive element. @* |
---|
159 | In order to do this (try all elements), field extensions like Z/pZ(a) |
---|
160 | are not allowed for the ground field k. @* |
---|
161 | @code{primitive_extra(i)} assumes that the second generator, g, is |
---|
162 | monic as polynomial in (k[x])[y]. |
---|
163 | EXAMPLE: example primitive_extra; shows an example |
---|
164 | " |
---|
165 | { |
---|
166 | def altring=basering; |
---|
167 | int grad1,grad2=deg(i[1]),deg(jet(i[2],0,intvec(1,0))); |
---|
168 | int countx,countz; |
---|
169 | ring deglexring=char(altring),(x,y,z),dp; |
---|
170 | map transfer=altring,x,z; |
---|
171 | ideal i=transfer(i); |
---|
172 | if (size(i)!=2) { |
---|
173 | "//** Error -- either wrong number of given minimal polynomials"; |
---|
174 | "//** or wrong choice of ring variables (must use the first two)"; |
---|
175 | setring altring; |
---|
176 | return(ideal(0)); |
---|
177 | } |
---|
178 | matrix mat; |
---|
179 | ring lexring=char(altring),(x,y),lp; |
---|
180 | ideal j; |
---|
181 | ring deglex2ring=char(altring),(x,y),dp; |
---|
182 | ideal j; |
---|
183 | setring deglexring; |
---|
184 | ideal j; |
---|
185 | option(redSB); |
---|
186 | poly g=z; |
---|
187 | int found=0; |
---|
188 | |
---|
189 | //---------------- Schleife zum Finden des primitiven Elements --------------- |
---|
190 | //--- Schleife ist so angordnet, dass g in Charakteristik 0 linear bleibt ---- |
---|
191 | while (found==0) { |
---|
192 | j=eliminate(i+ideal(g-y),z); |
---|
193 | setring deglex2ring; |
---|
194 | j=std(imap(deglexring,j)); |
---|
195 | setring lexring; |
---|
196 | j=fglm(deglex2ring,j); |
---|
197 | if (size(j)==2) { |
---|
198 | if (deg(j[1])==grad1*grad2) { |
---|
199 | j[2]=j[2]/leadcoef(j[2]); // Normierung |
---|
200 | if (lead(j[2])==x) { // Alles ok |
---|
201 | found=1; |
---|
202 | } |
---|
203 | } |
---|
204 | } |
---|
205 | setring deglexring; |
---|
206 | if (found==0) { |
---|
207 | //------------------ waehle ein neues Polynom g ------------------------------ |
---|
208 | dbprint("Still searching for primitive element..."); |
---|
209 | countx=0; |
---|
210 | countz=0; |
---|
211 | while (found==0) { |
---|
212 | countx++; |
---|
213 | if (countx>=grad1) { |
---|
214 | countx=0; |
---|
215 | countz++; |
---|
216 | if (countz>=grad2) { |
---|
217 | "//** Error: No primitive element found!! This should NEVER happen!"; |
---|
218 | setring altring; |
---|
219 | return(ideal(0)); |
---|
220 | } |
---|
221 | } |
---|
222 | g = g +x^countx *z^countz; |
---|
223 | mat=coeffs(g,z); |
---|
224 | if (size(mat)>countz) { |
---|
225 | mat=coeffs(mat[countz+1,1],x); |
---|
226 | if (size(mat)>countx) { |
---|
227 | if (mat[countx+1,1] != 0) { |
---|
228 | found=1; // d.h. hier: neues g gefunden |
---|
229 | }}} |
---|
230 | } |
---|
231 | found=0; |
---|
232 | } |
---|
233 | } |
---|
234 | //------------------- primitives Element gefunden; Rueckgabe ----------------- |
---|
235 | setring lexring; |
---|
236 | j[2]=x-j[2]; |
---|
237 | setring altring; |
---|
238 | map transfer=lexring,var(1),var(2); |
---|
239 | return(transfer(j)); |
---|
240 | } |
---|
241 | example |
---|
242 | { "EXAMPLE:"; echo = 2; |
---|
243 | ring exring=3,(x,y),dp; |
---|
244 | ideal i=x2+1,y3+y2-1; |
---|
245 | primitive_extra(i); |
---|
246 | ring extension=(3,y),x,dp; |
---|
247 | minpoly=y6-y5+y4-y3-y-1; |
---|
248 | number a=y5+y4+y2+y+1; |
---|
249 | a^2; |
---|
250 | factorize(x2+1); |
---|
251 | factorize(x3+x2-1); |
---|
252 | } |
---|
253 | /////////////////////////////////////////////////////////////////////////////// |
---|
254 | |
---|
255 | proc splitring(poly f,list #) |
---|
256 | "USAGE: splitring(f[,L]); f poly, L list of polys and/or ideals |
---|
257 | (optional) |
---|
258 | ASSUME: f is univariate and irreducible over the active ring. @* |
---|
259 | The active ring must allow an algebraic extension (e.g., it cannot |
---|
260 | be a transcendent ring extension of Q or Z/p). |
---|
261 | RETURN: ring; @ |
---|
262 | if called with a nonempty second parameter L, then in the output |
---|
263 | ring there is defined a list erg ( =L mapped to the new ring); |
---|
264 | if the minpoly of the active ring is non-zero, then the image of |
---|
265 | the primitive root of f in the output ring is appended as last |
---|
266 | entry of the list erg. |
---|
267 | NOTE: If the old ring has no parameter, the name @code{a} is chosen for the |
---|
268 | parameter of R (if @code{a} is no ring variable; if it is, @code{b} is |
---|
269 | chosen, etc.; if @code{a,b,c,o} are ring variables, |
---|
270 | @code{splitring(f[,L])} produces an error message), otherwise the |
---|
271 | name of the parameter is kept and only the minimal polynomial is |
---|
272 | changed. @* |
---|
273 | The names of the ring variables and the orderings are not affected. @* |
---|
274 | KEYWORDS: algebraic field extension; extension of rings |
---|
275 | EXAMPLE: example splitring; shows an example |
---|
276 | " |
---|
277 | { |
---|
278 | //----------------- split ist bereits eine proc in 'inout.lib' ! ------------- |
---|
279 | if (size(#)>=1) { |
---|
280 | list L=#; |
---|
281 | int L_groesse=size(L); |
---|
282 | } |
---|
283 | else { int L_groesse=-1; } |
---|
284 | //-------------- ermittle das Minimalpolynom des aktuellen Rings: ------------ |
---|
285 | string minp=string(minpoly); |
---|
286 | |
---|
287 | def altring=basering; |
---|
288 | string charakt=string(char(altring)); |
---|
289 | string varnames=varstr(altring); |
---|
290 | string algname; |
---|
291 | int i; |
---|
292 | int anzvar=size(maxideal(1)); |
---|
293 | //--------------- Fall 1: Bisheriger Ring hatte kein Minimalpolynom ---------- |
---|
294 | if (minp=="0") { // only possible without parameters (by assumption) |
---|
295 | if (find(varnames,"a")==0) { algname="a";} |
---|
296 | else { if (find(varnames,"b")==0) { algname="b";} |
---|
297 | else { if (find(varnames,"c")==0) |
---|
298 | { algname="c";} |
---|
299 | else { if (find(varnames,"o")==0) |
---|
300 | { algname="o";} |
---|
301 | else { |
---|
302 | "** Sorry -- could not find a free name for the primitive element."; |
---|
303 | "** Try e.g. a ring without 'a' or 'b' as variable."; |
---|
304 | return(); |
---|
305 | }} |
---|
306 | } |
---|
307 | } |
---|
308 | //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: - |
---|
309 | execute("ring splt1="+charakt+","+algname+",dp;"); |
---|
310 | ideal abbnach=var(1); |
---|
311 | for (i=1; i<anzvar; i++) { abbnach=abbnach,var(1); } |
---|
312 | map nach_splt1=altring,abbnach; |
---|
313 | execute("poly mipol="+string(nach_splt1(f))+";"); |
---|
314 | string Rminp=string(mipol); |
---|
315 | |
---|
316 | //--------------------- definiere den neuen Ring: --------------------------- |
---|
317 | execute("ring neuring = ("+charakt+","+algname+"),("+varnames+"),(" |
---|
318 | +ordstr(altring)+");"); |
---|
319 | execute("minpoly="+Rminp+";"); |
---|
320 | |
---|
321 | //---------------------- Berechne die zurueckzugebende Liste: --------------- |
---|
322 | if (L_groesse>0) { |
---|
323 | list erg; |
---|
324 | map take=altring,maxideal(1); |
---|
325 | erg=take(L); |
---|
326 | } |
---|
327 | } |
---|
328 | else { |
---|
329 | |
---|
330 | //------------- Fall 2: Bisheriger Ring hatte ein Minimalpolynom: ----------- |
---|
331 | algname=parstr(altring); // Name des algebraischen Elements |
---|
332 | if (npars(altring)>1) {"only one Parameter is allowed!!"; return(altring);} |
---|
333 | |
---|
334 | //---------------- Minimalpolynom in ein Polynom umwandeln: ----------------- |
---|
335 | execute("ring splt2="+charakt+","+algname+",dp;"); |
---|
336 | execute("poly mipol="+minp+";"); |
---|
337 | // f ist Polynom in algname und einer weiteren Variablen -> mache f bivariat: |
---|
338 | execute("ring splt3="+charakt+",("+algname+","+varnames+"),dp;"); |
---|
339 | poly f=imap(altring,f); |
---|
340 | |
---|
341 | //-------------- Vorbereitung des Aufrufes von primitive: ------------------- |
---|
342 | execute("ring splt1="+charakt+",(x,y),dp;"); |
---|
343 | ideal abbnach=x; |
---|
344 | for (i=1; i<=anzvar; i++) { abbnach=abbnach,y; } |
---|
345 | map nach_splt1_3=splt3,abbnach; |
---|
346 | map nach_splt1_2=splt2,x; |
---|
347 | ideal maxid=nach_splt1_2(mipol),nach_splt1_3(f); |
---|
348 | ideal primit=primitive(maxid); |
---|
349 | if (size(primit)==0) { // Suche mit 1. Proc erfolglos |
---|
350 | primit=primitive_extra(maxid); |
---|
351 | } |
---|
352 | //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: - |
---|
353 | setring splt2; |
---|
354 | map nach_splt2=splt1,0,var(1); // x->0, y->a |
---|
355 | minp=string(nach_splt2(primit)[1]); |
---|
356 | if (printlevel > -1) { "// new minimal polynomial:",minp; } |
---|
357 | //--------------------- definiere den neuen Ring: --------------------------- |
---|
358 | execute("ring neuring = ("+charakt+","+algname+"),("+varnames+"),(" |
---|
359 | +ordstr(altring)+");"); |
---|
360 | execute("minpoly="+minp+";"); |
---|
361 | |
---|
362 | if (L_groesse>0) { |
---|
363 | //---------------------- Berechne die zurueckzugebende Liste: ------------- |
---|
364 | list erg; |
---|
365 | setring splt3; |
---|
366 | list zwi=imap(altring,L); |
---|
367 | map nach_splt3_1=splt1,0,var(1); // x->0, y->a |
---|
368 | //----- rechne das primitive Element von altring in das von neuring um: --- |
---|
369 | ideal convid=maxideal(1); |
---|
370 | convid[1]=nach_splt3_1(primit)[2]; |
---|
371 | poly new_b=nach_splt3_1(primit)[3]; |
---|
372 | map convert=splt3,convid; |
---|
373 | zwi=convert(zwi); |
---|
374 | setring neuring; |
---|
375 | erg=imap(splt3,zwi); |
---|
376 | erg[size(erg)+1]=imap(splt3,new_b); |
---|
377 | } |
---|
378 | } |
---|
379 | if (defined(erg)){export erg;} |
---|
380 | return(neuring); |
---|
381 | } |
---|
382 | example |
---|
383 | { "EXAMPLE:"; echo = 2; |
---|
384 | ring r=0,(x,y),dp; |
---|
385 | splitring(x2-2,"r1"); // change to Q(sqrt(2)) |
---|
386 | // change to Q(sqrt(2),sqrt(sqrt(2)))=Q(a) and return the transformed |
---|
387 | // old parameter: |
---|
388 | splitring(x2-a,"r2",a); |
---|
389 | // the result is (a)^2 = (sqrt(sqrt(2)))^2 |
---|
390 | nameof(basering); |
---|
391 | r2; |
---|
392 | kill r1; kill r2; |
---|
393 | } |
---|
394 | /////////////////////////////////////////////////////////////////////////////// |
---|