Tuesday, February 14, 2017

Generate HTML or PNG representation of a data / table / model object


tex.print <- function(x, type=c("PNG", "HTML"), file=NULL, caption = file, digits=0) {
    ## Purpose: Generate HTML or PNG representation of a data/table/model object.
    ##          Require R "memisc" package. 
    ## Arguments:
    ##   x: an object (table, ftable, data frame, model object, etc. that are acceptable in R "memisc" package.
    ##   type: what to generate -- 
    ##         "HTML" shows a HTML table in a web browser. 
    ##         "PNG" shows a PNG (image) file (require linux commands: latex, dvipng, display).
    ##   file: make a copy of the PNG file with this name.  Also used for the table name.
    ##   caption: table caption. 
    ##   digits: number of decimal places to use.
    ## Return: Display the data representation and an image file (type="PNG") for insertion. 
    ## Author: Feiming Chen, Date: 14 Feb 2017, 11:59
    ## ________________________________________________

    type <- match.arg(type)

    is.tabular.data <- "tabular" %in% class(x) # "x" is from the "tables" package output
    is.tbl.data <- "tbl" %in% class(x)         # "x" is from the "dplyr" package output

    if (is.tbl.data) {
        x <- as.data.frame(x)
    }
    
    switch(type,
           HTML = {
               ## Show HTML table in a Web Browser
               if (is.null(file)) {
                   memisc::show_html(x, digits = digits)
               } else {
                   memisc::write_html(x, file = paste0(file,".html"), digits = digits)
               }
           }, 
           PNG = {
               ## Generate LaTeX and PNG Image file
               
               if (is.tabular.data) {
                   library(tables)
                   booktabs()
               }

               if (is.tabular.data || is.tbl.data) {

                   w <- Hmisc::latex(x, file="X.tex", ctable=TRUE, caption = caption, digits = digits)
                   if (is.tabular.data) w$style <- c("booktabs", "dcolumn")
                   d <- Hmisc::dvi(w)                         # convert to DVI file 
                   system(paste("dvipng -q* -o X.png -T tight -D 200", d$file)) # convert to PNG file with Tight box and Resolution of 200
                   file.remove("X.tex")

               } else {

                   r <- memisc:::toLatex.default(x, digits=digits, show.vars=TRUE)
                   
                   f <- file("X.tex", "w")
                   writeLines(c("\\documentclass{article}",
                                "\\usepackage{booktabs}",
                                "\\usepackage{dcolumn}",
                                "\\begin{document}", 
                                "\\pagenumbering{gobble}",
                                "\\begin{table}", 
                                "\\centering"),  f)

                   if (!is.null(caption)) writeLines(paste0("\\caption{", caption, "}"), f)

                   writeLines(r, f)

                   writeLines(c("\\end{table}", "\\end{document}"), f)

                   close(f)

                   system("latex X.tex >/dev/null") # Generate DVI file from LaTeX file (X.tex -=> X.dvi)
                   system("dvipng -q* -o X.png -T tight -D 200 X.dvi >/dev/null") # convert to PNG file with Tight box and Resolution of 200
                   file.remove("X.tex", "X.log", "X.aux", "X.dvi")
               }

               if (is.null(file)) {
                   if (!grepl("/tmp", getwd())) {
                       file.copy("X.png", "~/tmp/X.png", overwrite = T)
                   }
                   system("display ~/tmp/X.png &")                                     # display the PNG file. 
               } else {
                   file.rename("X.png", paste0(file,".png"))
               }
           }
           )
    invisible(NULL)
}
if (F) {                                # Unit Test
    x <- data.frame(age=c(1,1,1,5,5,5), height=c(10,12,9,20,23,18))
    tex.print(x)
    tex.print(ftable(x))
    x %>% group_by(age) %>% summarise(heights = mean(height)) -> y
    tex.print(y)
    tex.print(x, file="Test")
    tex.print(y, type="HTML")
    tex.print(y, type="HTML", file = "Test")

    library(tables)
    a <- tabular( (Species + 1) ~ (n=1) + Format(digits=2) * (Sepal.Length + Sepal.Width) * (mean + sd), data=iris )
    tex.print(a)
    tex.print(a, file = "test")

}







No comments:

Post a Comment