source: git/Singular/LIB/inout.lib @ 18dd47

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