Key word: R, xtable, pop-up comment

html_table_popup_comment.R

#'@title Generate HTML table from data.frame and add a pop-up comment on specific table entry
#'@param r_dataframe a data.frame object
#'@param js_show a list object whose name is the column names of r_dataframe, value is the added pop-up comment
html_table_popup_comment <- function(r_dataframe, js_show, ...) {
  stopifnot(require(xtable))
  global.env <- environment()
  r_dataframe.xtable <- xtable(r_dataframe)
  global.env$sanitize <- function(str) {
    result <- str
    result <- gsub("&", "&amp ", result, fixed = TRUE)
    result <- gsub(">", "&gt ", result, fixed = TRUE)
    result <- gsub("<", "&lt ", result, fixed = TRUE)
    return(result)
  }
  global.env$i <- 0
  print(names(js_show))
  result <- print.xtable(r_dataframe.xtable, type="html", sanitize.text.function=function(str) {
    str <- global.env$sanitize(str)
    i <- get("i", envir=parent.frame(1))
    x <- get("x", envir=parent.frame(1))
    print(colnames(x)[i])
    if (colnames(x)[i] %in% names(js_show)) {
      str <- paste("<a title=\"", js_show[[colnames(x)[i]]], "\">", str, "</a")
    }
    return(str)
  }, sanitize.rownames.function = global.env$santize, sanitize.colnames.function = global.env$santize, print.results=FALSE, ...)
  return(result)
}