# source:git/Singular/LIB/primitiv.lib@5480da

spielwiese
Last change on this file since 5480da was 5480da, checked in by Kai Krüger <krueger@…>, 25 years ago
• Property mode set to `100644`
File size: 9.5 KB
Line
1// \$Id: primitiv.lib,v 1.3 1998-04-03 22:47:11 krueger Exp \$
2// This library requires Singular 1.0
3
4version="\$Id: primitiv.lib,v 1.3 1998-04-03 22:47:11 krueger Exp \$";
5info="
6LIBRARY:    primitiv.lib    PROCEDURES FOR FINDING A PRIMITIVE ELEMENT
7
8 primitivE(ideal i); finds minimal polynomial for a primitive element
9
10 splitring(poly f,string R[,list L]);  define ring extension with name R
11                                       and switch to it
12 randomLast(int b);       random transformation of the last variable
13";
14
15LIB "random.lib";
16///////////////////////////////////////////////////////////////////////////////
17
18proc randomLast(int b)
19USAGE:   randomLast
20RETURN:  ideal = maxideal(1) but the last variable exchanged by
21         a sum of it with a linear random combination of the other
22         variables
23NOTE:
24EXAMPLE: 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}
34example
35{ "EXAMPLE:"; echo = 2;
36   ring  r = 0,(x,y,z),lp;
37   ideal i = randomLast(10);
38   i;
39}
40///////////////////////////////////////////////////////////////////////////////
41
42proc primitivE(ideal i)
43USAGE:  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
50RETURN: 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
54NOTE: the number of variables in the basering has to be exactly the number n of
55      given algebraic elements (and minimal polynomials)
56EXAMPLE:    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;
70 //-------- Mache so lange Random-Koord.wechsel, bis letztes Poly -------------
71 //--------------- das Minpoly eines primitiven Elements ist : ----------------
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;
82 //--------------- Berechne reduzierte Standardbasis mit fglm: ----------------
83   j=std(fetch(lexring,j));
84   setring lexring;
85   j=fglm(deglexring,j);
86 //-- teste, ob SB n Elemente enthaelt (falls ja, ob 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;}
91     }
92     if (schlecht==0) {
93 //--- Random-Koord.wechsel war gut: Berechne das zurueckzugebende Ideal: -----
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;
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
102       setring altring;
103       return(fetch(lexring,erg));
104     }
105   }
106   "The random coordinate change was bad!";
107 }
108}
109example
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}
125///////////////////////////////////////////////////////////////////////////////
126
127proc splitring
128USAGE:  splitring(f,R[,L]);  f poly, univariate, irreducible(!), R string,
129                     L list of polys and/or ideals (optional)
130ACTION: 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
140RETURNs: list L mapped into the new ring R, if L is given; else nothing
141ASSUME : 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)
143EXAMPLE: example splitring;  shows an example
144{
145 //----------------- split ist bereits eine proc in 'inout.lib' ! -------------
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; }
152 //-------------- ermittle das Minimalpolynom des aktuellen Rings: ------------
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;
164 //--------------- Fall 1: Bisheriger Ring hatte kein Minimalpolynom ----------
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";}
169 //----------- nur ZWEI Variablen erlaubt ==> c ist kein Variablenname --------
170  }
171 //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: --
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);
176 //--------------------- definiere den neuen Ring: ----------------------------
177  execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("
178           +ordstr(altring)+");");
179  execute("minpoly="+Rminp+";");
180  execute("export "+@R+";");
181  def neuring=basering;
182 //---------------------- Berechne die zurueckzugebende Liste: ----------------
183  list erg;
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);
187   erg=take(L);
188  }            // take(empty list) gibt nicht empty list, sondern Fehlermeldung
189 }
190 else {
191 //------------- Fall 2: Bisheriger Ring hatte ein Minimalpolynom: ------------
192  algname=parstr(altring);           // Name des algebraischen Elements
193  if (size(algname)>1) {"only one Parameter is allowed!!"; return();}
194 //---------------- Minimalpolynom in ein Polynom umwandeln: ------------------
195  execute("ring splt2="+charakt+","+algname+",dp;");
196  execute("poly mipol="+minp+";");
197 // f ist Polynom in algname und einer weiteren Variablen --> mache f bivariat:
198  execute("ring splt3="+charakt+",("+algname+","+varnames+"),dp;");
199  poly f=imap(altring,f);
200 //-------------- Vorbereitung des Aufrufes von primitivE: --------------------
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];
207 //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: --
208  setring splt2;
209  map nach_splt2=splt1,0,var(1);     // x->0, y->a
210  minp=string(nach_splt2(primit)[1]);
211 //--------------------- definiere den neuen Ring: ----------------------------
212  execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("+ordstr(altring)+");");
213  execute("minpoly="+minp+";");
214  execute("export "+@R+";");
215  def neuring=basering;
216
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;
221  if (L_groesse>0) {
222 //---------------------- Berechne die zurueckzugebende Liste: ----------------
223    setring splt3;
224    list zwi=imap(altring,L);
225    map nach_splt3_1=splt1,0,var(1);  // x->0, y->a
226 //----- rechne das primitive Element von altring in das von neuring um: ------
227    map convert=splt3,nach_splt3_1(primit)[2],var(2),var(3);
228    zwi=convert(zwi);
229    setring neuring;
230    erg=imap(splt3,zwi);
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}
244example
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}
Note: See TracBrowser for help on using the repository browser.