Nothing
#' @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())
}
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.