source: git/Singular/LIB/inout.lib @ 21324ab

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