(*^ ::[ Information = "This is a Mathematica Notebook file. It contains ASCII text, and can be transferred by email, ftp, or other text-file transfer utility. It should be read or edited using a copy of Mathematica or MathReader. If you received this as email, use your mail application or copy/paste to save everything from the line containing (*^ down to the line containing ^*) into a plain text file. On some systems you may have to give the file a name ending with ".ma" to allow Mathematica to recognize it as a Notebook. The line below identifies what version of Mathematica created this file, but it can be opened using any other version as well."; FrontEndVersion = "Macintosh Mathematica Notebook Front End Version 2.2"; MacintoshStandardFontEncoding; fontset = title, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, M7, bold, L12, 24, "Helvetica"; fontset = subtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, M7, bold, L12, 18, "Helvetica"; fontset = subsubtitle, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeTitle, M7, L12, 14, "Helvetica"; fontset = section, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, blackBox, M22, bold, L12, 14, "Helvetica"; fontset = subsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, grayBox, M19, bold, L12, 12, "Helvetica"; fontset = subsubsection, inactive, noPageBreakBelow, nohscroll, preserveAspect, groupLikeSection, whiteBox, M18, bold, L12, 12, "Helvetica"; fontset = text, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = smalltext, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 9, "Times"; fontset = input, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeInput, M42, N23, bold, e12, 10, "Courier"; fontset = output, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, e12, 10, "Courier"; fontset = message, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, e12, 10, "Courier"; fontset = print, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, e12, 10, "Courier"; fontset = info, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeOutput, M42, N23, B65535, e12, 10, "Courier"; fontset = postscript, PostScript, formatAsPostScript, output, inactive, noPageBreakInGroup, nowordwrap, preserveAspect, groupLikeGraphics, M7, l34, w282, h287, 12, "Courier"; fontset = name, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, italic, 10, "Geneva"; fontset = header, inactive, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = leftheader, inactive, 10, "Palatino"; fontset = footer, inactive, noKeepOnOnePage, preserveAspect, center, M7, 10, "Palatino"; fontset = leftfooter, inactive, 10, "Palatino"; fontset = help, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = clipboard, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = completions, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special1, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special2, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special3, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special4, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; fontset = special5, inactive, nohscroll, noKeepOnOnePage, preserveAspect, M7, 10, "Palatino"; paletteColors = 128; automaticGrouping; currentKernel; ] :[font = title; inactive; preserveAspect; startGroup] Chapter Seven Exporting Results from Mathematica :[font = subsection; inactive; preserveAspect; startGroup] 7.2.5 Creating a Data Table for output to a Printer :[font = input; preserveAspect; startGroup] data = {{15,15,15},{"Name","Age","Salary"}, {"John Smith","24","$40,000"}, {"Peter Long","63","$60,000"}} :[font = output; output; inactive; preserveAspect] {{15, 15, 15}, {"Name", "Age", "Salary"}, {"John Smith", "24", "$40,000"}, {"Peter Long", "63", "$60,000"}} ;[o] {{15, 15, 15}, {Name, Age, Salary}, {John Smith, 24, $40,000}, {Peter Long, 63, $60,000}} :[font = postscript; PostScript; formatAsPostScript; output; inactive; preserveAspect; pictureLeft = 25; pictureWidth = 310; pictureHeight = 189; endGroup] %! %%Creator: Mathematica %%AspectRatio: .61803 MathPictureStart %% Graphics /Courier findfont 10 scalefont setfont % Scaling calculations 0.05 0.05 0.332788 0.0475411 [ [ 0 0 0 0 ] [ 1 .61803 0 0 ] ] MathScale % Start of Graphics 1 setlinecap 1 setlinejoin newpath [ ] 0 setdash 0 g p P 0 0 m 1 0 L 1 .61803 L 0 .61803 L closepath clip newpath p p /Courier-Bold findfont 10 scalefont setfont [(Name)] .3 .3041 1 0 Mshowa P p /Courier-Bold findfont 10 scalefont setfont [(Age)] .5 .3041 1 0 Mshowa P p /Courier-Bold findfont 10 scalefont setfont [(Salary)] .7 .3041 1 0 Mshowa P p /Courier findfont 10 scalefont setfont [(John Smith)] .3 .23279 1 0 Mshowa P p /Courier findfont 10 scalefont setfont [(24)] .5 .23279 1 0 Mshowa P p /Courier findfont 10 scalefont setfont [($40,000)] .7 .23279 1 0 Mshowa P p /Courier findfont 10 scalefont setfont [(Peter Long)] .3 .18525 1 0 Mshowa P p /Courier findfont 10 scalefont setfont [(63)] .5 .18525 1 0 Mshowa P p /Courier findfont 10 scalefont setfont [($60,000)] .7 .18525 1 0 Mshowa P .004 w .05 .16148 m .9 .16148 L .9 .32787 L .05 .32787 L .05 .16148 L .05 .27082 L .9 .27082 L s P % End of Graphics MathPictureEnd :[font = subsubsection; inactive; preserveAspect; startGroup] Formatting your data :[font = input; preserveAspect] rightalign[text_,paddedlength_Integer] := Module[{textstring,textlength}, textstring = ToString[text]; textlength = StringLength[textstring]; StringJoin[ Apply[StringJoin,Table[" ",{paddedlength-textlength}]], textstring] ] :[font = input; preserveAspect; startGroup] FullForm[ rightalign["jason",10] ] :[font = output; output; inactive; preserveAspect; endGroup] FullForm[" jason"] ;[o] " jason" :[font = input; preserveAspect; startGroup] FullForm[ rightalign[{1,2,3},10] ] :[font = output; output; inactive; preserveAspect; endGroup] FullForm[" {1, 2, 3}"] ;[o] " {1, 2, 3}" :[font = input; preserveAspect] Attributes[rightalign] := {Listable} :[font = input; preserveAspect; startGroup] FullForm[ rightalign[{1,2,3},10] ] :[font = output; output; inactive; preserveAspect; endGroup] FullForm[{" 1", " 2", " 3"}] ;[o] List[" 1", " 2", " 3"] :[font = input; preserveAspect] 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] ]; :[font = input; preserveAspect] 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] ] :[font = input; preserveAspect; startGroup] output = tabletostring[data]; makefile[output,"jas.ps"]; !!jas.ps :[font = print; inactive; preserveAspect; endGroup] %!PS-Adobe-3.0 %%BoundingBox: 40 -181 375 -115 90 rotate 50 -125 moveto 315 0 rlineto 0 -46 rlineto -315 0 rlineto 0 46 rlineto 50 -139 moveto 315 0 rlineto stroke /Courier-Bold findfont 10 scalefont setfont 60 -135 moveto ( Name John Smith Peter Long) show /Courier findfont 10 scalefont setfont 60 -150 moveto ( Age 24 63) show 60 -160 moveto ( Salary $40,000 $60,000) show showpage %%EOF :[font = input; preserveAspect; plain; endGroup; endGroup; endGroup] 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[]; ^*)