Chapter Seven Exporting Results from Mathematica

7.2.5 Creating a Data Table for output to a Printer

data = {{15,15,15},{"Name","Age","Salary"},
        {"John Smith","24","$40,000"},
        {"Peter Long","63","$60,000"}}

Formatting your data

rightalign[text_,paddedlength_Integer] :=
Module[{textstring,textlength},
   textstring = ToString[text];
   textlength = StringLength[textstring];
   StringJoin[
      Apply[StringJoin,Table[" ",{paddedlength-textlength}]],
      textstring]
]

FullForm[  rightalign["jason",10]  ]

FullForm[  rightalign[{1,2,3},10]  ]

Attributes[rightalign] := {Listable}

FullForm[  rightalign[{1,2,3},10]  ]

tabletostring[data_List] :=
Module[{flip,widths},
widths = data[[1]];
flip = Transpose[Rest[data]];
flip = Table[Map[rightalign[#,widths[[i]]]&, flip[[i]]],
{i,1,Length[widths]}];
Map[StringJoin,flip]
];

makefile[tablelist_List,filename_String]:=
Module[{outline,tlx,tly,width,height},
  tlx = 50; tly = -125;
  width = 7*StringLength[tablelist[[1]]];
  height = 12*Length[tablelist]+10; 
  outline = OpenWrite[filename];
  WriteString[outline,"%!PS-Adobe-3.0 \n"];
  WriteString[outline,"%%BoundingBox: ", ToString[tlx-10]," ",
              ToString[tly-height-10]," ",ToString[tlx+width+10],
              " ",ToString[tly+10],"\n\n"]; 
  WriteString[outline,"90 rotate\n"];
  WriteString[outline,ToString[tlx]," ",ToString[tly]," moveto "];
  WriteString[outline,ToString[width]," 0 rlineto "];
  WriteString[outline," 0 ",ToString[-height]," rlineto\n"];
  WriteString[outline,ToString[-width]," 0 rlineto "];
  WriteString[outline," 0 ",ToString[height]," rlineto \n"];
  WriteString[outline,ToString[tlx]," " ToString[tly-14]," moveto "];
  WriteString[outline,ToString[width]," 0 rlineto \n"];
  WriteString[outline,"\n stroke \n\n"];
  WriteString[outline,"/Courier-Bold findfont 10 scalefont setfont \n"];
  WriteString[outline,"60 -135 moveto (",tablelist[[1]],") show \n\n"];
  WriteString[outline,"/Courier findfont 10 scalefont setfont \n"];
  Do[
     WriteString[outline,
       StringJoin["60 ",ToString[-130-10*i]," moveto (",
       tablelist[[i]],") show \n"]]
     ,{i,2,Length[tablelist]}];
  WriteString[outline,"\nshowpage \n%%EOF \n"];
  Close[outline]
]

output = tabletostring[data];
makefile[output,"jas.ps"];
!!jas.ps

BeginPackage["FortForm`"];

FortranPrint::usage = "FortranPrint[format,{data}] 
prints the data list to the \\nscreen using the format
specified by FormatNo[format]";

FortranWrite::usage = "FortranWrite[stream,format,{data}]
writes the data list to \\nthe Output Stream specified by
stream using the format \\nspecified by FormatNo[format]";

FormatNo::usage = "FormatNo[format] is a FORTRAN type format 
specifier. For \\nexample the FORTRAN format statement\\n\\n
10 FORMAT(4A10,5X)\\n\\nis implemented by\\n\\n
FormatNo[10] = {"4A10","5X"}\\n\\nSupported specifiers are 
A,X,I,E,F and /";

FortranRead::usage = "FortranRead[stream,format] reads in a 
list of data \\nfrom the stream assuming a format 
FormatNo[format]";

Begin["`Private`"];

      (* CODE TO WRITE FORMATTED DATA *)

 (* Define functions to create strings of spaces and 
    stars *)
spaces[n_Integer]:= Apply[StringJoin,Table[" ",{n}]];
stars[n_Integer] := Apply[StringJoin,Table["*",{n}]];

 (* Define a function which converts the decimal part 
    of a number into an integer *)
dec[x_String]:= ToExpression[ StringDrop[x,
                StringPosition[x,"."][[1,1]]]];

 (* Define a function which converts a format statement
    to a sensible form *)
Fconv[x_String] := Module[{},
    fieldpos = StringPosition[x,{"E","F","X","I","A","/"}][[1,1]];
    If[StringTake[x,{fieldpos}] == "X",
       return = {{"X",ToExpression[StringDrop[x,{fieldpos}]]}},
    reps = If[fieldpos == 1, 1,
              ToExpression[StringTake[x,fieldpos-1]]];
    return = {StringTake[x,{fieldpos}]};
    rest = StringDrop[x,fieldpos];
    If[StringLength[rest] == 0,,
       return = Append[return,
                       Floor[ToExpression[rest]]];
	   If[StringPosition[rest,"."] == {},,
		  return = Append[return,dec[rest]]
         ]
      ];
    return = Table[return,{reps}];
   ];
   return
];
Fconv[x_List] := Apply[Join,Map[Fconv,x]];



 (* Define a function which formats a list of 
    data according to a list of formats *) 
Fformat[{},{}] = "";
Fformat[{a___},{{"/"},b___}]:=
      StringJoin["\\n",Fformat[{a},{b}]];


 (* Define write and print statements which work like the
    FORTRAN version *)
FortranPrint[x_Integer,b_List] :=
          Print[Fformat[b,Fconv[FormatNo[x]]]];
FortranWrite[line_OutputStream,x_Integer,b_List] := 
          WriteString[line,Fformat[b,
          Fconv[Append[FormatNo[x],"/"]]]];


 (* Implementation of X capability *)
Fformat[{a___},{{"X",b_Integer},c___}] := 
    StringJoin[spaces[b],Fformat[{a},{c}]];

Implementation of A capability *)
Fformat[{a_String,b___},{{"A",c_Integer},d___}] :=
       StringJoin[asty[a,c],Fformat[{b},{d}]];
asty[text_String,field_Integer] :=
Module[{len = StringLength[text]},
       If[len < field, 
          StringJoin[spaces[field-len],text],
	      StringTake[text,field]
       ]
      ];

 (* Implementation of E capability *)
esty[x_,{field_Integer,pl_Integer}] := 
Module[{me = MantissaExponent[N[x]],temp},
	    temp = StringJoin[fsty[me[[1]],
               {pl+5/2-Sign[me[[1]]]/2,pl}],"E",
               ToString[PaddedForm[me[[2]],2, NumberPadding -> "0",
               NumberSigns -> {"-","+"},SignPadding -> True]]
               ];
	    If[StringLength[temp] > field, stars[field]
                               , asty[temp,field]]]
Fformat[{a_,b___},{{"E",c_Integer,d_Integer},f___}] := 
StringJoin[esty[a,{c,d}], Fformat[{b},{f}]];

 (* Implementation of F capability *)
fsty[r_Real,{a_Integer,b_Integer}] := 
Module[{len = StringLength[ToString[r]]},
       temp = ToString[PaddedForm[r,{len+5,b},
                       NumberPadding -> {"","0"}]];
       If[StringLength[temp]>a,stars[a],asty[temp,a]]];
Fformat[{a_Real,b___} ,{{"F",c_Integer,d_Integer},e___}] := 
StringJoin[fsty[a,{c,d}], Fformat[{b},{e}]];

 (* Implementation of I capability *)
isty[a_Integer,b_Integer] := 
Module[{temp = ToString[a]},
       If[StringLength[temp] > b, stars[b], asty[temp,b]]];
Fformat[{a_Integer,b___},{{"I",c_Integer},d___}] :=
StringJoin[isty[a,c],Fformat[{b},{d}]];



        (* CODE TO READ IN FORMATTED DATA *)

First we define a function to read in a number 
   of characters *)
