source: git/Singular/LIB/primitiv.lib @ e36ae54

spielwiese
Last change on this file since e36ae54 was 0132b0, checked in by Olaf Bachmann <obachman@…>, 26 years ago
* incoporated new versions from Martin git-svn-id: file:///usr/local/Singular/svn/trunk@1437 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 10.1 KB
Line 
1// $Id: primitiv.lib,v 1.4 1998-04-23 13:23:27 obachman Exp $
2// author:  Martin Lamm,  email: lamm@mathematik.uni-kl.de
3// last change:           11.3.98
4///////////////////////////////////////////////////////////////////////////////
5version="$Id: primitiv.lib,v 1.4 1998-04-23 13:23:27 obachman Exp $";
6info="
7LIBRARY:    primitiv.lib    PROCEDURES FOR FINDING A PRIMITIVE ELEMENT
8
9 primitive(ideal i);   finds minimal polynomial for a primitive element
10 splitring(f,R[,L]);   define ring extension with name R and switch to it
11 randomLast(b);        random transformation of the last variable
12";
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
23EXAMPLE: example randomLast; shows an example
24{
25  ideal i=maxideal(1);
26  int k=size(i);
27  i[k]=0;
28  i=randomid(i,size(i),b);
29  ideal ires=maxideal(1);
30  ires[k]=i[1]+var(k);
31  return(ires);
32}
33example
34{ "EXAMPLE:"; echo = 2;
35   ring  r = 0,(x,y,z),lp;
36   ideal i = randomLast(10);
37   i;
38}
39///////////////////////////////////////////////////////////////////////////////
40
41proc primitive(ideal i)
42USAGE:  primitive(i); i ideal of the following form:
43 Let k be the ground field of your basering, a_1,...,a_n algebraic over k,
44 m_1(x1), m_2(x_1,x_2),...,m_n(x_1,...,x_n) polynomials in k such that
45 m_j(a_1,...,a_(j-1),x_j) is minimal polynomial for a_j over k(a_1,...,a_(j-1))
46                                                        for all j=1,...,n.
47 Then i has to be generated by m_1,...,m_n.
48
49RETURN:  ideal j in k[x_n] such that
50 j[1] is minimal polynomial for a primitive element b of k(a_1,...,a_n)=k(b)
51         over k
52 j[2],...,j[n+1] polynomials in k[x_n] : j[i+1](b)=a_i for i=1,...,n
53NOTE:    the number of variables in the basering has to be exactly the number n
54         of given algebraic elements (and minimal polynomials)
55EXAMPLE: example primitive;  shows an example
56{
57 def altring=basering;
58 execute("ring deglexring=("+charstr(altring)+"),("+varstr(altring)+"),dp;");
59 ideal j;
60 execute("ring lexring=("+charstr(altring)+"),("+varstr(altring)+"),lp;");
61 ideal i=fetch(altring,i);
62
63 int k,schlecht;
64 int nva = nvars(basering);
65 ideal jmap,j;
66 map phi;
67 option(redSB);
68 int Fehlversuche;
69 //-------- Mache so lange Random-Koord.wechsel, bis letztes Poly -------------
70 //--------------- das Minpoly eines primitiven Elements ist : ----------------
71 for (Fehlversuche=0; 1; Fehlversuche++) {
72   schlecht=0;
73   if (Fehlversuche==0) { jmap=maxideal(1);}
74   else {
75     if (Fehlversuche<3) { jmap=randomLast(10);}
76     else                { jmap=randomLast(100);}
77   }
78   phi=lexring,jmap;
79   j=phi(i);
80   setring deglexring;
81 //--------------- Berechne reduzierte Standardbasis mit fglm: ----------------
82   j=std(fetch(lexring,j));
83   setring lexring;
84   j=fglm(deglexring,j);
85 //-- teste, ob SB n Elemente enthaelt (falls ja, ob lead(Fi)=xi i=1... n-1): -
86   if (size(j)==nva) {
87     for (k=1; k<nva; k++) {
88       j[k+1]=j[k+1]/leadcoef(j[k+1]);        // normiere die Erzeuger
89       if (lead(j[k+1]) != var(nva-k)) { schlecht=1;}
90     }
91     if (schlecht==0) {
92 //--- Random-Koord.wechsel war gut: Berechne das zurueckzugebende Ideal: -----
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);
99                               // sonst: "argument of a map must have a name"
100       erg=j[1]+chi(extra);    // j[1] = Minimalpolynom
101       setring altring;
102       return(fetch(lexring,erg));
103     }
104   }
105   "The random coordinate change was bad!";
106 }
107}
108example
109{ "EXAMPLE:"; echo = 2;
110 ring exring=0,(x,y),dp;
111 ideal i=x2+1,y2-x;                  // compute Q(i,i^(1/2))=:L
112 ideal j=primitive(i);               // -> we have L=Q(a):
113 "minimal polynomial of a:",j[1];    // => a=(-1)^(1/4)
114 "polynomial for i:       ",j[2];    // => i=a^2
115 "polynomial for i^(1/2): ",j[3];    // => i^(1/2)=a
116 // ==> the 2nd element was already primitive!
117 j=primitive(ideal(x2-2,y2-3));      // compute Q(sqrt(2),sqrt(3))
118 "minimal polynomial:",j[1];
119 "polynomial p s.t. p(a)=sqrt(2):",j[2];
120 "polynomial r s.t. r(a)=sqrt(3):",j[3];
121 // ==> no element was primitive -- the calculation of a is based on a random
122 //     choice.
123}
124///////////////////////////////////////////////////////////////////////////////
125
126proc splitring
127USAGE:  splitring(f,R[,L]);  f poly, univariate, irreducible(!), R string,
128                     L list of polys and/or ideals (optional)
129ACTION: defines a ring with name R, in which f is reducible, and changes to it
130        If the old ring has no parameter, the name 'a' is chosen for the
131        parameter of R (if a is no variable; if it is, the proc takes 'b',
132        etc.; if a,b,c,o are variables of the ring, produce an error message),
133        otherwise the name of the parameter is kept and only the
134        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
140RETURN: list L mapped into the new ring R, if L is given; else nothing
141ASSUME: the active ring must 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 int i;
165 int anzvar=size(maxideal(1));
166 //--------------- Fall 1: Bisheriger Ring hatte kein Minimalpolynom ----------
167 if (minp=="0") {
168  if (find(varnames,"a")==0)        { algname="a";}
169  else { if (find(varnames,"b")==0) { algname="b";}
170         else { if (find(varnames,"c")==0)
171                                    { algname="c";}
172         else { if (find(varnames,"o")==0)
173                                    { algname="o";}
174         else {
175           "** Sorry -- could not find a free name for the primitive element.";
176           "** Try e.g. a ring without 'a' or 'b' as variable.";
177           return();
178         }}
179       }
180  }
181 //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: --
182  execute("ring splt1="+charakt+","+algname+",dp;");
183  ideal abbnach=var(1);
184  for (i=1; i<anzvar; i++) { abbnach=abbnach,var(1); }
185  map nach_splt1=altring,abbnach;
186  execute("poly mipol="+string(nach_splt1(f))+";");
187  string Rminp=string(mipol);
188 //--------------------- definiere den neuen Ring: ----------------------------
189  execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("
190           +ordstr(altring)+");");
191  execute("minpoly="+Rminp+";");
192  execute("export "+@R+";");
193  def neuring=basering;
194 //---------------------- Berechne die zurueckzugebende Liste: ----------------
195  list erg;
196  if (L_groesse>0) {
197 // L ist ja nicht in 'neuring' def., daher merke man sich die Groesse als int
198   map take=altring,maxideal(1);
199   erg=take(L);
200  }            // take(empty list) gibt nicht empty list, sondern Fehlermeldung
201 }
202 else {
203 //------------- Fall 2: Bisheriger Ring hatte ein Minimalpolynom: ------------
204  algname=parstr(altring);           // Name des algebraischen Elements
205  if (size(algname)>1) {"only one Parameter is allowed!!"; return();}
206 //---------------- Minimalpolynom in ein Polynom umwandeln: ------------------
207  execute("ring splt2="+charakt+","+algname+",dp;");
208  execute("poly mipol="+minp+";");
209 // f ist Polynom in algname und einer weiteren Variablen --> mache f bivariat:
210  execute("ring splt3="+charakt+",("+algname+","+varnames+"),dp;");
211  poly f=imap(altring,f);
212 //-------------- Vorbereitung des Aufrufes von primitive: --------------------
213  execute("ring splt1="+charakt+",(x,y),dp;");
214  ideal abbnach=x;
215  for (i=1; i<=anzvar; i++) { abbnach=abbnach,y; }
216  map nach_splt1_3=splt3,abbnach;
217  map nach_splt1_2=splt2,x;
218  ideal maxid=nach_splt1_2(mipol),nach_splt1_3(f);
219  ideal primit=primitive(maxid);
220  "new minimal polynomial:",primit[1];
221 //-- erzeuge einen String, der das Minimalpolynom des neuen Rings enthaelt: --
222  setring splt2;
223  map nach_splt2=splt1,0,var(1);     // x->0, y->a
224  minp=string(nach_splt2(primit)[1]);
225 //--------------------- definiere den neuen Ring: ----------------------------
226  execute("ring "+@R+" = ("+charakt+","+algname+"),("+varnames+"),("
227          +ordstr(altring)+");");
228  execute("minpoly="+minp+";");
229  execute("export "+@R+";");
230  def neuring=basering;
231
232 //--------------- Uebersicht: wenn altring=(p,a),(x,y),dp; dann: -------------
233 //------------ splt1=p,(x,y),dp;  splt2=p,a,dp;  splt3=p,(a,x,y),dp; ---------
234
235  list erg;
236  if (L_groesse>0) {
237 //---------------------- Berechne die zurueckzugebende Liste: ----------------
238    setring splt3;
239    list zwi=imap(altring,L);
240    map nach_splt3_1=splt1,0,var(1);  // x->0, y->a
241 //----- rechne das primitive Element von altring in das von neuring um: ------
242    ideal convid=maxideal(1);
243    convid[1]=nach_splt3_1(primit)[2];
244    map convert=splt3,convid;
245    zwi=convert(zwi);
246    setring neuring;
247    erg=imap(splt3,zwi);
248  }
249 }
250 if (defined(altrname)) {
251   execute("kill "+altrname+";");
252   execute("def "+altrname+" = splt_temp;");
253   @R=altrname;
254   execute("export "+altrname+";");
255   kill splt_temp;
256 }
257
258 execute("keepring "+@R+";");
259 if (L_groesse >= 0) {return(erg);}
260}
261example
262{ "EXAMPLE:"; echo = 2;
263 ring r=0,(x,y),dp;
264 splitring(x2-2,"r1");   // change to Q(sqrt(2))
265 splitring(x2-a,"r2",a); // change to Q(sqrt(2),sqrt(sqrt(2)))=Q(a)
266                         // and return the transformed old parameter
267 // the result is (a2) == (sqrt(sqrt(2)))^2
268 nameof(basering);
269 r2;
270 kill r1; kill r2;
271}
Note: See TracBrowser for help on using the repository browser.