(* WriteTable, Version 1.0, August 27, 2002 *)
(* Author: A.I. McLeod *)
(* Copyright (c), A.I. McLeod, 2002 *)
(* Summary:
WriteTable outputs a matrix as a table in TeX or LaTeX. Row and Column
headings can be added by using optional arguments. Other options,
allow output as an ASCII tab-delimited or CSV file.
*)


BeginPackage["WriteTable`"]


Options[WriteTable] = {ColumnNames -> False, PrependColumn -> False, 
     OutputType -> "TeX", NumDecimals -> 3}
 
WriteTable /: WriteTable::usage = "WriteTable[filename, x] outputs a matrix x \
as a table in TeX showing exactly 3 decimals to the right of the decimal \
point.  The option Numdecimals can be used to change the number of decimals.  \
Also by setting NumDecimals->False, the matrix entries will be left as is.  \
Note that using NumDecimals->False also allows the numbers in the matrix to \
be preformatted character strings. See the companion function, \
MergeMatricies, for a function which may be used to make tables with multi \
valued entries. Tables may be output with row and column headings by using \
the options ColNames and PrependColumn. \
WriteTable[filename,x,ColumnNames->cn] outputs the matrix as a table with \
column names as given in the vector cn. The vector cn should be a vector of \
character strings. The length of cn must be equal to the number of columns in \
x in this case.  You can also add row names and column names with \
WriteTable[filename, ColumnNames->cn, PrependColumn->rn], where now cn and rn \
are vectors of characters strings. In this case cn must be of length equal to \
the number of columns of x plus one since the the first entry in cn will be \
the name for rn and rn must have length equal to the number of rows of x.  \
The option OutputType may also be set to OutputType->\"TXT\" for a \
tab-delimited ascii table, OutputType->\"CSV\" for a comma-delimited ASCII \
table and OutputType->\"HTML\" for an HTML formatted table. Note that \
beautiful tables, suitable for other applications, can also be created by \
using TableForm."

 
WriteTableTypeError /: WriteTableTypeError::InvalidType = "OutputType = `1` \
does not match valid output valid types: `2`. OutputType reset to \"TXT\".";
 
WriteTablePrependColumnError /: 
    WriteTablePrependColumnError::PrependColumnWrong = 
     "PrependColumn must be a vector of length `1`. Option ignored."
 
WriteTableColumnNamesError /: WriteTableColumnNamesError::ColumnNamesWrong = 
     "ColumnNames must be a vector of length `1`. Option ignored.";
  
 
Options[MergeMatricies] = {NumDecimals -> 3};
 
MergeMatricies /: MergeMatricies::usage = "MergeMatricies[x,y] merges two \
n-by-m matricies together to form an n-by-m matrix whose (i,j)-entry is the \
concatenation of the (i,j)-entry in each matrix. By default each entry in the \
matricies x and y are converted to character strings with exact 3 decimal \
places to the right of the decimal. Set the option NumDecimals to obtain a \
different number of decimal places. Alternatively set NumDecimals->False and \
each (i,j)-entry will be used \"as is\".";

Begin["`Private`"]

