source:git/Singular/LIB/ring.lib@3ca4229

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