# source:git/Singular/LIB/ring.lib@c238a0

spielwiese
Last change on this file since c238a0 was c238a0, checked in by Hans Schoenemann <hannes@…>, 9 years ago
Merge pull request #574 from surface-smoothers/fix.isQuotientRing fix isQuotientRing for cases that parameter ring and basering differ
• Property mode set to `100644`
File size: 33.2 KB
Line
1/////////////////////////////////////////////////////////////////////////////
2version="version ring.lib 4.0.0.0 Jun_2013 "; // \$Id\$
3category="General purpose";
4info="
5LIBRARY:  ring.lib      Manipulating Rings and Maps
6AUTHORS: Singular team
7
8PROCEDURES:
9 changechar(c[,r]); make a copy of basering [ring r] with new char c
10 changeord(o[,r]);  make a copy of basering [ring r] with new ord o
11 changevar(v[,r]);  make a copy of basering [ring r] with new vars v
12 defring(\"R\",c,n,v,o);  define a ring R in specified char c, n vars v, ord o
13 defrings(n[,p]);         define ring Sn in n vars, char 32003 [p], ord ds
14 defringp(n[,p]);         define ring Pn in n vars, char 32003 [p], ord dp
15 extendring(\"R\",n,v,o); extend given ring by n vars v, ord o and name it R
16 fetchall(R[,str]);       fetch all objects of ring R to basering
17 imapall(R[,str]);        imap all objects of ring R to basering
18 mapall(R,i[,str]);       map all objects of ring R via ideal i to basering
19 ord_test(R);             test wether ordering of R is global, local or mixed
20 ringtensor(s,t,..);      create ring, tensor product of rings s,t,...
21 ringweights(r);          intvec of weights of ring variables of ring r
22 preimageLoc(R,phi,Q)     computes preimage for non-global orderings
23 rootofUnity(n);          the minimal polynomial for the n-th primitive root of unity
24             (parameters in square brackets [] are optional)
25 optionIsSet(opt)         check if as a string given option is set or not.
26 hasFieldCoefficient      check if the coefficient ring is considered a field
27 hasNumericCoeffs(rng)    check for use of floating point numbers
28 hasCommutativeVars(rng)  non-commutive or commnuative polynomial ring
29 hasGlobalOrdering(rng)   global versus mixed/local monomial ordering
30 hasMixedOrdering()       mixed versus global/local ordering
31 hasFieldCoefficient(rng) coefficients are a field
32 isQuotientRing(rng)      ring is a qotient ring
33 isSubModule(I,J)         check if I is in J as submodule
34";
35
36LIB "inout.lib";
37LIB "general.lib";
38LIB "primdec.lib";
39
40///////////////////////////////////////////////////////////////////////////////
41proc optionIsSet(string optionName)
42"
43USAGE:       optionIsSet( optionName )
44PARAMETERS:  optionName: a name as string of an option of interest
45RETURN:      true, if the by optionName given option is active, false otherwise.
46EXAMPLE:     example optionIsSet;
47"
48{
49   def op = option(get);
50   //sanity check, if option is valid. will raise an error if not
51   option(optionName);    option("no" + optionName);
52   option(set,op);
53   // first entry is currently a comment "//options:", which is not an option.
54   int pos = find(option(), optionName, 11 );
55   return(pos>0);
56}
57example
58{
59    // check if the option "warn" is set.
60    optionIsSet("warn");
61    option("warn");
62    // now the option is set
63    optionIsSet("warn");
64
65    option("nowarn");
66    // now the option is unset
67    optionIsSet("warn");
68}
69
70
71static proc testOptionIsSet()
72{
73     option("warn");
74     ASSUME(0, optionIsSet("warn") );
75     option("nowarn");
76     ASSUME(0, 0 == optionIsSet("warn") );
77}
78
79///////////////////////////////////////////////////////////////////////////////
80
81proc changechar (list @L, list #)
82"USAGE:   changechar(c[,r]);  c=list, r=ring
83RETURN:  ring R, obtained from the ring r [default: r=basering], by changing
84         ringlist(r)[1] to c.
85EXAMPLE: example changechar; shows an example
86"
87{
88   def save_ring=basering;
89   if( size(#)==0 ) { def @r=basering; }
90   if(( size(#)==1 ) and (typeof(#[1])=="ring")) { def @r=#[1]; }
91   setring @r;
92   list rl=ringlist(@r);
93   if(defined(@L)!=voice) { def @L=fetch(save_ring,@L); }
94   if (size(@L)==1) { rl[1]=@L[1];} else { rl[1]=@L;}
95   def Rnew=ring(rl);
96   setring save_ring;
97   return(Rnew);
98}
99example
100{  "EXAMPLE:"; echo = 2;
101   ring rr=2,A,dp;
102   ring r=0,(x,y,u,v),(dp(2),ds);
103   def R=changechar(ringlist(rr)); R;"";
104   def R1=changechar(32003,R); setring R1; R1;
105   kill R,R1;
106}
107///////////////////////////////////////////////////////////////////////////////
108
109proc changeord (list @o, list #)
110"USAGE:   changeord(neword[,r]);  newordstr=list, r=ring/qring
111RETURN:  ring R, obtained from the ring r [default: r=basering], by changing
112         order(r) to neword.
113         If, say, neword=list(list(\"wp\",intvec(2,3)),list(list(\"dp\",1:(n-2))));
114         and if the ring r exists and has n variables, the ring R will be
115         equipped with the monomial ordering wp(2,3),dp.
116EXAMPLE: example changeord; shows an example
117"
118{
119   def save_ring=basering;
120   if( size(#)==0 ) { def @r=basering; }
121   if( size(#)==1 ) { def @r=#[1]; }
122   setring @r;
123   list rl=ringlist(@r);
124   rl[3]=@o;
125   def Rnew=ring(rl);
126   setring save_ring;
127   return(Rnew);
128}
129example
130{  "EXAMPLE:"; echo = 2;
131   ring r=0,(x,y,u,v),(dp(2),ds);
132   def R=changeord(list(list("wp",intvec(2,3)),list("dp",1:2))); R; "";
133   ideal i = x^2,y^2-u^3,v;
134   qring Q = std(i);
135   def Q'=changeord(list(list("lp",nvars(Q))),Q); setring Q'; Q';
136   kill R,Q,Q';
137}
138///////////////////////////////////////////////////////////////////////////////
139
140proc changevar (string vars, list #)
141"USAGE:   changevar(vars[,r]);  vars=string, r=ring/qring
142RETURN:  ring R, obtained from the ring r [default: r=basering], by changing
143         varstr(r) according to the value of vars.
144         If, say, vars = \"t()\" and the ring r exists and has n
145         variables, the new basering will have name R and variables
146         t(1),...,t(n).
147         If vars = \"a,b,c,d\", the new ring will have the variables a,b,c,d.
148NOTE:    This procedure is useful in connection with the procedure ringtensor,
149         when a conflict between variable names must be avoided.
150         This proc uses 'execute' or calls a procedure using 'execute'.
151EXAMPLE: example changevar; shows an example
152"
153{
154   if( size(#)==0 ) { def @r=basering; }
155   if( size(#)==1 ) { def @r=#[1]; }
156   setring @r;
157   ideal i = ideal(@r); int @q = size(i);
158   if( @q!=0 )
159      { string @s = "Rnew1"; }
160   else
161      { string @s = "Rnew"; }
162   string @newring = @s+"=("+charstr(@r)+"),(";
163   if( vars[size(vars)-1]=="(" and vars[size(vars)]==")" )
164   {
165      @newring = @newring+vars[1,size(vars)-2]+"(1.."+string(nvars(@r))+")";
166   }
167   else { @newring = @newring+vars; }
168   @newring = @newring+"),("+ordstr(@r)+");";
169   execute("ring "+@newring);
170   if( @q!=0 )
171   {
172      map phi = @r,maxideal(1);
173      ideal i = phi(i);
174      attrib(i,"isSB",1);         //*** attrib funktioniert ?
175      qring Rnew=i;
176   }
177   return(Rnew);
178}
179example
180{  "EXAMPLE:"; echo = 2;
181   ring r=0,(x,y,u,v),(dp(2),ds);
182   ideal i = x^2,y^2-u^3,v;
183   qring Q = std(i);
184   setring(r);
185   def R=changevar("A()"); R; "";
186   def Q'=changevar("a,b,c,d",Q); setring Q'; Q';
187   kill R,Q,Q';
188}
189///////////////////////////////////////////////////////////////////////////////
190
191proc defring (string s2, int n, string s3, string s4)
192"USAGE:   defring(ch,n,va,or);  ch,va,or=strings, n=integer
193RETURN:  ring R with characteristic 'ch', ordering 'or' and n variables with
194         names derived from va.
195         If va is a single letter, say va=\"a\", and if n<=26 then a and the
196         following n-1 letters from the alphabet (cyclic order) are taken as
197         variables. If n>26 or if va is a single letter followed by a bracket,
198         say va=\"T(\", the variables are T(1),...,T(n).
199NOTE:    This proc is useful for defining a ring in a procedure.
200         This proc uses 'execute' or calls a procedure using 'execute'.
201EXAMPLE: example defring; shows an example
202"
203{
204   string @newring = "ring newring =("+s2+"),(";
205   if( n>26 or s3[2]=="(" ) { string @v = s3[1]+"(1.."+string(n)+")"; }
206   else { string @v = A_Z(s3,n); }
207   @newring=@newring+@v+"),("+s4+");";
208   execute(@newring);
209   return(newring);
210}
211example
212{ "EXAMPLE:"; echo = 2;
213   def r=defring("0",5,"u","ls"); r; setring r;"";
214   def R=defring("2,A",10,"x(","dp(3),ws(1,2,3),ds"); R; setring R;
215   kill R,r;
216}
217///////////////////////////////////////////////////////////////////////////////
218
219proc defrings (int n, list #)
220"USAGE:   defrings(n,[p]);  n,p integers
221RETURN:  ring R with characteristic p [default: p=32003], ordering ds and n
222         variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26)
223NOTE:    This proc uses 'execute' or calls a procedure using 'execute'.
224EXAMPLE: example defrings; shows an example
225"
226{
227   int p;
228   if (size(#)==0) { p=32003; }
229   else { p=#[1]; }
230   if (n >26)
231   {
232      string s="ring S ="+string(p)+",x(1.."+string(n)+"),ds;";
233   }
234   else
235   {
236      string s="ring S ="+string(p)+",("+A_Z("x",n)+"),ds;";
237   }
238   execute(s);
239   dbprint(printlevel-voice+2,"
240// 'defrings' created a ring. To see the ring, type (if the name R was
241// assigned to the return value):
242    show R;
243// To make the ring the active basering, type
244    setring R; ");
245   return(S);
246}
247example
248{ "EXAMPLE:"; echo = 2;
249   def S5=defrings(5,0); S5; "";
250   def S30=defrings(30); S30;
251   kill S5,S30;
252}
253///////////////////////////////////////////////////////////////////////////////
254
255proc defringp (int n,list #)
256"USAGE:   defringp(n,[p]);  n,p=integers
257RETURN:  ring R with characteristic p [default: p=32003], ordering dp and n
258         variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26)
259NOTE:    This proc uses 'execute' or calls a procedure using 'execute'.
260EXAMPLE: example defringp; shows an example
261"
262{
263   int p;
264   if (size(#)==0) { p=32003; }
265   else { p=#[1]; }
266   if (n >26)
267   {
268      string s="ring P="+string(p)+",x(1.."+string(n)+"),dp;";
269   }
270   else
271   {
272     string s="ring P="+string(p)+",("+A_Z("x",n)+"),dp;";
273   }
274   execute(s);
275   dbprint(printlevel-voice+2,"
276// 'defringp' created a ring. To see the ring, type (if the name R was
277// assigned to the return value):
278    show R;
279// To make the ring the active basering, type
280    setring R; ");
281   return(P);
282}
283example
284{ "EXAMPLE:"; echo = 2;
285   def P5=defringp(5,0); P5; "";
286   def P30=defringp(30); P30;
287   kill P5,P30;
288}
289///////////////////////////////////////////////////////////////////////////////
290
291proc extendring (int n, string va, string o, list #)
292"USAGE:   extendring(n,va,o[,iv,i,r]);  va,o=strings, n,i=integers, r=ring,
293          iv=intvec of positive integers or iv=0
294RETURN:  ring R, which extends the ring r by adding n new variables in front
295         of (resp. after, if i!=0) the old variables.
296         [default: (i,r)=(0,basering)].
297@*       -- The characteristic is the characteristic of r.
298@*       -- The new vars are derived from va. If va is a single letter, say
299            va=\"T\", and if n<=26 then T and the following n-1 letters from
300            T..Z..T (resp. T(1..n) if n>26) are taken as additional variables.
301            If va is a single letter followed by a bracket, say va=\"x(\",
302            the new variables are x(1),...,x(n).
303@*       -- The ordering is the product ordering of the ordering of r and of an
304            ordering derived from `o` [and iv].
305@*        -  If o contains a 'c' or a 'C' in front resp. at the end, this is
306            taken for the whole ordering in front, resp. at the end. If o does
307            not contain a 'c' or a 'C' the same rule applies to ordstr(r).
308@*        -  If no intvec iv is given, or if iv=0, o may be any allowed ordstr,
309            like \"ds\" or \"dp(2),wp(1,2,3),Ds(2)\" or \"ds(a),dp(b),ls\" if
310            a and b are globally (!) defined integers and if a+b+1<=n.
311            If, however, a and b are local to a proc calling extendring, the
312            intvec iv must be used to let extendring know the values of a and b
313@*        -  If a non-zero intvec iv is given, iv[1],iv[2],... are taken for the
314            1st, 2nd,... block of o, if o contains no substring \"w\" or \"W\"
315            i.e. no weighted ordering (in the above case o=\"ds,dp,ls\"
316            and iv=a,b).
317            If o contains a weighted ordering (only one (!) weighted block is
318            allowed) iv[1] is taken as size for the weight-vector, the next
319            iv[1] values of iv are taken as weights and the remaining values of
320            iv as block size for the remaining non-weighted blocks.
321            e.g. o=\"dp,ws,Dp,ds\", iv=3,2,3,4,2,5 creates the ordering
322            dp(2),ws(2,3,4),Dp(5),ds
323NOTE:    This proc is useful for adding deformation parameters.
324         This proc uses 'execute' or calls a procedure using 'execute'.
325         If you use it in your own proc, it may be advisable to let the local
327EXAMPLE: example extendring; shows an example
328"
329{
330//--------------- initialization and place c/C of ordering properly -----------
331   string @o1,@o2,@ro,@wstr,@v,@newring;
332   int @i,@w,@ii,@k;
333   intvec @iv,@iw;
334   if( find(o,"c")+find(o,"C") != 0)
335   {
336      @k=1;
337      if( o[1]=="c" or o[1]=="C" ) { @o1=o[1,2]; o=o[3..size(o)]; }
338      else                         { @o2=o[size(o)-1,2]; o=o[1..size(o)-2]; }
339   }
340   if( size(#)==0 ) { #[1]=0; }
341   if( typeof(#[1])!="intvec" )
342   {
343     if( size(#)==1 ) { @i=#[1]; def @r=basering; }
344     if( size(#)==2 ) { @i=#[1]; def @r=#[2]; }
345     if( o[size(o)]!=")" and find(o,",")==0 ) { o=o+"("+string(n)+")"; }
346   }
347   else
348   {
349     @iv=#[1];
350     if( size(#)==2 ) { @i=#[2]; def @r=basering; }
351     if( size(#)==3 ) { @i=#[2]; def @r=#[3]; }
352     if( @iv==0 && o[size(o)]!=")" && find(o,",")==0 ) {o=o+"("+string(n)+")";}
353   }
354   @ro=ordstr(@r);
355   if( @ro[1]=="c" or @ro[1]=="C" )
356      { @v=@ro[1,2]; @ro=@ro[3..size(@ro)]; }
357   else
358      { @wstr=@ro[size(@ro)-1,2]; @ro=@ro[1..size(@ro)-2]; }
359   if( @k==0) { @o1=@v; @o2=@wstr; }
360//----------------- prepare ordering if an intvec is given --------------------
361   if( typeof(#[1])=="intvec" and #[1]!=0 )
362   {
363      @k=n;                             //@k counts no of vars not yet ordered
364      @w=find(o,"w")+find(o,"W");o=o+" ";
365      if( @w!=0 )
366      {
367         @wstr=o[@w..@w+1];
368         o=o[1,@w-1]+"@"+o[@w+2,size(o)];
369         @iw=@iv[2..@iv[1]+1];
370         @wstr=@wstr+"("+string(@iw)+")";
371         @k=@k-@iv[1];
372         @iv=@iv[@iv[1]+2..size(@iv)];
373         @w=0;
374      }
375      for( @ii=1; @ii<=size(@iv); @ii=@ii+1 )
376      {
377         if( find(o,",",@w+1)!=0 )
378         {
379            @w=find(o,",",@w+1);
380            if( o[@w-1]!="@" )
381            {
382               o=o[1,@w-1]+"("+string(@iv[@ii])+")"+o[@w,size(o)];
383               @w=find(o,",",@w+1);
384               @k=@k-@iv[@ii];
385            }
386            else { @ii=@ii-1; }
387         }
388      }
389      @w=find(o,"@");
390      if( @w!=0 ) { o=o[1,@w-1] + @wstr + o[@w+1,size(o)]; }
391      if( @k>0 and o[size(o)]!=")" ) { o=o+"("+string(@k)+")"; }
392   }
393//------------------------ prepare string of new ring -------------------------
394   @newring = "ring na =("+charstr(@r)+"),(";
395   if( n>26 or va[2]=="(" ) { @v = va[1]+"(1.."+string(n)+")"; }
396   else                     { @v = A_Z(va,n); }
397   if( @i==0 )
398   {
399      @v=@v+","+varstr(@r);
400      o=@o1+o+","+@ro+@o2;
401   }
402   else
403   {
404      @v=varstr(@r)+","+@v;
405      o=@o1+@ro+","+o+@o2;
406   }
407   @newring=@newring+@v+"),("+o+");";
408//---------------------------- execute and export -----------------------------
409   execute(@newring);
410   dbprint(printlevel-voice+2,"
411// 'extendring' created a new ring.
412// To see the ring, type (if the name 'R' was assigned to the return value):
413     show(R);
414");
415
416   return(na);
417}
418example
419{ "EXAMPLE:"; echo = 2;
420   ring r=0,(x,y,z),ds;
421   show(r);"";
422   // blocksize is derived from no of vars:
423   int t=5;
424   def R1=extendring(t,"a","dp");         //t global: "dp" -> "dp(5)"
425   show(R1); setring R1; "";
426   def R2=extendring(4,"T(","c,dp",1,r);    //"dp" -> "c,..,dp(4)"
427   show(R2); setring R2; "";
428
429   // no intvec given, blocksize given: given blocksize is used:
430   def R3=extendring(4,"T(","dp(2)",0,r);   // "dp(2)" -> "dp(2)"
431   show(R3); setring R3; "";
432
433   // intvec given: weights and blocksize is derived from given intvec
434   // (no specification of a blocksize in the given ordstr is allowed!)
435   // if intvec does not cover all given blocks, the last block is used
436   // for the remaining variables, if intvec has too many components,
437   // the last ones are ignored
438   intvec v=3,2,3,4,1,3;
439   def R4=extendring(10,"A","ds,ws,Dp,dp",v,0,r);
440   // v covers 3 blocks: v[1] (=3) : no of components of ws
441   // next v[1] values (=v[2..4]) give weights
442   // remaining components of v are used for the remaining blocks
443   show(R4);
444   kill r,R1,R2,R3,R4;
445}
446///////////////////////////////////////////////////////////////////////////////
447
448proc fetchall (def R, list #)
449"USAGE:   fetchall(R[,s]);  R=ring/qring, s=string
450CREATE:  fetch all objects of ring R (of type poly/ideal/vector/module/number/matrix)
451         into the basering.
452         If no 2nd argument is present, the names are the same as in R. If,
453         say, f is a polynomial in R and the 2nd argument is the string \"R\", then f
454         is mapped to f_R etc.
455RETURN:  no return value
456NOTE:    As fetch, this procedure maps the 1st, 2nd, ... variable of R to the
457         1st, 2nd, ... variable of the basering.
458         The 2nd argument is useful in order to avoid conflicts of names, the
459         empty string is allowed
460CAUTION: fetchall does not work for locally defined names.
461         It does not work if R contains a map.
463EXAMPLE: example fetchall; shows an example
464"
465{
466   list @L@=names(R);
467   int @ii@; string @s@;
468   if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
469   for( @ii@=size(@L@); @ii@>0; @ii@-- )
470   {
471      execute("def "+@L@[@ii@]+@s@+"=fetch(R,`@L@[@ii@]`);");
472      execute("export "+@L@[@ii@]+@s@+";");
473   }
474   return();
475}
476example
477{  "EXAMPLE:"; echo=2;
478// The example is not shown since fetchall does not work in a procedure;
479// (and hence not in the example procedure). Try the following commands:
480//   ring R=0,(x,y,z),dp;
481//   ideal j=x,y2,z2;
482//   matrix M[2][3]=1,2,3,x,y,z;
483//   j; print(M);
484//   ring S=0,(a,b,c),ds;
485//   fetchall(R);       //map from R to S: x->a, y->b, z->c;
486//   names(S);
487//   j; print(M);
488//   fetchall(S,"1");   //identity map of S: copy objects, change names
489//   names(S);
490//   kill R,S;
491}
492///////////////////////////////////////////////////////////////////////////////
493
494proc imapall (def R, list #)
495"USAGE:   imapall(R[,s]);  R=ring/qring, s=string
496CREATE:  map all objects of ring R (of type poly/ideal/vector/module/number/matrix)
497         into the basering by applying imap to all objects of R.
498         If no 2nd argument is present, the names are the same as in R. If,
499         say, f is a polynomial in R and the 3rd argument is the string \"R\", then f
500         is mapped to f_R etc.
501RETURN:  no return value
502NOTE:    As imap, this procedure maps the variables of R to the variables with
503         the same name in the basering, the other variables are mapped to 0.
504         The 2nd argument is useful in order to avoid conflicts of names, the
505         empty string is allowed
506CAUTION: imapall does not work for locally defined names.
507         It does not work if R contains a map
509EXAMPLE: example imapall; shows an example
510"
511{
512   list @L@=names(R);
513   int @ii@; string @s@;
514   if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
515   for( @ii@=size(@L@); @ii@>0; @ii@-- )
516   {
517         execute("def "+@L@[@ii@]+@s@+"=imap(R,`@L@[@ii@]`);");
518         execute("export "+@L@[@ii@]+@s@+";");
519   }
520   return();
521}
522example
523{  "EXAMPLE:"; echo = 2;
524// The example is not shown since imapall does not work in a procedure
525// (and hence not in the example procedure). Try the following commands:
526//   ring R=0,(x,y,z,u),dp;
527//   ideal j=x,y,z,u2+ux+z;
528//   matrix M[2][3]=1,2,3,x,y,uz;
529//   j; print(M);
530//   ring S=0,(a,b,c,x,z,y),ds;
531//   imapall(R);         //map from R to S: x->x, y->y, z->z, u->0
532//   names(S);
533//   j; print(M);
534//   imapall(S,"1");     //identity map of S: copy objects, change names
535//   names(S);
536//   kill R,S;
537}
538///////////////////////////////////////////////////////////////////////////////
539
540proc mapall (def R, ideal i, list #)
541"USAGE:   mapall(R,i[,s]);  R=ring/qring, i=ideal of basering, s=string
542CREATE:  map all objects of ring R (of type poly/ideal/vector/module/number/
543         matrix, map) into the basering by mapping the j-th variable of R to
544         the j-th generator of the ideal i. If no 3rd argument is present, the
545         names are the same as in R. If, say, f is a polynomial in R and the 3rd
546         argument is the string \"R\", then f is mapped to f_R etc.
547RETURN:  no return value.
548NOTE:    This procedure has the same effect as defining a map, say psi, by
549         map psi=R,i; and then applying psi to all objects of R. In particular,
550         maps from R to some ring S are composed with psi, creating thus a map
551         from the basering to S.
552         mapall may be combined with copyring to change vars for all objects.
553         The 3rd argument is useful in order to avoid conflicts of names, the
554         empty string is allowed.
555CAUTION: mapall does not work for locally defined names.
556EXAMPLE: example mapall; shows an example
557"
558{
559   list @L@=names(R); map @psi@ = R,i;
560   int @ii@; string @s@;
561   if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
562   for( @ii@=size(@L@); @ii@>0; @ii@-- )
563   {
564      execute("def "+@L@[@ii@]+@s@+"=@psi@(`@L@[@ii@]`);");
565      execute("export "+@L@[@ii@]+@s@+";");
566   }
567   return();
568}
569example
570{  "EXAMPLE:"; echo = 2;
571// The example is not shown since mapall does not work in a procedure
572// (and hence not in the example procedure). Try the following commands:
573//   ring R=0,(x,y,z),dp;
574//   ideal j=x,y,z;
575//   matrix M[2][3]=1,2,3,x,y,z;
576//   map phi=R,x2,y2,z2;
577//   ring S=0,(a,b,c),ds;
578//   ideal i=c,a,b;
579//   mapall(R,i);         //map from R to S: x->c, y->a, z->b
580//   names(S);
581//   j; print(M); phi;    //phi maps R to S: x->c2, y->a2, z->b2
582//   ideal i1=a2,a+b,1;
583//   mapall(R,i1,\"\");     //map from R to S: x->a2, y->a+b, z->1
584//   names(S);
585//   j_; print(M_); phi_;
586//   changevar(\"T\",\"x()\",R);  //change vars in R and call result T
587//   mapall(R,maxideal(1));   //identity map from R to T
588//   names(T);
589//   j; print(M); phi;
590//   kill R,S,T;
591}
592///////////////////////////////////////////////////////////////////////////////
593
594proc ord_test (def r)
595"USAGE:   ord_test(r);  r ring/qring
596RETURN:  int 1 (resp. -1, resp. 0) if ordering of r is global (resp. local,
597         resp. mixed)
599EXAMPLE: example ord_test; shows an example
600"
601{
602   if ((typeof(r) != "ring") and (typeof(r) != "qring"))
603   {
604      ERROR("ord_test requires a ring/qring as input");
605   }
606   if (attrib(r,"global")==1) { return(1);}
607   def BAS = basering;
608   setring r;
609   poly f;
610   int n,o,u = nvars(r),1,1;
611   int ii;
612   for ( ii=1; ii<=n; ii++ )
613   {
614      f = 1+var(ii);
615      o = o*(lead(f) == var(ii));
616      u = u*(lead(f) == 1);
617   }
618   setring BAS;
619   if ( o==1 ) { return(1); }
620   if ( u==1 ) { return(-1); }
621   else { return(0); }
622}
623example
624{ "EXAMPLE:"; echo = 2;
625   ring R = 0,(x,y),dp;
626   ring S = 0,(u,v),ls;
627   ord_test(R);
628   ord_test(S);
629   ord_test(R+S);
630}
631///////////////////////////////////////////////////////////////////////////////
632
633proc ringtensor (list #)
634"USAGE:   ringtensor(r1,r2,...);  r1,r2,...=rings
635RETURN:  ring R whose variables are the variables from all rings r1,r2,...
636         and whose monomial ordering is the block (product) ordering of the
637         respective monomial orderings of r1,r2,... . Hence, R
638         is the tensor product of the rings r1,r2,... with ordering matrix
639         equal to the direct sum of the ordering matrices of r1,r2,...
640NOTE:    The characteristic of the new ring will be p if one ring has
641         characteristic p. The names of variables in the rings r1,r2,...
642         must differ.
643         The procedure works also for quotient rings ri, if the characteristic
644         of ri is compatible with the characteristic of the result
645         (i.e. if imap from ri to the result is implemented)
647EXAMPLE: example ringtensor; shows an example
648"
649{
650   int @i;
651   int @n = size(#);
652   if (@n<=1) { ERROR("at least 2 rings required"); }
653   def @s=#[1]+#[2];
654   for (@i=3; @i<=@n;@i++)
655   {
656     def @ss=@s+#[@i];
657     kill @s;
658     def @s=@ss;
659     kill @ss;
660   }
661   dbprint(printlevel-voice+2,"
662// 'ringtensor' created a ring. To see the ring, type (if the name R was
663// assigned to the return value):
664    show(R);
665// To make the ring the active basering, type
666    setring R; ");
667   return(@s);
668}
669example
670{ "EXAMPLE:"; echo = 2;
671   ring r=32003,(x,y,u,v),dp;
672   ring s=0,(a,b,c),wp(1,2,3);
673   ring t=0,x(1..5),(c,ls);
674   def R=ringtensor(r,s,t);
675   type R;
676   setring s;
677   ideal i = a2+b3+c5;
678   def S=changevar("x,y,z");       //change vars of s
679   setring S;
680   qring qS =std(fetch(s,i));      //create qring of S mod i (mapped to S)
681   def T=changevar("d,e,f,g,h",t); //change vars of t
682   setring T;
683   qring qT=std(d2+e2-f3);         //create qring of T mod d2+e2-f3
684   def Q=ringtensor(s,qS,t,qT);
685   setring Q; type Q;
686   kill R,S,T,Q;
687}
688///////////////////////////////////////////////////////////////////////////////
689
690proc ringweights (def P)
691"USAGE:   ringweights(P); P=name of an existing ring (true name, not a string)
692RETURN:  intvec consisting of the weights of the variables of P, as they
693         appear when typing P;.
694NOTE:    This is useful when enlarging P but keeping the weights of the old
695         variables.
696EXAMPLE: example ringweights; shows an example
697"
698{
699   int i;
700   intvec rw;
701//------------------------- find weights  -------------------------
702   for(i=nvars(P);i>0;i--)
703   { rw[i]=ord(var(i)); }
704   return(rw);
705}
706example
707{"EXAMPLE:";  echo = 2;
708  ring r0 = 0,(x,y,z),dp;
709  ringweights(r0);
710  ring r1 = 0,x(1..5),(ds(3),wp(2,3));
711  ringweights(r1);"";
712  // an example for enlarging the ring, keeping the first weights:
713  intvec v = ringweights(r1),6,2,3,4,5;
714  ring R = 0,x(1..10),(a(v),dp);
715  ordstr(R);
716}
717///////////////////////////////////////////////////////////////////////////////
718proc preimageLoc(string R_name,string phi_name,string Q_name )
719"USAGE: preimageLoc ( ring_name, map_name, ideal_name );
720        all input parameters of type string
721RETURN:  ideal
722PURPOSE: compute the preimage of an ideal under a given map for non-global
723         orderings.
724         The 2nd argument has to be the name of a map from the basering to
725         the given ring (or the name of an ideal defining such a map), and
726         the ideal has to be an ideal in the given ring.
728KEYWORDS: preimage under a map between local rings, map between local rings, map between local and global rings
729EXAMPLE: example preimageLoc ; shows an example
730"{
731  def S=basering;
732  int i;
733  string newRing,minpoly_string;
734  if(attrib(S,"global")!=1)
735  {
736    if(typeof(S)=="qring")
737    {
738      ideal I=ideal(S);
739      newRing="ring S0=("+charstr(S)+"),("+varstr(S)+"),dp;";
740      minpoly_string=string(minpoly);
741      execute(newRing);
742      execute("minpoly="+minpoly_string+";");
743      ideal I=imap(S,I);
744      list pr=primdecGTZ(I);
745      newRing="ring SL=("+charstr(S)+"),("+varstr(S)+"),("+ordstr(S)+");";
746      execute(newRing);
747      execute("minpoly="+minpoly_string+";");
748      list pr=imap(S0,pr);
749      ideal I0=std(pr[1][1]);
750      for(i=2;i<=size(pr);i++)
751      {
752         I0=intersect(I0,std(pr[i][1]));
753      }
754      setring S0;
755      ideal I0=imap(SL,I0);
756      qring S1=std(I0);
757    }
758    else
759    {
760      def S1=S;
761    }
762  }
763  else
764  {
765    def S1=S;
766  }
767  def @R=`R_name`;
768  setring @R;
769  def @phi=`phi_name`;
770  ideal phiId=ideal(@phi);
771  def Q=`Q_name`;
772  if(attrib(@R,"global")!=1)
773  {
774    if(typeof(@R)=="qring")
775    {
776      ideal J=ideal(@R);
777      newRing="ring R0=("+charstr(@R)+"),("+varstr(@R)+"),dp;";
778      minpoly_string=string(minpoly);
779      execute(newRing);
780      execute("minpoly="+minpoly_string+";");
781      ideal J=imap(@R,J);
782      list pr=primdecGTZ(J);
783      newRing="ring RL=("+charstr(@R)+"),("+varstr(@R)+"),("+ordstr(@R)+");";
784      execute(newRing);
785      execute("minpoly="+minpoly_string+";");
786      list pr=imap(R0,pr);
787      ideal J0=std(pr[1][1]);
788      for(i=2;i<=size(pr);i++)
789      {
790         J0=intersect(J0,std(pr[i][1]));
791      }
792      setring R0;
793      ideal J0=imap(RL,J0);
794      qring R1=std(J0);
795      ideal Q=imap(@R,Q);
796      map @phi=S1,imap(@R,phiId);
797    }
798    else
799    {
800      def R1=@R;
801    }
802  }
803  else
804  {
805    def R1=@R;
806  }
807  setring S1;
808  ideal preQ=preimage(R1,@phi,Q);
809  setring S;
810  ideal prQ=imap(S1,preQ);
811  return(prQ);
812}
813example
814{ "EXAMPLE:"; echo=2;
815  ring S =0,(x,y,z),dp;
816  ring R0=0,(x,y,z),ds;
817  qring R=std(x+x2);
818  map psi=S,x,y,z;
819  ideal null;
820  setring S;
821  ideal nu=preimageLoc("R","psi","null");
822  nu;
823}
824
825//////////////////////////////////////////////////////////////////////////////
826/* moved here from the nctools.lib */
827///////////////////////////////////////////////////////////////////////////////
828proc rootofUnity(int n)
829"USAGE:  rootofUnity(n); n an integer
830RETURN:  number
831PURPOSE: compute the minimal polynomial for the n-th primitive root of unity
832NOTE: works only in field extensions by one element
833EXAMPLE: example rootofUnity; shows examples
834"
835{
836  if ( npars(basering) !=1 )
837  {
838    "the procedure works only with one parameter";
839    return(0);
840  }
841  if (n<1) { return(0); }
842  number mp = par(1);
843  if (n==1) { return(mp-1); }
844  if (n==2) { return(mp+1); }
845  def OldRing = basering;
846  string CH = charstr(basering);
847  string MCH;
848  int j=1;
849  while ( (CH[j] !=",") && (j<=size(CH)))
850  {
851    MCH=MCH+CH[j]; j++;
852  }
853  string SR = "ring @@rR="+MCH+","+parstr(basering)+",dp;";
854  execute(SR);
855  poly @t=var(1)^n-1; // (x^2i-1)=(x^i-1)(x^i+1)
856  list l=factorize(@t);
857  ideal @l=l[1];
858  list @d;
859  int s=size(@l);
860  int d=deg(@l[s]);
861  int cnt=1;
862  poly res;
863  for (j=s-1; j>=1; j--)
864  {
865    if ( deg(@l[j]) > d) { d=deg(@l[j]); }
866  }
867  for (j=1; j<=s; j++)
868  {
869    if ( deg(@l[j]) == d) { @d[cnt]=@l[j]; cnt++; }
870  }
871  if ( size(@d)==1 )
872  {
873    res = poly(@d[1]);
874  }
875  else
876  {
877    j=1;
878    while  ( j <= size(@d) )
879    {
881      if ( leadcoef(res) >=0 ) { j++; }
882      else { break; }
883    }
884    res = @d[j];
885  }
886  setring OldRing;
887  poly I = imap(@@rR,res);
889  kill @@rR;
890  return(mp);
891}
892example
893{
894  "EXAMPLE:";echo=2;
895  ring r = (0,q),(x,y,z),dp;
896  rootofUnity(6);
897  rootofUnity(7);
898  minpoly = rootofUnity(8);
899  r;
900}
901
902
903
904
905proc isQuotientRing( rng )
906"USAGE: isQuotientRing ( rng );
907RETURN:  1 if rng is a quotient ring, 0 otherwise.
908PURPOSE: check if typeof a rng "qring"
909KEYWORDS: qring ring ideal 'factor ring'
910EXAMPLE: example isQuotientRing ; shows an example
911"
912{
913    if ( defined(basering) )  {   def BAS=basering;  }
914
915    //access to quotient ideal will fail, if basering and rng differs.
916    setring rng;
917    int result =  ( size(ideal(rng)) != 0);
918
919    if ( defined(BAS) )   {    setring BAS;   }
920
921    return (result);
922}
923example
924{
925  ring rng = 0,x,dp;
926  isQuotientRing(rng); //no
927  // if a certain method does not support quotient rings,
928  // then a parameter test could be performed:
929   ASSUME( 0, 0==isQuotientRing(basering));
930
931  qring q= ideal(x);  // constructs rng/ideal(x)
932  isQuotientRing(q);  // yes
933}
934
935static proc testIsQuotientRing()
936{
937   ring rng7 = 7, x, dp;
938
939   ring rng = real,x,dp;
940   ASSUME(0, 0== isQuotientRing(rng) ) ;
941   ASSUME(0, 0== isQuotientRing(rng7) ) ;
942   ASSUME(0, char(basering)==0); // check that basering was not changed
943
944   qring qrng = 1;
945   ASSUME(0, isQuotientRing(qrng) ) ;
946
947   ring rng2 = integer,x,dp;
948   ASSUME(0, 0 == isQuotientRing(rng2) ) ;
949
950   qring qrng2=0;
951   ASSUME(0, not isQuotientRing(qrng2) ) ;
952
953   ring rng3 = 0,x,dp;
954   ASSUME(0, 0 == isQuotientRing(rng3) ) ;
955
956   qring qrng3=1;
957   ASSUME(0, isQuotientRing(qrng3) ) ;
958}
959
960proc hasFieldCoefficient( rng )
961"USAGE: hasFieldCoefficient ( rng );
962RETURN:  1 if the coeffcients form a field, 0 otherwise.
963KEYWORDS: ring coefficients
964EXAMPLE: example hasFieldCoefficient; shows an example
965"
966{
967  return (attrib(rng,"ring_cf")==0);
968}
969example
970{
971  ring rng = integer,x,dp;
972  hasFieldCoefficient(rng); //no
973  // if a certain method supports only rings with integer coefficients,
974  // then a parameter test could be performed:
975  ring rng2 = 0, x, dp;
976  hasFieldCoefficient(rng2);  // yes
977}
978
979proc hasGlobalOrdering (rng)
980"USAGE: hasGlobalOrdering ( rng );
981RETURN:  1 if rng has a global monomial ordering, 0 otherwise.
982KEYWORDS: monomial ordering
983EXAMPLE: example hasGlobalOrdering; shows an example
984"
985{
986  return (attrib(rng,"global")==1);
987}
988example
989{
990  ring rng = integer,x,dp;
991  hasGlobalOrdering(rng); //yes
992  ring rng2 = 0, x, ds;
993  hasGlobalOrdering(rng2);  // no
994}
995
996proc hasCommutativeVars (rng)
997"USAGE: hasCommutativeVars ( rng );
998RETURN:  1 if rng is a commutative polynomial ring, 0 otherwise.
999KEYWORDS: plural
1000EXAMPLE: example hasCommutativeVars; shows an example
1001"
1002{
1003  list rl=ringlist(rng);
1004  return (size(rl)==4);
1005}
1006example
1007{
1008 ring r=0,(x,y,z),dp;
1009 hasCommutativeVars(r);
1010}
1011
1012proc hasNumericCoeffs(rng)
1013"USAGE: hasNumericCoeffs ( rng );
1014RETURN:  1 if rng has inexact coeffcients, 0 otherwise.
1015KEYWORDS: floating point
1016EXAMPLE: example hasNumericCoeffs; shows an example
1017"
1018{
1019  ERROR("not yet implemented");
1020}
1021
1022proc isSubModule(I,J)
1023"USAGE: isSubModule(I,J): I, J: ideal or module
1024RETURN: 1 if module(I) is in module(J), 0 otherwise
1025EXAMPLE: isSubModule; shows an example
1026{
1027  if (attrib(J,"isSB")==1)
1028  { return(size(reduce(I,J,1)==0)); }
1029  else
1030  { return(size(reduce(I,groebner(J),1)==0)); }
1031}
1032example
1033{
1034  ring r=0,x,dp;
1035  ideal I1=x2;
1036  ideal I2=x3;
1037  isSubModule(I1,I2);
1038  isSubModule(I2,I1);
1039}
1040
1041proc hasMixedOrdering()
1042"USAGE:  hasMixedOrdering();
1043RETURN:  1 if ordering of basering is mixed, 0 else
1044EXAMPLE: example hasMixedOrdering(); shows an example
1045"
1046{
1047   int i,p,m;
1048   for(i = 1; i <= nvars(basering); i++)
1049   {
1050      if(var(i) > 1)
1051      {
1052         p++;
1053      }
1054      else
1055      {
1056         m++;
1057      }
1058   }
1059   if((p > 0) && (m > 0)) { return(1); }
1060   return(0);
1061}
1062example
1063{ "EXAMPLE:"; echo = 2;
1064   ring R1 = 0,(x,y,z),dp;
1065   hasMixedOrdering();
1066   ring R2 = 31,(x(1..4),y(1..3)),(ds(4),lp(3));
1067   hasMixedOrdering();
1068   ring R3 = 181,x(1..9),(dp(5),lp(4));
1069   hasMixedOrdering();
1070}
1071
Note: See TracBrowser for help on using the repository browser.