source: git/Singular/LIB/general.lib @ a70441f

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