source: git/Singular/LIB/general.lib @ 917fb5

spielwiese
Last change on this file since 917fb5 was 917fb5, checked in by Hans Schönemann <hannes@…>, 25 years ago
* hannes: removed pause; (scanner.l, febase.*) introduced pause([string]) (standard.lib) git-svn-id: file:///usr/local/Singular/svn/trunk@3237 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 23.4 KB
Line 
1// $Id: general.lib,v 1.15 1999-07-06 15:32:47 Singular Exp $
2//system("random",787422842);
3//GMG, last modified 18.6.99
4///////////////////////////////////////////////////////////////////////////////
5
6version="$Id: general.lib,v 1.15 1999-07-06 15:32:47 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 charakter
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
101/    0    1    2    3    4    5    6    7    8    9    :    ;    <    =
10247   48   49   50   51   52   53   54   55   56   57   58   59   60   61
103
104>    ?    @    A    B    C    D    E    F    G    H    I    J    K    L
10562   63   64   65   66   67   68   69   70   71   72   73   74   75   76
106
107M    N    O    P    Q    R    S    T    U    V    W    X    Y    Z    [
10877   78   79   80   81   82   83   84   85   86   87   88   89   90   91
109
110\\    ]    ^    _    `    a    b    c    d    e    f    g    h    i    j
11192   93   94   95   96   97   98   99  100  101  102  103  104  105  10
112
113k    l    m    n    o    p    q    r    s    t    u    v    w    x    y
114107  108  109  110  111  112  113  114  115  116  117  118  119  120  121
115
116z    {    |    }    ~
117122  123  124  125  126 ";
118
119   string s2 =
120 " !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~";
121
122   if ( size(#) == 0 )
123   {
124      return(s1);
125   }
126   if ( size(#) == 1 )
127   {
128      return( s2[#[1]-31] );
129   }
130   if ( size(#) == 2 )
131   {
132      return( s2[#[1]-31,#[2]-#[1]+1] );
133   }
134}
135example
136{ "EXAMPLE:"; echo = 2;
137   ASCII();"";
138   ASCII(42);
139   ASCII(32,126);
140}
141///////////////////////////////////////////////////////////////////////////////
142
143proc binomial (def n, int k, list #)
144"USAGE:   binomial(n,k[,p]); n,k,p integers
145RETURN:  binomial(n,k); binomial coefficient n choose k,
146         of type number if n is of type number (computed in char(basering)),
147         of type int if n is of type int (machine integer, limited size!)
148         binomial(n,k,p);  n choose k in char p, of type string
149EXAMPLE: example binomial; shows an example
150"
151{
152   if ( size(#)==0 )
153   {
154      if ( typeof(n)=="number" ) { number rr=1; }
155      else { int rr=1; }
156   }
157   if ( typeof(#[1])=="int") { ring bin = #[1],x,dp; number rr=1; }
158   if ( size(#)==0 or typeof(#[1])=="int" )
159   {
160      def r = rr;
161      if ( k<=0 or k>n ) { return((k==0)*r); }
162      if ( k>n-k ) { k = n-k; }
163      int l;
164      for (l=1; l<=k; l=l+1 )
165      {
166         r=r*(n+1-l)/l;
167      }
168      if ( typeof(#[1])=="int" ) { return(string(r)); }
169      return(r);
170   }
171}
172example
173{ "EXAMPLE:"; echo = 2;
174   int b1 = binomial(10,7); b1;
175   binomial(137,17,0);
176   ring t = 0,x,dp;
177   number b2 = binomial(number(137),17); b2;
178}
179///////////////////////////////////////////////////////////////////////////////
180
181proc factorial (def n)
182"USAGE:   factorial(n);  n = integer
183RETURN:  factorial(n); n! in char 0, of type string if n is of type int
184         n! of type number, computed in char(basering) if n is of type number
185EXAMPLE: example factorial; shows an example
186"
187{
188   int t,l;
189   if ( typeof(n)=="number" ) { number r=1; }
190   else { ring R = 0,x,dp; number r=1; t=1; }
191   for (l=2; l<=n; l=l+1)
192   {
193      r=r*l;
194   }
195   if ( t==1 ) { return(string(r)); }
196   return(r);
197}
198example
199{ "EXAMPLE:"; echo = 2;
200   factorial(37);
201   ring r1 = 32003,(x,y,z),ds;
202   number p = factorial(number(37)); p;
203}
204///////////////////////////////////////////////////////////////////////////////
205
206proc fibonacci (def n)
207"USAGE:   fibonacci(n);  (n integer)
208RETURN:  fibonacci(n); nth Fibonacci number,
209            f(0)=f(1)=1, f(i+1)=f(i-1)+f(i)
210         of type string if n is of type int
211         of type number computed in char(basering) if n is of type number
212EXAMPLE: example fibonacci; shows an example
213"
214{
215   int ii,t;
216   if ( typeof(n)=="number" ) { number f,g,h=1,1,1; }
217   else { ring fibo = 0,x,dp; number f,g,h=1,1,1; t=1; }
218   for (ii=3; ii<=n; ii=ii+1)
219   {
220      h = f+g; f = g; g = h;
221    }
222   if ( t==1 ) { return(string(h)); }
223   return(h);
224}
225example
226{ "EXAMPLE:"; echo = 2;
227   fibonacci(37);
228   ring r = 17,x,dp;
229   number b = fibonacci(number(37)); b;
230}
231///////////////////////////////////////////////////////////////////////////////
232
233proc kmemory (list #)
234"USAGE:   kmemory([n,[v]]); n = int
235RETURN:  memory in kilobyte of type int
236         n=0: memory used by active variables (same as no parameters)
237         n=1: total memory allocated by Singular
238         n=2: difference between top and init memory adress (sbrk memory)
239         n!=0,1,2: 0
240DISPLAY: detailed information about allocated and used memory if v!=0
241NOTE:    kmemory uses internal function 'memory' to compute kilobyte, and
242         is the same as 'memory' for n!=0,1,2
243EXAMPLE: example kmemory; shows an example
244"
245{
246   int n;
247   int verb;
248   if (size(#) != 0)
249   {
250     n=#[1];
251     if (size(#) >1)
252     { verb=#[2]; }
253   }
254
255  if ( verb != 0)
256  {
257    if ( n==0)
258    { dbprint(printlevel-voice+3,
259      "// memory used, at the moment, by active variables (kilobyte):"); }
260    if ( n==1 )
261    { dbprint(printlevel-voice+3,
262      "// total memory allocated, at the moment, by SINGULAR (kilobyte):"); }
263   }
264   return ((memory(n)+1023)/1024);
265}
266example
267{ "EXAMPLE:"; echo = 2;
268   kmemory();
269   kmemory(1,1);
270}
271///////////////////////////////////////////////////////////////////////////////
272
273proc killall
274"USAGE:   killall(); (no parameter)
275         killall(\"type_name\");
276         killall(\"not\", \"type_name\");
277COMPUTE: killall(); kills all user-defined variables but not loaded procedures
278         killall(\"type_name\"); kills all user-defined variables, of type \"type_name\"
279         killall(\"not\", \"type_name\"); kills all user-defined
280         variables, except those of type \"type_name\" and except loaded procedures
281RETURN:  no return value
282NOTE:    killall should never be used inside a procedure
283EXAMPLE: example killall; shows an example AND KILLS ALL YOUR VARIABLES
284"
285{
286   list L=names(); int joni=size(L);
287   if( size(#)==0 )
288   {
289      for ( ; joni>0; joni-- )
290      {
291         if( L[joni]!="LIB" and typeof(`L[joni]`)!="proc" ) { kill `L[joni]`; }
292      }
293   }
294   else
295   {
296     if( size(#)==1 )
297     {
298       if( #[1] == "proc" )
299       {
300          for ( joni=size(L); joni>0; joni-- )
301          {
302             if( L[joni]=="LIB" or typeof(`L[joni]`)=="proc" )
303               { kill `L[joni]`; }
304          }
305       }
306       else
307       {
308          for ( ; joni>2; joni-- )
309          {
310            if(typeof(`L[joni]`)==#[1] and L[joni]!="LIB" and typeof(`L[joni]`)!="proc") { kill `L[joni]`; }
311          }
312        }
313     }
314     else
315     {
316        for ( ; joni>2; joni-- )
317        {
318          if(typeof(`L[joni]`)!=#[2] and L[joni]!="LIB" and typeof(`L[joni]`)!="proc") { kill `L[joni]`; }
319        }
320     }
321  }
322  return();
323}
324example
325{ "EXAMPLE:"; echo = 2;
326   ring rtest; ideal i=x,y,z; number n=37; string str="hi"; int j = 3;
327   export rtest,i,n,str,j;     //this makes the local variables global
328   listvar(all);
329   killall("string"); // kills all string variables
330   listvar(all);
331   killall("not", "int"); // kills all variables except int's (and procs)
332   listvar(all);
333   killall(); // kills all vars except loaded procs
334   listvar(all);
335}
336///////////////////////////////////////////////////////////////////////////////
337
338proc number_e (int n)
339"USAGE:   number_e(n);  n integer
340COMPUTE: Euler number e=exp(1) up to n decimal digits (no rounding)
341         by A.H.J. Sale's algorithm
342RETURN:  - string of exp(1) if no basering of char 0 is defined;
343         - exp(1), of type number, if a basering of char 0 is defined and
344         display its decimal format
345EXAMPLE: example number_e; shows an example
346"
347{
348   int i,m,s,t;
349   intvec u,e;
350   u[n+2]=0; e[n+1]=0; e=e+1;
351   if( defined(basering) )
352   {
353      if( char(basering)==0 ) { number r=2; t=1; }
354   }
355   string result = "2.";
356   for( i=1; i<=n+1; i=i+1 )
357   {
358      e = e*10;
359      for( m=n+1; m>=1; m=m-1 )
360      {
361         s    = e[m]+u[m+1];
362         u[m] = s div (m+1);
363         e[m] = s%(m+1);
364      }
365      result = result+string(u[1]);
366      if( t==1 ) { r = r+number(u[1])/number(10)^i; }
367   }
368   if( t==1 ) { "//",result[1,n+1]; return(r); }
369   return(result[1,n+1]);
370}
371example
372{ "EXAMPLE:"; echo = 2;
373   number_e(15);
374   ring R = 0,t,lp;
375   number e = number_e(10);
376   e;
377}
378///////////////////////////////////////////////////////////////////////////////
379
380proc number_pi (int n)
381"USAGE:   number_pi(n);  n positive integer
382COMPUTE: pi (area of unit circle) up to n decimal digits (no rounding)
383         by algorithm of S. Rabinowitz
384RETURN:  - string of pi if no basering of char 0 is defined,
385         - pi, of type number, if a basering of char 0 is defined and display
386         its decimal format
387EXAMPLE: example number_pi; shows an example
388"
389{
390   int i,m,t,e,q,N;
391   intvec r,p,B,Prelim;
392   string result,prelim;
393   N = (10*n) div 3 + 2;
394   p[N+1]=0; p=p+2; r=p;
395   for( i=1; i<=N+1; i=i+1 ) { B[i]=2*i-1; }
396   if( defined(basering) )
397   {
398      if( char(basering)==0 ) { number pi; number pri; t=1; }
399   }
400   for( i=0; i<=n; i=i+1 )
401   {
402      p = r*10;
403      e = p[N+1];
404      for( m=N+1; m>=2; m=m-1 )
405      {
406         r[m] = e%B[m];
407         q    = e div B[m];
408         e    = q*(m-1)+p[m-1];
409      }
410      r[1] = e%10;
411      q    = e div 10;
412      if( q!=10 and q!=9 )
413      {
414         result = result+prelim;
415         Prelim = q;
416         prelim = string(q);
417      }
418      if( q==9 )
419      {
420         Prelim = Prelim,9;
421         prelim = prelim+"9";
422      }
423      if( q==10 )
424      {
425         Prelim = (Prelim+1)-((Prelim+1) div 10)*10;
426         for( m=size(Prelim); m>0; m=m-1)
427         {
428            prelim[m] = string(Prelim[m]);
429         }
430         result = result+prelim;
431         if( t==1 ) { pi=pi+pri; }
432         Prelim = 0;
433         prelim = "0";
434      }
435      if( t==1 ) { pi=pi+number(q)/number(10)^i; }
436   }
437   result = result,prelim[1];
438   result = "3."+result[2,n-1];
439   if( t==1 ) { "//",result; return(pi); }
440   return(result);
441}
442example
443{ "EXAMPLE:"; echo = 2;
444   number_pi(5);
445   ring r = 0,t,lp;
446   number pi = number_pi(6);
447   pi;
448}
449///////////////////////////////////////////////////////////////////////////////
450
451proc primes (int n, int m)
452"USAGE:   primes(n,m);  n,m integers
453RETURN:  intvec, consisting of all primes p, prime(n)<=p<=m, in increasing
454         order if n<=m, resp. prime(m)<=p<=n, in decreasing order if m<n
455NOTE:    prime(n); returns the biggest prime number <= n (if n>=2, else 2)
456EXAMPLE: example primes; shows an example
457"
458{  int change;
459   if ( n>m ) { change=n; n=m ; m=change; change=1; }
460   int q,p = prime(m),prime(n); intvec v = q; q = q-1;
461   while ( q>=p ) { q = prime(q); v = q,v; q = q-1; }
462   if ( change==1 ) { v = v[size(v)..1]; }
463   return(v);
464}
465example
466{  "EXAMPLE:"; echo = 2;
467   primes(50,100);
468   intvec v = primes(37,1); v;
469}
470///////////////////////////////////////////////////////////////////////////////
471
472proc product (id, list #)
473"USAGE:    product(id[,v]); id=ideal/vector/module/matrix
474          resp.id=intvec/intmat, v=intvec (e.g. v=1..n, n=integer)
475RETURN:   poly resp. int which is the product of all entries of id, with index
476          given by v (default: v=1..number of entries of id)
477NOTE:     id is treated as a list of polys resp. integers. A module m is
478          identified with corresponding matrix M (columns of M generate m)
479EXAMPLE:  example product; shows an example
480"
481{
482   int n,j;
483   if( typeof(id)=="poly" or typeof(id)=="ideal" or typeof(id)=="vector"
484       or typeof(id)=="module" or typeof(id)=="matrix" )
485   {
486      ideal i = ideal(matrix(id));
487      if( size(#)!=0 ) { i = i[#[1]]; }
488      n = ncols(i); poly f=1;
489   }
490   if( typeof(id)=="int" or typeof(id)=="intvec" or typeof(id)=="intmat" )
491   {
492      if ( typeof(id) == "int" ) { intmat S =id; }
493      else { intmat S = intmat(id); }
494      intvec i = S[1..nrows(S),1..ncols(S)];
495      if( size(#)!=0 ) { i = i[#[1]]; }
496      n = size(i); int f=1;
497   }
498   for( j=1; j<=n; j=j+1 ) { f=f*i[j]; }
499   return(f);
500}
501example
502{  "EXAMPLE:"; echo = 2;
503   ring r= 0,(x,y,z),dp;
504   ideal m = maxideal(1);
505   product(m);
506   matrix M[2][3] = 1,x,2,y,3,z;
507   product(M);
508   intvec v=2,4,6;
509   product(M,v);
510   intvec iv = 1,2,3,4,5,6,7,8,9;
511   v=1..5,7,9;
512   product(iv,v);
513   intmat A[2][3] = 1,1,1,2,2,2;
514   product(A,3..5);
515}
516///////////////////////////////////////////////////////////////////////////////
517
518proc ringweights (r)
519"USAGE:   ringweights(r); r ring
520RETURN:  intvec of weights of ring variables. If, say, x(1),...,x(n) are the
521         variables of the ring r, in this order, the resulting intvec is
522         deg(x(1)),...,deg(x(n)) where deg denotes the weighted degree if
523         the monomial ordering of r has only one block of type ws,Ws,wp or Wp.
524NOTE:    In all other cases, in particular if there is more than one block,
525         the resulting intvec is 1,...,1
526EXAMPLE: example ringweights; shows an example
527"
528{
529   int i; intvec v; setring r;
530   for (i=1; i<=nvars(basering); i=i+1) { v[i] = deg(var(i)); }
531   return(v);
532}
533example
534{ "EXAMPLE:"; echo = 2;
535   ring r1=32003,(x,y,z),wp(1,2,3);
536   ring r2=32003,(x,y,z),Ws(1,2,3);
537   ring r=0,(x,y,u,v),lp;
538   intvec vr=ringweights(r1); vr;
539   ringweights(r2);
540   ringweights(r);
541}
542///////////////////////////////////////////////////////////////////////////////
543
544proc sort (id, list #)
545"USAGE:   sort(id[v,o,n]); id=ideal/module/intvec/list (of intvec's or int's)
546         sort may be called with 1, 2 or 3 arguments in the following way:
547         -  sort(id[v,n]); v=intvec of positive integers, n=integer,
548         -  sort(id[o,n]); o=string (any allowed ordstr of a ring), n=integer
549RETURN:  a list of two elements:
550         [1]: object of same type as input but sorted in the following manner:
551           - if id=ideal/module: generators of id are sorted w.r.t. intvec v
552             (id[v[1]] becomes 1-st, id[v[2]]  2-nd element, etc.). If no v is
553             present, id is sorted w.r.t. ordering o (if o is given) or w.r.t.
554             actual monomial ordering (if no o is given):
555                    generators with smaller leading term come first
556             (e.g. sort(id); sorts w.r.t actual monomial ordering)
557           - if id=list of intvec's or int's: consider a list element, say
558             id[1]=3,2,5, as exponent vector of the monomial x^3*y^2*z^5;
559             the corresponding monomials are ordered w.r.t. intvec v (s.a.).
560             If no v is present, the monomials are sorted w.r.t. ordering o
561             (if o is given) or w.r.t. lexicographical ordering (if no o is
562             given). The corresponding ordered list of exponent vectors is
563             returned.
564             (e.g. sort(id); sorts lexicographically, smaller int's come first)
565             WARNING: Since negative exponents create the 0 polynomial in
566             Singular, id should not contain negative integers: the result
567             might not be as expected
568           - if id=intvec: id is treated as list of integers
569           - if n!=0 the ordering is inverse, i.e. w.r.t. v(size(v)..1)
570             default: n=0
571         [2]: intvec, describing the permutation of the input (hence [2]=v if
572             v is given (with positive integers)
573NOTE:    If v is given id may be any simply indexed object (e.g. any list or
574         string); if v[i]<0 and i<=size(id) v[i] is set internally to i;
575         entries of v must be pairwise distinct to get a permutation if id.
576         Zero generators of ideal/module are deleted
577EXAMPLE: example sort; shows an example
578"
579{
580   int ii,jj,s,n = 0,0,1,0;
581   intvec v;
582   if ( defined(basering) ) { def P = basering; }
583   if ( size(#)==0 and (typeof(id)=="ideal" or typeof(id)=="module") )
584   {
585      id = simplify(id,2);
586      for ( ii=1; ii<size(id); ii++ )
587      {
588         if ( id[ii]!=id[ii+1] ) { break;}
589      }
590      if ( ii != size(id) ) { v = sortvec(id); }
591      else  { v = size(id)..1; }
592   }
593   if ( size(#)>=1 and (typeof(id)=="ideal" or typeof(id)=="module") )
594   {
595      if ( typeof(#[1])=="string" )
596      {
597         execute "ring r1 =("+charstr(P)+"),("+varstr(P)+"),("+#[1]+");";
598         def i = imap(P,id);
599         v = sortvec(i);
600         setring P;
601         n=2;
602      }
603   }
604   if ( typeof(id)=="intvec" or typeof(id)=="list" and n==0 )
605   {
606      string o;
607      if ( size(#)==0 ) { o = "lp"; n=1; }
608      if ( size(#)>=1 )
609      {
610         if ( typeof(#[1])=="string" ) { o = #[1]; n=1; }
611      }
612   }
613   if ( typeof(id)=="intvec" or typeof(id)=="list" and n==1 )
614   {
615      if ( typeof(id)=="list" )
616      {
617         for (ii=1; ii<=size(id); ii++)
618         {
619            if (typeof(id[ii]) != "intvec" and typeof(id[ii]) != "int")
620               { "// list elements must be intvec/int"; return(); }
621            else
622               { s=size(id[ii])*(s < size(id[ii])) + s*(s >= size(id[ii])); }
623         }
624      }
625      execute "ring r=0,x(1..s),("+o+");";
626      ideal i;
627      poly f;
628      for (ii=1; ii<=size(id); ii++)
629      {
630         f=1;
631         for (jj=1; jj<=size(id[ii]); jj++)
632         {
633            f=f*x(jj)^(id[ii])[jj];
634         }
635         i[ii]=f;
636      }
637      v = sort(i)[2];
638   }
639   if ( size(#)!=0 and n==0 ) { v = #[1]; }
640   if( size(#)==2 )
641   {
642      if ( #[2] != 0 ) { v = v[size(v)..1]; }
643   }
644   s = size(v);
645   if( size(id) < s ) { s = size(id); }
646   def m = id;
647   if ( size(m) != 0 )
648   {
649      for ( jj=1; jj<=s; jj=jj+1)
650      {
651         if ( v[jj]<=0 ) { v[jj]=jj; }
652         m[jj] = id[v[jj]];
653      }
654   }
655   if ( v == 0 ) { v = 1; }
656   list L=m,v;
657   return(L);
658}
659example
660{  "EXAMPLE:"; echo = 2;
661   ring r0 = 0,(x,y,z),lp;
662   ideal i = x3,y3,z3,x2z,x2y,y2z,y2x,z2y,z2x,xyz;
663   show(sort(i));"";
664   show(sort(i,"wp(1,2,3)"));"";
665   intvec v=10..1;
666   show(sort(i,v));"";
667   show(sort(i,v,1));"";   // should be the identity
668   ring r1  = 0,t,ls;
669   ideal j = t14,t6,t28,t20,t12,t34,t26,t18,t40,t32,t24,t38,t30,t36;
670   show(sort(j)[1]);"";
671   show(sort(j,"lp")[1]);"";
672   list L =1,5..8,10,2,8..5,8,3..10;
673   sort(L)[1];"";          // sort L lexicographically
674   sort(L,"Dp",1)[1];      // sort L w.r.t (total sum, reverse lex)
675}
676///////////////////////////////////////////////////////////////////////////////
677
678proc sum (id, list #)
679"USAGE:    sum(id[,v]); id=ideal/vector/module/matrix resp. id=intvec/intmat,
680                       v=intvec (e.g. v=1..n, n=integer)
681RETURN:   poly resp. int which is the sum of all entries of id, with index
682          given by v (default: v=1..number of entries of id)
683NOTE:     id is treated as a list of polys resp. integers. A module m is
684          identified with corresponding matrix M (columns of M generate m)
685EXAMPLE:  example sum; shows an example
686"
687{
688   if( typeof(id)=="poly" or typeof(id)=="ideal" or typeof(id)=="vector"
689       or typeof(id)=="module" or typeof(id)=="matrix" )
690   {
691      ideal i = ideal(matrix(id));
692      if( size(#)!=0 ) { i = i[#[1]]; }
693      matrix Z = matrix(i);
694   }
695   if( typeof(id)=="int" or typeof(id)=="intvec" or typeof(id)=="intmat" )
696   {
697      if ( typeof(id) == "int" ) { intmat S =id; }
698      else { intmat S = intmat(id); }
699      intvec i = S[1..nrows(S),1..ncols(S)];
700      if( size(#)!=0 ) { i = i[#[1]]; }
701      intmat Z=transpose(i);
702   }
703   intvec v; v[ncols(Z)]=0; v=v+1;
704   return((Z*v)[1,1]);
705}
706example
707{  "EXAMPLE:"; echo = 2;
708   ring r= 0,(x,y,z),dp;
709   vector pv = [xy,xz,yz,x2,y2,z2];
710   sum(pv);
711   //sum(pv,2..5);
712   //matrix M[2][3] = 1,x,2,y,3,z;
713   //sum(M);
714   //intvec w=2,4,6;
715   //sum(M,w);
716   //intvec iv = 1,2,3,4,5,6,7,8,9;
717   //w=1..5,7,9;
718   //sum(iv,w);
719   //intmat m[2][3] = 1,1,1,2,2,2;
720   //sum(m,3..4);
721}
722///////////////////////////////////////////////////////////////////////////////
723
724proc which (command)
725"USAGE:    which(command); command = string expression
726RETURN:   Absolute pathname of command, if found in search path.
727          Empty string, otherwise.
728NOTE:     Based on the Unix command 'which'.
729EXAMPLE:  example which; shows an example
730"
731{
732   int rs;
733   int i;
734   string fn = "/tmp/which_" + string(system("pid"));
735   string pn;
736   if( typeof(command) != "string")
737   {
738     return (pn);
739   }
740   i = system("sh", "which " + command + " > " + fn);
741   pn = read(fn);
742   pn[size(pn)] = "";
743   i = 1;
744   while ((pn[i] != " ") and (pn[i] != ""))
745   {
746     i = i+1;
747   }
748   if (pn[i] == " ") {pn[i] = "";}
749   rs = system("sh", "ls " + pn + " > " + fn + " 2>&1 ");
750   i = system("sh", "rm " + fn);
751   if (rs == 0) {return (pn);}
752   else
753   {
754     print (command + " not found ");
755     return ("");
756   }
757}
758example
759{  "EXAMPLE:"; echo = 2;
760    which("Singular");
761}
762///////////////////////////////////////////////////////////////////////////////
Note: See TracBrowser for help on using the repository browser.