1 | //===========================================================================// |
---|
2 | // LIBRARY: lib0 library of some general procedures // |
---|
3 | // type lib0(); to list the procedures // |
---|
4 | // 7/94 GMG+BM // |
---|
5 | //===========================================================================// |
---|
6 | |
---|
7 | proc A_Z (string s,int n) |
---|
8 | USAGE: A_Z("a",n); a any letter, n integer (-26<= n <=26, !=0) |
---|
9 | RETURN: string of n small (if a is small) or capital (if a is capital) |
---|
10 | letters, comma seperated, beginning with a, in alphabetical |
---|
11 | order (or revers alphabetical order if n<0) |
---|
12 | EXAMPLE: example A_Z; shows an example |
---|
13 | { |
---|
14 | if (n>=-26 and n<=26 and n!=0 ) |
---|
15 | { |
---|
16 | string @alpha = |
---|
17 | "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,"+ |
---|
18 | "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,"+ |
---|
19 | "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,"+ |
---|
20 | "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"; |
---|
21 | int @ii; int @aa; |
---|
22 | for (@ii=1; @ii<=51; @ii=@ii+2) |
---|
23 | { |
---|
24 | if ( @alpha[@ii] == s ) |
---|
25 | { |
---|
26 | @aa = @ii; |
---|
27 | } |
---|
28 | } |
---|
29 | if ( @aa == 0) |
---|
30 | { |
---|
31 | for (@ii=105; @ii<=155; @ii=@ii+2) |
---|
32 | { |
---|
33 | if ( @alpha[@ii] == s ) |
---|
34 | { |
---|
35 | @aa = @ii; |
---|
36 | } |
---|
37 | } |
---|
38 | } |
---|
39 | } |
---|
40 | if ( @aa != 0) |
---|
41 | { |
---|
42 | string @out; |
---|
43 | if (n > 0) |
---|
44 | { |
---|
45 | @out = @alpha[@aa,2*(n)-1]; |
---|
46 | return (@out); |
---|
47 | } |
---|
48 | string @beta = |
---|
49 | "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,"+ |
---|
50 | "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,"+ |
---|
51 | "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,"+ |
---|
52 | "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"; |
---|
53 | if ( @aa < 52 ) |
---|
54 | { |
---|
55 | @aa=52-@aa; |
---|
56 | } |
---|
57 | if ( @aa > 104 ) |
---|
58 | { |
---|
59 | @aa=260-@aa; |
---|
60 | } |
---|
61 | @out = @beta[@aa,2*(-n)-1]; |
---|
62 | return (@out); |
---|
63 | } |
---|
64 | } |
---|
65 | example |
---|
66 | { |
---|
67 | //--------------------------------- EXAMPLE ---------------------------------- |
---|
68 | "EXAMPLE:"; |
---|
69 | " A_Z(\"c\",5);"; A_Z("c",5); |
---|
70 | " A_Z(\"Z\",-5);"; A_Z("Z",-5); |
---|
71 | " string sR = \"ring R = (0,\"+A_Z(\"A\",6)+\"),(\"+A_Z(\"a\",10)+\"),dp;\" "; |
---|
72 | string @sR = "ring R = (0,"+A_Z("A",6)+"),("+A_Z("a",10)+"),dp;"; |
---|
73 | " sR;"; @sR; |
---|
74 | " execute sR;"; execute @sR; |
---|
75 | " R;"; R; |
---|
76 | " kill R;"; kill R; |
---|
77 | } |
---|
78 | /////////////////////////////////////////////////////////////////////////////// |
---|
79 | proc bin (int n,int m) |
---|
80 | USAGE: bin(n,m); n, m integers |
---|
81 | RETURN: n choose m of type <int>, limited size (machine integers)! |
---|
82 | NOTE: Use proc binom and ring of characteristic 0 for bigger integers |
---|
83 | { |
---|
84 | int @r; |
---|
85 | if ( m < 0 or m > n ) |
---|
86 | { |
---|
87 | return(@r); |
---|
88 | } |
---|
89 | @r=1; |
---|
90 | if (m == 0) |
---|
91 | { |
---|
92 | return(@r); |
---|
93 | } |
---|
94 | if (m >= n-m) |
---|
95 | { |
---|
96 | m=n-m; |
---|
97 | } |
---|
98 | for (int @l=1 ; @l<=m ; @l=@l+1 ) |
---|
99 | { |
---|
100 | @r=@r*(n+1-@l) / @l; |
---|
101 | } |
---|
102 | return (@r); |
---|
103 | } |
---|
104 | example |
---|
105 | { |
---|
106 | "EXAMPLE:"; |
---|
107 | " bin(7,3);"; bin(7,3); |
---|
108 | " int n=10; int m=7;"; int @n=10; int @m=7; |
---|
109 | " int b=bin(n,m); b;"; int @b=bin(@n,@m); @b; |
---|
110 | kill @n,@m,@b; |
---|
111 | } |
---|
112 | /////////////////////////////////////////////////////////////////////////////// |
---|
113 | |
---|
114 | proc binom |
---|
115 | { |
---|
116 | if (#ARGS !=1 and #ARGS !=2) |
---|
117 | { |
---|
118 | //============================================================================= |
---|
119 | " USAGE: binom(n,k); n, k integers"; |
---|
120 | " RETURN: n choose k of type <poly>, uses characteristic of basering"; |
---|
121 | " NOTE: needs a basering(!), result is computed in corresponding char,"; |
---|
122 | " for small integers you may use procedure bin;"; |
---|
123 | " EXAMPLE: binom(\"ex\"); shows an example"; |
---|
124 | //============================================================================= |
---|
125 | return(); |
---|
126 | } |
---|
127 | |
---|
128 | parameter = "n", "k"; |
---|
129 | if( #ARGS ==2 and defined(basering) ) |
---|
130 | { |
---|
131 | if ( typeof(#1) == "int" and typeof(#2) == "int" ) |
---|
132 | { |
---|
133 | poly @r; |
---|
134 | if (#k < 0) |
---|
135 | { |
---|
136 | return(@r); |
---|
137 | } |
---|
138 | if (#k > #n) |
---|
139 | { |
---|
140 | return(@r); |
---|
141 | } |
---|
142 | @r=1; |
---|
143 | if (#k == 0) |
---|
144 | { |
---|
145 | return(@r); |
---|
146 | } |
---|
147 | if (#k >= #n-#k) |
---|
148 | { |
---|
149 | #k = #n-#k; |
---|
150 | } |
---|
151 | int @l; |
---|
152 | string @st; |
---|
153 | for (@l=1 ; @l<=#k ; @l=@l+1 ) |
---|
154 | { |
---|
155 | @r=@r*(#n+1-@l); |
---|
156 | @st="@r=@r*(1/"+string(@l)+");"; |
---|
157 | execute(@st); |
---|
158 | } |
---|
159 | return (@r); |
---|
160 | } |
---|
161 | } |
---|
162 | //--------------------------------- EXAMPLE ----------------------------------- |
---|
163 | if (( typeof(#1) == "string" ) and ( #1 == "ex" )) |
---|
164 | { |
---|
165 | "EXAMPLE:"; |
---|
166 | " ring r1=0,x,ls;"; ring @r1=0,x,ls; |
---|
167 | " binom(37,17);"; binom(37,17); |
---|
168 | " ring r2=31,x,dp;"; ring @r2=31,x,dp; |
---|
169 | " poly p = binom(37,17);p;"; poly @p = binom(37,17);@p; |
---|
170 | return(); |
---|
171 | } |
---|
172 | " USAGE: binom(n,k); n, k integers"; |
---|
173 | " RETURN: n choose k of type <poly>, uses characteristic of basering"; |
---|
174 | " NOTE: needs a basering(!), result is computed in corresponding char,"; |
---|
175 | " for small integers you may use procedure bin;"; |
---|
176 | " EXAMPLE: binom(\"ex\"); shows an example"; |
---|
177 | } |
---|
178 | /////////////////////////////////////////////////////////////////////////////// |
---|
179 | |
---|
180 | proc fac |
---|
181 | { |
---|
182 | if ( #ARGS !=1 ) |
---|
183 | { |
---|
184 | //============================================================================= |
---|
185 | " USAGE: fac(n); (n integer)"; |
---|
186 | " RETURN: n!, of type <poly>, uses characteristic of basering"; |
---|
187 | " NOTE: needs a basering(!), result is computed in corresponding char,"; |
---|
188 | " EXAMPLE: fac(\"ex\"); shows an example"; |
---|
189 | //============================================================================= |
---|
190 | return(); |
---|
191 | } |
---|
192 | |
---|
193 | parameter = "n"; |
---|
194 | if( typeof(#1) == "int" and defined(basering) ) |
---|
195 | { |
---|
196 | poly @p=1; |
---|
197 | int @i; |
---|
198 | for ( @i=1; @i<=#n; @i=@i+1) |
---|
199 | { |
---|
200 | @p=@p*@i; |
---|
201 | } |
---|
202 | return(@p); |
---|
203 | } |
---|
204 | //--------------------------------- EXAMPLE ----------------------------------- |
---|
205 | if (( typeof(#1) == "string" ) and ( #1 == "ex" )) |
---|
206 | { |
---|
207 | "EXAMPLE:"; |
---|
208 | " ring r1=0,x,ls;"; ring @r1=0,x,ls; |
---|
209 | " fac(37);"; fac(37); |
---|
210 | " ring r2=17,x,dp;"; ring @r2=17,x,dp; |
---|
211 | " poly p = fac(37);p;"; poly @p = fac(37);@p; |
---|
212 | return(); |
---|
213 | } |
---|
214 | " USAGE: fac(n); (n integer)"; |
---|
215 | " RETURN: n!, of type <poly>, uses characteristic of basering"; |
---|
216 | " NOTE: needs a basering(!), result is computed in corresponding char,"; |
---|
217 | " EXAMPLE: fac(\"ex\"); shows an example"; |
---|
218 | } |
---|
219 | /////////////////////////////////////////////////////////////////////////////// |
---|
220 | |
---|
221 | proc koszul1 |
---|
222 | { |
---|
223 | if (#ARGS != 1 and #ARGS != 2) |
---|
224 | { |
---|
225 | //============================================================================= |
---|
226 | " USAGE: koszul1(<ideal>,n); n integer"; |
---|
227 | " RETURN: <matrix>:= n-th koszul1 matrix of <ideal>"; |
---|
228 | " EXAMPLE: koszul1(\"ex\"); shows an example"; |
---|
229 | //============================================================================= |
---|
230 | return(); |
---|
231 | } |
---|
232 | |
---|
233 | if (#ARGS == 2) |
---|
234 | { |
---|
235 | if (typeof(#1) == "ideal" and typeof(#2) == "int") |
---|
236 | { |
---|
237 | //-------------------------- compare_index(iv,iv) ----------------------------- |
---|
238 | proc compare_ind |
---|
239 | { |
---|
240 | parameter="v1","v2"; |
---|
241 | int @q=size(#v1); |
---|
242 | intvec @res; |
---|
243 | int @a;int @b;int @c=1;int @d; |
---|
244 | for (@a=1; @a<=@q; @a=@a+1) |
---|
245 | { |
---|
246 | @b=@b+1; |
---|
247 | if (#v1[@a] != #v2[@b]) |
---|
248 | { |
---|
249 | @d=@d+1; |
---|
250 | if (@d>1) |
---|
251 | { |
---|
252 | @res=0,1; |
---|
253 | return(@res); |
---|
254 | } |
---|
255 | @res=#v2[@b],@c; |
---|
256 | @a=@a-1; |
---|
257 | } |
---|
258 | @c=-@c; |
---|
259 | if (@d == 0) |
---|
260 | { |
---|
261 | @res=#v2[@q+1],@c; |
---|
262 | } |
---|
263 | } |
---|
264 | return(@res); |
---|
265 | } |
---|
266 | //--------------------------- next_ind(#iv,#n,#p) ----------------------------- |
---|
267 | proc next_ind |
---|
268 | { |
---|
269 | parameter="v","n","p"; |
---|
270 | int @l;int @q;int @s;intvec @res=#v; |
---|
271 | for ( @l=#p; @l>0; @l=@l-1 ) |
---|
272 | { |
---|
273 | @s=#v[@l]-#n+#p-@l; |
---|
274 | if (@s<0) |
---|
275 | { |
---|
276 | @s=#v[@l]; |
---|
277 | for (@q=@l; @q<=#p; @q=@q+1 ) |
---|
278 | { |
---|
279 | @res[@q]=@s+@q-@l+1; |
---|
280 | } |
---|
281 | return(@res); |
---|
282 | } |
---|
283 | } |
---|
284 | return(0); |
---|
285 | } |
---|
286 | //------------------------------ alt_ind(#n,#p) ------------------------------- |
---|
287 | proc alt_ind |
---|
288 | { |
---|
289 | parameter="n","p"; |
---|
290 | int @m=bin(#n,#p);int @a; |
---|
291 | intvec ind(1)=1..#p; |
---|
292 | for ( @a=2; @a<=@m; @a=@a+1 ) |
---|
293 | { |
---|
294 | intvec ind(@a)=next_ind(ind(@a-1),#n,#p); |
---|
295 | } |
---|
296 | return(); |
---|
297 | } |
---|
298 | //------------------------------- end_ind(#m) --------------------------------- |
---|
299 | proc end_ind |
---|
300 | { |
---|
301 | parameter="m"; |
---|
302 | int @n; |
---|
303 | for (@n=1; @n<=#m; @n=@n+1) |
---|
304 | { |
---|
305 | kill ind(@n); |
---|
306 | } |
---|
307 | return(); |
---|
308 | } |
---|
309 | //------------------------------ koszul1(id,nr) -------------------------------- |
---|
310 | int @t; |
---|
311 | int @w; |
---|
312 | int @e; |
---|
313 | int @n=ncols(#1); |
---|
314 | int @p=#2; |
---|
315 | ideal @id=#1; |
---|
316 | intvec @zz; |
---|
317 | if ((@p>@n) or (@p<=0)) |
---|
318 | { |
---|
319 | kill compare_ind; kill next_ind; kill alt_ind; kill end_ind; |
---|
320 | return("#2 out of range"); |
---|
321 | } |
---|
322 | int @c=bin(@n,@p); |
---|
323 | int @r=bin(@n,@p-1); |
---|
324 | matrix @res[@r][@c]; |
---|
325 | alt_ind(@n,@p); |
---|
326 | intvec @riv=1..@p-1; |
---|
327 | for (@t=1; @t<=@n-@p+1; @t=@t+1) |
---|
328 | { |
---|
329 | @res[1,@t]=@id[@t+@p-1]; |
---|
330 | if (@p-2*(@p/2)==0) |
---|
331 | { |
---|
332 | @res[1,@t]=-@res[1,@t]; |
---|
333 | } |
---|
334 | } |
---|
335 | for (@e=2; @e<=@r; @e=@e+1) |
---|
336 | { |
---|
337 | @riv=next_ind(@riv,@n,@p-1); |
---|
338 | for (@w=1; @w<=@c; @w=@w+1) |
---|
339 | { |
---|
340 | @zz=compare_ind(@riv,ind(@w)); |
---|
341 | if (@zz[1] != 0) |
---|
342 | { |
---|
343 | @res[@e,@w]=@id[@zz[1]]*@zz[2]; |
---|
344 | } |
---|
345 | } |
---|
346 | } |
---|
347 | end_ind(@c); |
---|
348 | kill compare_ind; kill next_ind; kill alt_ind; kill end_ind; |
---|
349 | return(@res); |
---|
350 | } |
---|
351 | } |
---|
352 | //--------------------------------- EXAMPLE ----------------------------------- |
---|
353 | if (( typeof(#1)=="string") and (#1 == "ex")) |
---|
354 | { |
---|
355 | "EXAMPLE:"; |
---|
356 | " ring r=200,(a,b,c,d),ds;"; ring @r=200,(a,b,c,d),ds; |
---|
357 | " ideal i=a,b,c,d;"; ideal @i=a,b,c,d; |
---|
358 | " pmat(koszul1(i,2));"; pmat(koszul1(@i,2)); |
---|
359 | return(); |
---|
360 | } |
---|
361 | " USAGE: koszul1(<id>,<int>);"; |
---|
362 | " RETURN: <mat>:= i-th koszul1 matrix of <id>"; |
---|
363 | " EXAMPLE: koszul1(\"ex\"); shows an example"; |
---|
364 | } |
---|
365 | /////////////////////////////////////////////////////////////////////////////// |
---|
366 | |
---|
367 | proc mem |
---|
368 | { |
---|
369 | if ( #ARGS !=1 ) |
---|
370 | { |
---|
371 | //============================================================================= |
---|
372 | " USAGE: mem(n); n integer "; |
---|
373 | " RETURNS: mem(0) = memory used by active variables"; |
---|
374 | " mem(1) = total memory used"; |
---|
375 | //============================================================================= |
---|
376 | return(); |
---|
377 | } |
---|
378 | |
---|
379 | parameter = "n"; |
---|
380 | if (typeof(#n) == "int") |
---|
381 | { |
---|
382 | if (#n == 0) |
---|
383 | { |
---|
384 | string @m = |
---|
385 | "//memory used by active variables: ",string((memory(0)+1023)/1024),"k"; |
---|
386 | return(@m); |
---|
387 | } |
---|
388 | if (#n != 0) |
---|
389 | { |
---|
390 | string @m = |
---|
391 | "//total memory used: ",string((memory(1)+1023)/1024),"k"; |
---|
392 | return(@m); |
---|
393 | } |
---|
394 | } |
---|
395 | //--------------------------------- EXAMPLE ----------------------------------- |
---|
396 | if ( typeof(#1) == "string" ) |
---|
397 | { if ( #1 == "ex" ) |
---|
398 | { |
---|
399 | "EXAMPLE:"; |
---|
400 | " mem(0);"; mem(0); |
---|
401 | " string s=mem(1); s;"; string @s=mem(1); @s; |
---|
402 | return(); |
---|
403 | } |
---|
404 | } |
---|
405 | " USAGE: mem(n); n integer "; |
---|
406 | " RETURNS: mem(0) = memory used by active variables"; |
---|
407 | " mem(1) = total memory used"; |
---|
408 | return(); |
---|
409 | } |
---|
410 | /////////////////////////////////////////////////////////////////////////////// |
---|
411 | |
---|
412 | proc multiply |
---|
413 | { |
---|
414 | if (#ARGS !=1 and #ARGS !=2) |
---|
415 | { |
---|
416 | //============================================================================= |
---|
417 | " USAGE1: multiply(<ideal/poly>,<module>);"; |
---|
418 | " RETURN: module <ideal/poly>*<module>"; |
---|
419 | " USAGE2: multiply(<ideal>,<matrix>);"; |
---|
420 | " RETURN: ideal <ideal>*<matrix> (consider <ideal> as row vector)"; |
---|
421 | " USAGE3: multiply(<poly>,<matrix>);"; |
---|
422 | " RETURN: matrix <poly>*<matrix> (mult. each entry of <matrix> with <poly>)"; |
---|
423 | " USAGE4: multiply(<matrix>,<vector>);"; |
---|
424 | " RETURN: vector <matrix>*<vector> (consider <vector> as column vector)"; |
---|
425 | " EXAMPLE: multiply(\"ex\"); shows an example"; |
---|
426 | //============================================================================= |
---|
427 | return(); |
---|
428 | } |
---|
429 | |
---|
430 | parameter = "i", "m"; |
---|
431 | if ( #ARGS == 2 ) |
---|
432 | { |
---|
433 | int @ii; int @jj; |
---|
434 | //-------------------------- <ideal/poly>*<module> ---------------------------- |
---|
435 | if ((typeof(#i)=="ideal" or typeof(#i)=="poly") and typeof(#m)=="module") |
---|
436 | { |
---|
437 | ideal @i = #i; |
---|
438 | module @m; module @mo; |
---|
439 | for ( @ii=1; @ii<=size(@i); @ii=@ii+1 ) |
---|
440 | { |
---|
441 | for ( @jj=1; @jj<=size(#m); @jj=@jj+1 ) |
---|
442 | { |
---|
443 | @m = @m,@i[@ii]*#m[@jj]; |
---|
444 | } |
---|
445 | } |
---|
446 | return(@m+@mo); |
---|
447 | } |
---|
448 | //----------------------------- <ideal>*<matrix> ------------------------------ |
---|
449 | if ( typeof(#i) == "ideal" and typeof(#m) == "matrix" ) |
---|
450 | { |
---|
451 | if ( nrows(#m) != ncols(#i) ) |
---|
452 | { |
---|
453 | "//size not compatible: ncols(<ideal>) != nrows(<matrix>)"; |
---|
454 | return(); |
---|
455 | } |
---|
456 | return(ideal(matrix(#i)*#m)); |
---|
457 | } |
---|
458 | //----------------------------- <poly>*<matrix> ------------------------------- |
---|
459 | if ( typeof(#i) == "poly" and typeof(#m) == "matrix") |
---|
460 | { |
---|
461 | matrix @m[nrows(#m)][ncols(#m)]; |
---|
462 | for ( @ii=1; @ii<=nrows(#m); @ii=@ii+1 ) |
---|
463 | { |
---|
464 | for ( @jj=1; @jj<=ncols(#m); @jj=@jj+1 ) |
---|
465 | { |
---|
466 | @m[@ii,@jj] = #1*#m[@ii,@jj]; |
---|
467 | } |
---|
468 | } |
---|
469 | return(@m); |
---|
470 | } |
---|
471 | //----------------------------- <matrix>*<vector> ----------------------------- |
---|
472 | if ( typeof(#i) == "matrix" and typeof(#m) == "vector" ) |
---|
473 | { |
---|
474 | module @m=#m; |
---|
475 | matrix @a=matrix(@m); |
---|
476 | if ( nrows(@a) != ncols(#i) ) |
---|
477 | { |
---|
478 | "//size not compatible: ncols(<matrix>) != nrows(<vector>)"; |
---|
479 | return(); |
---|
480 | } |
---|
481 | module @i = module(#i*@a); |
---|
482 | vector @v = @i[1]; |
---|
483 | return(@v); |
---|
484 | } |
---|
485 | } |
---|
486 | //--------------------------------- EXAMPLE ----------------------------------- |
---|
487 | if (( typeof(#1) == "string" ) and ( #1 == "ex" )) |
---|
488 | { |
---|
489 | "EXAMPLE:"; |
---|
490 | " ring r=0,(x,y,z),(c,dp);"; ring @r=0,(x,y,z),(c,dp); |
---|
491 | " ideal i = xy,xz,yz;"; ideal @i = xy,xz,yz; |
---|
492 | " poly f = xyz;"; poly @f = xyz; |
---|
493 | " module m = [1,2,3],[x,y,z];"; module @m = [1,2,3],[x,y,z]; |
---|
494 | " vector v = [xy,xz,yz];"; vector @v = [xy,xz,yz]; |
---|
495 | " matrix M[2][3] = 1,2,3,x,y,z;"; matrix @M[2][3] =1,2,3,x,y,z; |
---|
496 | " pmat(M);"; pmat(@M); |
---|
497 | " multiply(i,m);"; multiply(@i,@m); |
---|
498 | " multiply(f,m);"; multiply(@f,@m); |
---|
499 | " multiply(i,transpose(M));"; multiply(@i,transpose(@M)); |
---|
500 | " pmat(multiply(f,M));"; pmat(multiply(@f,@M)); |
---|
501 | " multiply(M,v);"; multiply(@M,@v); |
---|
502 | return(); |
---|
503 | } |
---|
504 | " USAGE1: multiply(<ideal/poly>,<module>);"; |
---|
505 | " RETURN: module <ideal/poly>*<module>"; |
---|
506 | " USAGE2: multiply(<ideal>,<matrix>);"; |
---|
507 | " RETURN: ideal <ideal>*<matrix> (consider <ideal> as row vector)"; |
---|
508 | " USAGE3: multiply(<poly>,<matrix>);"; |
---|
509 | " RETURN: matrix <poly>*<matrix> (mult. each entry of <matrix> with <poly>)"; |
---|
510 | " USAGE4: multiply(<matrix>,<vector>);"; |
---|
511 | " RETURN: vector <matrix>*<vector> (consider <vector> as column vector)"; |
---|
512 | " EXAMPLE: multiply(\"ex\"); shows an example"; |
---|
513 | } |
---|
514 | /////////////////////////////////////////////////////////////////////////////// |
---|
515 | |
---|
516 | proc pmat (matrix m,list #) |
---|
517 | USAGE: pmat(<matrix>,[n]); n integer |
---|
518 | RETURNS: <matrix> in array format if it fits into pagewidth. If n is |
---|
519 | given, only the first n characters of each colum are shown |
---|
520 | { |
---|
521 | if ( size(#) == 0) |
---|
522 | { |
---|
523 | //------------- main case: input is a matrix, no second argument--------------- |
---|
524 | int @elems; |
---|
525 | int @mlen; |
---|
526 | int @slen; |
---|
527 | int @c; |
---|
528 | int @r; |
---|
529 | //-------------- count maximal size of each column, and sum up ---------------- |
---|
530 | |
---|
531 | for ( @c=1; @c<=ncols(m); @c=@c+1) |
---|
532 | { int @len(@c); |
---|
533 | for (@r=1; @r<=nrows(m); @r=@r+1) |
---|
534 | { |
---|
535 | @elems = @elems + 1; |
---|
536 | string @s(@elems) = string(m[@r,@c])+","; |
---|
537 | @slen = size(@s(@elems)); |
---|
538 | if (@slen > @len(@c)) |
---|
539 | { |
---|
540 | @len(@c) = @slen; |
---|
541 | } |
---|
542 | } |
---|
543 | @mlen = @mlen + @len(@c); |
---|
544 | } |
---|
545 | //---------------------- print all - except last - rows ----------------------- |
---|
546 | |
---|
547 | string @aus; |
---|
548 | string @sep = " "; |
---|
549 | if (@mlen >= pagewidth) |
---|
550 | { |
---|
551 | @sep = newline; |
---|
552 | } |
---|
553 | |
---|
554 | for (@r=1; @r<nrows(m); @r=@r+1) |
---|
555 | { |
---|
556 | @elems = @r; |
---|
557 | @aus = ""; |
---|
558 | for (@c=1; @c<=ncols(m); @c=@c+1) |
---|
559 | { |
---|
560 | @aus = @aus + @s(@elems)[1,@len(@c)] + @sep; |
---|
561 | @elems = @elems + nrows(m); |
---|
562 | } |
---|
563 | @aus; |
---|
564 | } |
---|
565 | //--------------- print last row (no comma after last entry) ------------------ |
---|
566 | |
---|
567 | @aus = ""; |
---|
568 | @elems = nrows(m); |
---|
569 | for (@c=1; @c<ncols(m); @c=@c+1) |
---|
570 | { |
---|
571 | @aus = @aus + @s(@elems)[1,@len(@c)] + @sep; |
---|
572 | @elems = @elems + nrows(m); |
---|
573 | } |
---|
574 | @aus = @aus + string(m[nrows(m),ncols(m)]); |
---|
575 | @aus; |
---|
576 | return(); |
---|
577 | } |
---|
578 | //--------- second case: input is a matrix, second argument is given ---------- |
---|
579 | |
---|
580 | if ( size(#) == 1 ) |
---|
581 | { |
---|
582 | if ( typeof(#[1]) == "int" ) |
---|
583 | { |
---|
584 | string @aus; |
---|
585 | string @tmp; |
---|
586 | int @ll; |
---|
587 | int @c; |
---|
588 | int @r; |
---|
589 | for ( @r=1; @r<=nrows(m); @r=@r+1) |
---|
590 | { |
---|
591 | @aus = ""; |
---|
592 | for (@c=1; @c<=ncols(m); @c=@c+1) |
---|
593 | { |
---|
594 | @tmp = string(m[@r,@c]); |
---|
595 | @aus = @aus + @tmp[1,#[1]] + " "; |
---|
596 | } |
---|
597 | @aus; |
---|
598 | } |
---|
599 | } |
---|
600 | } |
---|
601 | } |
---|
602 | example |
---|
603 | { |
---|
604 | //--------------------------------- EXAMPLE ---------------------------------- |
---|
605 | " EXAMPLE:"; |
---|
606 | " ring r=0,(x,y,z),ls;"; ring @r=0,(x,y,z),ls; |
---|
607 | " ideal i= x,z+3y,x+y,z;"; ideal @i= x,z+3y,x+y,z; |
---|
608 | " matrix m[3][3] =i^2;"; matrix @m[3][3]=@i^2; |
---|
609 | " pmat(m);"; pmat(@m); |
---|
610 | " pmat(m,3);"; pmat(@m,3); |
---|
611 | kill @r; |
---|
612 | } |
---|
613 | /////////////////////////////////////////////////////////////////////////////// |
---|
614 | |
---|
615 | proc randommat |
---|
616 | { |
---|
617 | if (#ARGS != 1 and #ARGS != 3 and #ARGS != 5) |
---|
618 | { |
---|
619 | //============================================================================= |
---|
620 | " USAGE: randommat(n,m,d[,u,o]); n,m,d,u,o integers"; |
---|
621 | " RETURNS: nxm matrix with entries homogeneous polynomials of degree d"; |
---|
622 | " [and coefficients between u and o]"; |
---|
623 | " NOTE: For performance reasons try small bounds u and o in char 0"; |
---|
624 | " EXAMPLE: randommat(\"ex\"); shows an example"; |
---|
625 | //============================================================================= |
---|
626 | return(); |
---|
627 | } |
---|
628 | |
---|
629 | parameter="n","m","d","u","o"; |
---|
630 | if (#ARGS == 3) |
---|
631 | { |
---|
632 | int #u=-30000; |
---|
633 | int #o= 30000; |
---|
634 | #ARGS=5; |
---|
635 | } |
---|
636 | if (#ARGS == 5) |
---|
637 | { |
---|
638 | if ( typeof(#n)=="int" and typeof(#m)=="int" and |
---|
639 | typeof(#d)=="int" and typeof(#u)=="int" and typeof(#o)=="int" ) |
---|
640 | { |
---|
641 | int @g =size(maxideal(#d)); |
---|
642 | matrix @m = matrix(maxideal(#d)); |
---|
643 | matrix @col[@g][1]; |
---|
644 | matrix @random[#n][#m]; |
---|
645 | int @k; int @l; int @ii; |
---|
646 | for ( @k=#n; @k>0; @k=@k-1) |
---|
647 | { |
---|
648 | for ( @l=#m; @l>0; @l=@l-1) |
---|
649 | { |
---|
650 | for ( @ii=1; @ii<=@g; @ii=@ii+1) |
---|
651 | { |
---|
652 | @col[@ii,1] = random(#u,#o); |
---|
653 | } |
---|
654 | @random[@k,@l]=(@m*@col)[1,1]; |
---|
655 | } |
---|
656 | } |
---|
657 | return(@random); |
---|
658 | } |
---|
659 | } |
---|
660 | //--------------------------------- EXAMPLE ----------------------------------- |
---|
661 | if (( typeof(#1) == "string" ) and ( #1 == "ex" )) |
---|
662 | { |
---|
663 | "EXAMPLE:"; |
---|
664 | " ring r=0,(x,y,z),dp;"; ring @r=0,(x,y,z),dp; |
---|
665 | " matrix A=randommat(3,3,2,-9,9);"; matrix @A=randommat(3,3,2,-9,9); |
---|
666 | " A; pmat(A);"; @A; pmat(@A); |
---|
667 | return(); |
---|
668 | } |
---|
669 | " USAGE: randommat(n,m,d[,u,o]); n,m,d,u,o integers"; |
---|
670 | " RETURNS: nxm matrix with entries homogeneous polynomials of degree d"; |
---|
671 | " [and coefficients between u and o]"; |
---|
672 | " NOTE: For performance reasons try small bounds u and o in char 0"; |
---|
673 | " EXAMPLE: randommat(\"ex\"); shows an example"; |
---|
674 | } |
---|
675 | /////////////////////////////////////////////////////////////////////////////// |
---|
676 | |
---|
677 | proc shift |
---|
678 | { |
---|
679 | if ( #ARGS != 1 and #ARGS != 2 ) |
---|
680 | { |
---|
681 | //============================================================================= |
---|
682 | " USAGE: shift(<ideal>,n); n integer"; |
---|
683 | " RETURN: module <ideal>*gen(n), n-th component generated by <ideal>"; |
---|
684 | " EXAMPLE: shift(\"ex\"); shows an example"; |
---|
685 | //============================================================================= |
---|
686 | return(); |
---|
687 | } |
---|
688 | |
---|
689 | parameter = "i","n"; |
---|
690 | if (#ARGS == 2) |
---|
691 | { |
---|
692 | if (typeof(#1) == "ideal" and typeof(#2) == "int") |
---|
693 | { |
---|
694 | module @m=#i[1]*gen(#n); |
---|
695 | for (int @n=2; @n<=ncols(#i) ; @n=@n+1 ) |
---|
696 | { |
---|
697 | @m=@m,#i[@n]*gen(#n); |
---|
698 | } |
---|
699 | return(@m); |
---|
700 | } |
---|
701 | } |
---|
702 | //--------------------------------- EXAMPLE ---------------------------------- |
---|
703 | if (( typeof(#1) == "string" ) and ( #1 == "ex" )) |
---|
704 | { |
---|
705 | "EXAMPLE:"; |
---|
706 | " ring r = 0,(x,y,z),(c,dp);"; ring @r= 0,(x,y,z),(c,dp); |
---|
707 | " ideal i = xy,xz,yz;"; ideal @i= xy,xz,yz; |
---|
708 | " module m = shift(i,2)+shift(i,4);"; module @m=shift(@i,2)+shift(@i,4); |
---|
709 | " m;"; @m; |
---|
710 | return(); |
---|
711 | } |
---|
712 | " USAGE: shift(<ideal>,n); n integer"; |
---|
713 | " RETURN: module <ideal>*gen(n), n-th component generated by <ideal>"; |
---|
714 | " EXAMPLE: shift(\"ex\"); shows an example"; |
---|
715 | return(); |
---|
716 | } |
---|
717 | /////////////////////////////////////////////////////////////////////////////// |
---|
718 | |
---|
719 | proc sum |
---|
720 | { |
---|
721 | if ( #ARGS !=1 ) |
---|
722 | { |
---|
723 | //============================================================================= |
---|
724 | " USAGE: sum(v); v vector or intvec"; |
---|
725 | " RETURN: <poly> or <int> = sum of components of v"; |
---|
726 | " EXAMPLE: sum(\"ex\"); shows an example"; |
---|
727 | //============================================================================= |
---|
728 | return(); |
---|
729 | } |
---|
730 | |
---|
731 | if ( #ARGS ==1 ) |
---|
732 | { |
---|
733 | if ( typeof(#1) == "vector" ) |
---|
734 | { |
---|
735 | poly @v; |
---|
736 | module @m = #1; |
---|
737 | matrix @mat=matrix(@m); |
---|
738 | for ( int @n=1 ; @n<=nrows(@mat); @n=@n+1) |
---|
739 | { |
---|
740 | @v=@v+@mat[@n,1]; |
---|
741 | } |
---|
742 | return(@v); |
---|
743 | } |
---|
744 | if ( typeof(#1) == "intvec" ) |
---|
745 | { |
---|
746 | int @v; |
---|
747 | for (int @n=1 ; @n<=size(#1); @n=@n+1) |
---|
748 | { |
---|
749 | @v=@v+#1[@n]; |
---|
750 | } |
---|
751 | return(@v); |
---|
752 | } |
---|
753 | } |
---|
754 | //--------------------------------- EXAMPLE ---------------------------------- |
---|
755 | if (( typeof(#1) == "string" ) and ( #1 == "ex" )) |
---|
756 | { |
---|
757 | "EXAMPLE:"; |
---|
758 | " ring r = 0,(x,y,z),dp;"; ring @r= 0,(x,y,z),dp; |
---|
759 | " vector v = [xy,xz,yz];"; vector @pv = [xy,xz,yz]; |
---|
760 | " sum(v);"; sum(@pv); |
---|
761 | " intvec iv = 1,2,3,4,5;"; intvec @iv = 1,2,3,4,5; |
---|
762 | " sum(iv);"; sum(@iv); |
---|
763 | return(); |
---|
764 | } |
---|
765 | " USAGE: sum(v); v vector or intvec"; |
---|
766 | " RETURN: <poly> or <int> = sum of components of v"; |
---|
767 | " EXAMPLE: sum(\"ex\"); shows an example"; |
---|
768 | return(); |
---|
769 | } |
---|
770 | /////////////////////////////////////////////////////////////////////////////// |
---|
771 | |
---|
772 | proc trmod |
---|
773 | { |
---|
774 | if (#ARGS != 1) |
---|
775 | { |
---|
776 | //============================================================================= |
---|
777 | " USAGE: trmod(<module>);"; |
---|
778 | " RETURNS: transposed (dual) module"; |
---|
779 | " EXAMPLE: trmod(\"ex\"); shows an example"; |
---|
780 | //============================================================================= |
---|
781 | return(); |
---|
782 | } |
---|
783 | |
---|
784 | if (typeof(#1) == "module") |
---|
785 | { |
---|
786 | matrix @mat=matrix(#1); |
---|
787 | module @mod=module(transpose(@mat)); |
---|
788 | return(@mod); |
---|
789 | } |
---|
790 | //--------------------------------- EXAMPLE ---------------------------------- |
---|
791 | if (( typeof(#1) == "string" ) and ( #1 == "ex" )) |
---|
792 | { |
---|
793 | "EXAMPLE:"; |
---|
794 | " ring r = 0,(x,y,z),(c,dp);"; ring @r= 0,(x,y,z),(c,dp); |
---|
795 | " module m = [xy,xz,yz]; m;"; module m = [xy,xz,yz]; m; |
---|
796 | " m = trmod(m); m;"; m=trmod(m); m; |
---|
797 | return(); |
---|
798 | } |
---|
799 | " USAGE: trmod(<module>);"; |
---|
800 | " RETURNS: transposed (dual) module"; |
---|
801 | " EXAMPLE: trmod(\"ex\"); shows an example"; |
---|
802 | return(); |
---|
803 | } |
---|
804 | /////////////////////////////////////////////////////////////////////////////// |
---|
805 | |
---|
806 | proc tab |
---|
807 | USAGE: tab(n); (n integer) |
---|
808 | RETURNS: string of n space tabs |
---|
809 | EXAMPLE: example tab; shows an example |
---|
810 | { |
---|
811 | if (#ARGS == 1) |
---|
812 | { |
---|
813 | if (typeof(#1) == "int") |
---|
814 | { |
---|
815 | if (#1 == 0) |
---|
816 | { |
---|
817 | return(""); |
---|
818 | } |
---|
819 | string @s=" "; |
---|
820 | return(@s[1,#1]); |
---|
821 | } |
---|
822 | } |
---|
823 | } |
---|
824 | example |
---|
825 | { |
---|
826 | "EXAMPLE:"; |
---|
827 | " for(int n=0; n<=5; n=n+1)"; |
---|
828 | " { tab(5-n)+\"*\"+tab(n)+\"+\"+tab(n)+\"*\"; }"; |
---|
829 | for(int @n=0; @n<=5; @n=@n+1) |
---|
830 | { |
---|
831 | tab(5-@n)+"*"+tab(@n)+"+"+tab(@n)+"*"; |
---|
832 | } |
---|
833 | kill @n; |
---|
834 | } |
---|
835 | /////////////////////////////////////////////////////////////////////////////// |
---|
836 | |
---|
837 | proc primes |
---|
838 | { |
---|
839 | if ( #ARGS !=2 and #ARGS != 1) |
---|
840 | { |
---|
841 | //============================================================================= |
---|
842 | " USAGE: primes(n,m); n,m integers "; |
---|
843 | " RETURNS: intvec, consisting of all primes p, prime(n)<=p<=m, in increasing"; |
---|
844 | " order if n<m, resp. prime(m)<=p<=n, in decreasing order if m<n"; |
---|
845 | " EXAMPLE: primes(\"ex\"); shows an example"; |
---|
846 | //============================================================================= |
---|
847 | return(); |
---|
848 | } |
---|
849 | |
---|
850 | parameter = "n", "m"; |
---|
851 | if ( #ARGS ==2 ) |
---|
852 | { |
---|
853 | if ( typeof(#n)=="int" and typeof(#m)=="int" ) |
---|
854 | { |
---|
855 | int @n = #n; int @m = #m; |
---|
856 | if (#n>#m) |
---|
857 | { |
---|
858 | @n=#m ; @m= #n; |
---|
859 | } |
---|
860 | int @q = prime(@m); |
---|
861 | int @p = prime(@n); |
---|
862 | intvec @v = @q; |
---|
863 | @q = @q-1; |
---|
864 | if ( #n>#m ) |
---|
865 | { |
---|
866 | while ( @q>=@p ) |
---|
867 | { |
---|
868 | @q = prime(@q); |
---|
869 | @v = @v,@q; |
---|
870 | @q = @q-1; |
---|
871 | } |
---|
872 | return(@v); |
---|
873 | } |
---|
874 | while ( @q>=@p ) |
---|
875 | { |
---|
876 | @q = prime(@q); |
---|
877 | @v = @q,@v; |
---|
878 | @q = @q-1; |
---|
879 | } |
---|
880 | return(@v) ; |
---|
881 | } |
---|
882 | } |
---|
883 | //--------------------------------- EXAMPLE ----------------------------------- |
---|
884 | if (( typeof(#1) == "string" ) and ( #1 == "ex" )) |
---|
885 | { |
---|
886 | "EXAMPLE:"; |
---|
887 | "primes(50,100);"; primes(50,100); |
---|
888 | "intvec v=primes(37,1); v;"; intvec @v = primes(37,1); @v; |
---|
889 | return(); |
---|
890 | } |
---|
891 | " USAGE: primes(n,m); n,m integers "; |
---|
892 | " RETURNS: intvec, consisting of all primes p, prime(n)<=p<=m, in increasing"; |
---|
893 | " order if n<m (resp. prime(m)<=p<=n, in decreasing order if m<n)"; |
---|
894 | " EXAMPLE: primes(\"ex\"); shows an example"; |
---|
895 | } |
---|
896 | /////////////////////////////////////////////////////////////////////////////// |
---|
897 | |
---|
898 | proc split |
---|
899 | { |
---|
900 | if ( #ARGS!=1 and #ARGS!=2 ) |
---|
901 | { |
---|
902 | //============================================================================= |
---|
903 | " USAGE: split(s,n); s string, n integer "; |
---|
904 | " RETURNS: same string, split into lines of length n separated by \\"; |
---|
905 | " EXAMPLE: split(\"ex\"); shows an example"; |
---|
906 | //============================================================================= |
---|
907 | return(); |
---|
908 | } |
---|
909 | |
---|
910 | parameter = "s","n"; |
---|
911 | if ( #ARGS == 2 ) |
---|
912 | { |
---|
913 | if ( typeof(#s) == "string" and typeof(#n) == "int" ) |
---|
914 | { |
---|
915 | string @line; |
---|
916 | string @res=""; |
---|
917 | int @l=size(#s); |
---|
918 | int @p; |
---|
919 | int @i; |
---|
920 | if ( #s[@l,1] != newline ) |
---|
921 | { |
---|
922 | #s=#s+newline; |
---|
923 | } |
---|
924 | while (1) |
---|
925 | { |
---|
926 | @l=find(#s,newline); |
---|
927 | @line=#s[1,@l]; |
---|
928 | @p=1; |
---|
929 | while ( @l>=#n ) |
---|
930 | { |
---|
931 | @res=@res+@line[@p,#n-1]+"\\"+newline; |
---|
932 | @p=@p+#n-1; |
---|
933 | @l=@l-#n+1; |
---|
934 | } |
---|
935 | @res=@res+@line[@p,@l]; |
---|
936 | @l=size(@line); |
---|
937 | if ( @l>=size(#s)) break; |
---|
938 | #s=#s[@l+1,size(#s)-@l]; |
---|
939 | } |
---|
940 | return (@res); |
---|
941 | } |
---|
942 | } |
---|
943 | //--------------------------------- EXAMPLE ---------------------------------- |
---|
944 | if (( typeof(#1) == "string" ) and ( #1 == "ex" )) |
---|
945 | { |
---|
946 | "EXAMPLE:"; |
---|
947 | " ring r = 0,(x,y,z),ds;"; ring @r= 0,(x,y,z),ds; |
---|
948 | " poly f = (x+y+z)^9;"; poly @f = (x+y+z)^9; |
---|
949 | " split(string(f),40);"; split(string(@f),40); |
---|
950 | return(); |
---|
951 | } |
---|
952 | " USAGE: split(s,n); s string, n integer "; |
---|
953 | " RETURNS: same string, split into lines of length n separated by \\"; |
---|
954 | " EXAMPLE: split(\"ex\"); shows an example"; |
---|
955 | } |
---|
956 | /////////////////////////////////////////////////////////////////////////////// |
---|