WriteTable[(filename_)?StringQ, (x_)?MatrixQ, (opts___)?OptionQ] := 
    Module[{cn, iscn, pc, ispc, nd, isnum, nrows, ncols, xSiz, x2, 
      ValidTableTypes = {"TeX", "TXT", "HTML"}}, 
     cn = ColumnNames /. {opts} /. Options[WriteTable]; iscn = VectorQ[cn]; 
      pc = PrependColumn /. {opts} /. Options[WriteTable]; 
      ispc = VectorQ[pc]; tabType = OutputType /. {opts} /. 
        Options[WriteTable]; tabType = 
       If[ !MemberQ[ValidTableTypes, tabType], 
        Message[WriteTableTypeError::InvalidType, tabType, ValidTableTypes]; 
         "TXT", tabType]; nd = NumDecimals /. {opts} /. Options[WriteTable]; 
      isnum = IntegerQ[nd] && nd >= 0; {nrows, ncols} = Dimensions[x]; 
      If[ispc && Length[pc] != nrows, Message[
        WriteTablePrependColumnError::PrependColumnWrong, nrows]]; 
      If[ispc && iscn && Length[cn] != ncols + 1, 
       Message[WriteTableColumnNamesError::ColumnNamesWrong, ncols + 1]]; 
      If[ !ispc && iscn && Length[cn] != ncols, 
       Message[WriteTableColumnNamesError::ColumnNamesWrong, ncols]]; 
      x2 = If[isnum, xSiz = Ceiling[Log[10, Max[Abs[x] + 0.01]]] + 
           If[Min[x] < 0, 1, 0]; Map[PaddedForm[#1, {xSiz + nd, nd}] & , x, 
          {2}], x]; x2 = If[ispc && Length[pc] == nrows, 
        Transpose[Prepend[Transpose[x2], pc]], x2]; 
      x2 = Switch[tabType, "TeX", MakeTexTable[x2, cn, iscn], "TXT", 
        MakeTXTTable[x2, cn, iscn], "HTML", MakeHTMLTable[x2, cn, iscn]]; 
      OpenWrite[filename]; WriteString[filename, x2]; Close[filename]];
 


MakeTexTable[x2_, cn_, iscn_] := If[iscn, BuildOutabYes[x2, cn, iscn], 
     BuildOutabNo[x2]];
 
BuildOutabYes[x_, cn_, ispc_] := Module[{cn2, Add2Lines, EndTable}, 
     cn2 = ToString /@ cn; If[Length[cn] != Last[Dimensions[x]], 
       BuildOutabNo[x], Add2Lines = "\n\\noalign{\\hrule}\n\\noalign{\\smalls\
kip}\n\\noalign{\\hrule}\n\\noalign{\\smallskip}\n"; 
        EndTable = "\n\\noalign{\\smallskip}\n\\noalign{\\hrule}\n}}$$"; 
        StringJoin[BuildTemplate[First[Dimensions[x]]], Add2Lines, 
         AddColumnNames[cn2, ispc], Buildata[x], EndTable]]];
 
BuildOutabNo[(x_)?MatrixQ] := Module[{EndTable, Add2Lines}, 
     EndTable = "\n\\noalign{\\smallskip}\n\\noalign{\\hrule}\n}}$$"; 
      Add2Lines = "\n\\noalign{\\hrule}\n\\noalign{\\smallskip}\n\\noalign{\\\
hrule}\n\\noalign{\\smallskip}\n"; StringJoin[BuildTemplate[
        First[Dimensions[x]]], Add2Lines, Buildata[x], EndTable]];
 
BuildTemplate[nrows_] := Module[{outab, template, EndTemplate}, 
     outab = "$$\\vbox{\\halign{\\strut\n \\hfill#\\quad    %push to right"; 
      template = "&\\hfill#\\quad    %push to right"; 
      EndTemplate = "\\cr             %END OF TEMPLATE"; 
      Do[outab = StringJoin[outab, "\n", template], {nrows - 1}]; 
      StringJoin[outab, "\n", EndTemplate]];
 
Buildata[x_] := StringReplace[StringJoin["$", StringReplace[
       StringJoin[StringReplace[StringReplace[StringReplace[
           StringReplace[StringDrop[StringDrop[ToString[x], -2], 2], 
            "{" -> ""], "}" -> "$\n\\cr\n"], "," -> "$&$"], " " -> ""], 
        "$\n\\cr"], "\\cr\n$&" -> "\\cr\n$"]], "$$" -> "$"];
 
AddColumnNames[cn_, ispc_] := Module[{rowend}, 
     rowend = 
       "\\noalign{\\smallskip}\n\\noalign{\\hrule}\n\\noalign{\\smallskip}"; 
      StringJoin["$", StringReplace[StringReplace[StringDrop[
          StringDrop[ToString[cn], -1], 1], "," -> "$&$"], " " -> ""], 
       "$\n\\cr\n", rowend]];
 
MakeTXTTable[x2_, cn_, iscn_] := If[iscn, BuildTXTYes[x2, cn], BuildTXT[x2]];
 
BuildTXTYes[x_, cn_] := If[Length[cn] != Last[Dimensions[x]], BuildTXT[x], 
     StringJoin[AddColumnNamesTXT[ToString[cn]], "\n", BuildTXT[x]]];
 
BuildTXT[x_] := StringJoin["\t", StringReplace[StringReplace[
       StringReplace[StringReplace[StringDrop[StringDrop[ToString[x], -2], 
          2], "{" -> ""], "}" -> "\t\n"], "," -> "\t"], " " -> ""]];
 
AddColumnNamesTXT[cn_] := Module[{}, StringJoin["\t", 
      StringReplace[StringReplace[StringDrop[StringDrop[cn, -1], 1], 
        "," -> "\t"], " " -> ""]]];

MergeMatricies[(x_)?MatrixQ, (y_)?MatrixQ, (opts___)?OptionQ] := 
    Module[{nd, xy, xySiz}, nd = NumDecimals /. {opts} /. 
        Options[WriteTable]; isnum = IntegerQ[nd] && nd >= 0; 
      xy = Transpose[{x, y}, {3, 1, 2}]; 
      xy = If[isnum, xySiz = Ceiling[Log[10, Max[Abs[xy] + 0.01]]] + 
           If[Min[xy] < 0, 1, 0]; Map[PaddedForm[#1, {xySiz + nd, nd}] & , 
          xy, {2}], xy]; 
      xy = Map[StringReplace[StringReplace[StringDrop[StringDrop[
             ToString[#1], 1], -1], " " -> ""], "," -> "|"] & , xy, {2}]; xy];
  
 
MakeHTMLTable[x2_, cn_, iscn_] := StringJoin["<TABLE BORDER>", 
     If[iscn, BuildHTMLYes[x2, cn], BuildHTML[x2]], "</TABLE>"];
 
BuildHTMLYes[x_, cn_] := If[Length[cn] != Last[Dimensions[x]], BuildHTML[x], 
     StringJoin[AddColumnNamesHTML[ToString[cn]], BuildHTML[x]]];
 
BuildHTML[x_] := StringReplace[StringReplace[StringReplace[
       StringReplace[StringReplace[StringDrop[StringDrop[ToString[x], -1], 
          1], " " -> ""], "{" -> "<TR><TD> "], "}," -> "</TD>"], 
      "," -> "</TD><TD> "], "}" -> "</TD>"];
 
AddColumnNamesHTML[cn_] := StringJoin["<TH>", StringReplace[
      StringReplace[StringDrop[StringDrop[cn, -1], 1], "," -> "</TH><TH>"], 
      " " -> ""], "</TH>"];
 
End[];
EndPackage[];
