# source:git/Singular/LIB/ring.lib@2761f3

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