1 | // (GMG/BM, last modified 22.06.96) |
---|
2 | /////////////////////////////////////////////////////////////////////////////// |
---|
3 | version="$Id$"; |
---|
4 | category="General purpose"; |
---|
5 | info=" |
---|
6 | LIBRARY: inout.lib Printing and Manipulating In- and Output |
---|
7 | |
---|
8 | PROCEDURES: |
---|
9 | allprint(list); print list if ALLprint is defined, with pause if >0 |
---|
10 | lprint(poly/...[,n]); display poly/... fitting to pagewidth [size n] |
---|
11 | pmat(matrix[,n]); print form-matrix [first n chars of each colum] |
---|
12 | rMacaulay(string); read Macaulay_1 output and return its @sc{Singular} format |
---|
13 | show(any); display any object in a compact format |
---|
14 | showrecursive(id,p); display id recursively with respect to variables in p |
---|
15 | split(string,n); split given string into lines of length n |
---|
16 | tab(n); string of n space tabs |
---|
17 | pause([prompt]); stop the computation until user input |
---|
18 | (parameters in square brackets [] are optional) |
---|
19 | "; |
---|
20 | |
---|
21 | /////////////////////////////////////////////////////////////////////////////// |
---|
22 | |
---|
23 | proc allprint (list #) |
---|
24 | "USAGE: allprint(L); L list |
---|
25 | DISPLAY: prints L[1], L[2], ... if an integer with name ALLprint is defined. |
---|
26 | @* makes \"pause\", if ALLprint > 0 |
---|
27 | RETURN: no return value |
---|
28 | EXAMPLE: example allprint; shows an example |
---|
29 | " |
---|
30 | { |
---|
31 | if( defined(ALLprint) ) |
---|
32 | { |
---|
33 | int i; |
---|
34 | for( i=1; i<=size(#); i=i+1 ) { print(#[i]); } |
---|
35 | if( ALLprint >0 ) { pause(); } |
---|
36 | } |
---|
37 | return(); |
---|
38 | } |
---|
39 | example |
---|
40 | { "EXAMPLE:"; echo = 2; |
---|
41 | ring S; |
---|
42 | matrix M=matrix(freemodule(2),3,3); |
---|
43 | int ALLprint; export ALLprint; |
---|
44 | allprint("M =",M); |
---|
45 | kill ALLprint; |
---|
46 | } |
---|
47 | /////////////////////////////////////////////////////////////////////////////// |
---|
48 | |
---|
49 | proc lprint |
---|
50 | "USAGE: lprint(id[,n]); id poly/ideal/vector/module/matrix, n integer |
---|
51 | RETURN: string of id in a format fitting into lines of size n, such that no |
---|
52 | monomial gets destroyed, i.e. the new line starts with + or -; |
---|
53 | (default: n = pagewidth). |
---|
54 | NOTE: id is printed columnwise, each column separated by a blank line; |
---|
55 | hence lprint(transpose(id)); displays a matrix id in a format which |
---|
56 | can be used as input. |
---|
57 | EXAMPLE: example lprint; shows an example |
---|
58 | " |
---|
59 | { |
---|
60 | if (size(#)==1) { int n = pagewidth-3; } |
---|
61 | else {int n = #[2]-3; } |
---|
62 | matrix M = matrix(#[1]); |
---|
63 | poly p,h,L; string s1,s,S; int jj,ii,a; |
---|
64 | for (jj=1; jj<=ncols(M); jj=jj+1) |
---|
65 | { |
---|
66 | for (ii=1; ii<=nrows(M); ii=ii+1) |
---|
67 | { |
---|
68 | a=2; |
---|
69 | if (a+size(string(M[ii,jj])) <= n) {s = " "+string(M[ii,jj]);} |
---|
70 | else |
---|
71 | { |
---|
72 | h = lead(M[ii,jj]); p = M[ii,jj] - h; L = lead(p); |
---|
73 | while (p != 0) |
---|
74 | { |
---|
75 | if (a+size(string(h+L)) > n) |
---|
76 | { |
---|
77 | s = string(h); |
---|
78 | if (a != 0) { s = " "+s; } |
---|
79 | if (a == 0 and s[1] != "-") { s = "+" + s; } |
---|
80 | a=0; h=0; S=S+newline+s; |
---|
81 | } |
---|
82 | h = h + L; p = p - L; L = lead(p); |
---|
83 | } |
---|
84 | s = string(h); |
---|
85 | if (a == 0 and s[1] != "-") { s = "+" + s; } |
---|
86 | } |
---|
87 | if (ii != nrows(M)) { s = s+","; S=S+newline+s; } |
---|
88 | else |
---|
89 | { |
---|
90 | if (jj != ncols(M)) { s = s+","; S=S+newline+s+newline;} |
---|
91 | else { S=S+newline+s; } |
---|
92 | } |
---|
93 | } |
---|
94 | } |
---|
95 | return(S[2,size(S)-1]); |
---|
96 | } |
---|
97 | example |
---|
98 | { "EXAMPLE:"; echo = 2; |
---|
99 | ring r= 0,(x,y,z),ds; |
---|
100 | poly f=((x+y)*(x-y)*(x+z)*(y+z)^2); |
---|
101 | lprint(f,40); |
---|
102 | module m = [f*(x-y)],[0,f*(x-y)]; |
---|
103 | string s=lprint(m); s;""; |
---|
104 | execute("matrix M[2][2]="+s+";"); //use the string s as input |
---|
105 | module m1 = transpose(M); //should be the same as m |
---|
106 | print(matrix(m)-matrix(m1)); |
---|
107 | } |
---|
108 | /////////////////////////////////////////////////////////////////////////////// |
---|
109 | |
---|
110 | proc pmat (matrix m, list #) |
---|
111 | "USAGE: pmat(M[,n]); M matrix, n integer |
---|
112 | RETURN: A string representing M in array format if it fits into |
---|
113 | pagewidth; if n is given, only the first n characters of |
---|
114 | each column are shown (n>1 required), where a truncation |
---|
115 | of a column is indicated by two dots (\'..\') |
---|
116 | EXAMPLE: example pmat; shows an example |
---|
117 | " |
---|
118 | { |
---|
119 | //------------- main case: input is a matrix, no second argument--------------- |
---|
120 | string OUT = ""; |
---|
121 | if ( size(#)==0) |
---|
122 | { |
---|
123 | int elems,mlen,slen,c,r; |
---|
124 | //-------------- count maximal size of each column, and sum up ------------- |
---|
125 | for ( c=1; c<=ncols(m); c=c+1) |
---|
126 | { int len(c); |
---|
127 | for (r=1; r<=nrows(m); r=r+1) |
---|
128 | { |
---|
129 | elems = elems+1; |
---|
130 | string s(elems) = string(m[r,c])+","; |
---|
131 | slen = size(s(elems)); |
---|
132 | if ( slen>len(c) ) { len(c) = slen; } |
---|
133 | } |
---|
134 | mlen = mlen+len(c); |
---|
135 | } |
---|
136 | //---------------------- print all - except last - rows -------------------- |
---|
137 | string aus; string sep = " "; |
---|
138 | if (mlen >= pagewidth) { sep = newline; } |
---|
139 | for (r=1; r<nrows(m); r=r+1) |
---|
140 | { elems = r; aus = ""; |
---|
141 | for (c=1; c<=ncols(m); c=c+1) |
---|
142 | { |
---|
143 | aus = aus + s(elems)[1,len(c)] + sep; |
---|
144 | elems = elems + nrows(m); |
---|
145 | } |
---|
146 | OUT=OUT+aus+newline; |
---|
147 | } |
---|
148 | //--------------- print last row (no comma after last entry) --------------- |
---|
149 | aus = ""; elems = nrows(m); |
---|
150 | for (c=1; c<ncols(m); c=c+1) |
---|
151 | { |
---|
152 | aus = aus + s(elems)[1,len(c)] + sep; |
---|
153 | elems = elems + nrows(m); |
---|
154 | } |
---|
155 | aus = aus + string(m[nrows(m),ncols(m)]); |
---|
156 | OUT=OUT+aus; return(OUT); |
---|
157 | } |
---|
158 | //---------- second case: second argument is given and of type int ------------ |
---|
159 | if ( typeof(#[1])=="int" and #[1]>1) |
---|
160 | { string aus,tmp; int c,r; |
---|
161 | //---------------------- print all - except last - rows -------------------- |
---|
162 | for ( r=1; r<nrows(m); r=r+1) |
---|
163 | { aus = ""; |
---|
164 | for (c=1; c<=ncols(m); c=c+1) |
---|
165 | { |
---|
166 | tmp=string(m[r,c]); |
---|
167 | if (size(tmp)>#[1]) |
---|
168 | { tmp[#[1]-1]="."; |
---|
169 | tmp[#[1]] ="."; |
---|
170 | aus=aus+tmp[1,#[1]]+", "; |
---|
171 | } |
---|
172 | else |
---|
173 | { tmp=tmp+","; |
---|
174 | aus=aus+tmp[1,#[1]+1]+" "; |
---|
175 | } |
---|
176 | } |
---|
177 | OUT=OUT+aus+newline; |
---|
178 | } |
---|
179 | //--------------- print last row (no comma after last entry) --------------- |
---|
180 | aus = ""; |
---|
181 | for (c=1; c<ncols(m); c=c+1) |
---|
182 | { tmp=string(m[r,c]); |
---|
183 | if (size(tmp)>#[1]) |
---|
184 | { tmp[#[1]-1]="."; |
---|
185 | tmp[#[1]] ="."; |
---|
186 | aus=aus+tmp[1,#[1]]+", "; |
---|
187 | } |
---|
188 | else |
---|
189 | { tmp=tmp+","; |
---|
190 | aus=aus+tmp[1,#[1]+1]+" "; |
---|
191 | } |
---|
192 | } |
---|
193 | tmp=string(m[nrows(m),ncols(m)]); |
---|
194 | if (size(tmp)>#[1]) |
---|
195 | { tmp[#[1]-1]="."; |
---|
196 | tmp[#[1]] ="."; |
---|
197 | } |
---|
198 | aus = aus + tmp[1,#[1]]; |
---|
199 | OUT=OUT+aus; return(OUT); |
---|
200 | } |
---|
201 | } |
---|
202 | example |
---|
203 | { "EXAMPLE:"; echo = 2; |
---|
204 | ring r=0,(x,y,z),ls; |
---|
205 | ideal i= x,z+3y,x+y,z; |
---|
206 | matrix m[3][3]=i^2; |
---|
207 | pmat(m); |
---|
208 | pmat(m,5); |
---|
209 | } |
---|
210 | /////////////////////////////////////////////////////////////////////////////// |
---|
211 | |
---|
212 | proc rMacaulay |
---|
213 | "USAGE: rMacaulay(s[,n]); s string, n integer |
---|
214 | RETURN: A string denoting a file which should be readable by Singular |
---|
215 | and it should be produced by Macaulay Classic. |
---|
216 | If a second argument is present the first |
---|
217 | n lines of the file are deleted (which is useful if the file was |
---|
218 | produced e.g. by the putstd command of Macaulay). |
---|
219 | NOTE: This does not always work with 'cut and paste' since the character |
---|
220 | \ is treated differently |
---|
221 | EXAMPLE: example rMacaulay; shows an example |
---|
222 | " |
---|
223 | { |
---|
224 | int n; |
---|
225 | if( size(#)==2 ) { n=#[2]; } |
---|
226 | string s0 = #[1]; |
---|
227 | //------------------------ delete first n=#[2] lines -------------------------- |
---|
228 | int ii=find(s0,newline); int jj; |
---|
229 | for ( jj=1; jj<=n; jj=jj+1) |
---|
230 | { |
---|
231 | s0 = s0[ii+1,size(s0)-ii]; |
---|
232 | ii = find(s0,newline); |
---|
233 | } |
---|
234 | //--------------- delete blanks and 'newline' at start and end ---------------- |
---|
235 | ii = 1; |
---|
236 | while( s0[ii]==" " or s0[ii]==newline ) { ii=ii+1; } |
---|
237 | s0 = s0[ii,size(s0)-ii+1]; ii = size(s0); |
---|
238 | while ( s0[ii]==" " or s0[ii]==newline) { ii=ii-1; } |
---|
239 | s0 = s0[1,ii]; |
---|
240 | //------------------------- make each line a string --------------------------- |
---|
241 | ii = find(s0,newline); jj=0; int kk; |
---|
242 | while( ii!=0 ) |
---|
243 | { jj = jj+1; kk = ii+1; |
---|
244 | while( s0[kk]==" " or s0[kk]==newline ) { kk=kk+1; } |
---|
245 | string s(jj) = s0[1,ii-1]; |
---|
246 | s0 = s0[kk,size(s0)-kk+1]; |
---|
247 | ii = find(s0,newline); |
---|
248 | } |
---|
249 | jj=jj+1; |
---|
250 | string s(jj) = s0; |
---|
251 | //------------ delete blanks and \ at end of each string and add , ------------ |
---|
252 | for( ii=1; ii<=jj; ii=ii+1 ) |
---|
253 | { kk = 1; |
---|
254 | while( s(ii)[kk]==" " ) { kk=kk+1; } |
---|
255 | s(ii) = s(ii)[kk,size(s(ii))-kk+1]; |
---|
256 | kk = size(s(ii)); |
---|
257 | while( s(ii)[kk]==" " or s(ii)[kk]=="\\" or s(ii)[kk]==newline ) |
---|
258 | { kk = kk-1; } |
---|
259 | s(ii) = s(ii)[1,kk]+","+newline; |
---|
260 | } |
---|
261 | //------------------------ replace blanks by , and add up --------------------- |
---|
262 | int ll; s0 = ""; string s1,s2; |
---|
263 | for( ii=1; ii<=jj; ii=ii+1 ) |
---|
264 | { |
---|
265 | s1 = ""; s2 = s(ii); |
---|
266 | kk = find(s(ii)," "); ll=kk+1; |
---|
267 | while( kk!=0 ) |
---|
268 | { |
---|
269 | while( s2[ll]==" ") { ll=ll+1; } |
---|
270 | if( kk!=1 ) { s1=s1+s2[1,kk-1]+","+s2[kk+1,ll-kk]; } |
---|
271 | if( kk==1 ) { s1 = s1+","+s2[kk+1,ll-kk]; } |
---|
272 | s2 = s2[ll+1,size(s2)-ll]; |
---|
273 | kk = find(s2," "); ll=kk+1; |
---|
274 | } |
---|
275 | s(ii) = s1+s2; s0 = s0+s(ii); |
---|
276 | } |
---|
277 | //---------------------------- replace [] by () ------------------------------- |
---|
278 | s1 = ""; s2 = s0; |
---|
279 | ii = find(s2,"["); |
---|
280 | while( ii!=0 ) |
---|
281 | { |
---|
282 | s0 = s0[1,ii-1]+"("+s0[ii+1,size(s0)-ii]; |
---|
283 | if( ii>2 ) |
---|
284 | { |
---|
285 | if(s0[ii-2]!="+" and s0[ii-2]!="-" and s0[ii-2]!="," and s0[ii-2]!=newline) |
---|
286 | { |
---|
287 | s0 = s0[1,ii-2]+"*"+s0[ii-1,size(s0)-ii+2]; |
---|
288 | } |
---|
289 | } |
---|
290 | ii = find(s0,"["); |
---|
291 | } |
---|
292 | jj = find(s0,"]"); |
---|
293 | while ( jj!=0 ) |
---|
294 | { |
---|
295 | s0 = s0[1,jj-1]+")"+s0[jj+1,size(s0)-jj]; |
---|
296 | if(s0[jj+1]!="+"and s0[jj+1]!="-" and s0[jj+1]!="," and s0[jj+1]!="*") |
---|
297 | { s0 = s0[1,jj] + "^" + s0[jj+1,size(s0)-jj]; } |
---|
298 | jj = find(s0,"]"); |
---|
299 | } |
---|
300 | s0 = s0[1,size(s0)-2]; |
---|
301 | return(s0); |
---|
302 | } |
---|
303 | example |
---|
304 | { "EXAMPLE:"; echo = 2; |
---|
305 | // Assume there exists a file 'Macid' with the following ideal in |
---|
306 | // Macaulay format:" |
---|
307 | // x[0]3-101/74x[0]2x[1]+7371x[0]x[1]2-13/83x[1]3-x[0]2x[2] \ |
---|
308 | // -4/71x[0]x[1]x[2] |
---|
309 | // Read this file into Singular and assign it to the string s1 by: |
---|
310 | // string s1 = read("Macid"); |
---|
311 | // This is equivalent to"; |
---|
312 | string s1 = |
---|
313 | "x[0]3-101/74x[0]2x[1]+7371x[0]x[1]2-13/83x[1]3-x[0]2x[2]-4/71x[0]x[1]x[2]"; |
---|
314 | rMacaulay(s1); |
---|
315 | // You may wish to assign s1 to a Singular ideal id: |
---|
316 | string sid = "ideal id =",rMacaulay(s1),";"; |
---|
317 | ring r = 0,x(0..3),dp; |
---|
318 | execute(sid); |
---|
319 | id; ""; |
---|
320 | // Now treat a matrix in Macaulay format. Using the execute |
---|
321 | // command, this could be assinged to a Singular matrix as above. |
---|
322 | string s2 = " |
---|
323 | 0 0 0 0 0 |
---|
324 | a3 0 0 0 0 |
---|
325 | 0 b3 0 0 0 |
---|
326 | 0 0 c3 0 0 |
---|
327 | 0 0 0 d3 0 |
---|
328 | 0 0 0 0 e3 "; |
---|
329 | rMacaulay(s2); |
---|
330 | } |
---|
331 | |
---|
332 | /////////////////////////////////////////////////////////////////////////////// |
---|
333 | |
---|
334 | proc show (@@id, list #) |
---|
335 | "USAGE: show(id); id any object of basering or of type ring/qring |
---|
336 | @* show(R,s); R=ring, s=string (s = name of an object belonging to R) |
---|
337 | DISPLAY: display id/s in a compact format together with some information |
---|
338 | RETURN: no return value |
---|
339 | NOTE: objects of type string, int, intvec, intmat belong to any ring. |
---|
340 | id may be a ring or a qring. In this case the minimal polynomial is |
---|
341 | displayed, and, for a qring, also the defining ideal. |
---|
342 | id may be of type list but the list must not contain a ring. |
---|
343 | @* show(R,s) does not work inside a procedure! |
---|
344 | EXAMPLE: example show; shows an example |
---|
345 | " |
---|
346 | { |
---|
347 | //------------- use funny names in order to avoid name conflicts -------------- |
---|
348 | int @li@, @ii; |
---|
349 | string @s@,@@s; |
---|
350 | int @short@=short; short=1; |
---|
351 | //----------------------------- check syntax ---------------------------------- |
---|
352 | if( size(#)!= 0 ) |
---|
353 | { |
---|
354 | if( typeof(#[1])=="int" ) { @li@=#[1]; } |
---|
355 | } |
---|
356 | if ( typeof(@@id)!="list" ) |
---|
357 | { |
---|
358 | if( size(#)==0 ) |
---|
359 | { |
---|
360 | def @id@ = @@id; |
---|
361 | } |
---|
362 | if( size(#)==1 ) |
---|
363 | { |
---|
364 | if( typeof(#[1])=="int" ) |
---|
365 | { |
---|
366 | def @id@ = @@id; |
---|
367 | } |
---|
368 | if( typeof(#[1])=="string" ) |
---|
369 | { |
---|
370 | if( typeof(@@id)=="ring" or typeof(@@id)=="qring") |
---|
371 | { |
---|
372 | def @R@ = @@id; |
---|
373 | setring @R@; |
---|
374 | def @id@=`#[1]`; |
---|
375 | } |
---|
376 | } |
---|
377 | } |
---|
378 | } |
---|
379 | //----------------------- case: @@id is of type list ---------------------------- |
---|
380 | if ( typeof(@@id)=="list" ) |
---|
381 | { |
---|
382 | // @@s = tab(@li@)+"// list, "+string(size(@@id))+" element(s):"; |
---|
383 | @@s = tab((3*(voice-2)))+"// list, "+string(size(@@id))+" element(s):"; |
---|
384 | @@s; |
---|
385 | for ( @ii=1; @ii<=size(@@id); @ii++ ) |
---|
386 | { |
---|
387 | if( typeof(@@id[@ii])!="none" ) |
---|
388 | { |
---|
389 | def @id(@ii) = @@id[@ii]; |
---|
390 | tab(3*(voice-2))+"["+string(@ii)+"]:"; |
---|
391 | // show(@id(@ii),@li@+3*(voice-1)); |
---|
392 | show(@id(@ii),3*(voice-1)); |
---|
393 | } |
---|
394 | else |
---|
395 | { |
---|
396 | "["+string(@ii)+"]:"; |
---|
397 | tab(@li@+2),"//",@@id[@ii]; |
---|
398 | } |
---|
399 | } |
---|
400 | short=@short@; return(); |
---|
401 | } |
---|
402 | if( defined(@id@)!=voice ) { "// wrong syntax, type help show;"; return();} |
---|
403 | //-------------------- case: @id@ belongs to any ring ------------------------- |
---|
404 | if( typeof(@id@)=="string" or typeof(@id@)=="int" or typeof(@id@)=="intvec" |
---|
405 | or typeof(@id@)=="intmat" or typeof(@id@)=="list" ) |
---|
406 | { |
---|
407 | if( typeof(@id@)!="intmat" ) |
---|
408 | { |
---|
409 | @@s = tab(@li@)+"// "+typeof(@id@)+", size "+string(size(@id@)); |
---|
410 | @@s; |
---|
411 | } |
---|
412 | if( typeof(@id@)=="intmat" ) |
---|
413 | { |
---|
414 | @@s = tab(@li@)+"// "+typeof(@id@)+", "+string(nrows(@id@))+" rows, " |
---|
415 | + string(ncols(@id@))+" columns"; |
---|
416 | @@s; |
---|
417 | } |
---|
418 | @id@; |
---|
419 | short=@short@; return(); |
---|
420 | } |
---|
421 | //-------------------- case: @id@ belongs to basering ------------------------- |
---|
422 | if( typeof(@id@)=="poly" or typeof(@id@)=="ideal" or typeof(@id@)=="matrix" ) |
---|
423 | { |
---|
424 | @@s = tab(@li@)+"// "+ typeof(@id@); |
---|
425 | if( typeof(@id@)=="ideal" ) |
---|
426 | { |
---|
427 | @@s=@@s + ", "+string(ncols(@id@))+" generator(s)"; |
---|
428 | @@s; |
---|
429 | print(ideal(@id@)); |
---|
430 | } |
---|
431 | if( typeof(@id@)=="poly" ) |
---|
432 | { |
---|
433 | @@s=@@s + ", "+string(size(@id@))+" monomial(s)"; |
---|
434 | @@s; |
---|
435 | print(poly(@id@)); |
---|
436 | } |
---|
437 | if( typeof(@id@)=="matrix") |
---|
438 | { |
---|
439 | @@s=@@s + ", "+string(nrows(@id@))+"x"+string(ncols(@id@)); |
---|
440 | @@s; |
---|
441 | print(matrix(@id@)); |
---|
442 | } |
---|
443 | short=@short@; return(); |
---|
444 | } |
---|
445 | if( typeof(@id@)=="vector" ) |
---|
446 | { |
---|
447 | @@s = tab(@li@)+"// "+typeof(@id@); |
---|
448 | @@s; |
---|
449 | print(@id@); |
---|
450 | short=@short@; return(); |
---|
451 | } |
---|
452 | if( typeof(@id@)=="module" ) |
---|
453 | { |
---|
454 | @s@=", "+string(ncols(@id@))+" generator(s)"; |
---|
455 | @@s = tab(@li@)+"// "+ typeof(@id@)+ @s@; |
---|
456 | @@s; |
---|
457 | int @n@; |
---|
458 | for( @n@=1; @n@<=ncols(@id@); @n@=@n@+1 ) { print(@id@[@n@]); } |
---|
459 | short=@short@; return(); |
---|
460 | } |
---|
461 | if( typeof(@id@)=="number" or typeof(@id@)=="resolution" ) |
---|
462 | { |
---|
463 | @@s = tab(@li@)+"// ", typeof(@id@); |
---|
464 | @@s; |
---|
465 | @id@; short=@short@; return(); |
---|
466 | } |
---|
467 | if( typeof(@id@)=="map" ) |
---|
468 | { |
---|
469 | def @map = @id@; |
---|
470 | @@s = tab(@li@)+"// i-th variable of preimage ring is mapped to @map[i]"; |
---|
471 | @@s; |
---|
472 | if( size(#)==0 ) { type @map; } |
---|
473 | if( size(#)==1 ) |
---|
474 | { |
---|
475 | if( typeof(#[1])=="int" ) { type @map; } |
---|
476 | if( typeof(#[1])=="string" ) { type `#[1]`; } |
---|
477 | } |
---|
478 | short=@short@; return(); |
---|
479 | } |
---|
480 | //---------------------- case: @id@ is a ring/qring --------------------------- |
---|
481 | if( typeof(@id@)=="ring" or typeof(@id@)=="qring" ) |
---|
482 | { |
---|
483 | setring @id@; |
---|
484 | string s="("+charstr(@id@)+"),("+varstr(@id@)+"),("+ordstr(@id@)+");"; |
---|
485 | if( typeof(@id@)=="ring" ) |
---|
486 | { |
---|
487 | list na@me@s=names(@id@); |
---|
488 | kill @id@; |
---|
489 | @@s = tab(@li@)+"// ring:"; @@s,s; |
---|
490 | @@s = tab(@li@)+"// minpoly ="; @@s,minpoly; |
---|
491 | "// objects belonging to this ring:"; |
---|
492 | listvar(poly);listvar(ideal); |
---|
493 | listvar(vector);listvar(module); |
---|
494 | listvar(map);listvar(matrix); |
---|
495 | listvar(number);listvar(resolution); |
---|
496 | for(int names@i=1;names@i<=size(na@me@s);names@i++) |
---|
497 | { |
---|
498 | def @hi@lf@=`na@me@s[names@i]`; |
---|
499 | if ((typeof(@hi@lf@)!="poly") and |
---|
500 | (typeof(@hi@lf@)!="ideal") and |
---|
501 | (typeof(@hi@lf@)!="vector") and |
---|
502 | (typeof(@hi@lf@)!="module") and |
---|
503 | (typeof(@hi@lf@)!="map") and |
---|
504 | (typeof(@hi@lf@)!="matrix") and |
---|
505 | (typeof(@hi@lf@)!="number") and |
---|
506 | (typeof(@hi@lf@)!="resolution")) |
---|
507 | { |
---|
508 | listvar(`na@me@s[names@i]`); |
---|
509 | } |
---|
510 | kill @hi@lf@; |
---|
511 | } |
---|
512 | } |
---|
513 | if( typeof(@id@)=="qring" ) |
---|
514 | { |
---|
515 | list na@me@s=names(@id@); |
---|
516 | @@s = tab(@li@)+"// qring:"; @@s,s; |
---|
517 | @@s = tab(@li@)+"// minpoly ="; @@s, minpoly; |
---|
518 | @@s = tab(@li@)+"// quotient ring from ideal:"; @@s; |
---|
519 | ideal(@id@); |
---|
520 | listvar(poly);listvar(ideal); |
---|
521 | listvar(vector);listvar(module); |
---|
522 | listvar(map);listvar(matrix); |
---|
523 | listvar(number);listvar(resolution); |
---|
524 | for(int names@i=1;names@i<=size(na@me@s);names@i++) |
---|
525 | { |
---|
526 | def @hi@lf@=`na@me@s[names@i]`; |
---|
527 | if ((typeof(@hi@lf@)!="poly") and |
---|
528 | (typeof(@hi@lf@)!="ideal") and |
---|
529 | (typeof(@hi@lf@)!="vector") and |
---|
530 | (typeof(@hi@lf@)!="module") and |
---|
531 | (typeof(@hi@lf@)!="map") and |
---|
532 | (typeof(@hi@lf@)!="matrix") and |
---|
533 | (typeof(@hi@lf@)!="number") and |
---|
534 | (typeof(@hi@lf@)!="resolution")) |
---|
535 | { |
---|
536 | listvar(`na@me@s[names@i]`); |
---|
537 | } |
---|
538 | kill @hi@lf@; |
---|
539 | } |
---|
540 | } |
---|
541 | short=@short@; //return(); |
---|
542 | } |
---|
543 | } |
---|
544 | example |
---|
545 | { "EXAMPLE:"; echo = 2; |
---|
546 | ring r; |
---|
547 | show(r); |
---|
548 | ideal i=x^3+y^5-6*z^3,xy,x3-y2; |
---|
549 | show(i,3); // introduce 3 space tabs before information |
---|
550 | vector v=x*gen(1)+y*gen(3); |
---|
551 | module m=v,2*v+gen(4); |
---|
552 | list L = i,v,m; |
---|
553 | show(L); |
---|
554 | ring S=(0,T),(a,b,c,d),ws(1,2,3,4); |
---|
555 | minpoly = T^2+1; |
---|
556 | ideal i=a2+b,c2+T^2*d2; i=std(i); |
---|
557 | qring Q=i; |
---|
558 | show(Q); |
---|
559 | map F=r,a2,b^2,3*c3; |
---|
560 | show(F); |
---|
561 | // Apply 'show' to i (which does not belong to the basering) by typing |
---|
562 | // ring r; ideal i=xy,x3-y2; ring Q; show(r,"i"); |
---|
563 | } |
---|
564 | /////////////////////////////////////////////////////////////////////////////// |
---|
565 | |
---|
566 | proc showrecursive (@@id,poly p,list #) |
---|
567 | "USAGE: showrecursive(id,p[,ord]); id any object of basering, p= product of |
---|
568 | variables and ord=string (any allowed ordstr) |
---|
569 | DISPLAY: display 'id' in a recursive format as a polynomial in the variables |
---|
570 | occuring in p with coefficients in the remaining variables. This is |
---|
571 | done by mapping to a ring with parameters [and ordering 'ord', |
---|
572 | if a 3rd argument is present (default: ord=\"dp\")] and applying |
---|
573 | procedure 'show' |
---|
574 | RETURN: no return value |
---|
575 | EXAMPLE: example showrecursive; shows an example |
---|
576 | " |
---|
577 | { |
---|
578 | def P = basering; |
---|
579 | int ii; |
---|
580 | string newchar = charstr(P); |
---|
581 | string neword = "dp"; |
---|
582 | if( size(#) == 1 ) { neword = #[1]; } |
---|
583 | string newvar; |
---|
584 | for( ii=1; ii <= nvars(P); ii++ ) |
---|
585 | { |
---|
586 | if( p/var(ii) == 0 ) |
---|
587 | { |
---|
588 | newchar = newchar + ","+varstr(ii); |
---|
589 | } |
---|
590 | else |
---|
591 | { |
---|
592 | newvar = newvar + ","+varstr(ii); |
---|
593 | } |
---|
594 | } |
---|
595 | newvar = newvar[2,size(newvar)-1]; |
---|
596 | |
---|
597 | execute("ring newP=("+newchar+"),("+newvar+"),("+neword+");"); |
---|
598 | def @@id = imap(P,@@id); |
---|
599 | show(@@id); |
---|
600 | return(); |
---|
601 | } |
---|
602 | example |
---|
603 | { "EXAMPLE:"; echo=2; |
---|
604 | ring r=2,(a,b,c,d,x,y),ds; |
---|
605 | poly f=y+ax2+bx3+cx2y2+dxy3; |
---|
606 | showrecursive(f,x); |
---|
607 | showrecursive(f,xy,"lp"); |
---|
608 | } |
---|
609 | /////////////////////////////////////////////////////////////////////////////// |
---|
610 | |
---|
611 | proc split (string s, list #) |
---|
612 | "USAGE: split(s[,n]); s string, n integer |
---|
613 | RETURN: same string, split into lines of length n separated by \ |
---|
614 | (default: n=pagewidth) |
---|
615 | NOTE: may be used in connection with lprint |
---|
616 | EXAMPLE: example split; shows an example |
---|
617 | " |
---|
618 | { |
---|
619 | string line,re; int p,l; |
---|
620 | if( size(#)==0 ) { int n=pagewidth; } |
---|
621 | else { int n=#[1]; } |
---|
622 | if( s[size(s),1] != newline ) { s=s+newline; } |
---|
623 | l=size(s); |
---|
624 | while( 1 ) |
---|
625 | { |
---|
626 | p=1; |
---|
627 | l=find(s,newline); line=s[1,l]; |
---|
628 | while( l>=n ) |
---|
629 | { |
---|
630 | re=re+line[p,n-2]+"\\"+newline; |
---|
631 | p=p+n-2; l=l-n+2; |
---|
632 | } |
---|
633 | re=re+line[p,l-1]+"\\"+newline; |
---|
634 | l=size(line); |
---|
635 | if( l>=size(s) ) break; |
---|
636 | s=s[l+1,size(s)-l]; |
---|
637 | } |
---|
638 | return (re[1,size(re)-2]); |
---|
639 | } |
---|
640 | example |
---|
641 | { "EXAMPLE:"; echo = 2; |
---|
642 | ring r= 0,(x,y,z),ds; |
---|
643 | poly f = (x+y+z)^4; |
---|
644 | split(string(f),50); |
---|
645 | split(lprint(f)); |
---|
646 | } |
---|
647 | /////////////////////////////////////////////////////////////////////////////// |
---|
648 | |
---|
649 | proc tab (int n) |
---|
650 | "USAGE: tab(n); n integer |
---|
651 | RETURN: string of n space tabs |
---|
652 | EXAMPLE: example tab; shows an example |
---|
653 | " |
---|
654 | { |
---|
655 | if( n==0 ) { return(""); } |
---|
656 | string s=" "; |
---|
657 | return(s[1,n]); |
---|
658 | } |
---|
659 | example |
---|
660 | { "EXAMPLE:"; echo = 2; |
---|
661 | for(int n=0; n<=5; n=n+1) |
---|
662 | { tab(5-n)+"*"+tab(n)+"+"+tab(n)+"*"; } |
---|
663 | } |
---|
664 | /////////////////////////////////////////////////////////////////////////////// |
---|
665 | |
---|
666 | proc pause(list #) |
---|
667 | "USAGE: pause([ prompt ]) prompt string |
---|
668 | RETURN: none |
---|
669 | PURPOSE: interrupt the execution of commands, displays prompt or pause |
---|
670 | and waits for user input |
---|
671 | NOTE: pause is useful in procedures in connection with printlevel to |
---|
672 | interrupt the computation and to display intermediate results. |
---|
673 | SEE ALSO: read, printlevel |
---|
674 | EXAMPLE : example pause; shows an example |
---|
675 | " |
---|
676 | { |
---|
677 | string pr="pause>"; |
---|
678 | if (size(#)!=0) |
---|
679 | { |
---|
680 | pr=#[1]; |
---|
681 | } |
---|
682 | pr=read("",pr); |
---|
683 | } |
---|
684 | example |
---|
685 | { "EXAMPLE:"; echo=2; |
---|
686 | // can only be shown interactively, try the following commands: |
---|
687 | // pause("press <return> to continue"); |
---|
688 | // pause(); |
---|
689 | // In the following pocedure TTT, xxx is printed and the execution of |
---|
690 | // TTT is stopped until the return-key is pressed, if printlevel>0. |
---|
691 | // xxx may be any result of a previous computation or a comment, etc: |
---|
692 | // |
---|
693 | // proc TTT |
---|
694 | // { int pp = printlevel-voice+2; //pp=0 if printlevel=0 and if TTT is |
---|
695 | // .... //not called from another procedure |
---|
696 | // if( pp>0 ) |
---|
697 | // { |
---|
698 | // print( xxx ); |
---|
699 | // pause("press <return> to continue"); |
---|
700 | // } |
---|
701 | // .... |
---|
702 | // } |
---|
703 | } |
---|
704 | /////////////////////////////////////////////////////////////////////////////// |
---|