source:git/Singular/LIB/ring.lib@07329b2

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