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