1 | // $Id$ |
---|
2 | //system("random",787422842); |
---|
3 | //(GMG) |
---|
4 | /////////////////////////////////////////////////////////////////////////////// |
---|
5 | |
---|
6 | LIBRARY: lib0.lib PROCEDURES OF GENERAL TYPE |
---|
7 | |
---|
8 | A_Z("a",n); string of n comma seperated letters starting with a |
---|
9 | binomial(n,m[,int/str]);n choose m (type int), [type string/type number] |
---|
10 | changechar(r,"c","R"); makes a copy R of ring r with new char c the basering |
---|
11 | changeord(r,"ord","R"); makes a copy R of ring r with new ord the basering |
---|
12 | changevar(r,"vars","R");same as copyring |
---|
13 | copyring(r,"vars","R"); makes a copy R of ring r with new vars the basering |
---|
14 | copyring1(r,"vars","R");string to make a copy R of ring r with new variables |
---|
15 | defrings(n[,p]); define ring Sn in n vars, char 32003 [or p], ds |
---|
16 | defringp(n[,p]); define ring Pn in n vars, char 32003 [or p], dp |
---|
17 | factorial(n[,int/str]); n factorial (=n!) (type int), [type string/number] |
---|
18 | fetchall(R[,str]); fetch all objects of ring R to basering |
---|
19 | fibonacci(n[,p]); nth Fibonacci number [char p] |
---|
20 | ishomog(poly/...); int, =1 resp. =0 if input is homogeneous resp. not |
---|
21 | kmemory(); int = active memory (kilobyte) |
---|
22 | killall(); kill all user-defined variables |
---|
23 | imapall(R [,str]); imap all objects of ring R to basering |
---|
24 | mapall(R,i[,str]); map all objects of ring R via ideal i to basering |
---|
25 | maxcoef(poly/...); maximal length of coefficient occuring in poly/... |
---|
26 | maxdeg(poly/...); int/intmat = degree/s of terms of maximal order |
---|
27 | mindeg(poly/...); int/intmat = degree/s of terms of minimal order |
---|
28 | normalize(poly/...); normalize poly/... such that leading coefficient is 1 |
---|
29 | primes(n,m); intvec of primes p, n<=p<=m |
---|
30 | product(vector/..[,v]); multiply components of vector/ideal/...[indices v] |
---|
31 | ringsum(s,t,..."r"); create a ring r from existing rings s,t,... |
---|
32 | ringweights(r); intvec of weights of ring variables of ring r |
---|
33 | sort(ideal/module); sort generators according to monomial ordering |
---|
34 | sum(vector/id/..[,v]); add components of vector/ideal/...[with indices v] |
---|
35 | (parameters in square brackets [] are optional) |
---|
36 | |
---|
37 | LIB "inout.lib"; |
---|
38 | /////////////////////////////////////////////////////////////////////////////// |
---|
39 | |
---|
40 | proc A_Z (string s,int n) |
---|
41 | USAGE: A_Z("a",n); a any letter, n integer (-26<= n <=26, !=0) |
---|
42 | RETURN: string of n small (if a is small) or capital (if a is capital) |
---|
43 | letters, comma seperated, beginning with a, in alphabetical |
---|
44 | order (or revers alphabetical order if n<0) |
---|
45 | EXAMPLE: example A_Z; shows an example |
---|
46 | { |
---|
47 | if ( n>=-26 and n<=26 and n!=0 ) |
---|
48 | { |
---|
49 | string alpha = |
---|
50 | "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,"+ |
---|
51 | "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,"+ |
---|
52 | "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,"+ |
---|
53 | "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"; |
---|
54 | int ii; int aa; |
---|
55 | for(ii=1; ii<=51; ii=ii+2) |
---|
56 | { |
---|
57 | if( alpha[ii]==s ) { aa=ii; } |
---|
58 | } |
---|
59 | if ( aa==0) |
---|
60 | { |
---|
61 | for(ii=105; ii<=155; ii=ii+2) |
---|
62 | { |
---|
63 | if( alpha[ii]==s ) { aa=ii; } |
---|
64 | } |
---|
65 | } |
---|
66 | if( aa!=0 ) |
---|
67 | { |
---|
68 | string out; |
---|
69 | if (n > 0) { out = alpha[aa,2*(n)-1]; return (out); } |
---|
70 | if (n < 0) |
---|
71 | { |
---|
72 | string beta = |
---|
73 | "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,"+ |
---|
74 | "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,"+ |
---|
75 | "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,"+ |
---|
76 | "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"; |
---|
77 | if ( aa < 52 ) { aa=52-aa; } |
---|
78 | if ( aa > 104 ) { aa=260-aa; } |
---|
79 | out = beta[aa,2*(-n)-1]; return (out); |
---|
80 | } |
---|
81 | } |
---|
82 | } |
---|
83 | } |
---|
84 | example |
---|
85 | { "EXAMPLE:"; echo = 2; |
---|
86 | A_Z("c",5); |
---|
87 | A_Z("Z",-5); |
---|
88 | string sR = "ring R = (0,"+A_Z("A",6)+"),("+A_Z("a",10)+"),dp;"; |
---|
89 | sR; |
---|
90 | execute sR; |
---|
91 | R; |
---|
92 | } |
---|
93 | /////////////////////////////////////////////////////////////////////////////// |
---|
94 | |
---|
95 | proc binomial (int n, int k, list #) |
---|
96 | USAGE: binomial(n,k[,p/s]); n,k,p integers, s string |
---|
97 | RETURN: binomial(n,k); binomial coefficient n choose k of type int |
---|
98 | (machine integer, limited size! ) |
---|
99 | binomial(n,k,p); n choose k in char p of type string |
---|
100 | binomial(n,k,s); n choose k of type number (s any string), computed |
---|
101 | in char of basering if a basering is defined |
---|
102 | EXAMPLE: example binomial; shows an example |
---|
103 | { |
---|
104 | if ( size(#)==0 ) { int rr=1; } |
---|
105 | if ( typeof(#[1])=="int") { ring bin = #[1],x,dp; number rr=1; } |
---|
106 | if ( typeof(#[1])=="string") { number rr=1; } |
---|
107 | if ( size(#)==0 or typeof(#[1])=="int" or typeof(#[1])=="string" ) |
---|
108 | { |
---|
109 | def r = rr; |
---|
110 | if ( k<=0 or k>n ) { return((k==0)*r); } |
---|
111 | if ( k>=n-k ) { k = n-k; } |
---|
112 | int l; |
---|
113 | for (l=1 ; l<=k ; l++ ) |
---|
114 | { |
---|
115 | r=r*(n+1-l)/l; |
---|
116 | } |
---|
117 | if ( typeof(#[1])=="int" ) { return(string(r)); } |
---|
118 | return(r); |
---|
119 | } |
---|
120 | } |
---|
121 | example |
---|
122 | { "EXAMPLE:"; echo = 2; |
---|
123 | int b1 = binomial(10,7); b1; |
---|
124 | binomial(37,17,0); |
---|
125 | ring t = 31,x,dp; |
---|
126 | number b2 = binomial(37,17,""); b2; |
---|
127 | } |
---|
128 | /////////////////////////////////////////////////////////////////////////////// |
---|
129 | |
---|
130 | proc changechar (r, string c, string newr) |
---|
131 | USAGE: changechar(r,c,newr); r=ring/qring, c,newr=strings |
---|
132 | CREATE: creates a new ring with name `newr` and makes it the basering if r is |
---|
133 | an existing ring/qring. |
---|
134 | The new ring differs from the old ring only in the characteristic. If, |
---|
135 | say, (c,newr) = ("0,A","R") and the ring r exists, the new basering |
---|
136 | will have name R characteristic 0 and one parameter A. |
---|
137 | RETURN: No return value |
---|
138 | NOTE: //*** Buggy for qrings |
---|
139 | EXAMPLE: example changechar; shows an example |
---|
140 | { |
---|
141 | setring r; |
---|
142 | ideal i = ideal(r); int q = size(i); |
---|
143 | if( q!=0 ) |
---|
144 | { string s = "newr1"; } |
---|
145 | else |
---|
146 | { string s = newr; } |
---|
147 | string newring = s+"=("+c+"),("+varstr(r)+"),("+ordstr(r)+");"; |
---|
148 | execute("ring "+newring); |
---|
149 | if( q!=0 ) |
---|
150 | { |
---|
151 | map phi = r,maxideal(1); |
---|
152 | ideal i = phi(i); |
---|
153 | attrib(i,"isSB",1); //*** attrib funktioniert ? |
---|
154 | execute("qring "+newr+"=i;"); |
---|
155 | } |
---|
156 | export(`newr`); |
---|
157 | keepring(`newr`); |
---|
158 | return(); |
---|
159 | } |
---|
160 | example |
---|
161 | { "EXAMPLE:"; echo = 2; |
---|
162 | ring r=0,(x,y,u,v),(dp(2),ds); |
---|
163 | show(r); |
---|
164 | changechar(r,"2,A","R"); |
---|
165 | show(R); |
---|
166 | kill R; |
---|
167 | } |
---|
168 | /////////////////////////////////////////////////////////////////////////////// |
---|
169 | |
---|
170 | proc changeord (r, string o, string newr) |
---|
171 | USAGE: changeord(r,o,newr); r=ring/qring, o,newr=strings |
---|
172 | CREATE: creates a new ring with name `newr` and makes it the basering if r is |
---|
173 | an existing ring/qring. |
---|
174 | The new ring differs from the old ring only in the ordering. If, say, |
---|
175 | (o,newr) = ("wp(2,3),dp","R") and the ring r exists and has >=3 |
---|
176 | variables, the new basering will have name R and ordering wp(2,3),dp. |
---|
177 | RETURN: No return value |
---|
178 | EXAMPLE: example changeord; shows an example |
---|
179 | { |
---|
180 | setring r; |
---|
181 | ideal i = ideal(r); int q = size(i); |
---|
182 | if( q!=0 ) |
---|
183 | { string s = "newr1"; } |
---|
184 | else |
---|
185 | { string s = newr; } |
---|
186 | string newring = s+"=("+charstr(r)+"),("+varstr(r)+"),("+o+");"; |
---|
187 | execute("ring "+newring); |
---|
188 | if( q!=0 ) |
---|
189 | { |
---|
190 | map phi = r,maxideal(1); |
---|
191 | ideal i = phi(i); |
---|
192 | attrib(i,"isSB",1); //*** attrib funktioniert ? |
---|
193 | execute("qring "+newr+"=i;"); |
---|
194 | } |
---|
195 | export(`newr`); |
---|
196 | keepring(`newr`); |
---|
197 | return(); |
---|
198 | } |
---|
199 | example |
---|
200 | { "EXAMPLE:"; echo = 2; |
---|
201 | ring r=0,(x,y,u,v),(dp(2),ds); |
---|
202 | changeord(r,"wp(2,3),dp","R"); |
---|
203 | show(R); |
---|
204 | ideal i = x^2,y^2-u^3,v; |
---|
205 | qring Q = std(i); |
---|
206 | changeord(Q,"lp","Q'"); |
---|
207 | show(Q'); |
---|
208 | kill R,Q,Q'; |
---|
209 | } |
---|
210 | /////////////////////////////////////////////////////////////////////////////// |
---|
211 | |
---|
212 | proc changevar (r, string vars, string newr) |
---|
213 | USAGE: changevar(r,vars,newr); r=ring/qring, vars,newr=strings |
---|
214 | CREATE: creates a new ring with name `newr` and makes it the basering if r is |
---|
215 | an existing ring/qring. |
---|
216 | NOTE: This procedure is the same as copyring |
---|
217 | EXAMPLE: example changevar; shows an example |
---|
218 | { |
---|
219 | copyring(r,vars,newr); |
---|
220 | } |
---|
221 | example |
---|
222 | { "EXAMPLE:"; echo = 2; |
---|
223 | ring r=0,(x,y,u,v),(dp(2),ds); |
---|
224 | changevar(r,"A()","R"); |
---|
225 | show(R); |
---|
226 | ideal i = x^2,y^2-u^3,v; |
---|
227 | qring Q = std(i); |
---|
228 | changevar(Q,"a,b,c,d","Q'"); |
---|
229 | show(Q'); |
---|
230 | kill R,Q,Q'; |
---|
231 | } |
---|
232 | /////////////////////////////////////////////////////////////////////////////// |
---|
233 | |
---|
234 | proc copyring (r, string vars, string newr) |
---|
235 | USAGE: copyring(r,vars,newr); r ring/qring, vars, newr strings |
---|
236 | CREATE: creates a new ring with name `newr` and makes it the basering if r is |
---|
237 | an existing ring/qring. |
---|
238 | The new ring differs from the old ring only in the variables. If, say, |
---|
239 | (vars,newr) = ("t()","R") and the ring r exists and has n variables, |
---|
240 | the new basering will have name R and variables t(1),...,t(n). |
---|
241 | If vars = "a,b,c,d", the new ring will have the variables a,b,c,d. |
---|
242 | RETURN: No return value |
---|
243 | NOTE: This procedure is useful in connection with the procedure ringsum, |
---|
244 | when a conflict between variable names must be avoided. See proc |
---|
245 | copyring1 for an alternative |
---|
246 | EXAMPLE: example copyring; shows an example |
---|
247 | { |
---|
248 | setring r; |
---|
249 | ideal i = ideal(r); int q = size(i); |
---|
250 | if( q!=0 ) |
---|
251 | { string s = "newr1"; } |
---|
252 | else |
---|
253 | { string s = newr; } |
---|
254 | string newring = s+"=("+charstr(r)+"),("; |
---|
255 | if( vars[size(vars)-1]=="(" and vars[size(vars)]==")" ) |
---|
256 | { |
---|
257 | newring = newring+vars[1,size(vars)-2]+"(1.."+string(nvars(r))+")"; |
---|
258 | } |
---|
259 | else { newring = newring+vars; } |
---|
260 | newring = newring+"),("+ordstr(r)+");"; |
---|
261 | execute("ring "+newring); |
---|
262 | if( q!=0 ) |
---|
263 | { |
---|
264 | map phi = r,maxideal(1); |
---|
265 | ideal i = phi(i); |
---|
266 | attrib(i,"isSB",1); //*** attrib funktioniert ? |
---|
267 | execute("qring "+newr+"=i;"); |
---|
268 | } |
---|
269 | export(`newr`); |
---|
270 | keepring(`newr`); |
---|
271 | return(); |
---|
272 | } |
---|
273 | example |
---|
274 | { "EXAMPLE:"; echo = 2; |
---|
275 | ring r=0,(x,y,u,v),(dp(2),ds); |
---|
276 | copyring(r,"A()","R"); |
---|
277 | type R; |
---|
278 | ideal i = A(1)^2,A(2)^2-A(3)^3,A(4); |
---|
279 | qring Q = std(i); |
---|
280 | copyring(Q,"a,b,c,d","Q'"); |
---|
281 | type Q'; |
---|
282 | kill R,Q,Q'; |
---|
283 | } |
---|
284 | /////////////////////////////////////////////////////////////////////////////// |
---|
285 | |
---|
286 | proc copyring1 (r, string vars, string newr) |
---|
287 | USAGE: copyring1(r,vars,newr); r ring, vars, newr strings |
---|
288 | RETURN: a string which can be executed to define a new ring with name equal |
---|
289 | to `newr` if r is an existing ring name. |
---|
290 | The new ring differs from the old ring only in the variables. If, say, |
---|
291 | (vars,newr) = ("t()","R") and the ring r exists and has n variables, |
---|
292 | the new basering will have name R and variables t(1),...,t(n). |
---|
293 | If vars = "a,b,c,d", the new ring will have the variables a,b,c,d. |
---|
294 | NOTE: This procedure differs from copyring that it returns the string to |
---|
295 | create newring, but does not execute this string. Contrary to |
---|
296 | copyring this procedure does not work for a qring |
---|
297 | EXAMPLE: example copyring1; shows an example |
---|
298 | { |
---|
299 | string newring = "ring "+newr+"=("+charstr(r)+"),("; |
---|
300 | if( vars[size(vars)-1]=="(" and vars[size(vars)]==")" ) |
---|
301 | { string v = vars[1,size(vars)-2]+"(1.."+string(nvars(r))+")"; } |
---|
302 | else { string v = vars; } |
---|
303 | return(newring+v+"),("+ordstr(r)+");"); |
---|
304 | } |
---|
305 | example |
---|
306 | { "EXAMPLE:"; echo = 2; |
---|
307 | ring r=0,(x,y,u,v),(dp(2),ds); |
---|
308 | string s=copyring1(r,"A()","R");s; |
---|
309 | execute(s); |
---|
310 | type R; |
---|
311 | execute(copyring1(R,"a,b,c,d,e","r'")); |
---|
312 | type r'; |
---|
313 | kill R,r'; |
---|
314 | } |
---|
315 | /////////////////////////////////////////////////////////////////////////////// |
---|
316 | |
---|
317 | proc defring (string s1, string s2, int n, string s3, string s4) |
---|
318 | USAGE: defring(s1,s2,n,s3,s4); s1..s4=strings, n=integer |
---|
319 | CREATE: Defines a ring with name 's1', characteristic 's2', ordering 's4' and |
---|
320 | n variables with names derived from s3: if s3 is a single letter, say |
---|
321 | s3="a", and if n<=26 then a and the following n-1 letters from the |
---|
322 | alphabeth (cyclic order) are taken as variables. If n>26 or if s3 is |
---|
323 | a single letter followed by (, say s3="T(", the variables are |
---|
324 | T(1),...,T(n). |
---|
325 | RETURN: No return value |
---|
326 | EXAMPLE: example defring; shows an example |
---|
327 | { |
---|
328 | string newring = "ring "+s1+"=("+s2+"),("; |
---|
329 | if( n>26 or s3[2]=="(" ) { string v = s3[1]+"(1.."+string(n)+")"; } |
---|
330 | else { string v = A_Z(s3,n); } |
---|
331 | newring=newring+v+"),("+s4+");"; |
---|
332 | execute(newring); |
---|
333 | export(basering); |
---|
334 | keepring(`s1`); |
---|
335 | if (voice==2) { "// basering is now:",s1; } |
---|
336 | return(); |
---|
337 | } |
---|
338 | example |
---|
339 | { "EXAMPLE:"; echo = 2; |
---|
340 | defring("r","0",5,"u","ls"); r; |
---|
341 | defring("R","2,A",10,"x(","dp(3),ws(1,2,3),ds"); R; |
---|
342 | kill r,R; |
---|
343 | } |
---|
344 | /////////////////////////////////////////////////////////////////////////////// |
---|
345 | |
---|
346 | proc defrings (int n, list #) |
---|
347 | USAGE: defrings(n,[p]); n,p integers |
---|
348 | CREATE: Defines a ring with name Sn, characteristic p, ordering ds and n |
---|
349 | variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26) and makes it |
---|
350 | the basering (default: p=32003) |
---|
351 | RETURN: No return value |
---|
352 | EXAMPLE: example defrings; shows an example |
---|
353 | { |
---|
354 | int p; |
---|
355 | if (size(#)==0) { p=32003; } |
---|
356 | else { p=#[1]; } |
---|
357 | if (n >26) |
---|
358 | { |
---|
359 | string s="ring S"+string(n)+"="+string(p)+",x(1.."+string(n)+"),ds;"; |
---|
360 | } |
---|
361 | else |
---|
362 | { |
---|
363 | string s="ring S"+string(n)+"="+string(p)+",("+A_Z("x",n)+"),ds;"; |
---|
364 | } |
---|
365 | execute(s); |
---|
366 | export basering; |
---|
367 | execute("keepring S"+string(n)+";"); |
---|
368 | if (voice==2) { "// basering is now:",s; } |
---|
369 | } |
---|
370 | example |
---|
371 | { "EXAMPLE:"; echo = 2; |
---|
372 | defrings(5,0); S5; |
---|
373 | defrings(30); S30; |
---|
374 | kill S5, S30; |
---|
375 | } |
---|
376 | /////////////////////////////////////////////////////////////////////////////// |
---|
377 | |
---|
378 | proc defringp (int n,list #) |
---|
379 | USAGE: defringp(n,[p]); n,p=integers |
---|
380 | CREATE: defines a ring with name Pn, characteristic p, ordering dp and n |
---|
381 | variables x,y,z,a,b,...if n<=26 (resp. x(1..n) if n>26) and makes it |
---|
382 | the basering (default: p=32003) |
---|
383 | RETURN: No return value |
---|
384 | EXAMPLE: example defringp; shows an example |
---|
385 | { |
---|
386 | int p; |
---|
387 | if (size(#)==0) { p=32003; } |
---|
388 | else { p=#[1]; } |
---|
389 | if (n >26) |
---|
390 | { |
---|
391 | string s="ring P"+string(n)+"="+string(p)+",x(1.."+string(n)+"),dp;"; |
---|
392 | } |
---|
393 | else |
---|
394 | { |
---|
395 | string s="ring P"+string(n)+"="+string(p)+",("+A_Z("x",n)+"),dp;"; |
---|
396 | } |
---|
397 | execute(s); |
---|
398 | export basering; |
---|
399 | execute("keepring P"+string(n)+";"); |
---|
400 | //the next comment is only shown if defringp is not called by another proc |
---|
401 | if (voice==2) { "// basering is now:",s; } |
---|
402 | } |
---|
403 | example |
---|
404 | { "EXAMPLE:"; echo = 2; |
---|
405 | defringp(5,0); P5; |
---|
406 | defringp(30); P30; |
---|
407 | kill P5, P30; |
---|
408 | } |
---|
409 | /////////////////////////////////////////////////////////////////////////////// |
---|
410 | |
---|
411 | proc factorial (int n, list #) |
---|
412 | USAGE: factorial(n[,string]); n integer |
---|
413 | RETURN: factorial(n); string of n! in char 0 |
---|
414 | factorial(n,s); n! of type number (s any string), computed in char of |
---|
415 | basering if a basering is defined |
---|
416 | EXAMPLE: example factorial; shows an example |
---|
417 | { |
---|
418 | if ( size(#)==0 ) { ring R = 0,x,dp; poly r=1; } |
---|
419 | if ( typeof(#[1])=="string" ) { number r=1; } |
---|
420 | if ( size(#)==0 or typeof(#[1])=="string" ) |
---|
421 | { |
---|
422 | int l; |
---|
423 | for (l=2; l<=n; l++) |
---|
424 | { |
---|
425 | r=r*l; |
---|
426 | } |
---|
427 | if ( size(#)==0 ) { return(string(r)); } |
---|
428 | return(r); |
---|
429 | } |
---|
430 | } |
---|
431 | example |
---|
432 | { "EXAMPLE:"; echo = 2; |
---|
433 | factorial(37); |
---|
434 | ring r1 = 32003,(x,y,z),ds; |
---|
435 | number p = factorial(37,""); p; |
---|
436 | } |
---|
437 | /////////////////////////////////////////////////////////////////////////////// |
---|
438 | |
---|
439 | proc fetchall (R, list #) |
---|
440 | USAGE: fetchall(R[,s]); R=ring/qring, s=string |
---|
441 | CREATE: fetch all objects of ring R (of type poly, ideal, vector, module, |
---|
442 | number, matrix) into the basering. |
---|
443 | If no 3rd argument is present, the names are the same as in R. If, say, |
---|
444 | f is a poly in R and the 3rd argument is the string "R", then f is |
---|
445 | maped to f_R etc. |
---|
446 | RETURN: no return value |
---|
447 | NOTE: As fetch, this procedure maps the 1st, 2nd, ... variable of R to the |
---|
448 | 1st, 2nd, ... variable of the basering. |
---|
449 | The 3rd argument is useful in order to avoid conflicts of names, the |
---|
450 | empty string is allowed |
---|
451 | CAUTION: fetchall does not work inside a procedure |
---|
452 | //***at the moment it does not work if R contains a map |
---|
453 | EXAMPLE: example fetchall; shows an example |
---|
454 | { |
---|
455 | list @L@=names(R); |
---|
456 | int @ii@; string @s@; |
---|
457 | if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; } |
---|
458 | for( @ii@=size(@L@); @ii@>0; @ii@=@ii@-- ) |
---|
459 | { |
---|
460 | execute("def "+@L@[@ii@]+@s@+"=fetch(R,`@L@[@ii@]`);"); |
---|
461 | execute("export "+@L@[@ii@]+@s@+";"); |
---|
462 | } |
---|
463 | return(); |
---|
464 | } |
---|
465 | example |
---|
466 | { "EXAMPLE:"; |
---|
467 | "// This example is not executed since fetchall does not work in a procedure"; |
---|
468 | "// (and hence not in the example procedure). Just try the following commands:"; |
---|
469 | " ring R=0,(x,y,z),dp;"; |
---|
470 | " ideal j=x,y2,z2;"; |
---|
471 | " matrix M[2][3]=1,2,3,x,y,z;"; |
---|
472 | " j; print(M);"; |
---|
473 | " ring S=0,(a,b,c),ds;"; |
---|
474 | " fetchall(R); // map from R to S: x->a, y->b, z->c"; |
---|
475 | " names(S);"; |
---|
476 | " j; print(M);"; |
---|
477 | " fetchall(S,\"1\"); // identity map of S: copy objects, change names"; |
---|
478 | " names(S);"; |
---|
479 | " kill R,S;"; |
---|
480 | } |
---|
481 | /////////////////////////////////////////////////////////////////////////////// |
---|
482 | |
---|
483 | proc fibonacci (int n, list #) |
---|
484 | USAGE: fibonacci(n[,string]); (n integer) |
---|
485 | RETURN: fibonacci(n); string of nth Fibonacci number, |
---|
486 | f(0)=f(1)=1, f(i+1)=f(i-1)+f(i) |
---|
487 | fibonacci(n,s); nth Fibonacci number of type number (s any string), |
---|
488 | computed in characteristic of basering if a basering is defined |
---|
489 | EXAMPLE: example fibonacci; shows an example |
---|
490 | { |
---|
491 | if ( size(#)==0 ) { ring fibo = 0,x,dp; number f=1; } |
---|
492 | if ( typeof(#[1])=="string" ) { number f=1; } |
---|
493 | if ( size(#)==0 or typeof(#[1])=="string" ) |
---|
494 | { |
---|
495 | number g,h = 1,1; int ii; |
---|
496 | for (ii=3; ii<=n; ii++) |
---|
497 | { |
---|
498 | h = f+g; f = g; g = h; |
---|
499 | } |
---|
500 | if ( size(#)==0 ) { return(string(h)); } |
---|
501 | return(h); |
---|
502 | } |
---|
503 | } |
---|
504 | example |
---|
505 | { "EXAMPLE:"; echo = 2; |
---|
506 | fibonacci(37); |
---|
507 | ring r = 17,x,dp; |
---|
508 | number b = fibonacci(37,""); b; |
---|
509 | } |
---|
510 | /////////////////////////////////////////////////////////////////////////////// |
---|
511 | |
---|
512 | proc ishomog (id) |
---|
513 | USAGE: ishomog(id); id poly/ideal/vector/module/matrix |
---|
514 | RETURN: integer which is 1 if input is homogeneous (resp. weighted homogeneous |
---|
515 | if the monomial ordering consists of one block of type ws,Ws,wp or Wp, |
---|
516 | assuming that all weights are positive) and 0 otherwise |
---|
517 | NOTE: A vector is homogeneous, if the components are homogeneous of same |
---|
518 | degree, a module/matrix is homogeneous if all column vectors are |
---|
519 | homogeneous |
---|
520 | //*** ergaenzen, wenn Matrizen Spalten Gewichte haben |
---|
521 | EXAMPLE: example ishomog; shows an example |
---|
522 | { |
---|
523 | module M = module(matrix(id)); |
---|
524 | M = simplify(M,2); // remove 0-columns |
---|
525 | intvec v = ringweights(basering); |
---|
526 | int i,j=1,1; |
---|
527 | for (i=1; i<=ncols(M); i++) |
---|
528 | { |
---|
529 | if( M[i]!=jet(M[i],deg(lead(M[i])),v)-jet(M[i],deg(lead(M[i]))-1,v)) |
---|
530 | { return(0); } |
---|
531 | } |
---|
532 | return(1); |
---|
533 | } |
---|
534 | example |
---|
535 | { "EXAMPLE:"; echo = 2; |
---|
536 | ring r = 0,(x,y,z),wp(1,2,3); |
---|
537 | ishomog(x5-yz+y3); |
---|
538 | ideal i = x6+y3+z2, x9-z3; |
---|
539 | ishomog(i); |
---|
540 | ring s = 0,(a,b,c),ds; |
---|
541 | vector v = [a2,0,ac+bc]; |
---|
542 | vector w = [a3,b3,c4]; |
---|
543 | ishomog(v); |
---|
544 | ishomog(w); |
---|
545 | } |
---|
546 | /////////////////////////////////////////////////////////////////////////////// |
---|
547 | |
---|
548 | proc kmemory () |
---|
549 | USAGE: kmemory(); |
---|
550 | RETURN: memory used by active variables, of type int (in kilobyte) |
---|
551 | EXAMPLE: example kmemory; shows an example |
---|
552 | { |
---|
553 | if ( voice==2 ) { "// memory used by active variables (kilobyte):"; } |
---|
554 | return ((memory(0)+1023)/1024); |
---|
555 | } |
---|
556 | example |
---|
557 | { "EXAMPLE:"; echo = 2; |
---|
558 | kmemory(); |
---|
559 | } |
---|
560 | /////////////////////////////////////////////////////////////////////////////// |
---|
561 | |
---|
562 | proc killall () |
---|
563 | USAGE: killall(); (no parameter) |
---|
564 | CREATE: kill all user-defined variables but not loaded procedures |
---|
565 | RETURN: no return value |
---|
566 | NOTE: killall should never be used inside a procedure |
---|
567 | EXAMPLE: example killall; shows an example AND KILLS ALL YOUR VARIABLES |
---|
568 | { |
---|
569 | list L=names(); int joni=size(L); |
---|
570 | for ( ; joni>0; joni-- ) |
---|
571 | { |
---|
572 | if( L[joni]!="LIB" and typeof(`L[joni]`)!="proc" ) { kill `L[joni]`; } |
---|
573 | } |
---|
574 | } |
---|
575 | example |
---|
576 | { "EXAMPLE:"; echo = 2; |
---|
577 | ring rtest; ideal i=x,y,z; number n=37; string str="hi"; |
---|
578 | export rtest,i,n,str; //this makes the local variables global |
---|
579 | listvar(all); |
---|
580 | killall(); |
---|
581 | listvar(all); |
---|
582 | } |
---|
583 | /////////////////////////////////////////////////////////////////////////////// |
---|
584 | |
---|
585 | proc imapall (R, list #) |
---|
586 | USAGE: imapall(R[,s]); R=ring/qring, s=string |
---|
587 | CREATE: map all objects of ring R (of type poly, ideal, vector, module, number, |
---|
588 | matrix) into the basering, by applying imap to all objects of R. |
---|
589 | If no 3rd argument is present, the names are the same as in R. If, say, |
---|
590 | f is a poly in R and the 3rd argument is the string "R", then f is |
---|
591 | maped to f_R etc. |
---|
592 | RETURN: no return value |
---|
593 | NOTE: As imap, this procedure maps the variables of R to the variables with |
---|
594 | the same name in the basering, the other variables are maped to 0. |
---|
595 | The 3rd argument is useful in order to avoid conflicts of names, the |
---|
596 | empty string is allowed |
---|
597 | CAUTION: imapall does not work inside a procedure |
---|
598 | //***at the moment it does not work if R contains a map |
---|
599 | EXAMPLE: example imapall; shows an example |
---|
600 | { |
---|
601 | list @L@=names(R); |
---|
602 | int @ii@; string @s@; |
---|
603 | if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; } |
---|
604 | for( @ii@=size(@L@); @ii@>0; @ii@=@ii@-- ) |
---|
605 | { |
---|
606 | execute("def "+@L@[@ii@]+@s@+"=imap(R,`@L@[@ii@]`);"); |
---|
607 | execute("export "+@L@[@ii@]+@s@+";"); |
---|
608 | } |
---|
609 | return(); |
---|
610 | } |
---|
611 | example |
---|
612 | { "EXAMPLE:"; |
---|
613 | "// This example is not executed since imapall does not work in a procedure"; |
---|
614 | "// (and hence not in the example procedure). Just try the following commands:"; |
---|
615 | " ring R=0,(x,y,z,u),dp;"; |
---|
616 | " ideal j=x,y,z,u2+ux+z;"; |
---|
617 | " matrix M[2][3]=1,2,3,x,y,uz;"; |
---|
618 | " j; print(M);"; |
---|
619 | " ring S=0,(a,b,c,x,z,y),ds;"; |
---|
620 | " imapall(R); // map from R to S: x->x, y->y, z->z, u->0"; |
---|
621 | " names(S);"; |
---|
622 | " j; print(M);"; |
---|
623 | " imapall(S,\"1\"); // identity map of S: copy objects, change names"; |
---|
624 | " names(S);"; |
---|
625 | " kill R,S;"; |
---|
626 | } |
---|
627 | /////////////////////////////////////////////////////////////////////////////// |
---|
628 | |
---|
629 | proc mapall (R, ideal i, list #) |
---|
630 | USAGE: mapall(R,i[,s]); R=ring/qring, i=ideal of basering, s=string |
---|
631 | CREATE: map all objects of ring R (of type poly, ideal, vector, module, number, |
---|
632 | matrix, map) into the basering, by mapping the jth variable of R to |
---|
633 | the jth generator of the ideal i. If no 3rd argument is present, the |
---|
634 | names are the same as in R. If, say, f is a poly in R and the 3rd |
---|
635 | argument is the string "R", then f is maped to f_R etc. |
---|
636 | RETURN: no return value |
---|
637 | NOTE: This procedure has the same effect as defining a map, say psi, by |
---|
638 | map psi=R,i; and then applying psi to all objects of R. In particular, |
---|
639 | maps from R to some ring S are composed with psi, creating thus a map |
---|
640 | from the basering to S. |
---|
641 | mapall may be combined with copyring to change vars for all objects. |
---|
642 | The 3rd argument is useful in order to avoid conflicts of names, the |
---|
643 | empty string is allowed |
---|
644 | CAUTION: mapall does not work inside a procedure |
---|
645 | EXAMPLE: example mapall; shows an example |
---|
646 | { |
---|
647 | list @L@=names(R); map @psi@ = R,i; |
---|
648 | int @ii@; string @s@; |
---|
649 | if( size(#) > 0 ) { @s@=@s@+"_"+#[1]; } |
---|
650 | for( @ii@=size(@L@); @ii@>0; @ii@=@ii@-- ) |
---|
651 | { |
---|
652 | execute("def "+@L@[@ii@]+@s@+"=@psi@(`@L@[@ii@]`);"); |
---|
653 | execute("export "+@L@[@ii@]+@s@+";"); |
---|
654 | } |
---|
655 | return(); |
---|
656 | } |
---|
657 | example |
---|
658 | { "EXAMPLE:"; |
---|
659 | "// This example is not executed since mapall does not work in a procedure"; |
---|
660 | "// (and hence not in the example procedure). Just try the following commands:"; |
---|
661 | " ring R=0,(x,y,z),dp;"; |
---|
662 | " ideal j=x,y,z;"; |
---|
663 | " matrix M[2][3]=1,2,3,x,y,z;"; |
---|
664 | " map phi=R,x2,y2,z2; "; |
---|
665 | " ring S=0,(a,b,c),ds;"; |
---|
666 | " ideal i=c,a,b;"; |
---|
667 | " mapall(R,i); // map from R to S: x->c, y->a, z->b"; |
---|
668 | " names(S);"; |
---|
669 | " j; print(M); phi; // phi is a map from R to S: x->c2, y->a2, z->b2"; |
---|
670 | " ideal i1=a2,a+b,1;"; |
---|
671 | " mapall(R,i1,\"\"); // map from R to S: x->a2, y->a+b, z->1"; |
---|
672 | " names(S);"; |
---|
673 | " j_; print(M_); phi_;"; |
---|
674 | " copyring(S,\"x()\",\"T\");"; |
---|
675 | " mapall(R,maxideal(1)); // identity map from R to T"; |
---|
676 | " names(T);"; |
---|
677 | " j; print(M); phi;"; |
---|
678 | " kill R,S,T;"; |
---|
679 | } |
---|
680 | /////////////////////////////////////////////////////////////////////////////// |
---|
681 | |
---|
682 | proc maxcoef (f) |
---|
683 | USAGE: maxcoef(f); f poly/ideal/vector/module/matrix |
---|
684 | RETURN: maximal length of coefficient of f of type int (by counting the |
---|
685 | length of the string of each coefficient) |
---|
686 | EXAMPLE: example maxcoef; shows an example |
---|
687 | { |
---|
688 | int max,s,ii,jj; string t; |
---|
689 | ideal i = ideal(matrix(f)); |
---|
690 | i = simplify(i,6); //* delete 0's and keep first of equal elements |
---|
691 | poly m = var(1); matrix C; |
---|
692 | for (ii=2;ii<=nvars(basering);ii++) { m = m*var(ii); } |
---|
693 | for (ii=1; ii<=size(i); ii++) |
---|
694 | { |
---|
695 | C = coef(i[ii],m); |
---|
696 | for (jj=1; jj<=ncols(C); jj++) |
---|
697 | { |
---|
698 | t = string(C[2,jj]); s = size(t); |
---|
699 | if ( t[1] == "-" ) { s = s - 1; } |
---|
700 | if ( s > max ) { max = s; } |
---|
701 | } |
---|
702 | } |
---|
703 | return(max); |
---|
704 | } |
---|
705 | example |
---|
706 | { "EXAMPLE:"; echo = 2; |
---|
707 | ring r= 0,(x,y,z),ds; |
---|
708 | poly g = 345x2-1234567890y+7/4z; |
---|
709 | maxcoef(g); |
---|
710 | ideal i = g,10/1234567890; |
---|
711 | maxcoef(i); |
---|
712 | // since i[2]=1/123456789 |
---|
713 | } |
---|
714 | /////////////////////////////////////////////////////////////////////////////// |
---|
715 | |
---|
716 | proc maxdeg (id) |
---|
717 | USAGE: maxdeg(id); id poly/ideal/vector/module/matrix |
---|
718 | RETURN: maximal degree/s of monomials of id independent of ring ordering |
---|
719 | (maxdeg of each variable is 1) |
---|
720 | of type int if id is of type poly, of type intmat else |
---|
721 | EXAMPLE: example maxdeg; shows an example |
---|
722 | { |
---|
723 | //------------------- find maximal degree of given component ------------------ |
---|
724 | proc findmaxdeg |
---|
725 | { |
---|
726 | poly c = #[1]; |
---|
727 | if (c==0) { return(-1); } |
---|
728 | //--- guess upper 'o' and lower 'u' bound, in case of negative weights ----- |
---|
729 | int d = (deg(c)>=0)*deg(c)-(deg(c)<0)*deg(c); |
---|
730 | int i = d; |
---|
731 | while ( c-jet(c,i) != 0 ) { i = 2*(i+1); } |
---|
732 | int o = i-1; |
---|
733 | int u = (d != i)*((i/ 2)-1); |
---|
734 | //----------------------- "quick search" for maxdeg ------------------------ |
---|
735 | while ( (c-jet(c,i)==0)*(c-jet(c,i-1)!=0) == 0) |
---|
736 | { |
---|
737 | i = (o+1+u)/ 2; |
---|
738 | if (c-jet(c,i)!=0) { u = i+1; } |
---|
739 | else { o = i-1; } |
---|
740 | } |
---|
741 | return(i); |
---|
742 | } |
---|
743 | //------------------------------ main program --------------------------------- |
---|
744 | matrix M = matrix(id); |
---|
745 | int r,c = nrows(M), ncols(M); int i,j; |
---|
746 | intmat m[r][c]; |
---|
747 | for (i=r; i>0; i--) |
---|
748 | { |
---|
749 | for (j=c; j>0; j--) { m[i,j] = findmaxdeg(M[i,j]); } |
---|
750 | } |
---|
751 | if( typeof(id)=="poly" ) { return(m[1,1]); } |
---|
752 | return(m); |
---|
753 | } |
---|
754 | example |
---|
755 | { "EXAMPLE:"; echo = 2; |
---|
756 | ring r = 0,(x,y,z),wp(-1,-2,-3); |
---|
757 | poly f = x+y2+z3; |
---|
758 | deg(f); //deg returns weighted degree (in case of 1 block)! |
---|
759 | maxdeg(f); |
---|
760 | matrix m[2][2]=f+x10,1,0,f^2; |
---|
761 | maxdeg(m); |
---|
762 | } |
---|
763 | /////////////////////////////////////////////////////////////////////////////// |
---|
764 | |
---|
765 | proc mindeg (id) |
---|
766 | USAGE: mindeg(id); id poly/ideal/vector/module/matrix |
---|
767 | RETURN: minimal degree/s of monomials of id independent of ring ordering |
---|
768 | (mindeg of each variable is 1) |
---|
769 | of type int if id is of type poly, of type intmat else |
---|
770 | EXAMPLE: example mindeg; shows an example |
---|
771 | { |
---|
772 | //------------------- find minimal degree of given component ------------------ |
---|
773 | proc findmindeg |
---|
774 | { |
---|
775 | poly c = #[1]; |
---|
776 | if (c==0) { return(-1); } |
---|
777 | //--- guess upper 'o' and lower 'u' bound, in case of negative weights ----- |
---|
778 | int d = (ord(c)>=0)*ord(c)-(ord(c)<0)*ord(c); |
---|
779 | int i = d; |
---|
780 | while ( jet(c,i) == 0 ) { i = 2*(i+1); } |
---|
781 | int o = i-1; |
---|
782 | int u = (d != i)*((i/ 2)-1); |
---|
783 | //----------------------- "quick search" for mindeg -------------------------- |
---|
784 | while ( (jet(c,u)==0)*(jet(c,o)!=0) ) |
---|
785 | { |
---|
786 | i = (o+u)/ 2; |
---|
787 | if (jet(c,i)==0) { u = i+1; } |
---|
788 | else { o = i-1; } |
---|
789 | } |
---|
790 | if (jet(c,u)!=0) { return(u); } |
---|
791 | else { return(o+1); } |
---|
792 | } |
---|
793 | //------------------------------ main program --------------------------------- |
---|
794 | matrix M = matrix(id); |
---|
795 | int r,c = nrows(M), ncols(M); int i,j; |
---|
796 | intmat m[r][c]; |
---|
797 | for (i=r; i>0; i--) |
---|
798 | { |
---|
799 | for (j=c; j>0; j--) { m[i,j] = findmindeg(M[i,j]); } |
---|
800 | } |
---|
801 | if (typeof(id)=="poly") { return(m[1,1]); } |
---|
802 | return(m); |
---|
803 | } |
---|
804 | example |
---|
805 | { "EXAMPLE:"; echo = 2; |
---|
806 | ring r = 0,(x,y,z),ls; |
---|
807 | poly f = x5+y2+z3; |
---|
808 | ord(f); // ord returns weighted order of leading term! |
---|
809 | mindeg(f); |
---|
810 | matrix m[2][2]=x10,1,0,f^2; |
---|
811 | mindeg(m); |
---|
812 | } |
---|
813 | /////////////////////////////////////////////////////////////////////////////// |
---|
814 | |
---|
815 | proc normalize (id) |
---|
816 | USAGE: normalize(id); id=poly/vector/ideal/module |
---|
817 | RETURN: object of same type with leading coefficient equal to 1 |
---|
818 | EXAMPLE: example normalize; shows an example |
---|
819 | { |
---|
820 | return(simplify(id,1)); |
---|
821 | } |
---|
822 | example |
---|
823 | { "EXAMPLE:"; echo = 2; |
---|
824 | ring r = 0,(x,y,z),ls; |
---|
825 | poly f = 2x5+3y2+4z3; |
---|
826 | normalize(f); |
---|
827 | module m=[9xy,0,3z3],[4z,6y,2x]; |
---|
828 | show(normalize(m)); |
---|
829 | ring s = 0,(x,y,z),(c,ls); |
---|
830 | module m=[9xy,0,3z3],[4z,6y,2x]; |
---|
831 | show(normalize(m)); |
---|
832 | normalize(matrix(m)); // by automatic type conversion to module! |
---|
833 | } |
---|
834 | /////////////////////////////////////////////////////////////////////////////// |
---|
835 | |
---|
836 | proc primes (int n, int m) |
---|
837 | USAGE: primes(n,m); n,m integers |
---|
838 | RETURN: intvec, consisting of all primes p, prime(n)<=p<=m, in increasing |
---|
839 | order if n<=m, resp. prime(m)<=p<=n, in decreasing order if m<n |
---|
840 | NOTE: prime(n); returns the biggest prime number <= n (if n>=2, else 2) |
---|
841 | EXAMPLE: example primes; shows an example |
---|
842 | { int change; |
---|
843 | if ( n>m ) { change=n; n=m ; m=change; change=1; } |
---|
844 | int q,p = prime(m),prime(n); intvec v = q; q = q-1; |
---|
845 | while ( q>=p ) { q = prime(q); v = q,v; q = q-1; } |
---|
846 | if ( change==1 ) { v = v[size(v)..1]; } |
---|
847 | return(v); |
---|
848 | } |
---|
849 | example |
---|
850 | { "EXAMPLE:"; echo = 2; |
---|
851 | primes(50,100); |
---|
852 | intvec v = primes(37,1); v; |
---|
853 | } |
---|
854 | /////////////////////////////////////////////////////////////////////////////// |
---|
855 | |
---|
856 | proc product (id, list #) |
---|
857 | USAGE: product(id[,v]); id=ideal/vector/module/matrix |
---|
858 | resp.id=intvec/intmat, v=intvec (e.g. v=1..n, n=integer) |
---|
859 | RETURN: poly resp. int which is the product of all entries of id, with index |
---|
860 | given by v (default: v=1..number of entries of id) |
---|
861 | NOTE: id is treated as a list of polys resp. integers. A module m is |
---|
862 | identified with corresponding matrix M (columns of M generate m) |
---|
863 | EXAMPLE: example product; shows an example |
---|
864 | { |
---|
865 | int n,j; |
---|
866 | if( typeof(id)=="poly" or typeof(id)=="ideal" or typeof(id)=="vector" |
---|
867 | or typeof(id)=="module" or typeof(id)=="matrix" ) |
---|
868 | { |
---|
869 | ideal i = ideal(matrix(id)); |
---|
870 | if( size(#)!=0 ) { i = i[#[1]]; } |
---|
871 | n = ncols(i); poly f=1; |
---|
872 | } |
---|
873 | if( typeof(id)=="int" or typeof(id)=="intvec" or typeof(id)=="intmat" ) |
---|
874 | { |
---|
875 | intmat S = intmat(id); |
---|
876 | intvec i = S[1..nrows(S),1..ncols(S)]; |
---|
877 | if( size(#)!=0 ) { i = i[#[1]]; } |
---|
878 | n = size(i); int f=1; |
---|
879 | } |
---|
880 | for( j=1; j<=n; j++ ) { f=f*i[j]; } |
---|
881 | return(f); |
---|
882 | } |
---|
883 | example |
---|
884 | { "EXAMPLE:"; echo = 2; |
---|
885 | ring r= 0,(x,y,z),dp; |
---|
886 | ideal m = maxideal(1); |
---|
887 | product(m); |
---|
888 | matrix M[2][3] = 1,x,2,y,3,z; |
---|
889 | product(M); |
---|
890 | intvec v=2,4,6; |
---|
891 | product(M,v); |
---|
892 | intvec iv = 1,2,3,4,5,6,7,8,9; |
---|
893 | v=1..5,7,9; |
---|
894 | product(iv,v); |
---|
895 | intmat A[2][3] = 1,1,1,2,2,2; |
---|
896 | product(A,3..5); |
---|
897 | } |
---|
898 | /////////////////////////////////////////////////////////////////////////////// |
---|
899 | |
---|
900 | proc ringsum (list #) |
---|
901 | USAGE: ringsum(r1,r2,...,s); r1,r2,... rings, s string (name of result ring) |
---|
902 | CREATE: A new base ring with name equal to s if r1,r2,... are existing rings. |
---|
903 | If, say, s = "R" and the rings r1,r2,... exist, the new ring will |
---|
904 | have name R, variables from all rings r1,r2,... and as monomial |
---|
905 | ordering the block (product) ordering of r1,r2,.... Mathematically, R |
---|
906 | is the tensor product of the rings r1,r2,... with ordering matrix |
---|
907 | equal to the direct sum of the ordering matrices of r1,r2,... |
---|
908 | RETURN: no return value |
---|
909 | NOTE: The characteristic of the new ring will be that of r1. The names of |
---|
910 | variables in the rings r1,r2,... should differ (if a name, say x, |
---|
911 | occurs in r1 and r2, then, in the new ring r, x always refers to the |
---|
912 | variable with name x in r1, there is no access to x in r2). |
---|
913 | The procedure works also for quotient rings. |
---|
914 | EXAMPLE: example ringsum; shows an example |
---|
915 | { |
---|
916 | int ii,q; |
---|
917 | int n = size(#); |
---|
918 | string vars,order,oi,s; |
---|
919 | for(ii=1; ii<=n-1; ii++) |
---|
920 | { |
---|
921 | if( ordstr(#[ii])[1]=="C" or ordstr(#[ii])[1]=="c" ) |
---|
922 | { oi=ordstr(#[ii])[3,size(ordstr(#[ii]))-2]; } |
---|
923 | else { oi=ordstr(#[ii])[1,size(ordstr(#[ii]))-2]; } |
---|
924 | vars = vars+varstr(#[ii])+","; |
---|
925 | order= order+oi+","; |
---|
926 | def r(ii)=#[ii]; |
---|
927 | setring r(ii); |
---|
928 | ideal i(ii)=ideal(r(ii)); |
---|
929 | int q(ii)=size(i(ii)); |
---|
930 | q=q+q(ii); |
---|
931 | } |
---|
932 | if( q!=0 ) { s = "newr"; } |
---|
933 | else { s = #[size(#)]; } |
---|
934 | string newring ="=("+charstr(#[1])+"),("+vars[1,size(vars)-1]+"),(" |
---|
935 | +order[1,size(order)-1]+");"; |
---|
936 | execute("ring "+s+newring); |
---|
937 | if( q!=0 ) |
---|
938 | { |
---|
939 | ideal i; |
---|
940 | for(ii=1; ii<=n-1; ii++) |
---|
941 | { |
---|
942 | if( q(ii)!=0 ) |
---|
943 | { |
---|
944 | map phi = r(ii),maxideal(1); |
---|
945 | i = i+phi(i(ii)); |
---|
946 | kill phi; |
---|
947 | } |
---|
948 | } |
---|
949 | i=std(i); |
---|
950 | execute("qring "+#[size(#)]+"=i;"); |
---|
951 | } |
---|
952 | export(`#[size(#)]`); |
---|
953 | keepring(`#[size(#)]`); |
---|
954 | return(); |
---|
955 | } |
---|
956 | example |
---|
957 | { "EXAMPLE:"; echo = 2; |
---|
958 | ring r=0,(x,y,u,v),dp; |
---|
959 | ring s=32003,(a,b,c),wp(1,2,3); |
---|
960 | ring t=37,x(1..5),(c,ls); |
---|
961 | ringsum(r,s,t,"R"); |
---|
962 | type R; |
---|
963 | setring s; |
---|
964 | ideal i = a2+b3+c5; i=std(i); |
---|
965 | qring qs =i; |
---|
966 | setring s; qring qt=i; |
---|
967 | ringsum(r,qs,t,qt,"Q"); |
---|
968 | type Q; |
---|
969 | kill R,Q; |
---|
970 | } |
---|
971 | /////////////////////////////////////////////////////////////////////////////// |
---|
972 | |
---|
973 | proc ringweights (r) |
---|
974 | USAGE: ringweights(r); r ring |
---|
975 | RETURN: intvec of weights of ring variables. If, say, x(1),...,x(n) are the |
---|
976 | variables of the ring r, in this order, the resulting intvec is |
---|
977 | deg(x(1)),...,deg(x(n)) where deg denotes the weighted degree if |
---|
978 | the monomial ordering of r has only one block of type ws,Ws,wp or Wp. |
---|
979 | NOTE: In all other cases, in particular if there is more than one block, |
---|
980 | the resulting intvec is 1,...,1 |
---|
981 | EXAMPLE: example ringweights; shows an example |
---|
982 | { |
---|
983 | int i; intvec v; setring r; |
---|
984 | for (i=1; i<=nvars(basering); i++) { v[i] = deg(var(i)); } |
---|
985 | return(v); |
---|
986 | } |
---|
987 | example |
---|
988 | { "EXAMPLE:"; echo = 2; |
---|
989 | ring r1=32003,(x,y,z),wp(1,2,3); |
---|
990 | ring r2=32003,(x,y,z),Ws(1,2,3); |
---|
991 | ring r=0,(x,y,u,v),lp; |
---|
992 | intvec vr=ringweights(r1); vr; |
---|
993 | ringweights(r2); |
---|
994 | ringweights(r); |
---|
995 | } |
---|
996 | /////////////////////////////////////////////////////////////////////////////// |
---|
997 | |
---|
998 | proc sort |
---|
999 | USAGE: sort(id); id ideal or module |
---|
1000 | RETURN: ideal with generators of id sorted with respect to monomial ordering |
---|
1001 | of the basering (generators with smaller leading term come first) |
---|
1002 | EXAMPLE: example sort; shows an example |
---|
1003 | { |
---|
1004 | intvec v = sortvec(#[1]); |
---|
1005 | int s = size(v); |
---|
1006 | def m = #[1]; |
---|
1007 | for (int jj=1;jj<=s;jj++) { m[jj] = #[1][v[jj]]; } |
---|
1008 | return(m); |
---|
1009 | } |
---|
1010 | example |
---|
1011 | { "EXAMPLE:"; echo = 2; |
---|
1012 | ring r0 = 0,(x,y,z),lp; |
---|
1013 | ideal i = x3,y3,z3,x2z,x2y,y2z,y2x,z2y,z2x,xyz; |
---|
1014 | sort(i); |
---|
1015 | ring r1 = 0,t,ls; |
---|
1016 | ideal i = t47,t14,t6; |
---|
1017 | ideal j = i; |
---|
1018 | int ii; |
---|
1019 | for (ii=1;ii<=8;ii=ii+1) { j=simplify(jet(j+i^ii,50),6); } |
---|
1020 | print (matrix(j)); |
---|
1021 | print (matrix(sort(j))); |
---|
1022 | } |
---|
1023 | /////////////////////////////////////////////////////////////////////////////// |
---|
1024 | |
---|
1025 | proc sum (id, list #) |
---|
1026 | USAGE: sum(id[,v]); id=ideal/vector/module/matrix resp. id=intvec/intmat, |
---|
1027 | v=intvec (e.g. v=1..n, n=integer) |
---|
1028 | RETURN: poly resp. int which is the sum of all entries of id, with index |
---|
1029 | given by v (default: v=1..number of entries of id) |
---|
1030 | NOTE: id is treated as a list of polys resp. integers. A module m is |
---|
1031 | identified with corresponding matrix M (columns of M generate m) |
---|
1032 | EXAMPLE: example sum; shows an example |
---|
1033 | { |
---|
1034 | if( typeof(id)=="poly" or typeof(id)=="ideal" or typeof(id)=="vector" |
---|
1035 | or typeof(id)=="module" or typeof(id)=="matrix" ) |
---|
1036 | { |
---|
1037 | ideal i = ideal(matrix(id)); |
---|
1038 | if( size(#)!=0 ) { i = i[#[1]]; } |
---|
1039 | matrix Z = matrix(i); |
---|
1040 | intvec v; v[ncols(Z)]=0; v=v+1; |
---|
1041 | } |
---|
1042 | if( typeof(id)=="int" or typeof(id)=="intvec" or typeof(id)=="intmat" ) |
---|
1043 | { |
---|
1044 | intmat S = intmat(id); |
---|
1045 | intvec v = S[1..nrows(S),1..ncols(S)]; |
---|
1046 | if( size(#)!=0 ) { v = v[#[1]]; } |
---|
1047 | intvec z; z[size(v)]=0; z=z+1; |
---|
1048 | intmat Z=transpose(z); |
---|
1049 | } |
---|
1050 | return((Z*v)[1,1]); |
---|
1051 | } |
---|
1052 | example |
---|
1053 | { "EXAMPLE:"; echo = 2; |
---|
1054 | ring r= 0,(x,y,z),dp; |
---|
1055 | vector pv = [xy,xz,yz,x2,y2,z2]; |
---|
1056 | sum(pv); |
---|
1057 | sum(pv,2..5); |
---|
1058 | matrix M[2][3] = 1,x,2,y,3,z; |
---|
1059 | sum(M); |
---|
1060 | intvec v=2,4,6; |
---|
1061 | sum(M,v); |
---|
1062 | intvec iv = 1,2,3,4,5,6,7,8,9; |
---|
1063 | v=1..5,7,9; |
---|
1064 | sum(iv,v); |
---|
1065 | intmat m[2][3] = 1,1,1,2,2,2; |
---|
1066 | sum(m,3..4); |
---|
1067 | } |
---|
1068 | /////////////////////////////////////////////////////////////////////////////// |
---|