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