source: git/Singular/LIB/ring.lib @ 7c5f9d2

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