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

// $Id: general.lib,v 1.18 1999-08-23 14:54:03 Singular Exp $
//system("random",787422842);
//GMG, last modified 18.6.99
///////////////////////////////////////////////////////////////////////////////

version="$Id: general.lib,v 1.18 1999-08-23 14:54:03 Singular Exp $";
info="
LIBRARY:  general.lib   PROCEDURES OF GENERAL TYPE

PROCEDURES:
 A_Z(\"a\",n);          string a,b,... of n comma seperated letters
 ASCII([n,m]);          string of printable ASCII characters (number n to m)
 binomial(n,m[,../..]); n choose m (type int), [type string/type number]
 factorial(n[,../..]);  n factorial (=n!) (type int), [type string/number]
 fibonacci(n[,p]);      nth Fibonacci number [char p]
 kmemory([n[,v]]);      active [allocated] memory in kilobyte
 killall();             kill all user-defined variables
 number_e(n);           compute exp(1) up to n decimal digits
 number_pi(n);          compute pi (area of unit circle) up to n digits
 primes(n,m);           intvec of primes p, n<=p<=m
 product(../..[,v]);    multiply components of vector/ideal/...[indices v]
 ringweights(r);        intvec of weights of ring variables of ring r
 sort(ideal/module);    sort generators according to monomial ordering
 sum(vector/id/..[,v]); add components of vector/ideal/...[with indices v]
 which(command);        search for command and return absolute path, if found
           (parameters in square brackets [] are optional)
";

LIB "inout.lib";
///////////////////////////////////////////////////////////////////////////////

proc A_Z (string s,int n)
"USAGE:   A_Z(\"a\",n);  a any letter, n integer (-26<= n <=26, !=0)
RETURN:  string of n small (if a is small) or capital (if a is capital)
         letters, comma seperated, beginning with a, in alphabetical
         order (or revers alphabetical order if n<0)
EXAMPLE: example A_Z; shows an example
"
{
  if ( n>=-26 and n<=26 and n!=0 )
  {
    string alpha =
    "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,"+
    "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,"+
    "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,"+
    "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";
    int ii; int aa;
    for(ii=1; ii<=51; ii=ii+2)
    {
       if( alpha[ii]==s ) { aa=ii; }
    }
    if ( aa==0)
    {
      for(ii=105; ii<=155; ii=ii+2)
      {
        if( alpha[ii]==s ) { aa=ii; }
      }
    }
    if( aa!=0 )
    {
      string out;
      if (n > 0) { out = alpha[aa,2*(n)-1];  return (out); }
      if (n < 0)
      {
        string beta =
        "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,"+
        "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,"+
        "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,"+
        "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";
        if ( aa < 52 ) { aa=52-aa; }
        if ( aa > 104 ) { aa=260-aa; }
        out = beta[aa,2*(-n)-1]; return (out);
      }
    }
  }
}
example
{ "EXAMPLE:"; echo = 2;
   A_Z("c",5);
   A_Z("Z",-5);
   string sR = "ring R = (0,"+A_Z("A",6)+"),("+A_Z("a",10)+"),dp;";
   sR;
   execute sR;
   R;
}
///////////////////////////////////////////////////////////////////////////////
proc ASCII (list #)
"USAGE:   ASCII([n,m]); n,m= integers (32 <= n <= m <= 126)
RETURN:   printable ASCII characters (no native language support)
          ASCII():    string of  all ASCII characters with its numbers,
                      no return value
          ASCII(n):   string, n-th ASCII character
          ASCII(n,m): list, n-th up to m-th ASCII character (inclusive)
EXAMPLE: example ASCII; shows an example
"
{
  string s1 =
 "     !    \"    #    $       &    '    (    )    *    +    ,    -    .
32   33   34   35   36   37   38   39   40   41   42   43   44   45   46
/    0    1    2    3    4    5    6    7    8    9    :    ;    <    =
47   48   49   50   51   52   53   54   55   56   57   58   59   60   61
>    ?    @    A    B    C    D    E    F    G    H    I    J    K    L
62   63   64   65   66   67   68   69   70   71   72   73   74   75   76
M    N    O    P    Q    R    S    T    U    V    W    X    Y    Z    [
77   78   79   80   81   82   83   84   85   86   87   88   89   90   91
\\    ]    ^    _    `    a    b    c    d    e    f    g    h    i    j
92   93   94   95   96   97   98   99  100  101  102  103  104  105  10
k    l    m    n    o    p    q    r    s    t    u    v    w    x    y
107  108  109  110  111  112  113  114  115  116  117  118  119  120  121
z    {    |    }    ~
122  123  124  125  126 ";

   string s2 =
 " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~";

   if ( size(#) == 0 )
   {
      return(s1);
   }
   if ( size(#) == 1 )
   {
      return( s2[#[1]-31] );
   }
   if ( size(#) == 2 )
   {
      return( s2[#[1]-31,#[2]-#[1]+1] );
   }
}
example
{ "EXAMPLE:"; echo = 2;
   ASCII();"";
   ASCII(42);
   ASCII(32,126);
}
///////////////////////////////////////////////////////////////////////////////

proc binomial (int n, int k, list #)
"USAGE:   binomial(n,k[,p]); n,k,p integers
RETURN:  binomial(n,k); binomial coefficient n choose k,
         - of type string (computed in characteristic 0)
         binomial(n,k,p); n choose k, computed in characteristic prime(p)
         - of type number if a basering is present and prime(p)=char(basering)
         - of type string else
NOTE:    In any characteristic, binomial(n,k) = coefficient of x^k in (1+x)^n
EXAMPLE: example binomial; shows an example
"
{
   int str,p;
//---------------------------- initialization -------------------------------
   if ( size(#) == 0 )
   {  str = 1;
      ring bin = 0,x,dp;
      number r=1;
   }
   if ( size(#) > 0 )
   {
      p = (#[1]!=0)*prime(#[1]);
      if ( defined(basering) )
      {
         if ( p == char(basering) )
         {  number r=1;
         }
         else
         {  str = 1;
            ring bin = p,x,dp;
            number r=1;
         }
      }
      else
      {  str = 1;
         ring bin = p,x,dp;
         number r=1;
      }
   }
//-------------------------------- char 0 -----------------------------------
   if ( p==0 )
   {
      r = binom0(n,k);
   }
//-------------------------------- char p -----------------------------------
   else
   {
      r = binomp(n,k,p);
   }
//-------------------------------- return -----------------------------------
   if ( str==1 ) { return(string(r)); }
   else { return(r); }
 }
example
{ "EXAMPLE:"; echo = 2;
   binomial(200,100);"";                   //type string, computed in char 0
   binomial(200,100,3);"";                 //type string, computed in char 3
   int n,k = 200,100;
   ring r = 0,x,dp;
   number b1 = binomial(n,k,0);            //type number, computed in ring r
   poly b2 = coeffs((x+1)^n,x)[k+1,1];     //coefficient of x^k in (x+1)^n
   b1-b2;                                  //b1 and b2 should coincide
}
///////////////////////////////////////////////////////////////////////////////

static proc binom0 (int n, int k)
 //computes binomial coefficient n choose k in basering, assume 0<k<=n
 //and char(basering) = 0 or n < char(basering)
{
   int l;
   number r=1;
   if ( k > n-k )
   { k = n-k;
   }
   if ( k<=0 or k>n )               //trivial cases
   { r = (k==0)*r;
   }
   for (l=1; l<=k; l++ )
   {
      r=r*(n+1-l)/l;
   }
   return(r);
}
///////////////////////////////////////////////////////////////////////////////

static proc binomp (int n, int k, int p)
 //computes binomial coefficient n choose k in basering of char p > 0
 //binomial(n,k) = coefficient of x^k in (1+x)^n.
 //Let n=q*p^j, gcd(q,p)=1, then (1+x)^n = (1 + x^(p^j))^q. We have
 //binomial(n,k)=0 if k!=l*p^j and binomial(n,l*p^j) = binomial(q,l).
 //Do this reduction first. Then, in denominator and numerator
 //of defining formula for binomial coefficient, reduce those factors
 //mod p which are not divisible by p and cancel common factors p. Hence,
 //if n = h*p+r, k=l*p+s, r,s<p, binomial(n,k) = binomial(r,s)*binomial(h,l)
{
   int l,q,i= 1,n,1;
   number r=1;
   if ( k > n-k )
   { k = n-k;
   }
   if ( k<=0 or k>n)               //trivial cases
   { r = (k==0)*r;
   }
   else
   {
      while ( q mod p == 0 )
      {  l = l*p;
         q = q div p;
      }                            //we have now n=q*l, l=p^j, gcd(q,p)=1;
      if (k mod l != 0 )
      { r = 0;
      }
      else
      {  l = k div l;
         n = q mod p;
         k = l mod p;              //now 0<= k,n <p, use binom0 for n,k
         q = q div p;              //recursion for q,l
         l = l div p;              //use binomp for q,l
         r = binom0(n,k)*binomp(q,l,p);
      }
   }
   return(r);
}
///////////////////////////////////////////////////////////////////////////////

proc factorial (int n, list #)
"USAGE:   factorial(n[,p]);  n,p integers
RETURN:  factorial(n):   n! (computed in characteristic 0), of type string
         factorial(n,p): n! computed in characteristic prime(p)
         - of type number if a basering is present and prime(p)=char(basering)
         - of type string else
EXAMPLE: example factorial; shows an example
"
{   int str,l,p;
//---------------------------- initialization -------------------------------
   if ( size(#) == 0 )
   {  str = 1;
      ring bin = 0,x,dp;
      number r=1;
   }
   if ( size(#) > 0 )
   {
      p = (#[1]!=0)*prime(#[1]);
      if ( defined(basering) )
      {
         if ( p == char(basering) )
         {  number r=1;
         }
         else
         {  str = 1;
            ring bin = p,x,dp;
            number r=1;
         }
      }
      else
      {  str = 1;
         ring bin = p,x,dp;
         number r=1;
      }
   }
//------------------------------ computation --------------------------------
   for (l=2; l<=n; l++)
   {
      r=r*l;
   }
   if ( str==1 ) { return(string(r)); }
   else { return(r); }
}
example
{ "EXAMPLE:"; echo = 2;
   factorial(37);"";                   //37! of type string (as long integer)
   ring r1 = 0,x,dp;
   number p = factorial(37,0);         //37! of type number, computed in r
   p;
}
///////////////////////////////////////////////////////////////////////////////

proc fibonacci (int n, list #)
"USAGE:   fibonacci(n);  n,p integers
RETURN:  fibonacci(n): nth Fibonacci number, f(0)=f(1)=1, f(i+1)=f(i-1)+f(i)
         - computed in characteristic 0, of type string
         of type number computed in char(basering) if n is of type number
         fibonacci(n,p): f(n) computed in characteristic prime(p)
         - of type number if a basering is present and prime(p)=char(basering)
         - of type string else
EXAMPLE: example fibonacci; shows an example
"
{   int str,ii,p;
//---------------------------- initialization -------------------------------
   if ( size(#) == 0 )
   {  str = 1;
      ring bin = 0,x,dp;
      number f,g,h=1,1,1;
   }
   if ( size(#) > 0 )
   {
      p = (#[1]!=0)*prime(#[1]);
      if ( defined(basering) )
      {
         if ( p == char(basering) )
         {  number f,g,h=1,1,1;
         }
         else
         {  str = 1;
            ring bin = p,x,dp;
            number f,g,h=1,1,1;
         }
      }
      else
      {  str = 1;
         ring bin = p,x,dp;
         number f,g,h=1,1,1;
      }
   }
//------------------------------ computation --------------------------------
   for (ii=3; ii<=n; ii=ii+1)
   {
      h = f+g; f = g; g = h;
    }
   if ( str==1 ) { return(string(h)); }
   else { return(h); }
}
example
{ "EXAMPLE:"; echo = 2;
   fibonacci(333); "";              //f(333) of type string (as long integer)
   ring r = 17,x,dp;
   number b = fibonacci(333,17);    //f(333) of type number, computed in r
   b;
}
///////////////////////////////////////////////////////////////////////////////

proc kmemory (list #)
"USAGE:   kmemory([n,[v]]); n = int
RETURN:  memory in kilobyte of type int
         n=0: memory used by active variables (same as no parameters)
         n=1: total memory allocated by Singular
         n=2: difference between top and init memory adress (sbrk memory)
         n!=0,1,2: 0
DISPLAY: detailed information about allocated and used memory if v!=0
NOTE:    kmemory uses internal function 'memory' to compute kilobyte, and
         is the same as 'memory' for n!=0,1,2
EXAMPLE: example kmemory; shows an example
"
{
   int n;
   int verb;
   if (size(#) != 0)
   {
     n=#[1];
     if (size(#) >1)
     { verb=#[2]; }
   }

  if ( verb != 0)
  {
    if ( n==0)
    { dbprint(printlevel-voice+3,
      "// memory used, at the moment, by active variables (kilobyte):"); }
    if ( n==1 )
    { dbprint(printlevel-voice+3,
      "// total memory allocated, at the moment, by SINGULAR (kilobyte):"); }
   }
   return ((memory(n)+1023)/1024);
}
example
{ "EXAMPLE:"; echo = 2;
   kmemory();
   kmemory(1,1);
}
///////////////////////////////////////////////////////////////////////////////

proc killall
"USAGE:   killall(); (no parameter)
         killall(\"type_name\");
         killall(\"not\", \"type_name\");
COMPUTE: killall(); kills all user-defined variables but not loaded procedures
         killall(\"type_name\"); kills all user-defined variables,
         of type \"type_name\"
         killall(\"not\", \"type_name\"); kills all user-defined variables,
         except those of type \"type_name\" and except loaded procedures
RETURN:  no return value
NOTE:    killall should never be used inside a procedure
EXAMPLE: example killall; shows an example AND KILLS ALL YOUR VARIABLES
"
{
   list L=names(); int joni=size(L);
   if( size(#)==0 )
   {
      for ( ; joni>0; joni-- )
      {
         if( L[joni]!="LIB" and typeof(`L[joni]`)!="proc" ) { kill `L[joni]`; }
      }
   }
   else
   {
     if( size(#)==1 )
     {
       if( #[1] == "proc" )
       {
          for ( joni=size(L); joni>0; joni-- )
          {
             if( L[joni]=="LIB" or typeof(`L[joni]`)=="proc" )
               { kill `L[joni]`; }
          }
       }
       else
       {
          for ( ; joni>2; joni-- )
          {
            if(typeof(`L[joni]`)==#[1] and L[joni]!="LIB" and typeof(`L[joni]`)!="proc") { kill `L[joni]`; }
          }
        }
     }
     else
     {
        for ( ; joni>2; joni-- )
        {
          if(typeof(`L[joni]`)!=#[2] and L[joni]!="LIB" and typeof(`L[joni]`)!="proc") { kill `L[joni]`; }
        }
     }
  }
  return();
}
example
{ "EXAMPLE:"; echo = 2;
   ring rtest; ideal i=x,y,z; string str="hi"; int j = 3;
   export rtest,i,str,j;       //this makes the local variables global
   listvar();
   killall("ring");            // kills all rings
   listvar();
   killall("not", "int");      // kills all variables except int's (and procs)
   listvar();
   killall();                  // kills all vars except loaded procs
   listvar();
}
///////////////////////////////////////////////////////////////////////////////

proc number_e (int n)
"USAGE:   number_e(n);  n integer
COMPUTE: Euler number e=exp(1) up to n decimal digits (no rounding)
         by A.H.J. Sale's algorithm
RETURN:  - string of exp(1) if no basering of char 0 is defined;
         - exp(1), type number, if a basering of char 0 is defined, display its
         decimal format if printlevel >= voice (default:printlevel=voice-1 )
EXAMPLE: example number_e; shows an example
"
{
   int i,m,s,t;
   intvec u,e;
   u[n+2]=0; e[n+1]=0; e=e+1;
   if( defined(basering) )
   {
      if( char(basering)==0 ) { number r=2; t=1; }
   }
   string result = "2.";
   for( i=1; i<=n+1; i=i+1 )
   {
      e = e*10;
      for( m=n+1; m>=1; m=m-1 )
      {
         s    = e[m]+u[m+1];
         u[m] = s div (m+1);
         e[m] = s%(m+1);
      }
      result = result+string(u[1]);
      if( t==1 ) { r = r+number(u[1])/number(10)^i; }
   }
   if( t==1 )
   { dbprint(printlevel-voice+2,"// "+result[1,n+1]);
     return(r);
   }
   return(result[1,n+1]);
}
example
{ "EXAMPLE:"; echo = 2;
   number_e(30);"";
   ring R = 0,t,lp;
   number e = number_e(30);
   e;
}
///////////////////////////////////////////////////////////////////////////////

proc number_pi (int n)
"USAGE:   number_pi(n);  n positive integer
COMPUTE: pi (area of unit circle) up to n decimal digits (no rounding)
         by algorithm of S. Rabinowitz
RETURN:  - string of pi if no basering of char 0 is defined,
         - pi, of type number, if a basering of char 0 is defined, display its
         decimal format if printlevel >= voice (default:printlevel=voice-1 )
EXAMPLE: example number_pi; shows an example
"
{
   int i,m,t,e,q,N;
   intvec r,p,B,Prelim;
   string result,prelim;
   N = (10*n) div 3 + 2;
   p[N+1]=0; p=p+2; r=p;
   for( i=1; i<=N+1; i=i+1 ) { B[i]=2*i-1; }
   if( defined(basering) )
   {
      if( char(basering)==0 ) { number pi; number pri; t=1; }
   }
   for( i=0; i<=n; i=i+1 )
   {
      p = r*10;
      e = p[N+1];
      for( m=N+1; m>=2; m=m-1 )
      {
         r[m] = e%B[m];
         q    = e div B[m];
         e    = q*(m-1)+p[m-1];
      }
      r[1] = e%10;
      q    = e div 10;
      if( q!=10 and q!=9 )
      {
         result = result+prelim;
         Prelim = q;
         prelim = string(q);
      }
      if( q==9 )
      {
         Prelim = Prelim,9;
         prelim = prelim+"9";
      }
      if( q==10 )
      {
         Prelim = (Prelim+1)-((Prelim+1) div 10)*10;
         for( m=size(Prelim); m>0; m=m-1)
         {
            prelim[m] = string(Prelim[m]);
         }
         result = result+prelim;
         if( t==1 ) { pi=pi+pri; }
         Prelim = 0;
         prelim = "0";
      }
      if( t==1 ) { pi=pi+number(q)/number(10)^i; }
   }
   result = result,prelim[1];
   result = "3."+result[2,n-1];
   if( t==1 )
   { dbprint(printlevel-voice+2,"// "+result);
     return(pi);
   }
   return(result);
}
example
{ "EXAMPLE:"; echo = 2;
   number_pi(11);"";
   ring r = (real,10),t,dp;
   number pi = number_pi(11); pi;
}
///////////////////////////////////////////////////////////////////////////////

proc primes (int n, int m)
"USAGE:   primes(n,m);  n,m integers
RETURN:  intvec, consisting of all primes p, prime(n)<=p<=m, in increasing
         order if n<=m, resp. prime(m)<=p<=n, in decreasing order if m<n
NOTE:    prime(n); returns the biggest prime number <= n (if n>=2, else 2)
EXAMPLE: example primes; shows an example
"
{  int change;
   if ( n>m ) { change=n; n=m ; m=change; change=1; }
   int q,p = prime(m),prime(n); intvec v = q; q = q-1;
   while ( q>=p ) { q = prime(q); v = q,v; q = q-1; }
   if ( change==1 ) { v = v[size(v)..1]; }
   return(v);
}
example
{  "EXAMPLE:"; echo = 2;
    primes(50,100);"";
    intvec v = primes(37,1); v;
}
///////////////////////////////////////////////////////////////////////////////

proc product (id, list #)
"USAGE:    product(id[,v]); id ideal/vector/module/matrix/intvec/intmat/list,
          v intvec  (default: v=1.. number of entries of id)
RETURN:   - if id is not a list: poly resp. int, the product of all entries of
          id with index given by v.
          id is treated as a list of polys resp. integers. A module m is
          identified with corresponding matrix M (columns of M generate m)
          - if id is a list: product of list entries, with index given by v.
          Assume that list members can be multiplied
EXAMPLE:  example product; shows an example
"
{
   int n,j,tt;
   string ty;
   list l;
   int s = size(#);
   if( s!=0 )
   {  if ( typeof(#[s])=="intvec" )
      {  intvec v = #[s];
         tt=1; s=s-1;
         if ( s>0 ) { # = #[1..s]; }
      }
   }
   if ( s>0 )
   {
     l = list(id)+#;
     kill id;
     list id = l;
     ty = "list";
   }
   else
   { ty = typeof(id);
   }
   if( ty=="list" )
   { n = size(id);
     def f(1) = id[1];
     for( j=2; j<=n; j=j+1 ) { def f(j)=f(j-1)*id[j]; }
     return(f(n));
   }
   if( ty=="poly" or ty=="ideal" or ty=="vector"
       or ty=="module" or ty=="matrix" )
   {
      ideal i = ideal(matrix(id));
      kill id;
      ideal id = i;
      if( tt!=0 ) { id = id[v]; }
      n = ncols(id); poly f(1)=id[1];
   }
   if( ty=="int" or ty=="intvec" or ty=="intmat" )
   {
      if ( ty == "int" ) { intmat S =id; }
      else { intmat S = intmat(id); }
      intvec i = S[1..nrows(S),1..ncols(S)];
      kill id;
      intvec id = i;
      if( tt!=0 ) { id = id[v]; }
      n = size(id); int f(1)=id[1];
   }
   for( j=2; j<=n; j=j+1 ) { def f(j)=f(j-1)*id[j]; }
   return(f(n));
}
example
{  "EXAMPLE:"; echo = 2;
   ring r= 0,(x,y,z),dp;
   ideal m = maxideal(1);
   product(m);
   product(m[2..3]);
   matrix M[2][3] = 1,x,2,y,3,z;
   product(M);
   intvec v=2,4,6;
   product(M,v);
   intvec iv = 1,2,3,4,5,6,7,8,9;
   v=1..5,7,9;
   product(iv,v);
   intmat A[2][3] = 1,1,1,2,2,2;
   product(A,3..5);
}
///////////////////////////////////////////////////////////////////////////////

proc ringweights (r)
"USAGE:   ringweights(r); r ring
RETURN:  intvec of weights of ring variables. If, say, x(1),...,x(n) are the
         variables of the ring r, in this order, the resulting intvec is
         deg(x(1)),...,deg(x(n)) where deg denotes the weighted degree if
         the monomial ordering of r has only one block of type ws,Ws,wp or Wp.
NOTE:    In all other cases, in particular if there is more than one block,
         the resulting intvec is 1,...,1
EXAMPLE: example ringweights; shows an example
"
{
   int i; intvec v; setring r;
   for (i=1; i<=nvars(basering); i=i+1) { v[i] = deg(var(i)); }
   return(v);
}
example
{ "EXAMPLE:"; echo = 2;
   ring r1=32003,(x,y,z),wp(1,2,3);
   ring r2=32003,(x,y,z),Ws(1,2,3);
   ring r=0,(x,y,u,v),lp;
   intvec vr=ringweights(r1); vr;
   ringweights(r2);
   ringweights(r);
}
///////////////////////////////////////////////////////////////////////////////

proc sort (id, list #)
"USAGE:   sort(id[v,o,n]); id=ideal/module/intvec/list (of intvec's or int's)
         sort may be called with 1, 2 or 3 arguments in the following way:
         sort(id[v,n]); v=intvec of positive integers, n=integer,
         sort(id[o,n]); o=string (any allowed ordstr of a ring), n=integer
RETURN:  a list of two elements:
         [1]: object of same type as input but sorted in the following manner:
           - if id=ideal/module: generators of id are sorted w.r.t. intvec v
             (id[v[1]] becomes 1-st, id[v[2]]  2-nd element, etc.). If no v is
             present, id is sorted w.r.t. ordering o (if o is given) or w.r.t.
             actual monomial ordering (if no o is given):
                    generators with smaller leading term come first
             (e.g. sort(id); sorts w.r.t actual monomial ordering)
           - if id=list of intvec's or int's: consider a list element, say
             id[1]=3,2,5, as exponent vector of the monomial x^3*y^2*z^5;
             the corresponding monomials are ordered w.r.t. intvec v (s.a.).
             If no v is present, the monomials are sorted w.r.t. ordering o
             (if o is given) or w.r.t. lexicographical ordering (if no o is
             given). The corresponding ordered list of exponent vectors is
             returned.
             (e.g. sort(id); sorts lexicographically, smaller int's come first)
             WARNING: Since negative exponents create the 0 polynomial in
             Singular, id should not contain negative integers: the result
             might not be as expected
           - if id=intvec: id is treated as list of integers
           - if n!=0 the ordering is inverse, i.e. w.r.t. v(size(v)..1)
             default: n=0
         [2]: intvec, describing the permutation of the input (hence [2]=v if
             v is given (with positive integers)
NOTE:    If v is given id may be any simply indexed object (e.g. any list or
         string); if v[i]<0 and i<=size(id) v[i] is set internally to i;
         entries of v must be pairwise distinct to get a permutation if id.
         Zero generators of ideal/module are deleted
EXAMPLE: example sort; shows an example
"
{  int ii,jj,s,n = 0,0,1,0;
   intvec v;
   if ( defined(basering) ) { def P = basering; }
   if ( size(#)==0 and (typeof(id)=="ideal" or typeof(id)=="module") )
   {
      id = simplify(id,2);
      for ( ii=1; ii<size(id); ii++ )
      {
         if ( id[ii]!=id[ii+1] ) { break;}
      }
      if ( ii != size(id) ) { v = sortvec(id); }
      else  { v = size(id)..1; }
   }
   if ( size(#)>=1 and (typeof(id)=="ideal" or typeof(id)=="module") )
   {
      if ( typeof(#[1])=="string" )
      {
         execute "ring r1 =("+charstr(P)+"),("+varstr(P)+"),("+#[1]+");";
         def i = imap(P,id);
         v = sortvec(i);
         setring P;
         n=2;
      }
   }
   if ( typeof(id)=="intvec" or typeof(id)=="list" and n==0 )
   {
      string o;
      if ( size(#)==0 ) { o = "lp"; n=1; }
      if ( size(#)>=1 )
      {
         if ( typeof(#[1])=="string" ) { o = #[1]; n=1; }
      }
   }
   if ( typeof(id)=="intvec" or typeof(id)=="list" and n==1 )
   {
      if ( typeof(id)=="list" )
      {
         for (ii=1; ii<=size(id); ii++)
         {
            if (typeof(id[ii]) != "intvec" and typeof(id[ii]) != "int")
               { "// list elements must be intvec/int"; return(); }
            else
               { s=size(id[ii])*(s < size(id[ii])) + s*(s >= size(id[ii])); }
         }
      }
      execute "ring r=0,x(1..s),("+o+");";
      ideal i;
      poly f;
      for (ii=1; ii<=size(id); ii++)
      {
         f=1;
         for (jj=1; jj<=size(id[ii]); jj++)
         {
            f=f*x(jj)^(id[ii])[jj];
         }
         i[ii]=f;
      }
      v = sort(i)[2];
   }
   if ( size(#)!=0 and n==0 ) { v = #[1]; }
   if( size(#)==2 )
   {
      if ( #[2] != 0 ) { v = v[size(v)..1]; }
   }
   s = size(v);
   if( size(id) < s ) { s = size(id); }
   def m = id;
   if ( size(m) != 0 )
   {
      for ( jj=1; jj<=s; jj=jj+1)
      {
         if ( v[jj]<=0 ) { v[jj]=jj; }
         m[jj] = id[v[jj]];
      }
   }
   if ( v == 0 ) { v = 1; }
   list L=m,v;
   return(L);
}
example
{  "EXAMPLE:"; echo = 2;
   ring r0 = 0,(x,y,z,t),lp;
   ideal i = x3,z3,xyz;
   sort(i);                // sort w.r.t. lex ordering
   sort(i,3..1);
   sort(i,"ls")[1];        // sort w.r.t. negative lex ordering
   list L =1,8..5,3..10;
   sort(L)[1];             // sort L lexicographically
   sort(L,"Dp",1)[1];      // sort L w.r.t (total sum, reverse lex)
}
///////////////////////////////////////////////////////////////////////////////

proc sum (id, list #)
"USAGE:    sum(id[,v]); id=ideal/vector/module/matrix resp. id=intvec/intmat,
                       v=intvec (e.g. v=1..n, n=integer)
RETURN:   poly resp. int which is the sum of all entries of id, with index
          given by v (default: v=1..number of entries of id)
NOTE:     id is treated as a list of polys resp. integers. A module m is
          identified with corresponding matrix M (columns of M generate m)
EXAMPLE:  example sum; shows an example
"
{
   if( typeof(id)=="poly" or typeof(id)=="ideal" or typeof(id)=="vector"
       or typeof(id)=="module" or typeof(id)=="matrix" )
   {
      ideal i = ideal(matrix(id));
      if( size(#)!=0 ) { i = i[#[1]]; }
      matrix Z = matrix(i);
   }
   if( typeof(id)=="int" or typeof(id)=="intvec" or typeof(id)=="intmat" )
   {
      if ( typeof(id) == "int" ) { intmat S =id; }
      else { intmat S = intmat(id); }
      intvec i = S[1..nrows(S),1..ncols(S)];
      if( size(#)!=0 ) { i = i[#[1]]; }
      intmat Z=transpose(i);
   }
   intvec v; v[ncols(Z)]=0; v=v+1;
   return((Z*v)[1,1]);
 }
example
{  "EXAMPLE:"; echo = 2;
   ring r= 0,(x,y,z),dp;
   vector pv = [xy,xz,yz,x2,y2,z2];
   sum(pv);
   sum(pv,2..5);
   matrix M[2][3] = 1,x,2,y,3,z;
   intvec w=2,4,6;
   sum(M,w);
   intvec iv = 1,2,3,4,5,6,7,8,9;
   sum(iv,2..4);
}
///////////////////////////////////////////////////////////////////////////////

proc which (command)
"USAGE:    which(command); command = string expression
RETURN:   Absolute pathname of command, if found in search path.
          Empty string, otherwise.
NOTE:     Based on the Unix command 'which'.
EXAMPLE:  example which; shows an example
"
{
   int rs;
   int i;
   string fn = "/tmp/which_" + string(system("pid"));
   string pn;
   if( typeof(command) != "string")
   {
     return (pn);
   }
   i = system("sh", "which " + command + " > " + fn);
   pn = read(fn);
   pn[size(pn)] = "";
   i = 1;
   while ((pn[i] != " ") and (pn[i] != ""))
   {
     i = i+1;
   }
   if (pn[i] == " ") {pn[i] = "";}
   rs = system("sh", "ls " + pn + " > " + fn + " 2>&1 ");
   i = system("sh", "rm " + fn);
   if (rs == 0) {return (pn);}
   else
   {
     print (command + " not found ");
     return ("");
   }
}
example
{  "EXAMPLE:"; echo = 2;
    which("Singular");
}
///////////////////////////////////////////////////////////////////////////////