source: git/Singular/LIB/general.lib @ 949d0d

fieker-DuValspielwiese
Last change on this file since 949d0d was 949d0d, checked in by Hans Schönemann <hannes@…>, 25 years ago
*hannes: do not use pause in libs (except...) git-svn-id: file:///usr/local/Singular/svn/trunk@3533 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 28.0 KB
Line 
1// $Id: general.lib,v 1.18 1999-08-23 14:54:03 Singular Exp $
2//system("random",787422842);
3//GMG, last modified 18.6.99
4///////////////////////////////////////////////////////////////////////////////
5
6version="$Id: general.lib,v 1.18 1999-08-23 14:54:03 Singular Exp $";
7info="
8LIBRARY:  general.lib   PROCEDURES OF GENERAL TYPE
9
10PROCEDURES:
11 A_Z(\"a\",n);          string a,b,... of n comma seperated letters
12 ASCII([n,m]);          string of printable ASCII characters (number n to m)
13 binomial(n,m[,../..]); n choose m (type int), [type string/type number]
14 factorial(n[,../..]);  n factorial (=n!) (type int), [type string/number]
15 fibonacci(n[,p]);      nth Fibonacci number [char p]
16 kmemory([n[,v]]);      active [allocated] memory in kilobyte
17 killall();             kill all user-defined variables
18 number_e(n);           compute exp(1) up to n decimal digits
19 number_pi(n);          compute pi (area of unit circle) up to n digits
20 primes(n,m);           intvec of primes p, n<=p<=m
21 product(../..[,v]);    multiply components of vector/ideal/...[indices v]
22 ringweights(r);        intvec of weights of ring variables of ring r
23 sort(ideal/module);    sort generators according to monomial ordering
24 sum(vector/id/..[,v]); add components of vector/ideal/...[with indices v]
25 which(command);        search for command and return absolute path, if found
26           (parameters in square brackets [] are optional)
27";
28
29LIB "inout.lib";
30///////////////////////////////////////////////////////////////////////////////
31
32proc A_Z (string s,int n)
33"USAGE:   A_Z(\"a\",n);  a any letter, n integer (-26<= n <=26, !=0)
34RETURN:  string of n small (if a is small) or capital (if a is capital)
35         letters, comma seperated, beginning with a, in alphabetical
36         order (or revers alphabetical order if n<0)
37EXAMPLE: example A_Z; shows an example
38"
39{
40  if ( n>=-26 and n<=26 and n!=0 )
41  {
42    string alpha =
43    "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,"+
44    "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,"+
45    "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,"+
46    "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";
47    int ii; int aa;
48    for(ii=1; ii<=51; ii=ii+2)
49    {
50       if( alpha[ii]==s ) { aa=ii; }
51    }
52    if ( aa==0)
53    {
54      for(ii=105; ii<=155; ii=ii+2)
55      {
56        if( alpha[ii]==s ) { aa=ii; }
57      }
58    }
59    if( aa!=0 )
60    {
61      string out;
62      if (n > 0) { out = alpha[aa,2*(n)-1];  return (out); }
63      if (n < 0)
64      {
65        string beta =
66        "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,"+
67        "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,"+
68        "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,"+
69        "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";
70        if ( aa < 52 ) { aa=52-aa; }
71        if ( aa > 104 ) { aa=260-aa; }
72        out = beta[aa,2*(-n)-1]; return (out);
73      }
74    }
75  }
76}
77example
78{ "EXAMPLE:"; echo = 2;
79   A_Z("c",5);
80   A_Z("Z",-5);
81   string sR = "ring R = (0,"+A_Z("A",6)+"),("+A_Z("a",10)+"),dp;";
82   sR;
83   execute sR;
84   R;
85}
86///////////////////////////////////////////////////////////////////////////////
87proc ASCII (list #)
88"USAGE:   ASCII([n,m]); n,m= integers (32 <= n <= m <= 126)
89RETURN:   printable ASCII characters (no native language support)
90          ASCII():    string of  all ASCII characters with its numbers,
91                      no return value
92          ASCII(n):   string, n-th ASCII character
93          ASCII(n,m): list, n-th up to m-th ASCII character (inclusive)
94EXAMPLE: example ASCII; shows an example
95"
96{
97  string s1 =
98 "     !    \"    #    $       &    '    (    )    *    +    ,    -    .
9932   33   34   35   36   37   38   39   40   41   42   43   44   45   46
100/    0    1    2    3    4    5    6    7    8    9    :    ;    <    =
10147   48   49   50   51   52   53   54   55   56   57   58   59   60   61
102>    ?    @    A    B    C    D    E    F    G    H    I    J    K    L
10362   63   64   65   66   67   68   69   70   71   72   73   74   75   76
104M    N    O    P    Q    R    S    T    U    V    W    X    Y    Z    [
10577   78   79   80   81   82   83   84   85   86   87   88   89   90   91
106\\    ]    ^    _    `    a    b    c    d    e    f    g    h    i    j
10792   93   94   95   96   97   98   99  100  101  102  103  104  105  10
108k    l    m    n    o    p    q    r    s    t    u    v    w    x    y
109107  108  109  110  111  112  113  114  115  116  117  118  119  120  121
110z    {    |    }    ~
111122  123  124  125  126 ";
112
113   string s2 =
114 " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~";
115
116   if ( size(#) == 0 )
117   {
118      return(s1);
119   }
120   if ( size(#) == 1 )
121   {
122      return( s2[#[1]-31] );
123   }
124   if ( size(#) == 2 )
125   {
126      return( s2[#[1]-31,#[2]-#[1]+1] );
127   }
128}
129example
130{ "EXAMPLE:"; echo = 2;
131   ASCII();"";
132   ASCII(42);
133   ASCII(32,126);
134}
135///////////////////////////////////////////////////////////////////////////////
136
137proc binomial (int n, int k, list #)
138"USAGE:   binomial(n,k[,p]); n,k,p integers
139RETURN:  binomial(n,k); binomial coefficient n choose k,
140         - of type string (computed in characteristic 0)
141         binomial(n,k,p); n choose k, computed in characteristic prime(p)
142         - of type number if a basering is present and prime(p)=char(basering)
143         - of type string else
144NOTE:    In any characteristic, binomial(n,k) = coefficient of x^k in (1+x)^n
145EXAMPLE: example binomial; shows an example
146"
147{
148   int str,p;
149//---------------------------- initialization -------------------------------
150   if ( size(#) == 0 )
151   {  str = 1;
152      ring bin = 0,x,dp;
153      number r=1;
154   }
155   if ( size(#) > 0 )
156   {
157      p = (#[1]!=0)*prime(#[1]);
158      if ( defined(basering) )
159      {
160         if ( p == char(basering) )
161         {  number r=1;
162         }
163         else
164         {  str = 1;
165            ring bin = p,x,dp;
166            number r=1;
167         }
168      }
169      else
170      {  str = 1;
171         ring bin = p,x,dp;
172         number r=1;
173      }
174   }
175//-------------------------------- char 0 -----------------------------------
176   if ( p==0 )
177   {
178      r = binom0(n,k);
179   }
180//-------------------------------- char p -----------------------------------
181   else
182   {
183      r = binomp(n,k,p);
184   }
185//-------------------------------- return -----------------------------------
186   if ( str==1 ) { return(string(r)); }
187   else { return(r); }
188 }
189example
190{ "EXAMPLE:"; echo = 2;
191   binomial(200,100);"";                   //type string, computed in char 0
192   binomial(200,100,3);"";                 //type string, computed in char 3
193   int n,k = 200,100;
194   ring r = 0,x,dp;
195   number b1 = binomial(n,k,0);            //type number, computed in ring r
196   poly b2 = coeffs((x+1)^n,x)[k+1,1];     //coefficient of x^k in (x+1)^n
197   b1-b2;                                  //b1 and b2 should coincide
198}
199///////////////////////////////////////////////////////////////////////////////
200
201static proc binom0 (int n, int k)
202 //computes binomial coefficient n choose k in basering, assume 0<k<=n
203 //and char(basering) = 0 or n < char(basering)
204{
205   int l;
206   number r=1;
207   if ( k > n-k )
208   { k = n-k;
209   }
210   if ( k<=0 or k>n )               //trivial cases
211   { r = (k==0)*r;
212   }
213   for (l=1; l<=k; l++ )
214   {
215      r=r*(n+1-l)/l;
216   }
217   return(r);
218}
219///////////////////////////////////////////////////////////////////////////////
220
221static proc binomp (int n, int k, int p)
222 //computes binomial coefficient n choose k in basering of char p > 0
223 //binomial(n,k) = coefficient of x^k in (1+x)^n.
224 //Let n=q*p^j, gcd(q,p)=1, then (1+x)^n = (1 + x^(p^j))^q. We have
225 //binomial(n,k)=0 if k!=l*p^j and binomial(n,l*p^j) = binomial(q,l).
226 //Do this reduction first. Then, in denominator and numerator
227 //of defining formula for binomial coefficient, reduce those factors
228 //mod p which are not divisible by p and cancel common factors p. Hence,
229 //if n = h*p+r, k=l*p+s, r,s<p, binomial(n,k) = binomial(r,s)*binomial(h,l)
230{
231   int l,q,i= 1,n,1;
232   number r=1;
233   if ( k > n-k )
234   { k = n-k;
235   }
236   if ( k<=0 or k>n)               //trivial cases
237   { r = (k==0)*r;
238   }
239   else
240   {
241      while ( q mod p == 0 )
242      {  l = l*p;
243         q = q div p;
244      }                            //we have now n=q*l, l=p^j, gcd(q,p)=1;
245      if (k mod l != 0 )
246      { r = 0;
247      }
248      else
249      {  l = k div l;
250         n = q mod p;
251         k = l mod p;              //now 0<= k,n <p, use binom0 for n,k
252         q = q div p;              //recursion for q,l
253         l = l div p;              //use binomp for q,l
254         r = binom0(n,k)*binomp(q,l,p);
255      }
256   }
257   return(r);
258}
259///////////////////////////////////////////////////////////////////////////////
260
261proc factorial (int n, list #)
262"USAGE:   factorial(n[,p]);  n,p integers
263RETURN:  factorial(n):   n! (computed in characteristic 0), of type string
264         factorial(n,p): n! computed in characteristic prime(p)
265         - of type number if a basering is present and prime(p)=char(basering)
266         - of type string else
267EXAMPLE: example factorial; shows an example
268"
269{   int str,l,p;
270//---------------------------- initialization -------------------------------
271   if ( size(#) == 0 )
272   {  str = 1;
273      ring bin = 0,x,dp;
274      number r=1;
275   }
276   if ( size(#) > 0 )
277   {
278      p = (#[1]!=0)*prime(#[1]);
279      if ( defined(basering) )
280      {
281         if ( p == char(basering) )
282         {  number r=1;
283         }
284         else
285         {  str = 1;
286            ring bin = p,x,dp;
287            number r=1;
288         }
289      }
290      else
291      {  str = 1;
292         ring bin = p,x,dp;
293         number r=1;
294      }
295   }
296//------------------------------ computation --------------------------------
297   for (l=2; l<=n; l++)
298   {
299      r=r*l;
300   }
301   if ( str==1 ) { return(string(r)); }
302   else { return(r); }
303}
304example
305{ "EXAMPLE:"; echo = 2;
306   factorial(37);"";                   //37! of type string (as long integer)
307   ring r1 = 0,x,dp;
308   number p = factorial(37,0);         //37! of type number, computed in r
309   p;
310}
311///////////////////////////////////////////////////////////////////////////////
312
313proc fibonacci (int n, list #)
314"USAGE:   fibonacci(n);  n,p integers
315RETURN:  fibonacci(n): nth Fibonacci number, f(0)=f(1)=1, f(i+1)=f(i-1)+f(i)
316         - computed in characteristic 0, of type string
317         of type number computed in char(basering) if n is of type number
318         fibonacci(n,p): f(n) computed in characteristic prime(p)
319         - of type number if a basering is present and prime(p)=char(basering)
320         - of type string else
321EXAMPLE: example fibonacci; shows an example
322"
323{   int str,ii,p;
324//---------------------------- initialization -------------------------------
325   if ( size(#) == 0 )
326   {  str = 1;
327      ring bin = 0,x,dp;
328      number f,g,h=1,1,1;
329   }
330   if ( size(#) > 0 )
331   {
332      p = (#[1]!=0)*prime(#[1]);
333      if ( defined(basering) )
334      {
335         if ( p == char(basering) )
336         {  number f,g,h=1,1,1;
337         }
338         else
339         {  str = 1;
340            ring bin = p,x,dp;
341            number f,g,h=1,1,1;
342         }
343      }
344      else
345      {  str = 1;
346         ring bin = p,x,dp;
347         number f,g,h=1,1,1;
348      }
349   }
350//------------------------------ computation --------------------------------
351   for (ii=3; ii<=n; ii=ii+1)
352   {
353      h = f+g; f = g; g = h;
354    }
355   if ( str==1 ) { return(string(h)); }
356   else { return(h); }
357}
358example
359{ "EXAMPLE:"; echo = 2;
360   fibonacci(333); "";              //f(333) of type string (as long integer)
361   ring r = 17,x,dp;
362   number b = fibonacci(333,17);    //f(333) of type number, computed in r
363   b;
364}
365///////////////////////////////////////////////////////////////////////////////
366
367proc kmemory (list #)
368"USAGE:   kmemory([n,[v]]); n = int
369RETURN:  memory in kilobyte of type int
370         n=0: memory used by active variables (same as no parameters)
371         n=1: total memory allocated by Singular
372         n=2: difference between top and init memory adress (sbrk memory)
373         n!=0,1,2: 0
374DISPLAY: detailed information about allocated and used memory if v!=0
375NOTE:    kmemory uses internal function 'memory' to compute kilobyte, and
376         is the same as 'memory' for n!=0,1,2
377EXAMPLE: example kmemory; shows an example
378"
379{
380   int n;
381   int verb;
382   if (size(#) != 0)
383   {
384     n=#[1];
385     if (size(#) >1)
386     { verb=#[2]; }
387   }
388
389  if ( verb != 0)
390  {
391    if ( n==0)
392    { dbprint(printlevel-voice+3,
393      "// memory used, at the moment, by active variables (kilobyte):"); }
394    if ( n==1 )
395    { dbprint(printlevel-voice+3,
396      "// total memory allocated, at the moment, by SINGULAR (kilobyte):"); }
397   }
398   return ((memory(n)+1023)/1024);
399}
400example
401{ "EXAMPLE:"; echo = 2;
402   kmemory();
403   kmemory(1,1);
404}
405///////////////////////////////////////////////////////////////////////////////
406
407proc killall
408"USAGE:   killall(); (no parameter)
409         killall(\"type_name\");
410         killall(\"not\", \"type_name\");
411COMPUTE: killall(); kills all user-defined variables but not loaded procedures
412         killall(\"type_name\"); kills all user-defined variables,
413         of type \"type_name\"
414         killall(\"not\", \"type_name\"); kills all user-defined variables,
415         except those of type \"type_name\" and except loaded procedures
416RETURN:  no return value
417NOTE:    killall should never be used inside a procedure
418EXAMPLE: example killall; shows an example AND KILLS ALL YOUR VARIABLES
419"
420{
421   list L=names(); int joni=size(L);
422   if( size(#)==0 )
423   {
424      for ( ; joni>0; joni-- )
425      {
426         if( L[joni]!="LIB" and typeof(`L[joni]`)!="proc" ) { kill `L[joni]`; }
427      }
428   }
429   else
430   {
431     if( size(#)==1 )
432     {
433       if( #[1] == "proc" )
434       {
435          for ( joni=size(L); joni>0; joni-- )
436          {
437             if( L[joni]=="LIB" or typeof(`L[joni]`)=="proc" )
438               { kill `L[joni]`; }
439          }
440       }
441       else
442       {
443          for ( ; joni>2; joni-- )
444          {
445            if(typeof(`L[joni]`)==#[1] and L[joni]!="LIB" and typeof(`L[joni]`)!="proc") { kill `L[joni]`; }
446          }
447        }
448     }
449     else
450     {
451        for ( ; joni>2; joni-- )
452        {
453          if(typeof(`L[joni]`)!=#[2] and L[joni]!="LIB" and typeof(`L[joni]`)!="proc") { kill `L[joni]`; }
454        }
455     }
456  }
457  return();
458}
459example
460{ "EXAMPLE:"; echo = 2;
461   ring rtest; ideal i=x,y,z; string str="hi"; int j = 3;
462   export rtest,i,str,j;       //this makes the local variables global
463   listvar();
464   killall("ring");            // kills all rings
465   listvar();
466   killall("not", "int");      // kills all variables except int's (and procs)
467   listvar();
468   killall();                  // kills all vars except loaded procs
469   listvar();
470}
471///////////////////////////////////////////////////////////////////////////////
472
473proc number_e (int n)
474"USAGE:   number_e(n);  n integer
475COMPUTE: Euler number e=exp(1) up to n decimal digits (no rounding)
476         by A.H.J. Sale's algorithm
477RETURN:  - string of exp(1) if no basering of char 0 is defined;
478         - exp(1), type number, if a basering of char 0 is defined, display its
479         decimal format if printlevel >= voice (default:printlevel=voice-1 )
480EXAMPLE: example number_e; shows an example
481"
482{
483   int i,m,s,t;
484   intvec u,e;
485   u[n+2]=0; e[n+1]=0; e=e+1;
486   if( defined(basering) )
487   {
488      if( char(basering)==0 ) { number r=2; t=1; }
489   }
490   string result = "2.";
491   for( i=1; i<=n+1; i=i+1 )
492   {
493      e = e*10;
494      for( m=n+1; m>=1; m=m-1 )
495      {
496         s    = e[m]+u[m+1];
497         u[m] = s div (m+1);
498         e[m] = s%(m+1);
499      }
500      result = result+string(u[1]);
501      if( t==1 ) { r = r+number(u[1])/number(10)^i; }
502   }
503   if( t==1 )
504   { dbprint(printlevel-voice+2,"// "+result[1,n+1]);
505     return(r);
506   }
507   return(result[1,n+1]);
508}
509example
510{ "EXAMPLE:"; echo = 2;
511   number_e(30);"";
512   ring R = 0,t,lp;
513   number e = number_e(30);
514   e;
515}
516///////////////////////////////////////////////////////////////////////////////
517
518proc number_pi (int n)
519"USAGE:   number_pi(n);  n positive integer
520COMPUTE: pi (area of unit circle) up to n decimal digits (no rounding)
521         by algorithm of S. Rabinowitz
522RETURN:  - string of pi if no basering of char 0 is defined,
523         - pi, of type number, if a basering of char 0 is defined, display its
524         decimal format if printlevel >= voice (default:printlevel=voice-1 )
525EXAMPLE: example number_pi; shows an example
526"
527{
528   int i,m,t,e,q,N;
529   intvec r,p,B,Prelim;
530   string result,prelim;
531   N = (10*n) div 3 + 2;
532   p[N+1]=0; p=p+2; r=p;
533   for( i=1; i<=N+1; i=i+1 ) { B[i]=2*i-1; }
534   if( defined(basering) )
535   {
536      if( char(basering)==0 ) { number pi; number pri; t=1; }
537   }
538   for( i=0; i<=n; i=i+1 )
539   {
540      p = r*10;
541      e = p[N+1];
542      for( m=N+1; m>=2; m=m-1 )
543      {
544         r[m] = e%B[m];
545         q    = e div B[m];
546         e    = q*(m-1)+p[m-1];
547      }
548      r[1] = e%10;
549      q    = e div 10;
550      if( q!=10 and q!=9 )
551      {
552         result = result+prelim;
553         Prelim = q;
554         prelim = string(q);
555      }
556      if( q==9 )
557      {
558         Prelim = Prelim,9;
559         prelim = prelim+"9";
560      }
561      if( q==10 )
562      {
563         Prelim = (Prelim+1)-((Prelim+1) div 10)*10;
564         for( m=size(Prelim); m>0; m=m-1)
565         {
566            prelim[m] = string(Prelim[m]);
567         }
568         result = result+prelim;
569         if( t==1 ) { pi=pi+pri; }
570         Prelim = 0;
571         prelim = "0";
572      }
573      if( t==1 ) { pi=pi+number(q)/number(10)^i; }
574   }
575   result = result,prelim[1];
576   result = "3."+result[2,n-1];
577   if( t==1 )
578   { dbprint(printlevel-voice+2,"// "+result);
579     return(pi);
580   }
581   return(result);
582}
583example
584{ "EXAMPLE:"; echo = 2;
585   number_pi(11);"";
586   ring r = (real,10),t,dp;
587   number pi = number_pi(11); pi;
588}
589///////////////////////////////////////////////////////////////////////////////
590
591proc primes (int n, int m)
592"USAGE:   primes(n,m);  n,m integers
593RETURN:  intvec, consisting of all primes p, prime(n)<=p<=m, in increasing
594         order if n<=m, resp. prime(m)<=p<=n, in decreasing order if m<n
595NOTE:    prime(n); returns the biggest prime number <= n (if n>=2, else 2)
596EXAMPLE: example primes; shows an example
597"
598{  int change;
599   if ( n>m ) { change=n; n=m ; m=change; change=1; }
600   int q,p = prime(m),prime(n); intvec v = q; q = q-1;
601   while ( q>=p ) { q = prime(q); v = q,v; q = q-1; }
602   if ( change==1 ) { v = v[size(v)..1]; }
603   return(v);
604}
605example
606{  "EXAMPLE:"; echo = 2;
607    primes(50,100);"";
608    intvec v = primes(37,1); v;
609}
610///////////////////////////////////////////////////////////////////////////////
611
612proc product (id, list #)
613"USAGE:    product(id[,v]); id ideal/vector/module/matrix/intvec/intmat/list,
614          v intvec  (default: v=1.. number of entries of id)
615RETURN:   - if id is not a list: poly resp. int, the product of all entries of
616          id with index given by v.
617          id is treated as a list of polys resp. integers. A module m is
618          identified with corresponding matrix M (columns of M generate m)
619          - if id is a list: product of list entries, with index given by v.
620          Assume that list members can be multiplied
621EXAMPLE:  example product; shows an example
622"
623{
624   int n,j,tt;
625   string ty;
626   list l;
627   int s = size(#);
628   if( s!=0 )
629   {  if ( typeof(#[s])=="intvec" )
630      {  intvec v = #[s];
631         tt=1; s=s-1;
632         if ( s>0 ) { # = #[1..s]; }
633      }
634   }
635   if ( s>0 )
636   {
637     l = list(id)+#;
638     kill id;
639     list id = l;
640     ty = "list";
641   }
642   else
643   { ty = typeof(id);
644   }
645   if( ty=="list" )
646   { n = size(id);
647     def f(1) = id[1];
648     for( j=2; j<=n; j=j+1 ) { def f(j)=f(j-1)*id[j]; }
649     return(f(n));
650   }
651   if( ty=="poly" or ty=="ideal" or ty=="vector"
652       or ty=="module" or ty=="matrix" )
653   {
654      ideal i = ideal(matrix(id));
655      kill id;
656      ideal id = i;
657      if( tt!=0 ) { id = id[v]; }
658      n = ncols(id); poly f(1)=id[1];
659   }
660   if( ty=="int" or ty=="intvec" or ty=="intmat" )
661   {
662      if ( ty == "int" ) { intmat S =id; }
663      else { intmat S = intmat(id); }
664      intvec i = S[1..nrows(S),1..ncols(S)];
665      kill id;
666      intvec id = i;
667      if( tt!=0 ) { id = id[v]; }
668      n = size(id); int f(1)=id[1];
669   }
670   for( j=2; j<=n; j=j+1 ) { def f(j)=f(j-1)*id[j]; }
671   return(f(n));
672}
673example
674{  "EXAMPLE:"; echo = 2;
675   ring r= 0,(x,y,z),dp;
676   ideal m = maxideal(1);
677   product(m);
678   product(m[2..3]);
679   matrix M[2][3] = 1,x,2,y,3,z;
680   product(M);
681   intvec v=2,4,6;
682   product(M,v);
683   intvec iv = 1,2,3,4,5,6,7,8,9;
684   v=1..5,7,9;
685   product(iv,v);
686   intmat A[2][3] = 1,1,1,2,2,2;
687   product(A,3..5);
688}
689///////////////////////////////////////////////////////////////////////////////
690
691proc ringweights (r)
692"USAGE:   ringweights(r); r ring
693RETURN:  intvec of weights of ring variables. If, say, x(1),...,x(n) are the
694         variables of the ring r, in this order, the resulting intvec is
695         deg(x(1)),...,deg(x(n)) where deg denotes the weighted degree if
696         the monomial ordering of r has only one block of type ws,Ws,wp or Wp.
697NOTE:    In all other cases, in particular if there is more than one block,
698         the resulting intvec is 1,...,1
699EXAMPLE: example ringweights; shows an example
700"
701{
702   int i; intvec v; setring r;
703   for (i=1; i<=nvars(basering); i=i+1) { v[i] = deg(var(i)); }
704   return(v);
705}
706example
707{ "EXAMPLE:"; echo = 2;
708   ring r1=32003,(x,y,z),wp(1,2,3);
709   ring r2=32003,(x,y,z),Ws(1,2,3);
710   ring r=0,(x,y,u,v),lp;
711   intvec vr=ringweights(r1); vr;
712   ringweights(r2);
713   ringweights(r);
714}
715///////////////////////////////////////////////////////////////////////////////
716
717proc sort (id, list #)
718"USAGE:   sort(id[v,o,n]); id=ideal/module/intvec/list (of intvec's or int's)
719         sort may be called with 1, 2 or 3 arguments in the following way:
720         sort(id[v,n]); v=intvec of positive integers, n=integer,
721         sort(id[o,n]); o=string (any allowed ordstr of a ring), n=integer
722RETURN:  a list of two elements:
723         [1]: object of same type as input but sorted in the following manner:
724           - if id=ideal/module: generators of id are sorted w.r.t. intvec v
725             (id[v[1]] becomes 1-st, id[v[2]]  2-nd element, etc.). If no v is
726             present, id is sorted w.r.t. ordering o (if o is given) or w.r.t.
727             actual monomial ordering (if no o is given):
728                    generators with smaller leading term come first
729             (e.g. sort(id); sorts w.r.t actual monomial ordering)
730           - if id=list of intvec's or int's: consider a list element, say
731             id[1]=3,2,5, as exponent vector of the monomial x^3*y^2*z^5;
732             the corresponding monomials are ordered w.r.t. intvec v (s.a.).
733             If no v is present, the monomials are sorted w.r.t. ordering o
734             (if o is given) or w.r.t. lexicographical ordering (if no o is
735             given). The corresponding ordered list of exponent vectors is
736             returned.
737             (e.g. sort(id); sorts lexicographically, smaller int's come first)
738             WARNING: Since negative exponents create the 0 polynomial in
739             Singular, id should not contain negative integers: the result
740             might not be as expected
741           - if id=intvec: id is treated as list of integers
742           - if n!=0 the ordering is inverse, i.e. w.r.t. v(size(v)..1)
743             default: n=0
744         [2]: intvec, describing the permutation of the input (hence [2]=v if
745             v is given (with positive integers)
746NOTE:    If v is given id may be any simply indexed object (e.g. any list or
747         string); if v[i]<0 and i<=size(id) v[i] is set internally to i;
748         entries of v must be pairwise distinct to get a permutation if id.
749         Zero generators of ideal/module are deleted
750EXAMPLE: example sort; shows an example
751"
752{  int ii,jj,s,n = 0,0,1,0;
753   intvec v;
754   if ( defined(basering) ) { def P = basering; }
755   if ( size(#)==0 and (typeof(id)=="ideal" or typeof(id)=="module") )
756   {
757      id = simplify(id,2);
758      for ( ii=1; ii<size(id); ii++ )
759      {
760         if ( id[ii]!=id[ii+1] ) { break;}
761      }
762      if ( ii != size(id) ) { v = sortvec(id); }
763      else  { v = size(id)..1; }
764   }
765   if ( size(#)>=1 and (typeof(id)=="ideal" or typeof(id)=="module") )
766   {
767      if ( typeof(#[1])=="string" )
768      {
769         execute "ring r1 =("+charstr(P)+"),("+varstr(P)+"),("+#[1]+");";
770         def i = imap(P,id);
771         v = sortvec(i);
772         setring P;
773         n=2;
774      }
775   }
776   if ( typeof(id)=="intvec" or typeof(id)=="list" and n==0 )
777   {
778      string o;
779      if ( size(#)==0 ) { o = "lp"; n=1; }
780      if ( size(#)>=1 )
781      {
782         if ( typeof(#[1])=="string" ) { o = #[1]; n=1; }
783      }
784   }
785   if ( typeof(id)=="intvec" or typeof(id)=="list" and n==1 )
786   {
787      if ( typeof(id)=="list" )
788      {
789         for (ii=1; ii<=size(id); ii++)
790         {
791            if (typeof(id[ii]) != "intvec" and typeof(id[ii]) != "int")
792               { "// list elements must be intvec/int"; return(); }
793            else
794               { s=size(id[ii])*(s < size(id[ii])) + s*(s >= size(id[ii])); }
795         }
796      }
797      execute "ring r=0,x(1..s),("+o+");";
798      ideal i;
799      poly f;
800      for (ii=1; ii<=size(id); ii++)
801      {
802         f=1;
803         for (jj=1; jj<=size(id[ii]); jj++)
804         {
805            f=f*x(jj)^(id[ii])[jj];
806         }
807         i[ii]=f;
808      }
809      v = sort(i)[2];
810   }
811   if ( size(#)!=0 and n==0 ) { v = #[1]; }
812   if( size(#)==2 )
813   {
814      if ( #[2] != 0 ) { v = v[size(v)..1]; }
815   }
816   s = size(v);
817   if( size(id) < s ) { s = size(id); }
818   def m = id;
819   if ( size(m) != 0 )
820   {
821      for ( jj=1; jj<=s; jj=jj+1)
822      {
823         if ( v[jj]<=0 ) { v[jj]=jj; }
824         m[jj] = id[v[jj]];
825      }
826   }
827   if ( v == 0 ) { v = 1; }
828   list L=m,v;
829   return(L);
830}
831example
832{  "EXAMPLE:"; echo = 2;
833   ring r0 = 0,(x,y,z,t),lp;
834   ideal i = x3,z3,xyz;
835   sort(i);                // sort w.r.t. lex ordering
836   sort(i,3..1);
837   sort(i,"ls")[1];        // sort w.r.t. negative lex ordering
838   list L =1,8..5,3..10;
839   sort(L)[1];             // sort L lexicographically
840   sort(L,"Dp",1)[1];      // sort L w.r.t (total sum, reverse lex)
841}
842///////////////////////////////////////////////////////////////////////////////
843
844proc sum (id, list #)
845"USAGE:    sum(id[,v]); id=ideal/vector/module/matrix resp. id=intvec/intmat,
846                       v=intvec (e.g. v=1..n, n=integer)
847RETURN:   poly resp. int which is the sum of all entries of id, with index
848          given by v (default: v=1..number of entries of id)
849NOTE:     id is treated as a list of polys resp. integers. A module m is
850          identified with corresponding matrix M (columns of M generate m)
851EXAMPLE:  example sum; shows an example
852"
853{
854   if( typeof(id)=="poly" or typeof(id)=="ideal" or typeof(id)=="vector"
855       or typeof(id)=="module" or typeof(id)=="matrix" )
856   {
857      ideal i = ideal(matrix(id));
858      if( size(#)!=0 ) { i = i[#[1]]; }
859      matrix Z = matrix(i);
860   }
861   if( typeof(id)=="int" or typeof(id)=="intvec" or typeof(id)=="intmat" )
862   {
863      if ( typeof(id) == "int" ) { intmat S =id; }
864      else { intmat S = intmat(id); }
865      intvec i = S[1..nrows(S),1..ncols(S)];
866      if( size(#)!=0 ) { i = i[#[1]]; }
867      intmat Z=transpose(i);
868   }
869   intvec v; v[ncols(Z)]=0; v=v+1;
870   return((Z*v)[1,1]);
871 }
872example
873{  "EXAMPLE:"; echo = 2;
874   ring r= 0,(x,y,z),dp;
875   vector pv = [xy,xz,yz,x2,y2,z2];
876   sum(pv);
877   sum(pv,2..5);
878   matrix M[2][3] = 1,x,2,y,3,z;
879   intvec w=2,4,6;
880   sum(M,w);
881   intvec iv = 1,2,3,4,5,6,7,8,9;
882   sum(iv,2..4);
883}
884///////////////////////////////////////////////////////////////////////////////
885
886proc which (command)
887"USAGE:    which(command); command = string expression
888RETURN:   Absolute pathname of command, if found in search path.
889          Empty string, otherwise.
890NOTE:     Based on the Unix command 'which'.
891EXAMPLE:  example which; shows an example
892"
893{
894   int rs;
895   int i;
896   string fn = "/tmp/which_" + string(system("pid"));
897   string pn;
898   if( typeof(command) != "string")
899   {
900     return (pn);
901   }
902   i = system("sh", "which " + command + " > " + fn);
903   pn = read(fn);
904   pn[size(pn)] = "";
905   i = 1;
906   while ((pn[i] != " ") and (pn[i] != ""))
907   {
908     i = i+1;
909   }
910   if (pn[i] == " ") {pn[i] = "";}
911   rs = system("sh", "ls " + pn + " > " + fn + " 2>&1 ");
912   i = system("sh", "rm " + fn);
913   if (rs == 0) {return (pn);}
914   else
915   {
916     print (command + " not found ");
917     return ("");
918   }
919}
920example
921{  "EXAMPLE:"; echo = 2;
922    which("Singular");
923}
924///////////////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.