// (GMG/BM, last modified 22.06.96) /////////////////////////////////////////////////////////////////////////////// version="$Id: inout.lib,v 1.33 2009-04-07 09:30:44 seelisch Exp $"; category="General purpose"; info=" LIBRARY: inout.lib Printing and Manipulating In- and Output PROCEDURES: allprint(list); print list if ALLprint is defined, with pause if >0 lprint(poly/...[,n]); display poly/... fitting to pagewidth [size n] pmat(matrix[,n]); print form-matrix [first n chars of each colum] rMacaulay(string); read Macaulay_1 output and return its Singular format show(any); display any object in a compact format showrecursive(id,p); display id recursively with respect to variables in p split(string,n); split given string into lines of length n tab(n); string of n space tabs writelist(...); write a list into a file and keep the list structure pause([prompt]); stop the computation until user input (parameters in square brackets [] are optional) "; /////////////////////////////////////////////////////////////////////////////// proc allprint (list #) "USAGE: allprint(L); L list DISPLAY: prints L[1], L[2], ... if an integer with name ALLprint is defined. @* makes \"pause\", if ALLprint > 0 RETURN: no return value EXAMPLE: example allprint; shows an example " { if( defined(ALLprint) ) { int i; for( i=1; i<=size(#); i=i+1 ) { print(#[i]); } if( ALLprint >0 ) { pause(); } } return(); } example { "EXAMPLE:"; echo = 2; ring S; matrix M=matrix(freemodule(2),3,3); int ALLprint; export ALLprint; allprint("M =",M); kill ALLprint; } /////////////////////////////////////////////////////////////////////////////// proc lprint "USAGE: lprint(id[,n]); id poly/ideal/vector/module/matrix, n integer RETURN: string of id in a format fitting into lines of size n, such that no monomial gets destroyed, i.e. the new line starts with + or -; (default: n = pagewidth). NOTE: id is printed columnwise, each column separated by a blank line; hence lprint(transpose(id)); displays a matrix id in a format which can be used as input. EXAMPLE: example lprint; shows an example " { if (size(#)==1) { int n = pagewidth-3; } else {int n = #[2]-3; } matrix M = matrix(#[1]); poly p,h,L; string s1,s,S; int jj,ii,a; for (jj=1; jj<=ncols(M); jj=jj+1) { for (ii=1; ii<=nrows(M); ii=ii+1) { a=2; if (a+size(string(M[ii,jj])) <= n) {s = " "+string(M[ii,jj]);} else { h = lead(M[ii,jj]); p = M[ii,jj] - h; L = lead(p); while (p != 0) { if (a+size(string(h+L)) > n) { s = string(h); if (a != 0) { s = " "+s; } if (a == 0 and s[1] != "-") { s = "+" + s; } a=0; h=0; S=S+newline+s; } h = h + L; p = p - L; L = lead(p); } s = string(h); if (a == 0 and s[1] != "-") { s = "+" + s; } } if (ii != nrows(M)) { s = s+","; S=S+newline+s; } else { if (jj != ncols(M)) { s = s+","; S=S+newline+s+newline;} else { S=S+newline+s; } } } } return(S[2,size(S)-1]); } example { "EXAMPLE:"; echo = 2; ring r= 0,(x,y,z),ds; poly f=((x+y)*(x-y)*(x+z)*(y+z)^2); lprint(f,40); module m = [f*(x-y)],[0,f*(x-y)]; string s=lprint(m); s;""; execute("matrix M[2][2]="+s+";"); //use the string s as input module m1 = transpose(M); //should be the same as m print(m-m1); } /////////////////////////////////////////////////////////////////////////////// proc pmat (matrix m, list #) "USAGE: pmat(M[,n]); M matrix, n integer RETURN: A string representing M in array format if it fits into pagewidth; if n is given, only the first n characters of each column are shown (n>1 required), where a truncation of a column is indicated by two dots (\'..\') EXAMPLE: example pmat; shows an example " { //------------- main case: input is a matrix, no second argument--------------- string OUT = ""; if ( size(#)==0) { int elems,mlen,slen,c,r; //-------------- count maximal size of each column, and sum up ------------- for ( c=1; c<=ncols(m); c=c+1) { int len(c); for (r=1; r<=nrows(m); r=r+1) { elems = elems+1; string s(elems) = string(m[r,c])+","; slen = size(s(elems)); if ( slen>len(c) ) { len(c) = slen; } } mlen = mlen+len(c); } //---------------------- print all - except last - rows -------------------- string aus; string sep = " "; if (mlen >= pagewidth) { sep = newline; } for (r=1; r1) { string aus,tmp; int c,r; //---------------------- print all - except last - rows -------------------- for ( r=1; r#[1]) { tmp[#[1]-1]="."; tmp[#[1]] ="."; aus=aus+tmp[1,#[1]]+", "; } else { tmp=tmp+","; aus=aus+tmp[1,#[1]+1]+" "; } } OUT=OUT+aus+newline; } //--------------- print last row (no comma after last entry) --------------- aus = ""; for (c=1; c#[1]) { tmp[#[1]-1]="."; tmp[#[1]] ="."; aus=aus+tmp[1,#[1]]+", "; } else { tmp=tmp+","; aus=aus+tmp[1,#[1]+1]+" "; } } tmp=string(m[nrows(m),ncols(m)]); if (size(tmp)>#[1]) { tmp[#[1]-1]="."; tmp[#[1]] ="."; } aus = aus + tmp[1,#[1]]; OUT=OUT+aus; return(OUT); } } example { "EXAMPLE:"; echo = 2; ring r=0,(x,y,z),ls; ideal i= x,z+3y,x+y,z; matrix m[3][3]=i^2; pmat(m); pmat(m,5); } /////////////////////////////////////////////////////////////////////////////// proc rMacaulay "USAGE: rMacaulay(s[,n]); s string, n integer RETURN: A string denoting a file which should be readable by Singular and it should be produced by Macaulay Classic. If a second argument is present the first n lines of the file are deleted (which is useful if the file was produced e.g. by the putstd command of Macaulay). NOTE: This does not always work with 'cut and paste' since the character \ is treated differently EXAMPLE: example rMacaulay; shows an example " { int n; if( size(#)==2 ) { n=#[2]; } string s0 = #[1]; //------------------------ delete first n=#[2] lines -------------------------- int ii=find(s0,newline); int jj; for ( jj=1; jj<=n; jj=jj+1) { s0 = s0[ii+1,size(s0)-ii]; ii = find(s0,newline); } //--------------- delete blanks and 'newline' at start and end ---------------- ii = 1; while( s0[ii]==" " or s0[ii]==newline ) { ii=ii+1; } s0 = s0[ii,size(s0)-ii+1]; ii = size(s0); while ( s0[ii]==" " or s0[ii]==newline) { ii=ii-1; } s0 = s0[1,ii]; //------------------------- make each line a string --------------------------- ii = find(s0,newline); jj=0; int kk; while( ii!=0 ) { jj = jj+1; kk = ii+1; while( s0[kk]==" " or s0[kk]==newline ) { kk=kk+1; } string s(jj) = s0[1,ii-1]; s0 = s0[kk,size(s0)-kk+1]; ii = find(s0,newline); } jj=jj+1; string s(jj) = s0; //------------ delete blanks and \ at end of each string and add , ------------ for( ii=1; ii<=jj; ii=ii+1 ) { kk = 1; while( s(ii)[kk]==" " ) { kk=kk+1; } s(ii) = s(ii)[kk,size(s(ii))-kk+1]; kk = size(s(ii)); while( s(ii)[kk]==" " or s(ii)[kk]=="\\" or s(ii)[kk]==newline ) { kk = kk-1; } s(ii) = s(ii)[1,kk]+","+newline; } //------------------------ replace blanks by , and add up --------------------- int ll; s0 = ""; string s1,s2; for( ii=1; ii<=jj; ii=ii+1 ) { s1 = ""; s2 = s(ii); kk = find(s(ii)," "); ll=kk+1; while( kk!=0 ) { while( s2[ll]==" ") { ll=ll+1; } if( kk!=1 ) { s1=s1+s2[1,kk-1]+","+s2[kk+1,ll-kk]; } if( kk==1 ) { s1 = s1+","+s2[kk+1,ll-kk]; } s2 = s2[ll+1,size(s2)-ll]; kk = find(s2," "); ll=kk+1; } s(ii) = s1+s2; s0 = s0+s(ii); } //---------------------------- replace [] by () ------------------------------- s1 = ""; s2 = s0; ii = find(s2,"["); while( ii!=0 ) { s0 = s0[1,ii-1]+"("+s0[ii+1,size(s0)-ii]; if( ii>2 ) { if(s0[ii-2]!="+" and s0[ii-2]!="-" and s0[ii-2]!="," and s0[ii-2]!=newline) { s0 = s0[1,ii-2]+"*"+s0[ii-1,size(s0)-ii+2]; } } ii = find(s0,"["); } jj = find(s0,"]"); while ( jj!=0 ) { s0 = s0[1,jj-1]+")"+s0[jj+1,size(s0)-jj]; if(s0[jj+1]!="+"and s0[jj+1]!="-" and s0[jj+1]!="," and s0[jj+1]!="*") { s0 = s0[1,jj] + "^" + s0[jj+1,size(s0)-jj]; } jj = find(s0,"]"); } s0 = s0[1,size(s0)-2]; return(s0); } example { "EXAMPLE:"; echo = 2; // Assume there exists a file 'Macid' with the following ideal in // Macaulay format:" // 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] // Read this file into Singular and assign it to the string s1 by: // string s1 = read("Macid"); // This is equivalent to"; string s1 = "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]"; rMacaulay(s1); // You may wish to assign s1 to a Singular ideal id: string sid = "ideal id =",rMacaulay(s1),";"; ring r = 0,x(0..3),dp; execute(sid); id; ""; // Now treat a matrix in Macaulay format. Using the execute // command, this could be assinged to a Singular matrix as above. string s2 = " 0 0 0 0 0 a3 0 0 0 0 0 b3 0 0 0 0 0 c3 0 0 0 0 0 d3 0 0 0 0 0 e3 "; rMacaulay(s2); } /////////////////////////////////////////////////////////////////////////////// proc show (@@id, list #) "USAGE: show(id); id any object of basering or of type ring/qring @* show(R,s); R=ring, s=string (s = name of an object belonging to R) DISPLAY: display id/s in a compact format together with some information RETURN: no return value NOTE: objects of type string, int, intvec, intmat belong to any ring. id may be a ring or a qring. In this case the minimal polynomial is displayed, and, for a qring, also the defining ideal. id may be of type list but the list must not contain a ring. @* show(R,s) does not work inside a procedure! EXAMPLE: example show; shows an example " { //------------- use funny names in order to avoid name conflicts -------------- int @li@, @ii; string @s@,@@s; int @short@=short; short=1; //----------------------------- check syntax ---------------------------------- if( size(#)!= 0 ) { if( typeof(#[1])=="int" ) { @li@=#[1]; } } if ( typeof(@@id)!="list" ) { if( size(#)==0 ) { def @id@ = @@id; } if( size(#)==1 ) { if( typeof(#[1])=="int" ) { def @id@ = @@id; } if( typeof(#[1])=="string" ) { if( typeof(@@id)=="ring" or typeof(@@id)=="qring") { def @R@ = @@id; setring @R@; def @id@=`#[1]`; } } } } //----------------------- case: @@id is of type list ---------------------------- if ( typeof(@@id)=="list" ) { // @@s = tab(@li@)+"// list, "+string(size(@@id))+" element(s):"; @@s = tab((3*(voice-2)))+"// list, "+string(size(@@id))+" element(s):"; @@s; for ( @ii=1; @ii<=size(@@id); @ii++ ) { if( typeof(@@id[@ii])!="none" ) { def @id(@ii) = @@id[@ii]; tab(3*(voice-2))+"["+string(@ii)+"]:"; // show(@id(@ii),@li@+3*(voice-1)); show(@id(@ii),3*(voice-1)); } else { "["+string(@ii)+"]:"; tab(@li@+2),"//",@@id[@ii]; } } short=@short@; return(); } if( defined(@id@)!=voice ) { "// wrong syntax, type help show;"; return();} //-------------------- case: @id@ belongs to any ring ------------------------- if( typeof(@id@)=="string" or typeof(@id@)=="int" or typeof(@id@)=="intvec" or typeof(@id@)=="intmat" or typeof(@id@)=="list" ) { if( typeof(@id@)!="intmat" ) { @@s = tab(@li@)+"// "+typeof(@id@)+", size "+string(size(@id@)); @@s; } if( typeof(@id@)=="intmat" ) { @@s = tab(@li@)+"// "+typeof(@id@)+", "+string(nrows(@id@))+" rows, " + string(ncols(@id@))+" columns"; @@s; } @id@; short=@short@; return(); } //-------------------- case: @id@ belongs to basering ------------------------- if( typeof(@id@)=="poly" or typeof(@id@)=="ideal" or typeof(@id@)=="matrix" ) { @@s = tab(@li@)+"// "+ typeof(@id@); if( typeof(@id@)=="ideal" ) { @@s=@@s + ", "+string(ncols(@id@))+" generator(s)"; @@s; print(ideal(@id@)); } if( typeof(@id@)=="poly" ) { @@s=@@s + ", "+string(size(@id@))+" monomial(s)"; @@s; print(poly(@id@)); } if( typeof(@id@)=="matrix") { @@s=@@s + ", "+string(nrows(@id@))+"x"+string(ncols(@id@)); @@s; print(matrix(@id@)); } short=@short@; return(); } if( typeof(@id@)=="vector" ) { @@s = tab(@li@)+"// "+typeof(@id@); @@s; print(@id@); short=@short@; return(); } if( typeof(@id@)=="module" ) { @s@=", "+string(ncols(@id@))+" generator(s)"; @@s = tab(@li@)+"// "+ typeof(@id@)+ @s@; @@s; int @n@; for( @n@=1; @n@<=ncols(@id@); @n@=@n@+1 ) { print(@id@[@n@]); } short=@short@; return(); } if( typeof(@id@)=="number" or typeof(@id@)=="resolution" ) { @@s = tab(@li@)+"// ", typeof(@id@); @@s; @id@; short=@short@; return(); } if( typeof(@id@)=="map" ) { def @map = @id@; @@s = tab(@li@)+"// i-th variable of preimage ring is mapped to @map[i]"; @@s; if( size(#)==0 ) { type @map; } if( size(#)==1 ) { if( typeof(#[1])=="int" ) { type @map; } if( typeof(#[1])=="string" ) { type `#[1]`; } } short=@short@; return(); } //---------------------- case: @id@ is a ring/qring --------------------------- if( typeof(@id@)=="ring" or typeof(@id@)=="qring" ) { setring @id@; string s="("+charstr(@id@)+"),("+varstr(@id@)+"),("+ordstr(@id@)+");"; if( typeof(@id@)=="ring" ) { list na@me@s=names(@id@); kill @id@; @@s = tab(@li@)+"// ring:"; @@s,s; @@s = tab(@li@)+"// minpoly ="; @@s,minpoly; "// objects belonging to this ring:"; listvar(poly);listvar(ideal); listvar(vector);listvar(module); listvar(map);listvar(matrix); listvar(number);listvar(resolution); for(int names@i=1;names@i<=size(na@me@s);names@i++) { def @hi@lf@=`na@me@s[names@i]`; if ((typeof(@hi@lf@)!="poly") and (typeof(@hi@lf@)!="ideal") and (typeof(@hi@lf@)!="vector") and (typeof(@hi@lf@)!="module") and (typeof(@hi@lf@)!="map") and (typeof(@hi@lf@)!="matrix") and (typeof(@hi@lf@)!="number") and (typeof(@hi@lf@)!="resolution")) { listvar(`na@me@s[names@i]`); } kill @hi@lf@; } } if( typeof(@id@)=="qring" ) { list na@me@s=names(@id@); @@s = tab(@li@)+"// qring:"; @@s,s; @@s = tab(@li@)+"// minpoly ="; @@s, minpoly; @@s = tab(@li@)+"// quotient ring from ideal:"; @@s; ideal(@id@); listvar(poly);listvar(ideal); listvar(vector);listvar(module); listvar(map);listvar(matrix); listvar(number);listvar(resolution); for(int names@i=1;names@i<=size(na@me@s);names@i++) { def @hi@lf@=`na@me@s[names@i]`; if ((typeof(@hi@lf@)!="poly") and (typeof(@hi@lf@)!="ideal") and (typeof(@hi@lf@)!="vector") and (typeof(@hi@lf@)!="module") and (typeof(@hi@lf@)!="map") and (typeof(@hi@lf@)!="matrix") and (typeof(@hi@lf@)!="number") and (typeof(@hi@lf@)!="resolution")) { listvar(`na@me@s[names@i]`); } kill @hi@lf@; } } short=@short@; //return(); } } example { "EXAMPLE:"; echo = 2; ring r; show(r); ideal i=x^3+y^5-6*z^3,xy,x3-y2; show(i,3); // introduce 3 space tabs before information vector v=x*gen(1)+y*gen(3); module m=v,2*v+gen(4); list L = i,v,m; show(L); ring S=(0,T),(a,b,c,d),ws(1,2,3,4); minpoly = T^2+1; ideal i=a2+b,c2+T^2*d2; i=std(i); qring Q=i; show(Q); map F=r,a2,b^2,3*c3; show(F); // Apply 'show' to i (which does not belong to the basering) by typing // ring r; ideal i=xy,x3-y2; ring Q; show(r,"i"); } /////////////////////////////////////////////////////////////////////////////// proc showrecursive (@@id,poly p,list #) "USAGE: showrecursive(id,p[,ord]); id any object of basering, p= product of variables and ord=string (any allowed ordstr) DISPLAY: display 'id' in a recursive format as a polynomial in the variables occuring in p with coefficients in the remaining variables. This is done by mapping to a ring with parameters [and ordering 'ord', if a 3rd argument is present (default: ord=\"dp\")] and applying procedure 'show' RETURN: no return value EXAMPLE: example showrecursive; shows an example " { def P = basering; int ii; string newchar = charstr(P); string neword = "dp"; if( size(#) == 1 ) { neword = #[1]; } string newvar; for( ii=1; ii <= nvars(P); ii++ ) { if( p/var(ii) == 0 ) { newchar = newchar + ","+varstr(ii); } else { newvar = newvar + ","+varstr(ii); } } newvar = newvar[2,size(newvar)-1]; execute("ring newP=("+newchar+"),("+newvar+"),("+neword+");"); def @@id = imap(P,@@id); show(@@id); return(); } example { "EXAMPLE:"; echo=2; ring r=2,(a,b,c,d,x,y),ds; poly f=y+ax2+bx3+cx2y2+dxy3; showrecursive(f,x); showrecursive(f,xy,"lp"); } /////////////////////////////////////////////////////////////////////////////// proc split (string s, list #) "USAGE: split(s[,n]); s string, n integer RETURN: same string, split into lines of length n separated by \ (default: n=pagewidth) NOTE: may be used in connection with lprint EXAMPLE: example split; shows an example " { string line,re; int p,l; if( size(#)==0 ) { int n=pagewidth; } else { int n=#[1]; } if( s[size(s),1] != newline ) { s=s+newline; } l=size(s); while( 1 ) { p=1; l=find(s,newline); line=s[1,l]; while( l>=n ) { re=re+line[p,n-2]+"\\"+newline; p=p+n-2; l=l-n+2; } re=re+line[p,l-1]+"\\"+newline; l=size(line); if( l>=size(s) ) break; s=s[l+1,size(s)-l]; } return (re[1,size(re)-2]); } example { "EXAMPLE:"; echo = 2; ring r= 0,(x,y,z),ds; poly f = (x+y+z)^4; split(string(f),50); split(lprint(f)); } /////////////////////////////////////////////////////////////////////////////// proc tab (int n) "USAGE: tab(n); n integer RETURN: string of n space tabs EXAMPLE: example tab; shows an example " { if( n==0 ) { return(""); } string s=" "; return(s[1,n]); } example { "EXAMPLE:"; echo = 2; for(int n=0; n<=5; n=n+1) { tab(5-n)+"*"+tab(n)+"+"+tab(n)+"*"; } } /////////////////////////////////////////////////////////////////////////////// proc writelist (string fil, string nam, list L) "USAGE: writelist(file,name,L); file,name strings (file-name, list-name), L a list. CREATE: a file with name `file`, write the content of the list L into it and call the list `name`, keeping the list structure RETURN: no return value NOTE: The syntax of writelist is similar to the syntax of the write command of Singular which does not manage lists properly. If (file,name) = (\"listfile\",\"L1\"), writelist creates (resp. appends if listfile exists) a file with name listfile and stores there the list L under the name L1. The Singular command execute(read(\"listfile\")); assigns the content of L (stored in listfile) to a list L1. @* On a UNIX system, write(\">file\",...) overwrites an existing file `file` while write(\"file\",...) and write(\">>file\",...) append. EXAMPLE: example writelist; shows an example " { int i; write(fil,"list "+nam+";"); if( fil[1]==">" ) { fil=fil[2..size(fil)]; } if( fil[1]==">" ) { fil=fil[2..size(fil)]; } for( i=1;i<=size(L);i=i+1 ) { write(fil," "+nam+"["+string(i)+"]="+typeof(L[i])+"(",string(L[i])+");"); } return(); } example { "EXAMPLE:"; echo = 2; ring r; ideal i=x,y,z; list k="Hi",nameof(basering),i,37; writelist("zumSpass","lustig",k); read("zumSpass"); list L=res(i,0); //resolution of the ideal i writelist("res_list","res-name",L); ""; read("res_list"); // execute(read("res_list")); would create a list with name res-name, // which is the resolution of i (the same content as L) system("sh","/bin/rm res_list zumSpass"); // Under UNIX, this removes the files 'res_list' and 'zumSpass' // Type help system; to get more information about the shell escape // If your operating system does not accept the shell escape, you // must remove the just created files 'zumSpass' and 'res_list' directly } /////////////////////////////////////////////////////////////////////////////// proc pause(list #) "USAGE: pause([ prompt ]) prompt string RETURN: none PURPOSE: interrupt the execution of commands, displays prompt or pause and waits for user input NOTE: pause is useful in procedures in connection with printlevel to interrupt the computation and to display intermediate results. SEE ALSO: read, printlevel EXAMPLE : example pause; shows an example " { string pr="pause>"; if (size(#)!=0) { pr=#[1]; } pr=read("",pr); } example { "EXAMPLE:"; echo=2; // can only be shown interactively, try the following commands: // pause("press to continue"); // pause(); // In the following pocedure TTT, xxx is printed and the execution of // TTT is stopped until the return-key is pressed, if printlevel>0. // xxx may be any result of a previous computation or a comment, etc: // // proc TTT // { int pp = printlevel-voice+2; //pp=0 if printlevel=0 and if TTT is // .... //not called from another procedure // if( pp>0 ) // { // print( xxx ); // pause("press to continue"); // } // .... // } } ///////////////////////////////////////////////////////////////////////////////