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