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

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