source: git/Tst/Old/lib0.lib @ 341696

spielwiese
Last change on this file since 341696 was 341696, checked in by Hans Schönemann <hannes@…>, 14 years ago
Adding Id property to all files git-svn-id: file:///usr/local/Singular/svn/trunk@12231 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 35.6 KB
Line 
1// $Id$
2//system("random",787422842);
3//(GMG)
4///////////////////////////////////////////////////////////////////////////////
5
6LIBRARY:  lib0.lib       PROCEDURES OF GENERAL TYPE
7
8 A_Z("a",n);             string of n comma seperated letters starting with a
9 binomial(n,m[,int/str]);n choose m (type int), [type string/type number]
10 changechar(r,"c","R");  makes a copy R of ring r with new char c the basering
11 changeord(r,"ord","R"); makes a copy R of ring r with new ord the basering
12 changevar(r,"vars","R");same as copyring
13 copyring(r,"vars","R"); makes a copy R of ring r with new vars the basering
14 copyring1(r,"vars","R");string to make a copy R of ring r with new variables
15 defrings(n[,p]);        define ring Sn in n vars, char 32003 [or p], ds
16 defringp(n[,p]);        define ring Pn in n vars, char 32003 [or p], dp
17 factorial(n[,int/str]); n factorial (=n!) (type int), [type string/number]
18 fetchall(R[,str]);      fetch all objects of ring R to basering
19 fibonacci(n[,p]);       nth Fibonacci number [char p]
20 ishomog(poly/...);      int, =1 resp. =0 if input is homogeneous resp. not
21 kmemory();              int = active memory (kilobyte)
22 killall();              kill all user-defined variables
23 imapall(R [,str]);      imap all objects of ring R to basering
24 mapall(R,i[,str]);      map all objects of ring R via ideal i to basering
25 maxcoef(poly/...);      maximal length of coefficient occuring in poly/...
26 maxdeg(poly/...);       int/intmat = degree/s of terms of maximal order
27 mindeg(poly/...);       int/intmat = degree/s of terms of minimal order
28 normalize(poly/...);    normalize poly/... such that leading coefficient is 1
29 primes(n,m);            intvec of primes p, n<=p<=m
30 product(vector/..[,v]); multiply components of vector/ideal/...[indices v]
31 ringsum(s,t,..."r");    create a ring r from existing rings s,t,...
32 ringweights(r);         intvec of weights of ring variables of ring r
33 sort(ideal/module);     sort generators according to monomial ordering
34 sum(vector/id/..[,v]);  add components of vector/ideal/...[with indices v]
35           (parameters in square brackets [] are optional)
36
37LIB "inout.lib";
38///////////////////////////////////////////////////////////////////////////////
39
40proc A_Z (string s,int n)
41USAGE:   A_Z("a",n);  a any letter, n integer (-26<= n <=26, !=0)
42RETURN:  string of n small (if a is small) or capital (if a is capital)
43         letters, comma seperated, beginning with a, in alphabetical
44         order (or revers alphabetical order if n<0)
45EXAMPLE: example A_Z; shows an example
46{
47  if ( n>=-26 and n<=26 and n!=0 )
48  {
49    string alpha =
50    "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,"+
51    "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z,"+
52    "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,"+
53    "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z";
54    int ii; int aa;
55    for(ii=1; ii<=51; ii=ii+2)
56    {
57       if( alpha[ii]==s ) { aa=ii; }
58    }
59    if ( aa==0)
60    {
61      for(ii=105; ii<=155; ii=ii+2)
62      {
63        if( alpha[ii]==s ) { aa=ii; }
64      }
65    }
66    if( aa!=0 )
67    {
68      string out;
69      if (n > 0) { out = alpha[aa,2*(n)-1];  return (out); }
70      if (n < 0)
71      {
72        string beta =
73        "z,y,x,w,v,u,t,s,r,q,p,o,n,m,l,k,j,i,h,g,f,e,d,c,b,a,"+
74        "z,y,x,w,v,u,t,s,r,q,p,o,n,m,l,k,j,i,h,g,f,e,d,c,b,a,"+
75        "Z,Y,X,W,V,U,T,S,R,Q,P,O,N,M,L,K,J,I,H,G,F,E,D,C,B,A,"+
76        "Z,Y,X,W,V,U,T,S,R,Q,P,O,N,M,L,K,J,I,H,G,F,E,D,C,B,A";
77        if ( aa < 52 ) { aa=52-aa; }
78        if ( aa > 104 ) { aa=260-aa; }
79        out = beta[aa,2*(-n)-1]; return (out);
80      }
81    }
82  }
83}
84example
85{ "EXAMPLE:"; echo = 2;
86   A_Z("c",5);
87   A_Z("Z",-5);
88   string sR = "ring R = (0,"+A_Z("A",6)+"),("+A_Z("a",10)+"),dp;";
89   sR;
90   execute sR;
91   R;
92}
93///////////////////////////////////////////////////////////////////////////////
94
95proc binomial (int n, int k, list #)
96USAGE:   binomial(n,k[,p/s]); n,k,p integers, s string
97RETURN:  binomial(n,k);    binomial coefficient n choose k of type int
98                           (machine integer, limited size! )
99         binomial(n,k,p);  n choose k in char p of type string
100         binomial(n,k,s);  n choose k of type number (s any string), computed
101                           in char of basering if a basering is defined
102EXAMPLE: example binomial; shows an example
103{
104   if ( size(#)==0 ) { int rr=1; }
105   if ( typeof(#[1])=="int") { ring bin = #[1],x,dp; number rr=1; }
106   if ( typeof(#[1])=="string") { number rr=1; }
107   if ( size(#)==0 or typeof(#[1])=="int" or typeof(#[1])=="string" )
108   {
109      def r = rr;
110      if ( k<=0 or k>n ) { return((k==0)*r); }
111      if ( k>=n-k ) { k = n-k; }
112      int l;
113      for (l=1 ; l<=k ; l++ )
114      {
115         r=r*(n+1-l)/l;
116      }
117      if ( typeof(#[1])=="int" ) { return(string(r)); }
118      return(r);
119   }
120}
121example
122{ "EXAMPLE:"; echo = 2;
123   int b1 = binomial(10,7); b1;
124   binomial(37,17,0);
125   ring t = 31,x,dp;
126   number b2 = binomial(37,17,""); b2;
127}
128///////////////////////////////////////////////////////////////////////////////
129
130proc changechar (r, string c, string newr)
131USAGE:   changechar(r,c,newr);  r=ring/qring, c,newr=strings
132CREATE:  creates a new ring with name `newr` and makes it the basering if r is
133         an existing ring/qring.
134         The new ring differs from the old ring only in the characteristic. If,
135         say, (c,newr) = ("0,A","R") and the ring r exists, the new basering
136         will have name R characteristic 0 and one parameter A.
137RETURN:  No return value
138NOTE:    //*** Buggy for qrings
139EXAMPLE: example changechar; shows an example
140{
141   setring r;
142   ideal i = ideal(r); int q = size(i);
143   if( q!=0 )
144      { string s = "newr1"; }
145   else
146      { string s = newr; }
147   string newring = s+"=("+c+"),("+varstr(r)+"),("+ordstr(r)+");";
148   execute("ring "+newring);
149   if( q!=0 )
150   {
151      map phi = r,maxideal(1);
152      ideal i = phi(i);
153      attrib(i,"isSB",1);         //*** attrib funktioniert ?
154      execute("qring "+newr+"=i;");
155   }
156   export(`newr`);
157   keepring(`newr`);
158   return();
159}
160example
161{  "EXAMPLE:"; echo = 2;
162   ring r=0,(x,y,u,v),(dp(2),ds);
163   show(r);
164   changechar(r,"2,A","R");
165   show(R);
166   kill R;
167}
168///////////////////////////////////////////////////////////////////////////////
169
170proc changeord (r, string o, string newr)
171USAGE:   changeord(r,o,newr);  r=ring/qring, o,newr=strings
172CREATE:  creates a new ring with name `newr` and makes it the basering if r is
173         an existing ring/qring.
174         The new ring differs from the old ring only in the ordering. If, say,
175         (o,newr) = ("wp(2,3),dp","R") and the ring r exists and has >=3
176         variables, the new basering will have name R and ordering wp(2,3),dp.
177RETURN:  No return value
178EXAMPLE: example changeord; shows an example
179{
180   setring r;
181   ideal i = ideal(r); int q = size(i);
182   if( q!=0 )
183      { string s = "newr1"; }
184   else
185      { string s = newr; }
186   string newring = s+"=("+charstr(r)+"),("+varstr(r)+"),("+o+");";
187   execute("ring "+newring);
188   if( q!=0 )
189   {
190      map phi = r,maxideal(1);
191      ideal i = phi(i);
192      attrib(i,"isSB",1);         //*** attrib funktioniert ?
193      execute("qring "+newr+"=i;");
194   }
195   export(`newr`);
196   keepring(`newr`);
197   return();
198}
199example
200{  "EXAMPLE:"; echo = 2;
201   ring r=0,(x,y,u,v),(dp(2),ds);
202   changeord(r,"wp(2,3),dp","R");
203   show(R);
204   ideal i = x^2,y^2-u^3,v;
205   qring Q = std(i);
206   changeord(Q,"lp","Q'");
207   show(Q');
208   kill R,Q,Q';
209}
210///////////////////////////////////////////////////////////////////////////////
211
212proc changevar (r, string vars, string newr)
213USAGE:   changevar(r,vars,newr);  r=ring/qring, vars,newr=strings
214CREATE:  creates a new ring with name `newr` and makes it the basering if r is
215         an existing ring/qring.
216NOTE:    This procedure is the same as copyring
217EXAMPLE: example changevar; shows an example
218{
219   copyring(r,vars,newr);
220}
221example
222{  "EXAMPLE:"; echo = 2;
223   ring r=0,(x,y,u,v),(dp(2),ds);
224   changevar(r,"A()","R");
225   show(R);
226   ideal i = x^2,y^2-u^3,v;
227   qring Q = std(i);
228   changevar(Q,"a,b,c,d","Q'");
229   show(Q');
230   kill R,Q,Q';
231}
232///////////////////////////////////////////////////////////////////////////////
233
234proc copyring (r, string vars, string newr)
235USAGE:   copyring(r,vars,newr);  r ring/qring, vars, newr strings
236CREATE:  creates a new ring with name `newr` and makes it the basering if r is
237         an existing ring/qring.
238         The new ring differs from the old ring only in the variables. If, say,
239         (vars,newr) = ("t()","R") and the ring r exists and has n variables,
240         the new basering will have name R and variables t(1),...,t(n).
241         If vars = "a,b,c,d", the new ring will have the variables a,b,c,d.
242RETURN:  No return value
243NOTE:    This procedure is useful in connection with the procedure ringsum,
244         when a conflict between variable names must be avoided. See proc
245         copyring1 for an alternative
246EXAMPLE: example copyring; shows an example
247{
248   setring r;
249   ideal i = ideal(r); int q = size(i);
250   if( q!=0 )
251      { string s = "newr1"; }
252   else
253      { string s = newr; }
254   string newring = s+"=("+charstr(r)+"),(";
255   if( vars[size(vars)-1]=="(" and vars[size(vars)]==")" )
256   {
257      newring = newring+vars[1,size(vars)-2]+"(1.."+string(nvars(r))+")";
258   }
259   else { newring = newring+vars; }
260   newring = newring+"),("+ordstr(r)+");";
261   execute("ring "+newring);
262   if( q!=0 )
263   {
264      map phi = r,maxideal(1);
265      ideal i = phi(i);
266      attrib(i,"isSB",1);         //*** attrib funktioniert ?
267      execute("qring "+newr+"=i;");
268   }
269   export(`newr`);
270   keepring(`newr`);
271   return();
272}
273example
274{  "EXAMPLE:"; echo = 2;
275   ring r=0,(x,y,u,v),(dp(2),ds);
276   copyring(r,"A()","R");
277   type R;
278   ideal i = A(1)^2,A(2)^2-A(3)^3,A(4);
279   qring Q = std(i);
280   copyring(Q,"a,b,c,d","Q'");
281   type Q';
282   kill R,Q,Q';
283}
284///////////////////////////////////////////////////////////////////////////////
285
286proc copyring1 (r, string vars, string newr)
287USAGE:   copyring1(r,vars,newr);  r ring, vars, newr strings
288RETURN:  a string which can be executed to define a new ring with name equal
289         to `newr` if r is an existing ring name.
290         The new ring differs from the old ring only in the variables. If, say,
291         (vars,newr) = ("t()","R") and the ring r exists and has n variables,
292         the new basering will have name R and variables t(1),...,t(n).
293         If vars = "a,b,c,d", the new ring will have the variables a,b,c,d.
294NOTE:    This procedure differs from copyring that it returns the string to
295         create newring, but does not execute this string. Contrary to
296         copyring this procedure does not work for a qring
297EXAMPLE: example copyring1; shows an example
298{
299   string newring = "ring "+newr+"=("+charstr(r)+"),(";
300   if( vars[size(vars)-1]=="(" and vars[size(vars)]==")" )
301        { string v = vars[1,size(vars)-2]+"(1.."+string(nvars(r))+")"; }
302   else { string v = vars; }
303   return(newring+v+"),("+ordstr(r)+");");
304}
305example
306{  "EXAMPLE:"; echo = 2;
307   ring r=0,(x,y,u,v),(dp(2),ds);
308   string s=copyring1(r,"A()","R");s;
309   execute(s);
310   type R;
311   execute(copyring1(R,"a,b,c,d,e","r'"));
312   type r';
313   kill R,r';
314}
315///////////////////////////////////////////////////////////////////////////////
316
317proc defring (string s1, string s2, int n, string s3, string s4)
318USAGE:   defring(s1,s2,n,s3,s4);  s1..s4=strings, n=integer
319CREATE:  Defines a ring with name 's1', characteristic 's2', ordering 's4' and
320         n variables with names derived from s3: if s3 is a single letter, say
321         s3="a", and if n<=26 then a and the following n-1 letters from the
322         alphabeth (cyclic order) are taken as variables. If n>26 or if s3 is
323         a single letter followed by (, say s3="T(", the variables are
324         T(1),...,T(n).
325RETURN:  No return value
326EXAMPLE: example defring; shows an example
327{
328   string newring = "ring "+s1+"=("+s2+"),(";
329   if( n>26 or s3[2]=="(" ) { string v = s3[1]+"(1.."+string(n)+")"; }
330   else { string v = A_Z(s3,n); }
331   newring=newring+v+"),("+s4+");";
332   execute(newring);
333   export(basering);
334   keepring(`s1`);
335   if (voice==2) { "// basering is now:",s1; }
336   return();
337}
338example
339{ "EXAMPLE:"; echo = 2;
340   defring("r","0",5,"u","ls"); r;
341   defring("R","2,A",10,"x(","dp(3),ws(1,2,3),ds"); R;
342   kill r,R;
343}
344///////////////////////////////////////////////////////////////////////////////
345
346proc defrings (int n, list #)
347USAGE:   defrings(n,[p]);  n,p integers
348CREATE:  Defines a ring with name Sn, characteristic p, ordering ds and n
349         variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26) and makes it
350         the basering (default: p=32003)
351RETURN:  No return value
352EXAMPLE: example defrings; shows an example
353{
354   int p;
355   if (size(#)==0) { p=32003; }
356   else { p=#[1]; }
357   if (n >26)
358   {
359      string s="ring S"+string(n)+"="+string(p)+",x(1.."+string(n)+"),ds;";
360   }
361   else
362   {
363      string s="ring S"+string(n)+"="+string(p)+",("+A_Z("x",n)+"),ds;";
364   }
365   execute(s);
366   export basering;
367   execute("keepring S"+string(n)+";");
368   if (voice==2) { "// basering is now:",s; }
369}
370example
371{ "EXAMPLE:"; echo = 2;
372   defrings(5,0); S5;
373   defrings(30); S30;
374   kill S5, S30;
375}
376///////////////////////////////////////////////////////////////////////////////
377
378proc defringp (int n,list #)
379USAGE:   defringp(n,[p]);  n,p=integers
380CREATE:  defines a ring with name Pn, characteristic p, ordering dp and n
381         variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26) and makes it
382         the basering (default: p=32003)
383RETURN:  No return value
384EXAMPLE: example defringp; shows an example
385{
386   int p;
387   if (size(#)==0) { p=32003; }
388   else { p=#[1]; }
389   if (n >26)
390   {
391      string s="ring P"+string(n)+"="+string(p)+",x(1.."+string(n)+"),dp;";
392   }
393   else
394   {
395     string s="ring P"+string(n)+"="+string(p)+",("+A_Z("x",n)+"),dp;";
396   }
397   execute(s);
398   export basering;
399   execute("keepring P"+string(n)+";");
400   //the next comment is only shown if defringp is not called by another proc
401   if (voice==2) { "// basering is now:",s; }
402}
403example
404{ "EXAMPLE:"; echo = 2;
405   defringp(5,0); P5;
406   defringp(30); P30;
407   kill P5, P30;
408}
409///////////////////////////////////////////////////////////////////////////////
410
411proc factorial (int n, list #)
412USAGE:   factorial(n[,string]);  n integer
413RETURN:  factorial(n); string of n! in char 0
414         factorial(n,s);  n! of type number (s any string), computed in char of
415         basering if a basering is defined
416EXAMPLE: example factorial; shows an example
417{
418   if ( size(#)==0 ) { ring R = 0,x,dp; poly r=1; }
419   if ( typeof(#[1])=="string" ) { number r=1; }
420   if ( size(#)==0 or typeof(#[1])=="string" )
421   {
422      int l;
423      for (l=2; l<=n; l++)
424      {
425         r=r*l;
426      }
427      if ( size(#)==0 ) { return(string(r)); }
428      return(r);
429   }
430}
431example
432{ "EXAMPLE:"; echo = 2;
433   factorial(37);
434   ring r1 = 32003,(x,y,z),ds;
435   number p = factorial(37,""); p;
436}
437///////////////////////////////////////////////////////////////////////////////
438
439proc fetchall (R, list #)
440USAGE:   fetchall(R[,s]);  R=ring/qring, s=string
441CREATE:  fetch all objects of ring R (of type poly, ideal, vector, module,
442         number, matrix) into the basering.
443         If no 3rd argument is present, the names are the same as in R. If, say,
444         f is a poly in R and the 3rd argument is the string "R", then f is
445         maped to f_R etc.
446RETURN:  no return value
447NOTE:    As fetch, this procedure maps the 1st, 2nd, ... variable of R to the
448         1st, 2nd, ... variable of the basering.
449         The 3rd argument is useful in order to avoid conflicts of names, the
450         empty string is allowed
451CAUTION: fetchall does not work inside a procedure
452         //***at the moment it does not work if R contains a map
453EXAMPLE: example fetchall; shows an example
454{
455   list @L@=names(R);
456   int @ii@; string @s@;
457   if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
458   for( @ii@=size(@L@); @ii@>0; @ii@=@ii@-- )
459   {
460         execute("def "+@L@[@ii@]+@s@+"=fetch(R,`@L@[@ii@]`);");
461         execute("export "+@L@[@ii@]+@s@+";");
462   }
463   return();
464}
465example
466{  "EXAMPLE:";
467"// This example is not executed since fetchall does not work in a procedure";
468"// (and hence not in the example procedure). Just try the following commands:";
469"   ring R=0,(x,y,z),dp;";
470"   ideal j=x,y2,z2;";
471"   matrix M[2][3]=1,2,3,x,y,z;";
472"   j; print(M);";
473"   ring S=0,(a,b,c),ds;";
474"   fetchall(R);           // map from R to S: x->a, y->b, z->c";
475"   names(S);";
476"   j; print(M);";
477"   fetchall(S,\"1\");       // identity map of S: copy objects, change names";
478"   names(S);";
479"   kill R,S;";
480}
481///////////////////////////////////////////////////////////////////////////////
482
483proc fibonacci (int n, list #)
484USAGE:   fibonacci(n[,string]);  (n integer)
485RETURN:  fibonacci(n); string of nth Fibonacci number,
486            f(0)=f(1)=1, f(i+1)=f(i-1)+f(i)
487         fibonacci(n,s);  nth Fibonacci number of type number (s any string),
488         computed in characteristic of basering if a basering is defined
489EXAMPLE: example fibonacci; shows an example
490{
491   if ( size(#)==0 ) { ring fibo = 0,x,dp; number f=1; }
492   if ( typeof(#[1])=="string" ) { number f=1; }
493   if ( size(#)==0 or typeof(#[1])=="string" )
494   {
495      number g,h = 1,1; int ii;
496      for (ii=3; ii<=n; ii++)
497      {
498         h = f+g; f = g; g = h;
499      }
500      if ( size(#)==0 ) { return(string(h)); }
501      return(h);
502   }
503}
504example
505{ "EXAMPLE:"; echo = 2;
506   fibonacci(37);
507   ring r = 17,x,dp;
508   number b = fibonacci(37,""); b;
509}
510///////////////////////////////////////////////////////////////////////////////
511
512proc ishomog (id)
513USAGE:   ishomog(id);  id  poly/ideal/vector/module/matrix
514RETURN:  integer which is 1 if input is homogeneous (resp. weighted homogeneous
515         if the monomial ordering consists of one block of type ws,Ws,wp or Wp,
516         assuming that all weights are positive) and 0 otherwise
517NOTE:    A vector is homogeneous, if the components are homogeneous of same
518         degree, a module/matrix is homogeneous if all column vectors are
519         homogeneous
520         //*** ergaenzen, wenn Matrizen Spalten Gewichte haben
521EXAMPLE: example ishomog; shows an example
522{
523   module M = module(matrix(id));
524   M = simplify(M,2);                        // remove 0-columns
525   intvec v = ringweights(basering);
526   int i,j=1,1;
527   for (i=1; i<=ncols(M); i++)
528   {
529      if( M[i]!=jet(M[i],deg(lead(M[i])),v)-jet(M[i],deg(lead(M[i]))-1,v))
530      { return(0); }
531   }
532   return(1);
533}
534example
535{ "EXAMPLE:"; echo = 2;
536   ring r = 0,(x,y,z),wp(1,2,3);
537   ishomog(x5-yz+y3);
538   ideal i = x6+y3+z2, x9-z3;
539   ishomog(i);
540   ring s = 0,(a,b,c),ds;
541   vector v = [a2,0,ac+bc];
542   vector w = [a3,b3,c4];
543   ishomog(v);
544   ishomog(w);
545}
546///////////////////////////////////////////////////////////////////////////////
547
548proc kmemory ()
549USAGE:   kmemory();
550RETURN:  memory used by active variables, of type int (in kilobyte)
551EXAMPLE: example kmemory; shows an example
552{
553  if ( voice==2 ) { "// memory used by active variables (kilobyte):"; }
554   return ((memory(0)+1023)/1024);
555}
556example
557{ "EXAMPLE:"; echo = 2;
558   kmemory();
559}
560///////////////////////////////////////////////////////////////////////////////
561
562proc killall ()
563USAGE:   killall(); (no parameter)
564CREATE:  kill all user-defined variables but not loaded procedures
565RETURN:  no return value
566NOTE:    killall should never be used inside a procedure
567EXAMPLE: example killall; shows an example AND KILLS ALL YOUR VARIABLES
568{
569   list L=names(); int joni=size(L);
570   for ( ; joni>0; joni-- )
571   {
572      if( L[joni]!="LIB" and typeof(`L[joni]`)!="proc" ) { kill `L[joni]`; }
573   }
574}
575example
576{ "EXAMPLE:"; echo = 2;
577   ring rtest; ideal i=x,y,z; number n=37; string str="hi";
578   export rtest,i,n,str;     //this makes the local variables global
579   listvar(all);
580   killall();
581   listvar(all);
582}
583///////////////////////////////////////////////////////////////////////////////
584
585proc imapall (R, list #)
586USAGE:   imapall(R[,s]);  R=ring/qring, s=string
587CREATE:  map all objects of ring R (of type poly, ideal, vector, module, number,
588         matrix) into the basering, by applying imap to all objects of R.
589         If no 3rd argument is present, the names are the same as in R. If, say,
590         f is a poly in R and the 3rd argument is the string "R", then f is
591         maped to f_R etc.
592RETURN:  no return value
593NOTE:    As imap, this procedure maps the variables of R to the variables with
594         the same name in the basering, the other variables are maped to 0.
595         The 3rd argument is useful in order to avoid conflicts of names, the
596         empty string is allowed
597CAUTION: imapall does not work inside a procedure
598         //***at the moment it does not work if R contains a map
599EXAMPLE: example imapall; shows an example
600{
601   list @L@=names(R);
602   int @ii@; string @s@;
603   if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
604   for( @ii@=size(@L@); @ii@>0; @ii@=@ii@-- )
605   {
606         execute("def "+@L@[@ii@]+@s@+"=imap(R,`@L@[@ii@]`);");
607         execute("export "+@L@[@ii@]+@s@+";");
608   }
609   return();
610}
611example
612{  "EXAMPLE:";
613"// This example is not executed since imapall does not work in a procedure";
614"// (and hence not in the example procedure). Just try the following commands:";
615"   ring R=0,(x,y,z,u),dp;";
616"   ideal j=x,y,z,u2+ux+z;";
617"   matrix M[2][3]=1,2,3,x,y,uz;";
618"   j; print(M);";
619"   ring S=0,(a,b,c,x,z,y),ds;";
620"   imapall(R);           // map from R to S: x->x, y->y, z->z, u->0";
621"   names(S);";
622"   j; print(M);";
623"   imapall(S,\"1\");       // identity map of S: copy objects, change names";
624"   names(S);";
625"   kill R,S;";
626}
627///////////////////////////////////////////////////////////////////////////////
628
629proc mapall (R, ideal i, list #)
630USAGE:   mapall(R,i[,s]);  R=ring/qring, i=ideal of basering, s=string
631CREATE:  map all objects of ring R (of type poly, ideal, vector, module, number,
632         matrix, map) into the basering, by mapping the jth variable of R to
633         the jth generator of the ideal i. If no 3rd argument is present, the
634         names are the same as in R. If, say, f is a poly in R and the 3rd
635         argument is the string "R", then f is maped to f_R etc.
636RETURN:  no return value
637NOTE:    This procedure has the same effect as defining a map, say psi, by
638         map psi=R,i; and then applying psi to all objects of R. In particular,
639         maps from R to some ring S are composed with psi, creating thus a map
640         from the basering to S.
641         mapall may be combined with copyring to change vars for all objects.
642         The 3rd argument is useful in order to avoid conflicts of names, the
643         empty string is allowed
644CAUTION: mapall does not work inside a procedure
645EXAMPLE: example mapall; shows an example
646{
647   list @L@=names(R); map @psi@ = R,i;
648   int @ii@; string @s@;
649   if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; }
650   for( @ii@=size(@L@); @ii@>0; @ii@=@ii@-- )
651   {
652      execute("def "+@L@[@ii@]+@s@+"=@psi@(`@L@[@ii@]`);");
653      execute("export "+@L@[@ii@]+@s@+";");
654   }
655   return();
656}
657example
658{  "EXAMPLE:";
659"// This example is not executed since mapall does not work in a procedure";
660"// (and hence not in the example procedure). Just try the following commands:";
661"   ring R=0,(x,y,z),dp;";
662"   ideal j=x,y,z;";
663"   matrix M[2][3]=1,2,3,x,y,z;";
664"   map phi=R,x2,y2,z2; ";
665"   ring S=0,(a,b,c),ds;";
666"   ideal i=c,a,b;";
667"   mapall(R,i);             // map from R to S: x->c, y->a, z->b";
668"   names(S);";
669"   j; print(M); phi;        // phi is a map from R to S: x->c2, y->a2, z->b2";
670"   ideal i1=a2,a+b,1;";
671"   mapall(R,i1,\"\");         // map from R to S: x->a2, y->a+b, z->1";
672"   names(S);";
673"   j_; print(M_); phi_;";
674"   copyring(S,\"x()\",\"T\");";
675"   mapall(R,maxideal(1));   // identity map from R to T";
676"   names(T);";
677"   j; print(M); phi;";
678"   kill R,S,T;";
679}
680///////////////////////////////////////////////////////////////////////////////
681
682proc maxcoef (f)
683USAGE:   maxcoef(f);  f  poly/ideal/vector/module/matrix
684RETURN:  maximal length of coefficient of f of type int (by counting the
685         length of the string of each coefficient)
686EXAMPLE: example maxcoef; shows an example
687{
688   int max,s,ii,jj; string t;
689   ideal i = ideal(matrix(f));
690   i = simplify(i,6);         //* delete 0's and keep first of equal elements
691   poly m = var(1); matrix C;
692   for (ii=2;ii<=nvars(basering);ii++) { m = m*var(ii); }
693   for (ii=1; ii<=size(i); ii++)
694   {
695      C = coef(i[ii],m);
696      for (jj=1; jj<=ncols(C); jj++)
697      {
698         t = string(C[2,jj]);  s = size(t);
699         if ( t[1] == "-" ) { s = s - 1; }
700         if ( s > max ) { max = s; }
701      }
702   }
703   return(max);
704}
705example
706{ "EXAMPLE:"; echo = 2;
707   ring r= 0,(x,y,z),ds;
708   poly g = 345x2-1234567890y+7/4z;
709   maxcoef(g);
710   ideal i = g,10/1234567890;
711   maxcoef(i);
712   // since i[2]=1/123456789
713}
714///////////////////////////////////////////////////////////////////////////////
715
716proc maxdeg (id)
717USAGE:   maxdeg(id);  id  poly/ideal/vector/module/matrix
718RETURN:  maximal degree/s of monomials of id independent of ring ordering
719         (maxdeg of each variable is 1)
720         of type int if id is of type poly, of type intmat else
721EXAMPLE: example maxdeg; shows an example
722{
723//------------------- find maximal degree of given component ------------------
724   proc findmaxdeg
725   {
726      poly c = #[1];
727      if (c==0) { return(-1); }
728   //--- guess upper 'o' and lower 'u' bound, in case of negative weights -----
729      int d = (deg(c)>=0)*deg(c)-(deg(c)<0)*deg(c);
730      int i = d;
731      while ( c-jet(c,i) != 0 ) { i = 2*(i+1); }
732      int o = i-1;
733      int u = (d != i)*((i/ 2)-1);
734   //----------------------- "quick search" for maxdeg ------------------------
735      while ( (c-jet(c,i)==0)*(c-jet(c,i-1)!=0) == 0)
736      {
737         i = (o+1+u)/ 2;
738         if (c-jet(c,i)!=0) { u = i+1; }
739         else { o = i-1; }
740      }
741      return(i);
742   }
743//------------------------------ main program ---------------------------------
744   matrix M = matrix(id);
745   int r,c = nrows(M), ncols(M); int i,j;
746   intmat m[r][c];
747   for (i=r; i>0; i--)
748   {
749      for (j=c; j>0; j--) { m[i,j] = findmaxdeg(M[i,j]); }
750   }
751   if( typeof(id)=="poly" ) { return(m[1,1]); }
752   return(m);
753}
754example
755{ "EXAMPLE:"; echo = 2;
756   ring r = 0,(x,y,z),wp(-1,-2,-3);
757   poly f = x+y2+z3;
758   deg(f);               //deg returns weighted degree (in case of 1 block)!
759   maxdeg(f);
760   matrix m[2][2]=f+x10,1,0,f^2;
761   maxdeg(m);
762}
763///////////////////////////////////////////////////////////////////////////////
764
765proc mindeg (id)
766USAGE:   mindeg(id);  id  poly/ideal/vector/module/matrix
767RETURN:  minimal degree/s of monomials of id independent of ring ordering
768         (mindeg of each variable is 1)
769         of type int if id is of type poly, of type intmat else
770EXAMPLE: example mindeg; shows an example
771{
772//------------------- find minimal degree of given component ------------------
773   proc findmindeg
774   {
775      poly c = #[1];
776      if (c==0) { return(-1); }
777   //--- guess upper 'o' and lower 'u' bound, in case of negative weights -----
778      int d = (ord(c)>=0)*ord(c)-(ord(c)<0)*ord(c);
779      int i = d;
780      while ( jet(c,i) == 0 ) { i = 2*(i+1); }
781      int o = i-1;
782      int u = (d != i)*((i/ 2)-1);
783//----------------------- "quick search" for mindeg --------------------------
784      while ( (jet(c,u)==0)*(jet(c,o)!=0) )
785      {
786         i = (o+u)/ 2;
787         if (jet(c,i)==0) { u = i+1; }
788         else { o = i-1; }
789      }
790      if (jet(c,u)!=0) { return(u); }
791      else { return(o+1); }
792   }
793//------------------------------ main program ---------------------------------
794   matrix M = matrix(id);
795   int r,c = nrows(M), ncols(M); int i,j;
796   intmat m[r][c];
797   for (i=r; i>0; i--)
798   {
799      for (j=c; j>0; j--) { m[i,j] = findmindeg(M[i,j]); }
800   }
801   if (typeof(id)=="poly") { return(m[1,1]); }
802   return(m);
803}
804example
805{ "EXAMPLE:"; echo = 2;
806   ring r = 0,(x,y,z),ls;
807   poly f = x5+y2+z3;
808   ord(f);                // ord returns weighted order of leading term!
809   mindeg(f);
810   matrix m[2][2]=x10,1,0,f^2;
811   mindeg(m);
812}
813///////////////////////////////////////////////////////////////////////////////
814
815proc normalize (id)
816USAGE:   normalize(id);  id=poly/vector/ideal/module
817RETURN:  object of same type with leading coefficient equal to 1
818EXAMPLE: example normalize; shows an example
819{
820   return(simplify(id,1));
821}
822example
823{  "EXAMPLE:"; echo = 2;
824   ring r = 0,(x,y,z),ls;
825   poly f = 2x5+3y2+4z3;
826   normalize(f);
827   module m=[9xy,0,3z3],[4z,6y,2x];
828   show(normalize(m));
829   ring s = 0,(x,y,z),(c,ls);
830   module m=[9xy,0,3z3],[4z,6y,2x];
831   show(normalize(m));
832   normalize(matrix(m));  // by automatic type conversion to module!
833}
834///////////////////////////////////////////////////////////////////////////////
835
836proc primes (int n, int m)
837USAGE:   primes(n,m);  n,m integers
838RETURN:  intvec, consisting of all primes p, prime(n)<=p<=m, in increasing
839         order if n<=m, resp. prime(m)<=p<=n, in decreasing order if m<n
840NOTE:    prime(n); returns the biggest prime number <= n (if n>=2, else 2)
841EXAMPLE: example primes; shows an example
842{  int change;
843   if ( n>m ) { change=n; n=m ; m=change; change=1; }
844   int q,p = prime(m),prime(n); intvec v = q; q = q-1;
845   while ( q>=p ) { q = prime(q); v = q,v; q = q-1; }
846   if ( change==1 ) { v = v[size(v)..1]; }
847   return(v);
848}
849example
850{  "EXAMPLE:"; echo = 2;
851   primes(50,100);
852   intvec v = primes(37,1); v;
853}
854///////////////////////////////////////////////////////////////////////////////
855
856proc product (id, list #)
857USAGE:    product(id[,v]); id=ideal/vector/module/matrix
858          resp.id=intvec/intmat, v=intvec (e.g. v=1..n, n=integer)
859RETURN:   poly resp. int which is the product of all entries of id, with index
860          given by v (default: v=1..number of entries of id)
861NOTE:     id is treated as a list of polys resp. integers. A module m is
862          identified with corresponding matrix M (columns of M generate m)
863EXAMPLE:  example product; shows an example
864{
865   int n,j;
866   if( typeof(id)=="poly" or typeof(id)=="ideal" or typeof(id)=="vector"
867       or typeof(id)=="module" or typeof(id)=="matrix" )
868   {
869      ideal i = ideal(matrix(id));
870      if( size(#)!=0 ) { i = i[#[1]]; }
871      n = ncols(i); poly f=1;
872   }
873   if( typeof(id)=="int" or typeof(id)=="intvec" or typeof(id)=="intmat" )
874   {
875      intmat S = intmat(id);
876      intvec i = S[1..nrows(S),1..ncols(S)];
877      if( size(#)!=0 ) { i = i[#[1]]; }
878      n = size(i); int f=1;
879   }
880   for( j=1; j<=n; j++ ) { f=f*i[j]; }
881   return(f);
882}
883example
884{  "EXAMPLE:"; echo = 2;
885   ring r= 0,(x,y,z),dp;
886   ideal m = maxideal(1);
887   product(m);
888   matrix M[2][3] = 1,x,2,y,3,z;
889   product(M);
890   intvec v=2,4,6;
891   product(M,v);
892   intvec iv = 1,2,3,4,5,6,7,8,9;
893   v=1..5,7,9;
894   product(iv,v);
895   intmat A[2][3] = 1,1,1,2,2,2;
896   product(A,3..5);
897}
898///////////////////////////////////////////////////////////////////////////////
899
900proc ringsum (list #)
901USAGE:   ringsum(r1,r2,...,s); r1,r2,... rings, s string (name of result ring)
902CREATE:  A new base ring with name equal to s if r1,r2,... are existing rings.
903         If, say, s = "R" and the rings r1,r2,... exist, the new ring will
904         have name R, variables from all rings r1,r2,... and as monomial
905         ordering the block (product) ordering of r1,r2,.... Mathematically, R
906         is the tensor product of the rings r1,r2,... with ordering matrix
907         equal to the direct sum of the ordering matrices of r1,r2,...
908RETURN:  no return value
909NOTE:    The characteristic of the new ring will be that of r1. The names of
910         variables in the rings r1,r2,... should differ (if a name, say x,
911         occurs in r1 and r2, then, in the new ring r, x always refers to the
912         variable with name x in r1, there is no access to x in r2).
913         The procedure works also for quotient rings.
914EXAMPLE: example ringsum; shows an example
915{
916   int ii,q;
917   int n = size(#);
918   string vars,order,oi,s;
919   for(ii=1; ii<=n-1; ii++)
920   {
921      if( ordstr(#[ii])[1]=="C" or ordstr(#[ii])[1]=="c" )
922           { oi=ordstr(#[ii])[3,size(ordstr(#[ii]))-2]; }
923      else { oi=ordstr(#[ii])[1,size(ordstr(#[ii]))-2]; }
924      vars = vars+varstr(#[ii])+",";
925      order= order+oi+",";
926      def r(ii)=#[ii];
927      setring r(ii);
928      ideal i(ii)=ideal(r(ii));
929      int q(ii)=size(i(ii));
930      q=q+q(ii);
931   }
932   if( q!=0 ) { s = "newr"; }
933   else {  s = #[size(#)]; }
934   string newring ="=("+charstr(#[1])+"),("+vars[1,size(vars)-1]+"),("
935                  +order[1,size(order)-1]+");";
936   execute("ring "+s+newring);
937   if( q!=0 )
938   {
939      ideal i;
940      for(ii=1; ii<=n-1; ii++)
941      {
942         if( q(ii)!=0 )
943         {
944            map phi = r(ii),maxideal(1);
945            i = i+phi(i(ii));
946            kill phi;
947         }
948      }
949      i=std(i);
950      execute("qring "+#[size(#)]+"=i;");
951   }
952   export(`#[size(#)]`);
953   keepring(`#[size(#)]`);
954   return();
955}
956example
957{ "EXAMPLE:"; echo = 2;
958   ring r=0,(x,y,u,v),dp;
959   ring s=32003,(a,b,c),wp(1,2,3);
960   ring t=37,x(1..5),(c,ls);
961   ringsum(r,s,t,"R");
962   type R;
963   setring s;
964   ideal i = a2+b3+c5; i=std(i);
965   qring qs =i;
966   setring s; qring qt=i;
967   ringsum(r,qs,t,qt,"Q");
968   type Q;
969   kill R,Q;
970}
971///////////////////////////////////////////////////////////////////////////////
972
973proc ringweights (r)
974USAGE:   ringweights(r); r ring
975RETURN:  intvec of weights of ring variables. If, say, x(1),...,x(n) are the
976         variables of the ring r, in this order, the resulting intvec is
977         deg(x(1)),...,deg(x(n)) where deg denotes the weighted degree if
978         the monomial ordering of r has only one block of type ws,Ws,wp or Wp.
979NOTE:    In all other cases, in particular if there is more than one block,
980         the resulting intvec is 1,...,1
981EXAMPLE: example ringweights; shows an example
982{
983   int i; intvec v; setring r;
984   for (i=1; i<=nvars(basering); i++) { v[i] = deg(var(i)); }
985   return(v);
986}
987example
988{ "EXAMPLE:"; echo = 2;
989   ring r1=32003,(x,y,z),wp(1,2,3);
990   ring r2=32003,(x,y,z),Ws(1,2,3);
991   ring r=0,(x,y,u,v),lp;
992   intvec vr=ringweights(r1); vr;
993   ringweights(r2);
994   ringweights(r);
995}
996///////////////////////////////////////////////////////////////////////////////
997
998proc sort
999USAGE:    sort(id); id ideal or module
1000RETURN:   ideal with generators of id sorted with respect to monomial ordering
1001          of the basering (generators with smaller leading term come first)
1002EXAMPLE:  example sort; shows an example
1003{
1004  intvec v = sortvec(#[1]);
1005  int s    = size(v);
1006  def m    = #[1];
1007  for (int jj=1;jj<=s;jj++) { m[jj] = #[1][v[jj]]; }
1008  return(m);
1009}
1010example
1011{  "EXAMPLE:"; echo = 2;
1012   ring r0 = 0,(x,y,z),lp;
1013   ideal i = x3,y3,z3,x2z,x2y,y2z,y2x,z2y,z2x,xyz;
1014   sort(i);
1015   ring r1  = 0,t,ls;
1016   ideal i = t47,t14,t6;
1017   ideal j = i;
1018   int ii;
1019   for (ii=1;ii<=8;ii=ii+1) { j=simplify(jet(j+i^ii,50),6); }
1020   print (matrix(j));
1021   print (matrix(sort(j)));
1022}
1023///////////////////////////////////////////////////////////////////////////////
1024
1025proc sum (id, list #)
1026USAGE:    sum(id[,v]); id=ideal/vector/module/matrix resp. id=intvec/intmat,
1027                       v=intvec (e.g. v=1..n, n=integer)
1028RETURN:   poly resp. int which is the sum of all entries of id, with index
1029          given by v (default: v=1..number of entries of id)
1030NOTE:     id is treated as a list of polys resp. integers. A module m is
1031          identified with corresponding matrix M (columns of M generate m)
1032EXAMPLE:  example sum; shows an example
1033{
1034   if( typeof(id)=="poly" or typeof(id)=="ideal" or typeof(id)=="vector"
1035       or typeof(id)=="module" or typeof(id)=="matrix" )
1036   {
1037      ideal i = ideal(matrix(id));
1038      if( size(#)!=0 ) { i = i[#[1]]; }
1039      matrix Z = matrix(i);
1040      intvec v; v[ncols(Z)]=0; v=v+1;
1041   }
1042   if( typeof(id)=="int" or typeof(id)=="intvec" or typeof(id)=="intmat" )
1043   {
1044      intmat S = intmat(id);
1045      intvec v = S[1..nrows(S),1..ncols(S)];
1046      if( size(#)!=0 ) { v = v[#[1]]; }
1047      intvec z; z[size(v)]=0; z=z+1;
1048      intmat Z=transpose(z);
1049   }
1050   return((Z*v)[1,1]);
1051}
1052example
1053{  "EXAMPLE:"; echo = 2;
1054   ring r= 0,(x,y,z),dp;
1055   vector pv = [xy,xz,yz,x2,y2,z2];
1056   sum(pv);
1057   sum(pv,2..5);
1058   matrix M[2][3] = 1,x,2,y,3,z;
1059   sum(M);
1060   intvec v=2,4,6;
1061   sum(M,v);
1062   intvec iv = 1,2,3,4,5,6,7,8,9;
1063   v=1..5,7,9;
1064   sum(iv,v);
1065   intmat m[2][3] = 1,1,1,2,2,2;
1066   sum(m,3..4);
1067}
1068///////////////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.