[R] Improved HTML Reporting Functions

[Zed A. Shaw]

Hello Everyone,

First, I'd like to appologize for the e-mail confirmation that was
attached to my last message.  It was entirely unintentional.

I've attached a set of R files that make writing HTML reports very easy.
I basically combined the HTML functions I wrote previously, David Dahl's
xtable from CRAN, and then wrote a series of wrapper functions to
automagically write the correct HTML for different datatypes.  With
this, you can write a report simply by doing:

r <- report.new("My Report")
report.begin(r)
report(somestuff,r)
report(summary(sumstuff,r))
report.plot("fit.png",somestuff,r)
report.end(r)


And it will write all the good stuff for you to an html file.  I've
included an example file report-test.r so you can see how it all works.

Please take a look at it and send me your suggestions.  Feel free to
contact me at the points in my signature.

Thanks for your time.

-------------------------
Zed A. Shaw
Senior Programmer Analyst
University of British Columbia

AOL: shawzed, ICQ: 101799544, Yahoo: zed_shaw, MSN: zedshaw at hotmail.com
I also hang out on SILC at silc.silcnet.org


-------------- next part --------------
source("html.r")
require(xtable)

# example of how to use these functions
html.file("report.html")
html.begin("Statistical Report 1")
html.h("Statistical Report 1")
html.p("This report describes the relationship between data BANK.SAV file given for assignment 1")

# write an image in the current directory
data(swiss)
attach(swiss)
swiss.lm <- lm(Agriculture ~ Examination)

png(filename = "fit1.png")
plot(formula(swiss.lm))
abline(swiss.lm)
dev.off()


# write the image to the report
html.h("Figure 1: Multiple Regression Fit", level=2)

html.img("fit1.png")

html.h("Table 1: Summary of Regression Results", level=2)
html.p("This table shows the results of the regression.  As you can see...")


# create an xtable for the analysis
swiss.lm.xtable <- xtable(swiss.lm)
caption(swiss.lm.xtable) <- "Multiple Regression of salnow ~ salbeg + work + age"
print(swiss.lm.xtable,type="html",file=html$file,append=TRUE)

# this demonstrates how to divert the commands that cannot print to a file
html.h("This output shows even more detail.", level=2)

tag.begin("pre")
html.divert()
summary(swiss.lm)
html.revert()
tag.end("pre")


html.h("Demonstration of Listing", level=2)
number.list <- c("One", "Two", "Three", "Four", "Five")
html.p("A unordered list:")
html.list(number.list)
html.p("An ordered list:")
html.list(number.list,type="ol")

html.end()

-------------- next part --------------
html <- list(file="report.html")


html.file <- function(file="report.html") { 
	html$file <- file
}


html.write <- function(text,file=html$file,append=TRUE) {
	cat(text,file=file,append=append)
} 


# generic function for beginning a tag
tag.begin <- function(name, file=html$file, ...) {
	# start the tag
	tag <- paste(c("<",name), collapse="")
	
	# build the attributes
	attr.list <- list(...)
	for(n in names(attr.list)) {
		attr <- paste(c(n,"=",attr.list[n]),collapse="")
		# add to the end of tag
		tag <- paste(c(tag,attr),collapse=" ")
	}
	
	# end the tag
	tag <- paste(c(tag, ">"), collapse="")
	html.write(tag,file)
}


# generic function for ending a tag
tag.end <- function(name,file=html$file) {
	tag <- paste(c("</",name,">"), collapse="")
	html.write(tag,file)
}




# begins an html document
html.begin <- function(title, file=html$file, bgcolor="#FFFFFF") {
	html.write("<!-- HTML output generated by Zed A. Shaw's HTML report library. -->",file, append=FALSE)
	tag.begin("html",file)
	tag.begin("head",file)
	tag.begin("title",file)
	html.write(title, file)
	tag.end("title",file)
	tag.end("head",file)
	tag.begin("body",file,bgcolor=bgcolor)
}


# begins an html header (H) tag
html.h <- function(title, file=html$file, level=1) {
	h <- paste(c("<h",level,">",title,"</h",level,">"),collapse="")
	html.write(h,file)
}


html.p <- function(text="",file=html$file) {
	p <- paste(c("<p>",text,"</p>"),collapse="")
	html.write(p,file)
}


html.list <- function(list.elements,file=html$file,type="ul") {
	tag.begin(type,file)
	
	for(item in list.elements) {
          tag.begin("li",file)
          html.write(item,file)
          tag.end("li",file)
        }
	
	tag.end(type,file)
}

# writes an HR tag
html.hr <- function(file=html$file) {
	tag.begin("hr",file)
	tag.end("hr",file)
}


# writes an img tag
html.img <- function(src,file=html$file,border="0") {
	tag.begin("img",file,src=src,border=border)
	tag.end("img",file)
}

