source:git/Singular/LIB/ring.lib@0bc582c

spielwiese
Last change on this file since 0bc582c was 0bc582c, checked in by Frank Seelisch <seelisch@…>, 14 years ago
removed some docu bugs prior to release 3-1-0 git-svn-id: file:///usr/local/Singular/svn/trunk@11624 2c84dea3-7e68-4137-9b89-c4e89433aadc
• Property mode set to `100644`
File size: 28.4 KB
Line
1///////////////////////////////////////////////////////////////////////////////
2version="\$Id: ring.lib,v 1.33 2009-04-06 09:17:01 seelisch Exp \$";
3category="General purpose";
4info="
5LIBRARY:  ring.lib      Manipulating Rings and Maps
6
7PROCEDURES:
8 changechar(\"R\",c[,r]); make a copy R of basering [ring r] with new char c
9 changeord(\"R\",o[,r]);  make a copy R of basering [ring r] with new ord o
10 changevar(\"R\",v[,r]);  make a copy R of basering [ring r] with new vars v
11 defring(\"R\",c,n,v,o);  define a ring R in specified char c, n vars v, ord o
12 defrings(n[,p]);         define ring Sn in n vars, char 32003 [p], ord ds
13 defringp(n[,p]);         define ring Pn in n vars, char 32003 [p], ord dp
14 extendring(\"R\",n,v,o); extend given ring by n vars v, ord o and name it R
15 fetchall(R[,str]);       fetch all objects of ring R to basering
16 imapall(R[,str]);        imap all objects of ring R to basering
17 mapall(R,i[,str]);       map all objects of ring R via ideal i to basering
18 ord_test(R);             test wether ordering of R is global, local or mixed
19 ringtensor(\"R\",s,t,..);create ring R, tensor product of rings s,t,...
20 ringweights(r);          intvec of weights of ring variables of ring r
21 preimageLoc(R,phi,Q)     computes preimage for non-global orderings
22 rootofUnity(n);         the minimal polynomial for the n-th primitive root of unity
23             (parameters in square brackets [] are optional)
24";
25
26LIB "inout.lib";
27LIB "general.lib";
28LIB "primdec.lib";
29///////////////////////////////////////////////////////////////////////////////
30
31proc changechar (string c, list #)
32"USAGE:   changechar(c[,r]);  c=string, r=ring
33RETURN:  ring R, obtained from the ring r [default: r=basering], by changing
34         charstr(r) to c.
35NOTE:    Works for qrings if map from old_char to new_char is implemented.
36         This proc uses 'execute' or calls a procedure using 'execute'.
37EXAMPLE: example changechar; shows an example
38"
39{
40   if( size(#)==0 ) { def @r=basering; }
41   if(( size(#)==1 ) and (typeof(#[1])=="ring")) { def @r=#[1]; }
42   setring @r;
43   ideal i = ideal(@r); int @q = size(i);
44   if( @q!=0 )
45      { string @s = "Rnew1"; }
46   else
47      { string @s = "Rnew"; }
48   string @newring = @s+"=("+c+"),("+varstr(@r)+"),("+ordstr(@r)+");";
49   execute("ring "+@newring);
50   if( @q!=0 )
51   {
52      map phi = @r,maxideal(1);
53      ideal i = phi(i);
54      attrib(i,"isSB",1);         //*** attrib funktioniert ?
55      qring Rnew=i;
56   }
57   return(Rnew);
58}
59example
60{  "EXAMPLE:"; echo = 2;
61   ring r=0,(x,y,u,v),(dp(2),ds);
62   def R=changechar("2,A"); R;"";
63   def R1=changechar("32003",R); setring R1; R1;
64   kill R,R1;
65}
66///////////////////////////////////////////////////////////////////////////////
67
68proc changeord (string o, list #)
69"USAGE:   changeord(newordstr[,r]);  newordstr=string, r=ring/qring
70RETURN:  ring R, obtained from the ring r [default: r=basering], by changing
71         ordstr(r) to newordstr. If, say, newordstr=(\"R\",\"wp(2,3),dp\") and
72         if the ring r exists and has >=3 variables, the ring R will be
73         equipped with the monomial ordering wp(2,3),dp.
74NOTE:    This proc uses 'execute' or calls a procedure using 'execute'.
75EXAMPLE: example changeord; shows an example
76"
77{
78   if( size(#)==0 ) { def @r=basering; }
79   if( size(#)==1 ) { def @r=#[1]; }
80   setring @r;
81   ideal i = ideal(@r); int @q = size(i);
82   if( @q!=0 )
83      { string @s = "Rnew1"; }
84   else
85      { string @s = "Rnew"; }
86   string @newring = @s+"=("+charstr(@r)+"),("+varstr(@r)+"),("+o+");";
87   execute("ring "+@newring);
88   if( @q!=0 )
89   {
90      map phi = @r,maxideal(1);
91      ideal i = phi(i);
92      attrib(i,"isSB",1);         //*** attrib funktioniert ?
93      qring Rnew=i;
94   }
95   return(Rnew);
96}
97example
98{  "EXAMPLE:"; echo = 2;
99   ring r=0,(x,y,u,v),(dp(2),ds);
100   def R=changeord("wp(2,3),dp"); R; "";
101   ideal i = x^2,y^2-u^3,v;
102   qring Q = std(i);
103   def Q'=changeord("lp",Q); setring Q'; Q';
104   kill R,Q,Q';
105}
106///////////////////////////////////////////////////////////////////////////////
107
108proc changevar (string vars, list #)
109"USAGE:   changevar(vars[,r]);  vars=string, r=ring/qring
110RETURN:  ring R, obtained from the ring r [default: r=basering], by changing
111         varstr(r) according to the value of vars.
112         If, say, vars = \"t()\" and the ring r exists and has n
113         variables, the new basering will have name R and variables
114         t(1),...,t(n).
115         If vars = \"a,b,c,d\", the new ring will have the variables a,b,c,d.
116NOTE:    This procedure is useful in connection with the procedure ringtensor,
117         when a conflict between variable names must be avoided.
118         This proc uses 'execute' or calls a procedure using 'execute'.
119EXAMPLE: example changevar; shows an example
120"
121{
122   if( size(#)==0 ) { def @r=basering; }
123   if( size(#)==1 ) { def @r=#[1]; }
124   setring @r;
125   ideal i = ideal(@r); int @q = size(i);
126   if( @q!=0 )
127      { string @s = "Rnew1"; }
128   else
129      { string @s = "Rnew"; }
130   string @newring = @s+"=("+charstr(@r)+"),(";
131   if( vars[size(vars)-1]=="(" and vars[size(vars)]==")" )
132   {
133      @newring = @newring+vars[1,size(vars)-2]+"(1.."+string(nvars(@r))+")";
134   }
135   else { @newring = @newring+vars; }
136   @newring = @newring+"),("+ordstr(@r)+");";
137   execute("ring "+@newring);
138   if( @q!=0 )
139   {
140      map phi = @r,maxideal(1);
141      ideal i = phi(i);
142      attrib(i,"isSB",1);         //*** attrib funktioniert ?
143      qring Rnew=i;
144   }
145   return(Rnew);
146}
147example
148{  "EXAMPLE:"; echo = 2;
149   ring r=0,(x,y,u,v),(dp(2),ds);
150   ideal i = x^2,y^2-u^3,v;
151   qring Q = std(i);
152   setring(r);
153   def R=changevar("A()"); R; "";
154   def Q'=changevar("a,b,c,d",Q); setring Q'; Q';
155   kill R,Q,Q';
156}
157///////////////////////////////////////////////////////////////////////////////
158
159proc defring (string s2, int n, string s3, string s4)
160"USAGE:   defring(ch,n,va,or);  ch,va,or=strings, n=integer
161RETURN:  ring R with characteristic 'ch', ordering 'or' and n variables with
162         names derived from va.
163         If va is a single letter, say va=\"a\", and if n<=26 then a and the
164         following n-1 letters from the alphabet (cyclic order) are taken as
165         variables. If n>26 or if va is a single letter followed by a bracket,
166         say va=\"T(\", the variables are T(1),...,T(n).
167NOTE:    This proc is useful for defining a ring in a procedure.
168         This proc uses 'execute' or calls a procedure using 'execute'.
169EXAMPLE: example defring; shows an example
170"
171{
172   string @newring = "ring newring =("+s2+"),(";
173   if( n>26 or s3[2]=="(" ) { string @v = s3[1]+"(1.."+string(n)+")"; }
174   else { string @v = A_Z(s3,n); }
175   @newring=@newring+@v+"),("+s4+");";
176   execute(@newring);
177   return(newring);
178}
179example
180{ "EXAMPLE:"; echo = 2;
181   def r=defring("0",5,"u","ls"); r; setring r;"";
182   def R=defring("2,A",10,"x(","dp(3),ws(1,2,3),ds"); R; setring R;
183   kill R,r;
184}
185///////////////////////////////////////////////////////////////////////////////
186
187proc defrings (int n, list #)
188"USAGE:   defrings(n,[p]);  n,p integers
189RETURN:  ring R with characteristic p [default: p=32003], ordering ds and n
190         variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26)
191NOTE:    This proc uses 'execute' or calls a procedure using 'execute'.
192EXAMPLE: example defrings; shows an example
193"
194{
195   int p;
196   if (size(#)==0) { p=32003; }
197   else { p=#[1]; }
198   if (n >26)
199   {
200      string s="ring S ="+string(p)+",x(1.."+string(n)+"),ds;";
201   }
202   else
203   {
204      string s="ring S ="+string(p)+",("+A_Z("x",n)+"),ds;";
205   }
206   execute(s);
207   dbprint(printlevel-voice+2,"
208// 'defrings' created a ring. To see the ring, type (if the name R was
209// assigned to the return value):
210    show R;
211// To make the ring the active basering, type
212    setring R; ");
213   return(S);
214}
215example
216{ "EXAMPLE:"; echo = 2;
217   def S5=defrings(5,0); S5; "";
218   def S30=defrings(30); S30;
219   kill S5,S30;
220}
221///////////////////////////////////////////////////////////////////////////////
222
223proc defringp (int n,list #)
224"USAGE:   defringp(n,[p]);  n,p=integers
225RETURN:  ring R with characteristic p [default: p=32003], ordering dp and n
226         variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26)
227NOTE:    This proc uses 'execute' or calls a procedure using 'execute'.
228EXAMPLE: example defringp; shows an example
229"
230{
231   int p;
232   if (size(#)==0) { p=32003; }
233   else { p=#[1]; }
234   if (n >26)
235   {
236      string s="ring P="+string(p)+",x(1.."+string(n)+"),dp;";
237   }
238   else
239   {
240     string s="ring P="+string(p)+",("+A_Z("x",n)+"),dp;";
241   }
242   execute(s);
243   dbprint(printlevel-voice+2,"
244// 'defringp' created a ring. To see the ring, type (if the name R was
245// assigned to the return value):
246    show R;
247// To make the ring the active basering, type
248    setring R; ");
249   return(P);
250}
251example
252{ "EXAMPLE:"; echo = 2;
253   def P5=defringp(5,0); P5; "";
254   def P30=defringp(30); P30;
255   kill P5,P30;
256}
257///////////////////////////////////////////////////////////////////////////////
258
259proc extendring (int n, string va, string o, list #)
260"USAGE:   extendring(n,va,o[,iv,i,r]);  va,o=strings, n,i=integers, r=ring,
261          iv=intvec of positive integers or iv=0
262RETURN:  ring R, which extends the ring r by adding n new variables in front
263         of (resp. after, if i!=0) the old variables.
264         [default: (i,r)=(0,basering)].
265@*       -- The characteristic is the characteristic of r.
266@*       -- The new vars are derived from va. If va is a single letter, say
267            va=\"T\", and if n<=26 then T and the following n-1 letters from
268            T..Z..T (resp. T(1..n) if n>26) are taken as additional variables.
269            If va is a single letter followed by a bracket, say va=\"x(\",
270            the new variables are x(1),...,x(n).
271@*       -- The ordering is the product ordering of the ordering of r and of an
272            ordering derived from `o` [and iv].
273@*        -  If o contains a 'c' or a 'C' in front resp. at the end, this is
274            taken for the whole ordering in front, resp. at the end. If o does
275            not contain a 'c' or a 'C' the same rule applies to ordstr(r).
276@*        -  If no intvec iv is given, or if iv=0, o may be any allowed ordstr,
277            like \"ds\" or \"dp(2),wp(1,2,3),Ds(2)\" or \"ds(a),dp(b),ls\" if
278            a and b are globally (!) defined integers and if a+b+1<=n.
279            If, however, a and b are local to a proc calling extendring, the
280            intvec iv must be used to let extendring know the values of a and b
281@*        -  If a non-zero intvec iv is given, iv[1],iv[2],... are taken for the
282            1st, 2nd,... block of o, if o contains no substring \"w\" or \"W\"
283            i.e. no weighted ordering (in the above case o=\"ds,dp,ls\"
284            and iv=a,b).
285            If o contains a weighted ordering (only one (!) weighted block is
286            allowed) iv[1] is taken as size for the weight-vector, the next
287            iv[1] values of iv are taken as weights and the remaining values of
288            iv as block size for the remaining non-weighted blocks.
289            e.g. o=\"dp,ws,Dp,ds\", iv=3,2,3,4,2,5 creates the ordering
290            dp(2),ws(2,3,4),Dp(5),ds
291NOTE:    This proc is useful for adding deformation parameters.
292         This proc uses 'execute' or calls a procedure using 'execute'.
293         If you use it in your own proc, it may be advisable to let the local
295EXAMPLE: example extendring; shows an example
296"
297{
298//--------------- initialization and place c/C of ordering properly -----------
299   string @o1,@o2,@ro,@wstr,@v,@newring;
300   int @i,@w,@ii,@k;
301   intvec @iv,@iw;
302   if( find(o,"c")+find(o,"C") != 0)
303   {
304      @k=1;
305      if( o[1]=="c" or o[1]=="C" ) { @o1=o[1,2]; o=o[3..size(o)]; }
306      else                         { @o2=o[size(o)-1,2]; o=o[1..size(o)-2]; }
307   }
308   if( size(#)==0 ) { #[1]=0; }
309   if( typeof(#[1])!="intvec" )
310   {
311     if( size(#)==1 ) { @i=#[1]; def @r=basering; }
312     if( size(#)==2 ) { @i=#[1]; def @r=#[2]; }
313     if( o[size(o)]!=")" and find(o,",")==0 ) { o=o+"("+string(n)+")"; }
314   }
315   else
316   {
317     @iv=#[1];
318     if( size(#)==2 ) { @i=#[2]; def @r=basering; }
319     if( size(#)==3 ) { @i=#[2]; def @r=#[3]; }
320     if( @iv==0 && o[size(o)]!=")" && find(o,",")==0 ) {o=o+"("+string(n)+")";}
321   }
322   @ro=ordstr(@r);
323   if( @ro[1]=="c" or @ro[1]=="C" )
324      { @v=@ro[1,2]; @ro=@ro[3..size(@ro)]; }
325   else
326      { @wstr=@ro[size(@ro)-1,2]; @ro=@ro[1..size(@ro)-2]; }
327   if( @k==0) { @o1=@v; @o2=@wstr; }
328//----------------- prepare ordering if an intvec is given --------------------
329   if( typeof(#[1])=="intvec" and #[1]!=0 )
330   {
331      @k=n;                             //@k counts no of vars not yet ordered
332      @w=find(o,"w")+find(o,"W");o=o+" ";
333      if( @w!=0 )
334      {
335         @wstr=o[@w..@w+1];
336         o=o[1,@w-1]+"@"+o[@w+2,size(o)];
337         @iw=@iv[2..@iv[1]+1];
338         @wstr=@wstr+"("+string(@iw)+")";
339         @k=@k-@iv[1];
340         @iv=@iv[@iv[1]+2..size(@iv)];
341         @w=0;
342      }
343      for( @ii=1; @ii<=size(@iv); @ii=@ii+1 )
344      {
345         if( find(o,",",@w+1)!=0 )
346         {
347            @w=find(o,",",@w+1);
348            if( o[@w-1]!="@" )
349            {
350               o=o[1,@w-1]+"("+string(@iv[@ii])+")"+o[@w,size(o)];
351               @w=find(o,",",@w+1);
352               @k=@k-@iv[@ii];
353            }
354            else { @ii=@ii-1; }
355         }
356      }
357      @w=find(o,"@");
358      if( @w!=0 ) { o=o[1,@w-1] + @wstr + o[@w+1,size(o)]; }
359      if( @k>0 and o[size(o)]!=")" ) { o=o+"("+string(@k)+")"; }
360   }
361//------------------------ prepare string of new ring -------------------------
362   @newring = "ring na =("+charstr(@r)+"),(";
363   if( n>26 or va[2]=="(" ) { @v = va[1]+"(1.."+string(n)+")"; }
364   else                     { @v = A_Z(va,n); }
365   if( @i==0 )
366   {
367      @v=@v+","+varstr(@r);
368      o=@o1+o+","+@ro+@o2;
369   }
370   else
371   {
372      @v=varstr(@r)+","+@v;
373      o=@o1+@ro+","+o+@o2;
374   }
375   @newring=@newring+@v+"),("+o+");";
376//---------------------------- execute and export -----------------------------
377   execute(@newring);
378   dbprint(printlevel-voice+2,"
379// 'extendring' created a new ring.
380// To see the ring, type (if the name 'R' was assigned to the return value):
381     show(R);
382");
383
384   return(na);
385}
386example
387{ "EXAMPLE:"; echo = 2;
388   ring r=0,(x,y,z),ds;
389   show(r);"";
390   // blocksize is derived from no of vars:
391   int t=5;
392   def R1=extendring(t,"a","dp");         //t global: "dp" -> "dp(5)"
393   show(R1); setring R1; "";
394   def R2=extendring(4,"T(","c,dp",1,r);    //"dp" -> "c,..,dp(4)"
395   show(R2); setring R2; "";
396
397   // no intvec given, blocksize given: given blocksize is used:
398   def R3=extendring(4,"T(","dp(2)",0,r);   // "dp(2)" -> "dp(2)"
399   show(R3); setring R3; "";
400
401   // intvec given: weights and blocksize is derived from given intvec
402   // (no specification of a blocksize in the given ordstr is allowed!)
403   // if intvec does not cover all given blocks, the last block is used
404   // for the remaining variables, if intvec has too many components,
405   // the last ones are ignored
406   intvec v=3,2,3,4,1,3;
407   def R4=extendring(10,"A","ds,ws,Dp,dp",v,0,r);
408   // v covers 3 blocks: v[1] (=3) : no of components of ws
409   // next v[1] values (=v[2..4]) give weights
410   // remaining components of v are used for the remaining blocks
411   show(R4);
412   kill r,R1,R2,R3,R4;
413}
414///////////////////////////////////////////////////////////////////////////////
415
416proc fetchall (R, list #)
417"USAGE:   fetchall(R[,s]);  R=ring/qring, s=string
418CREATE:  fetch all objects of ring R (of type poly/ideal/vector/module/number/matrix)
419         into the basering.
420         If no 2nd argument is present, the names are the same as in R. If,
421         say, f is a poly in R and the 2nd argument is the string \"R\", then f
422         is mapped to f_R etc.
423RETURN:  no return value
424NOTE:    As fetch, this procedure maps the 1st, 2nd, ... variable of R to the
425         1st, 2nd, ... variable of the basering.
426         The 2nd argument is useful in order to avoid conflicts of names, the
427         empty string is allowed
428CAUTION: fetchall does not work inside a procedure.
429         It does not work if R contains a map.
431EXAMPLE: example fetchall; shows an example
432"
433{
434   list @L@=names(R);
435   int @ii@; string @s@;
436   if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
437   for( @ii@=size(@L@); @ii@>0; @ii@=@ii@-1 )
438   {
439      execute("def "+@L@[@ii@]+@s@+"=fetch(R,`@L@[@ii@]`);");
440      execute("export "+@L@[@ii@]+@s@+";");
441   }
442   return();
443}
444example
445{  "EXAMPLE:"; echo=2;
446// The example is not shown since fetchall does not work in a procedure;
447// (and hence not in the example procedure). Try the following commands:
448//   ring R=0,(x,y,z),dp;
449//   ideal j=x,y2,z2;
450//   matrix M[2][3]=1,2,3,x,y,z;
451//   j; print(M);
452//   ring S=0,(a,b,c),ds;
453//   fetchall(R);       //map from R to S: x->a, y->b, z->c;
454//   names(S);
455//   j; print(M);
456//   fetchall(S,"1");   //identity map of S: copy objects, change names
457//   names(S);
458//   kill R,S;
459}
460///////////////////////////////////////////////////////////////////////////////
461
462proc imapall (R, list #)
463"USAGE:   imapall(R[,s]);  R=ring/qring, s=string
464CREATE:  map all objects of ring R (of type poly/ideal/vector/module/number/matrix)
465         into the basering by applying imap to all objects of R.
466         If no 2nd argument is present, the names are the same as in R. If,
467         say, f is a poly in R and the 3rd argument is the string \"R\", then f
468         is mapped to f_R etc.
469RETURN:  no return value
470NOTE:    As imap, this procedure maps the variables of R to the variables with
471         the same name in the basering, the other variables are mapped to 0.
472         The 2nd argument is useful in order to avoid conflicts of names, the
473         empty string is allowed
474CAUTION: imapall does not work inside a procedure
475         It does not work if R contains a map
477EXAMPLE: example imapall; shows an example
478"
479{
480   list @L@=names(R);
481   int @ii@; string @s@;
482   if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
483   for( @ii@=size(@L@); @ii@>0; @ii@=@ii@-1 )
484   {
485         execute("def "+@L@[@ii@]+@s@+"=imap(R,`@L@[@ii@]`);");
486         execute("export "+@L@[@ii@]+@s@+";");
487   }
488   return();
489}
490example
491{  "EXAMPLE:"; echo = 2;
492// The example is not shown since imapall does not work in a procedure
493// (and hence not in the example procedure). Try the following commands:
494//   ring R=0,(x,y,z,u),dp;
495//   ideal j=x,y,z,u2+ux+z;
496//   matrix M[2][3]=1,2,3,x,y,uz;
497//   j; print(M);
498//   ring S=0,(a,b,c,x,z,y),ds;
499//   imapall(R);         //map from R to S: x->x, y->y, z->z, u->0
500//   names(S);
501//   j; print(M);
502//   imapall(S,"1");     //identity map of S: copy objects, change names
503//   names(S);
504//   kill R,S;
505}
506///////////////////////////////////////////////////////////////////////////////
507
508proc mapall (R, ideal i, list #)
509"USAGE:   mapall(R,i[,s]);  R=ring/qring, i=ideal of basering, s=string
510CREATE:  map all objects of ring R (of type poly/ideal/vector/module/number/
511         matrix, map) into the basering by mapping the j-th variable of R to
512         the j-th generator of the ideal i. If no 3rd argument is present, the
513         names are the same as in R. If, say, f is a poly in R and the 3rd
514         argument is the string \"R\", then f is mapped to f_R etc.
515RETURN:  no return value.
516NOTE:    This procedure has the same effect as defining a map, say psi, by
517         map psi=R,i; and then applying psi to all objects of R. In particular,
518         maps from R to some ring S are composed with psi, creating thus a map
519         from the basering to S.
520         mapall may be combined with copyring to change vars for all objects.
521         The 3rd argument is useful in order to avoid conflicts of names, the
522         empty string is allowed.
523CAUTION: mapall does not work inside a procedure.
524EXAMPLE: example mapall; shows an example
525"
526{
527   list @L@=names(R); map @psi@ = R,i;
528   int @ii@; string @s@;
529   if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
530   for( @ii@=size(@L@); @ii@>0; @ii@=@ii@-1 )
531   {
532      execute("def "+@L@[@ii@]+@s@+"=@psi@(`@L@[@ii@]`);");
533      execute("export "+@L@[@ii@]+@s@+";");
534   }
535   return();
536}
537example
538{  "EXAMPLE:"; echo = 2;
539// The example is not shown since mapall does not work in a procedure
540// (and hence not in the example procedure). Try the following commands:
541//   ring R=0,(x,y,z),dp;
542//   ideal j=x,y,z;
543//   matrix M[2][3]=1,2,3,x,y,z;
544//   map phi=R,x2,y2,z2;
545//   ring S=0,(a,b,c),ds;
546//   ideal i=c,a,b;
547//   mapall(R,i);         //map from R to S: x->c, y->a, z->b
548//   names(S);
549//   j; print(M); phi;    //phi maps R to S: x->c2, y->a2, z->b2
550//   ideal i1=a2,a+b,1;
551//   mapall(R,i1,\"\");     //map from R to S: x->a2, y->a+b, z->1
552//   names(S);
553//   j_; print(M_); phi_;
554//   changevar(\"T\",\"x()\",R);  //change vars in R and call result T
555//   mapall(R,maxideal(1));   //identity map from R to T
556//   names(T);
557//   j; print(M); phi;
558//   kill R,S,T;
559}
560///////////////////////////////////////////////////////////////////////////////
561
562proc ord_test (r)
563"USAGE:   ord_test(r);  r ring/qring
564RETURN:  int 1 (resp. -1, resp. 0) if ordering of r is global (resp. local,
565         resp. mixed)
566EXAMPLE: example ord_test; shows an example
567"
568{
569   if ((typeof(r) != "ring") and (typeof(r) != "qring"))
570   {
571      ERROR("ord_test requires a ring/qring as input");
572   }
573   if (attrib(r,"global")==1) { return(1);}
574   def BAS = basering;
575   setring r;
576   poly f;
577   int n,o,u = nvars(r),1,1;
578   int ii;
579   for ( ii=1; ii<=n; ii++ )
580   {
581      f = 1+var(ii);
582      o = o*(lead(f) == var(ii));
583      u = u*(lead(f) == 1);
584   }
585   setring BAS;
586   if ( o==1 ) { return(1); }
587   if ( u==1 ) { return(-1); }
588   else { return(0); }
589}
590example
591{ "EXAMPLE:"; echo = 2;
592   ring R = 0,(x,y),dp;
593   ring S = 0,(u,v),ls;
594   ord_test(R);
595   ord_test(S);
596   ord_test(R+S);
597}
598///////////////////////////////////////////////////////////////////////////////
599
600proc ringtensor (list #)
601"USAGE:   ringtensor(r1,r2,...);  r1,r2,...=rings
602RETURN:  ring R whose variables are the variables from all rings r1,r2,...
603         and whose monomial ordering is the block (product) ordering of the
604         respective monomial orderings of r1,r2,... . Hence, R
605         is the tensor product of the rings r1,r2,... with ordering matrix
606         equal to the direct sum of the ordering matrices of r1,r2,...
607NOTE:    The characteristic of the new ring will be p if one ring has
608         characteristic p. The names of variables in the rings r1,r2,...
609         must differ.
610         The procedure works also for quotient rings ri, if the characteristic
611         of ri is compatible with the characteristic of the result
612         (i.e. if imap from ri to the result is implemented)
614EXAMPLE: example ringtensor; shows an example
615"
616{
617   int @i;
618   int @n = size(#);
619   if (@n<=1) { ERROR("at least 2 rings required"); }
620   def @s=#[1]+#[2];
621   for (@i=3; @i<=@n;@i++)
622   {
623     def @ss=@s+#[@i];
624     kill @s;
625     def @s=@ss;
626     kill @ss;
627   }
628   dbprint(printlevel-voice+2,"
629// 'ringtensor' created a ring. To see the ring, type (if the name R was
630// assigned to the return value):
631    show(R);
632// To make the ring the active basering, type
633    setring R; ");
634   return(@s);
635}
636example
637{ "EXAMPLE:"; echo = 2;
638   ring r=32003,(x,y,u,v),dp;
639   ring s=0,(a,b,c),wp(1,2,3);
640   ring t=0,x(1..5),(c,ls);
641   def R=ringtensor(r,s,t);
642   type R;
643   setring s;
644   ideal i = a2+b3+c5;
645   def S=changevar("x,y,z");       //change vars of s
646   setring S;
647   qring qS =std(fetch(s,i));      //create qring of S mod i (mapped to S)
648   def T=changevar("d,e,f,g,h",t); //change vars of t
649   setring T;
650   qring qT=std(d2+e2-f3);         //create qring of T mod d2+e2-f3
651   def Q=ringtensor(s,qS,t,qT);
652   setring Q; type Q;
653   kill R,S,T,Q;
654}
655///////////////////////////////////////////////////////////////////////////////
656
657proc ringweights (def P)
658"USAGE:   ringweights(P); P=name of an existing ring (true name, not a string)
659RETURN:  intvec consisting of the weights of the variables of P, as they
660         appear when typing P;.
661NOTE:    This is useful when enlarging P but keeping the weights of the old
662         variables.
663EXAMPLE: example ringweights; shows an example
664"
665{
666   int i;
667   intvec rw;
668//------------------------- find weights  -------------------------
669   for(i=nvars(P);i>0;i--)
670   { rw[i]=ord(var(i)); }
671   return(rw);
672}
673example
674{"EXAMPLE:";  echo = 2;
675  ring r0 = 0,(x,y,z),dp;
676  ringweights(r0);
677  ring r1 = 0,x(1..5),(ds(3),wp(2,3));
678  ringweights(r1);"";
679  // an example for enlarging the ring, keeping the first weights:
680  intvec v = ringweights(r1),6,2,3,4,5;
681  ring R = 0,x(1..10),(a(v),dp);
682  ordstr(R);
683}
684///////////////////////////////////////////////////////////////////////////////
685proc preimageLoc(string R_name,string phi_name,string Q_name )
686"USAGE: preimageLoc ( ring_name, map_name, ideal_name );
687        all input parameters of type string
688RETURN:  ideal
689PURPOSE: compute the preimage of an ideal under a given map for non-global
690         orderings.
691         The 2nd argument has to be the name of a map from the basering to
692         the given ring (or the name of an ideal defining such a map), and
693         the ideal has to be an ideal in the given ring.
695KEYWORDS: preimage under a map between local rings, map between local rings, map between local and global rings
696EXAMPLE: example preimageLoc ; shows an example
697"{
698  def S=basering;
699  int i;
700  string newRing,minpoly_string;
701  if(attrib(S,"global")!=1)
702  {
703    if(typeof(S)=="qring")
704    {
705      ideal I=ideal(S);
706      newRing="ring S0=("+charstr(S)+"),("+varstr(S)+"),dp;";
707      minpoly_string=string(minpoly);
708      execute(newRing);
709      execute("minpoly="+minpoly_string+";");
710      ideal I=imap(S,I);
711      list pr=primdecGTZ(I);
712      newRing="ring SL=("+charstr(S)+"),("+varstr(S)+"),("+ordstr(S)+");";
713      execute(newRing);
714      execute("minpoly="+minpoly_string+";");
715      list pr=imap(S0,pr);
716      ideal I0=std(pr[1][1]);
717      for(i=2;i<=size(pr);i++)
718      {
719         I0=intersect(I0,std(pr[i][1]));
720      }
721      setring S0;
722      ideal I0=imap(SL,I0);
723      qring S1=std(I0);
724    }
725    else
726    {
727      def S1=S;
728    }
729  }
730  else
731  {
732    def S1=S;
733  }
734  def @R=`R_name`;
735  setring @R;
736  def @phi=`phi_name`;
737  ideal phiId=ideal(@phi);
738  def Q=`Q_name`;
739  if(attrib(@R,"global")!=1)
740  {
741    if(typeof(@R)=="qring")
742    {
743      ideal J=ideal(@R);
744      newRing="ring R0=("+charstr(@R)+"),("+varstr(@R)+"),dp;";
745      minpoly_string=string(minpoly);
746      execute(newRing);
747      execute("minpoly="+minpoly_string+";");
748      ideal J=imap(@R,J);
749      list pr=primdecGTZ(J);
750      newRing="ring RL=("+charstr(@R)+"),("+varstr(@R)+"),("+ordstr(@R)+");";
751      execute(newRing);
752      execute("minpoly="+minpoly_string+";");
753      list pr=imap(R0,pr);
754      ideal J0=std(pr[1][1]);
755      for(i=2;i<=size(pr);i++)
756      {
757         J0=intersect(J0,std(pr[i][1]));
758      }
759      setring R0;
760      ideal J0=imap(RL,J0);
761      qring R1=std(J0);
762      ideal Q=imap(@R,Q);
763      map @phi=S1,imap(@R,phiId);
764    }
765    else
766    {
767      def R1=@R;
768    }
769  }
770  else
771  {
772    def R1=@R;
773  }
774  setring S1;
775  ideal preQ=preimage(R1,@phi,Q);
776  setring S;
777  ideal prQ=imap(S1,preQ);
778  return(prQ);
779}
780example
781{ "EXAMPLE:"; echo=2;
782  ring S =0,(x,y,z),dp;
783  ring R0=0,(x,y,z),ds;
784  qring R=std(x+x2);
785  map psi=S,x,y,z;
786  ideal null;
787  setring S;
788  ideal nu=preimageLoc("R","psi","null");
789  nu;
790}
791
792//////////////////////////////////////////////////////////////////////////////
793/* moved here from the nctools.lib */
794///////////////////////////////////////////////////////////////////////////////
795proc rootofUnity(int n)
796"USAGE:  rootofUnity(n); n an integer
797RETURN:  number
798PURPOSE: compute the minimal polynomial for the n-th primitive root of unity
799NOTE: works only in field extensions by one element
800EXAMPLE: example rootofUnity; shows examples
801"
802{
803  if ( npars(basering) !=1 )
804  {
805    "the procedure works only with one parameter";
806    return(0);
807  }
808  if (n<1) { return(0); }
809  number mp = par(1);
810  if (n==1) { return(mp-1); }
811  if (n==2) { return(mp+1); }
812  def OldRing = basering;
813  string CH = charstr(basering);
814  string MCH;
815  int j=1;
816  while ( (CH[j] !=",") && (j<=size(CH)))
817  {
818    MCH=MCH+CH[j]; j++;
819  }
820  string SR = "ring @@rR="+MCH+","+parstr(basering)+",dp;";
821  execute(SR);
822  poly @t=var(1)^n-1; // (x^2i-1)=(x^i-1)(x^i+1)
823  list l=factorize(@t);
824  ideal @l=l[1];
825  list @d;
826  int s=size(@l);
827  int d=deg(@l[s]);
828  int cnt=1;
829  poly res;
830  for (j=s-1; j>=1; j--)
831  {
832    if ( deg(@l[j]) > d) { d=deg(@l[j]); }
833  }
834  for (j=1; j<=s; j++)
835  {
836    if ( deg(@l[j]) == d) { @d[cnt]=@l[j]; cnt++; }
837  }
838  if ( size(@d)==1 )
839  {
840    res = poly(@d[1]);
841  }
842  else
843  {
844    j=1;
845    while  ( j <= size(@d) )
846    {
848      if ( leadcoef(res) >=0 ) { j++; }
849      else { break; }
850    }
851    res = @d[j];
852  }
853  setring OldRing;
854  poly I = imap(@@rR,res);