R/print.SciencesPo.R

In danielmarcelino/SciencesPo: A Tool Set for Analyzing Political Behavior Data

#' @encoding UTF-8
#' @title Print method for objects of class \code{SciencesPo}.
#' @description Display \code{SciencesPo} objects in the console, in \emph{RStudio}'s viewer or in web browser.
#' @param x SciencesPo object generated with \code{Freq}, \code{Describe} or \code{Standard}.
#' @param method one of \dQuote{pander}, \dQuote{viewer} or \dQuote{browser}. If \dQuote{viewer} is used outside RStudio, Web Browser will be used instead.
#' @param \dots additional arguments ignored at the moment.
#'
#' @author Daniel Marcelino, \email{dmarcelino@@live.com}
#' @keywords internal
#' @rdname print
#' @export
`print.SciencesPo` <- function(x, method="pander", ...) {

  # Build info.table and prepare the field  -----------------------------------

  if(method=="pander") {
    info.table <- c()
    for(a in c("df.name", "var.name", "var.label", "rows.subset")) {
      # other possible items are "date" and "col.names"
      if(a %in% names(attributes(x)))
        info.table <- append(info.table, paste(a, ":", paste(as.character(attr(x, a)),
                                                             collapse=", "),
                                               sep=""))
    }

    info.table <- sub("^df\\.name:",    "Dataset: ", info.table)
    info.table <- sub("^var\\.name:",   " Variable name: ", info.table)
    #info.table <- sub("^col\\.names:",  "  Column names: ", info.table)
    info.table <- sub("^var\\.label:",  "Variable label: ", info.table)
    info.table <- sub("^rows\\.subset:","   Rows subset: ", info.table)
    #info.table <- sub("^date:",         "          Date: ", info.table)
    info.table <- paste(info.table, collapse="\n")

    if(nchar(info.table)==0)
      info.table <- attr(x, "arg.str")
  }

  # for methods "browser" and "viewer"
  else {
    html.footer.line = paste("Generated by <a href='https://github.com/danielmarcelino/SciencesPo'>SciencesPo</a> package version ",
                             utils::packageVersion(pkg = "SciencesPo"),
                             " (<a href='http://www.r-project.org/'>R</a> version ", getRversion(), ")",
                             "<br/>", Sys.Date(), sep="")
}

  notes <- ifelse("notes" %in% names(attributes(x)),
                  yes = paste(attr(x,"notes")), no = "")


  # printing Normal objects -----------------------------------------------------
   if(attr(x, "scpo.type") == "Standard") {
    # with method=="pander"
      cat(info.table)
      pander.args <- append(attr(x, "pander.args"), list(x=quote(x)))
      cat(do.call(pander::pander, pander.args))
      cat(notes)
  }

  # Printing descr objects ----------------------------------------------------
 else if(attr(x, "scpo.type") == "descr") {

    # With method pander --------------------------------------
    if(method=="pander") {

      cat("\nDescriptive (Univariate) Statistics\n\n")
      cat(info.table)
      pander.args <- append(attr(x, "pander.args"), list(x=quote(x$stats)))
      cat(do.call(pander::pander, pander.args))
      cat("Observations")
      pander.args <- append(attr(x, "pander.args"), list(x=quote(x$observ)))
      cat(do.call(pander::pander, pander.args))
      cat(notes, "\n")
    }

    # With method viewer / browser --------------------------
    else if(grepl("(v|view(er)?)|(B|brow(ser)?)",method)) {

      descr.table.html <-
        xtable::print.xtable(xtable::xtable(x = x$stats, align = paste("r", paste(rep("c",ncol(x$stats)),collapse=""),sep=""), digits = c(0,rep(attr(x, "pander.args")$round,ncol(x$stats)))), type = "html", print.results = FALSE, html.table.attributes = 'class="table table-striped table-bordered"')

      obs.table.html <-
        xtable::print.xtable(xtable::xtable(x = x$observ, align = paste("r", paste(rep("c",ncol(x$observ)),collapse=""),sep=""),digits = c(0,rep(attr(x, "pander.args")$round,ncol(x$observ)))),type = "html", print.results = FALSE, html.table.attributes = 'class="table table-striped table-bordered"')

      stpath <- find.package("SciencesPo")

      html.content <- tags$html(
        tags$header(
          includeCSS(path = paste(stpath,"includes/stylesheets/bootstrap.min.css", sep="/")),
          includeCSS(path = paste(stpath,"includes/stylesheets/custom.css", sep="/"))
        ),
        tags$body(
          div(class="container", # style="width:80%",
              h3("Descriptive Univariate Statistics"),
              h2(attr(x, "df.name")),
              if("rows.subset" %in% names(attributes(x)))
                p("Rows subset:",attr(x,"rows.subset")),
              #h4("Number of rows: ", attr(x, "n.obs")),
              br(),
              HTML(gsub("<td> ", "<td>", descr.table.html)),
              h3("Observations"),
              HTML(gsub("<td> ", "<td>", obs.table.html)),
              p(notes),
              HTML(text = html.footer.line)
          )
        )
      )

      htmlfile <- paste(tempfile(),".html",sep="")
      utils::capture.output(html.content, file = htmlfile)
    }
  }


  # Printing Describe objects ------------------------------------------------
  else if(attr(x, "scpo.type") == "Describe") {

    # With method pander --------------------------
    if(method=="pander") {
      cat("\nSummary table\n")
      cat(info.table)
      pander.args <- append(attr(x, "pander.args"), list(x=quote(x)))
      cat(do.call(pander::pander, pander.args))
    }

    # with method viewer or browser ---------------
    else if(grepl("(v|view(er)?)|(B|brow(ser)?)",method)) {

      sanitize.colnames <- function(x) {
        x <- gsub("\\.", " ", x)
        x <- .Capitalise(x)
        x <- sub("levels or stats", "Levels / Stats", x)
        return(x)
      }

      Describe.html <-
        xtable::print.xtable(xtable::xtable(x = x,digits = 0,
                                            align = paste("c", paste(rep("l",ncol(x)),collapse=""),sep="")),
                             include.rownames = FALSE, type = "html", print.results = FALSE,
                             sanitize.colnames.function = sanitize.colnames,
                             html.table.attributes = 'class="table table-striped table-bordered"')

      stpath <- find.package("SciencesPo")

      html.content <- tags$html(
        tags$header(
          includeCSS(path = paste(stpath,"includes/stylesheets/bootstrap.min.css", sep="/")),
          includeCSS(path = paste(stpath,"includes/stylesheets/custom.css", sep="/"))
        ),
        tags$body(
          div(class="container", #style="width:80%",
              h3("Summary table"),
              h2(attr(x, "df.name")),
              if("rows.subset" %in% names(attributes(x)))
                p("Rows subset:",attr(x,"rows.subset")),
              h4("Number of rows: ", attr(x, "n.obs")),
              br(),
              HTML(gsub("<td> ", "<td>", Describe.html)),
              p(notes),
              HTML(text = html.footer.line)
          )
        )
      )

      htmlfile <- paste(tempfile(),".html",sep="")
      utils::capture.output(html.content, file = htmlfile)
    }
  }

  # printing freq objects -----------------------------------------------------
  else if(attr(x, "scpo.type") == "freq") {

    # with method=="pander"
    if(method=="pander") {
      cat("\nFrequencies\n\n")
      cat(info.table)
      pander.args <- append(attr(x, "pander.args"), list(x=quote(x)))
      cat(do.call(pander::pander, pander.args))
      cat(notes)
    }

    # with method viewer / browser --------------------
    else if(grepl("([v|V]iew)|(brow)",method)) {

      sanitize.colnames <- function(x) {
        x <- gsub("\\.", " ", x)
        x <- sub("\\%", "% ", x)
        return(x)
      }

      freq.table.html <-
        xtable::print.xtable(xtable::xtable(x = x, align = "rccccc",
                                            digits = c(0,0,rep(attr(x, "pander.args")$round,4))),
                             type = "html", print.results = FALSE,
                             sanitize.colnames.function = sanitize.colnames,
                             html.table.attributes = 'class="table table-striped table-bordered"')

      stpath <- find.package("SciencesPo")

      html.content <- tags$html(
        tags$header(
          includeCSS(path = paste(stpath,"includes/stylesheets/bootstrap.min.css", sep="/")),
          includeCSS(path = paste(stpath,"includes/stylesheets/custom.css", sep="/"))
        ),
        tags$body(
          div(class="container", #style="width:80%",
              h3("Frequencies"),
              h2(attr(x,"var.name")),
              if("rows.subset" %in% names(attributes(x)))
                p("Dataset:",attr(x,"df.name")),
              if("rows.subset" %in% names(attributes(x)))
                p("Rows subset:",attr(x,"rows.subset")),
              br(),
              HTML(gsub("<td> ", "<td>", freq.table.html)), # To avoid initial space in cells
              p(notes),
              HTML(text = html.footer.line)
          )
        )
      )
      htmlfile <- paste(tempfile(),".html",sep="")
      utils::capture.output(html.content, file = htmlfile)
    }
  }


  # Open the output html file --------------------------------------------
  if(grepl("v|view(er)?",method)) {
    if(!is.null(getOption("viewer")))
      rstudioapi::viewer(htmlfile)
    else
      utils::browseURL(htmlfile)
  } else if(grepl("b|Brow(ser)?", method)) {
    utils::browseURL(htmlfile)
  }

  # return file path for browser/viewer ----------------------------------
  if(grepl("(B|brow(ser)?)|(V|view(er)?)", method)) {
    message("Temporary html file created. To remove file from filesystem, please use file.remove(.Last.value)")
    return(normalizePath(htmlfile))
  } else {
    return(invisible())
  }
}