# ends an html document
html.end <- function(file=html$file) {
	tag.end("body",file)
	tag.end("html",file)
}


# sends the output to the html report file
html.divert <- function(file=html$file) {
  sink(file,append=TRUE)
}

# stops sending the output to the report file
html.revert <- function() {
  sink()
}
-------------- next part --------------
source("report.r")

# small sample of how to use the reporting stuff

data(swiss)
attach(swiss)
swiss.lm <- lm(Catholic ~ Fertility)
swiss.aov <- aov(swiss.lm)

swiss.report <- report.new("Swiss Data Report")
report.begin(swiss.report)

report(summary(swiss),swiss.report)
report(swiss.lm,swiss.report)
report(summary(swiss.lm),swiss.report)
report(swiss.aov,swiss.report)
report(summary(swiss.aov),swiss.report)

# a simple plot
report.plot("fit1.png",formula(swiss.lm),swiss.report)

# a more complex plot
report.plot("fit2.png",swiss.lm,swiss.report,plotfunc=function(x) {
  plot(formula(swiss.lm))
  abline(swiss.lm)
})


# all done
report.end(swiss.report)

-------------- next part --------------
source("html.r")
require(xtable)

# simple report writing to html functions


# This creates a new report object, which must be passed to all
# of the report functions so they know what to write.  The only
# type available right now is "html".
#
# It does NOT open the file or do anything, it merely makes the
# report object you need for the other report functions.
#
report.new <- function(title,file="report.html",type="html") {
  rep <- list(file="report.html",title=title)
  class(rep) <- "report"
  return(rep)
}


# This starts the report defined in the report object.
report.begin <- function(report) {
  html.begin(report$title,file=report$file)
  html.h(report$title)
}

# This ends the report defined in the report object.
report.end <- function(report) {
  html.end(report$file)
}



# Generic dispatch method that writes various report sections
# based on the type of object given in x.
report <- function(x,report, ...) {
  UseMethod("report")
}


# Writes tables to the report
report.xtable <- function(x,report, descr="",heading="Table", ...) {
  # write out the report
  html.h(heading,report$file)
  html.p(descr,report$file)
  print(x,type="html",report$file,append=TRUE)
}


report.data.frame <- function(x,report,desc="",heading="Data Frame", ...) {
  report.xtable(xtable(x),report,desc,heading,...)
}


report.summary.lm <- function(x,report,desc="",heading="LM Detailed Summary", ...) {
  html.h(heading ,report$file)
  html.p(desc,report$file)
  tag.begin("pre",report$file)
  html.divert(report$file)
  print(x)
  html.revert()
  tag.end("pre",report$file)
}


# For some reason, xtable can't do tables...
report.table <- function(x,report,desc="",heading="Generic Table") {
  html.h(heading,report$file)
  html.p(desc,report$file)
  tag.begin("pre",report$file)
  html.divert(report$file)
  print(x)
  html.revert()
  tag.end("pre",report$file)
}

report.lm <- function(x,report,desc="",heading="Linear Model",...) {
  report.xtable(xtable(x),report,desc,heading)
}

report.matrix <- function(x,report,desc="",heading="Matrix",...) {
    report.xtable(xtable(x),report,desc,heading)
}

report.anova <- function(x,report,desc="",heading="ANOVA",...) {
    report.xtable(xtable(x),report,desc,heading)
}

report.aov <- function(x,report,desc="",heading="AOV",...) {
    report.xtable(xtable(x),report,desc,heading)
}

report.summary.aov <- function(x,report,desc="",heading="AOV Detailed Summary",...) {
    report.xtable(xtable(x),report,desc,heading)
}

report.aovlist <- function(x,report,desc="",heading="AOV List",...) {
    report.xtable(xtable(x),report,desc,heading)
}

report.summary.aovlist <- function(x,report,desc="",heading="AOV List Detailed Summary",...) {
    report.xtable(xtable(x),report,desc,heading)
}


report.glm <- function(x,report,desc="",heading="Generalized Linear Model",...) {
    report.xtable(xtable(x),report,desc,heading)
}

report.summary.glm <- function(x,report,desc="",heading="GLM Detailed Summary",...) {
    report.xtable(xtable(x),report,desc,heading)
}

report.prcomp <- function(x,report,desc="",heading="PRComp",...) {
    report.xtable(xtable(x),report,desc,heading)
}

report.summary.prcomp <- function(x,report,desc="",heading="PRComp Detailed Summary",...) {
    report.xtable(xtable(x),report,desc,heading)
}


# special reporting function that will write out the given plot
# probably only useful for very simplistic plot situations

report.plot <- function(file,data,report,plotfunc=plot,desc="",heading="Figure",...) {
  png(filename = file,...)
  plotfunc(data)
  dev.off()

  # write the image to the report
  html.h(heading, report$file)
  html.p(desc,report$file)
  html.img(file,report$file) 
}