Small Functions for Writing HTML Files

Zed A. Shaw
-------------- next part --------------
# A small set of functions for writing an HTML file on the fly.  Most of the functions are fairly explanatory.
# Written by Zed A. Shaw


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


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


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


# generic function for beginning a tag
tag.begin <- function(name, ...) {
	# 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)
}


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




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


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


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


html.list <- function(list.elements,type="ul") {
	tag.begin(type)
	
	for(item in list.elements) {
          # if this is a vector or another list, then recursively process it
          if(!is.character(item) && (is.vector(item) || is.list(item))) {
            print("Listing ")
            print(item)
            html.list(item)
          } else {
            # otherwise, we just print out an item
            tag.begin("li")
            html.write(item)
            tag.end("li")
          }
	}
	
	tag.end(type)
}

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


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

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


# sends the output to the html report file
html.divert <- function() {
  print("Diverting output to the html file.  Remember to revert when you are done.")
  sink(html$file,append=TRUE)
}

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


# 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...")
html.p("Skipped for now until I get xtable on my laptop")


# 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()