source: git/Singular/LIB/ring.lib @ 6fe3a0

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