cread[line_InputStream,n_Integer] := 
      Apply[StringJoin,Read[line,Table[Character,{n}]]];

Implementation of A facility *)
fread[line_InputStream,{"A",x_Integer}] := cread[line,x];

Implementation of I facility *)
fread[line_InputStream, {"I",x_Integer}] := 
     ToExpression[cread[line, x]];

Implementation of E facility *)
fread[line_InputStream, {"E",x_Integer,y_Integer}] := 
      ToExpression[StringReplace[cread[line,x],
      {"e" -> " 10^","E" -> " 10^"}]];

Implementation of X facility *)
fread[line_InputStream,{"X",x_Integer}] := 
      Block[{},cread[line,x];];

Implementation of newline facility *)
fread[line_InputStream,{"/"}] := Block[{},cread[line,1];];

Implementation of F facility *)
fread[line_InputStream, {"F",x_Integer,y_Integer}] := 
     ToExpression[cread[line,x]];

Code to read in a multiple format statement *)
fread[line_InputStream,{b__List}] := 
     Select[Map[fread[line,#]&,{b}],!SameQ[#,Null]&];

Code to simulate FORTRAN read statement *)
FortranRead[line_InputStream,a_Integer] :=
     fread[line,Fconv[Append[FormatNo[a],"/"]]];

End[];

Protect[FortranRead,FortranPrint,FortranWrite];

EndPackage[];