Nothing
R/custom.html.R
In AnalysisPageServer: A framework for sharing interactive data and plots from R through the web
Defines functions
custom.body.html
custom.body.attr
aps.dataset.divs
aps.one.dataset.div
getScriptName
custom.html.headers
default.stylesheets
Documented in
aps.dataset.divs
aps.one.dataset.div
custom.body.attr
custom.body.html
custom.html.headers
default.stylesheets
## This file contains function to help build custom HTML that embeds AnalysisPageServer elements
##' Default stylesheets for HTML headers
##'
##' Default stylesheets for HTML headers
##' @title default.stylesheets
##' @return character vector
##' @author Brad Friedman
default.stylesheets <- function() {
getScriptName(filename = "bundle.css", type= c('apss'))
}
##' Generate HTML for custom headers to load AnalysisPageServer CSS and viewport
##'
##' Generate HTML for custom headers to load AnalysisPageServer CSS and viewport.
##' To be honest I don't understand how all this works. The main thing is that it you put this stuff
##' up top, in the header section. The only argument you should consider touching is \code{libbase.prefix},
##' if you are going to put your common libraries in a shared area instead making a copy next to each
##' dataset.
##' @title custom.html.headers
##' @param libbase.prefix Prefix where your shared CSS files will be located. Default: \code{get.APS.libbase.prefix()}.
##' @param viewport Default: "width=device-width, initial-scale=1.0". This will be used in a \code{<meta name="viewport">} tag.
##' @param stylesheets Charvec of stylesheets to load. Default is \code{default.stylesheets()}.
##' @param ep.svg.styles ep-svg-styles stylesheet. Default: NULL.
##' @return HTML string to be included in \code{<head>} section.
##' @author Brad Friedman
##' @export
custom.html.headers <- function(libbase.prefix = get.APS.libbase.prefix(),
viewport = "width=device-width, initial-scale=1.0",
stylesheets = default.stylesheets(),
ep.svg.styles = NULL) {
meta.viewport <- paste0('<meta name="viewport" content="', viewport, '">')
stylesheets.html <- paste0('<link href="', libbase.prefix, stylesheets, '" rel="stylesheet" type="text/css" />')
if(!is.null(ep.svg.styles)) {
stylesheets.html <- c(stylesheets.html,
paste0('<link id="ep-svg-styles" href="', libbase.prefix, ep.svg.styles, '" type="text/css" rel="stylesheet">'))
}
script.name.1 <- getScriptName(filename = "config.js", type= c('apss'))
script.name.2 <- getScriptName(filename = "bundle.js", type= c('apss'))
main.scripts <- paste0('<script id="ep-entry-script" src="', libbase.prefix, script.name.1, '"></script>', '\n',
'<script id="ep-entry-script" src="', libbase.prefix, script.name.2, '"></script>')
return(paste(c(meta.viewport, stylesheets.html, main.scripts), collapse= "\n"))
}
# Get script name from rev-manifest.json
getScriptName <- function(filename, type= c('aps', 'apss')){
stopifnot(length(filename) == 1)
if(missing(filename)) stop('filename is missing')
type <- match.arg(type)
type.path <- if(type == 'apss') 'dist-apss' else 'dist-aps'
rev.manifest <- rjson::fromJSON(file = file.path(
system.file(package='AnalysisPageServer'),
'htdocs', 'client', type.path,
'rev-manifest.json'))
if(filename %in% names(rev.manifest))
filename <- rev.manifest[[filename]]
return(filename)
}
##' Create HTML for a div element to contain one AnalysisPageServer data set
##'
##' Create HTML for a div element to contain one AnalysisPageServer data set.
##' This function does not created, modify, or even check for existance of
##' the SVG and JSON files. You provide paths and this function just includes
##' those paths, however awful, in the HTML returned.
##' @title aps.one.dataset.div
##' @param svg.path Path (could be relative to index.html) to (annotated) SVG file. NULL
##' to only have data table and no picture.
##' @param data.path Path (could be relative to index.html) to JSON file containing data set.
##' NULL to only have SVG and no table
##' @param show.sidebar Boolean. If TRUE (default) then show sidebar. If FALSE then omit it.
##' @param show.table Boolean. If TRUE (default) then show sidebar. If FALSE then omit it.
##' @param allow.zoom If TRUE (default) then allow zooming and panning. IF FALSE then
##' do not allow it.
##' @param plot.height If NULL (default) then do not specify 'data-plot-height' attribute.
##' Otherwise, use this number as 'data-plot-height' attribute, which will specify
##' the plot height (in pixels)
##' @param div.width If NULL (default) then do not specify div width in style.
##' Otherwise, supply a valid CSS width (e.g. "200px" or "60%")
##' and this will be rolled into the inline-style
##' @param style String specifying inline style of this div or NULL (default).
##' If NULL then and \code{div.width}
##' is also NULL then do not specfiy any inline style. If NULL and \code{div.width} is
##' non-NULL then create a centered div of \code{div.width} pixels wide with
##' \code{style="width:100px; margin:0 auto"} (or whatever div.width is, instead of "100px").
##' If non-NULL then use the string directly as the style attribute of the div.
##' @param num.table.rows Number of table rows to show. Default: 10
##' @param extra.html.class Thesee are extra classes to add to the div. This could be used for
##' whatever extended purpose you want, like extra styling or logic. Should be an unnamed charvec.
##' Default is \code{character()}, just use the basic required for APS.
##' @param extra.div.attr These are extra attributes to add to the div. For example you could
##' add an \code{id} attribute. It should be a named charvec, or NULL (default) to not anything
##' extra beyond that required for APS.
##' @return HTML string
##' @author Brad Friedman
##' @seealso \code{\link{aps.dataset.divs}}, a convenience wrapper for this
##' function to create multple divs at once.
##' @export
aps.one.dataset.div <- function(svg.path = NULL,
data.path = NULL,
show.sidebar = TRUE,
show.table = TRUE,
allow.zoom = TRUE,
plot.height = NULL,
div.width = NULL,
style = NULL,
num.table.rows = 10,
extra.html.class = character(),
extra.div.attr = NULL) {
basic.html.class <- c("ep-analysis-page-data-set","container-fluid")
class.string <- paste(collapse= " ", c(basic.html.class, extra.html.class))
length(extra.div.attr) == 0 || (is.character(extra.div.attr) && is.vector(extra.div.attr) && !is.null(names(extra.div.attr))) || stop("extra.div.attr must be NULL or a named charvec")
stopifnot(!is.null(svg.path) || !is.null(data.path))
if(is.null(data.path)) show.table <- FALSE
div.attr <- c(class = class.string,
`data-sidebar-visible` = if(show.sidebar) "yes" else "no",
`data-table-visible` = if(show.table) "yes" else "no",
extra.div.attr)
if(show.table)
div.attr["data-table-rows"] <- as.character(num.table.rows)
if(!allow.zoom)
div.attr["data-plot-zoomable"] <- "no"
if(!is.null(plot.height))
div.attr["data-plot-height"] <- plot.height
if(!is.null(svg.path))
div.attr["data-svg"] <- svg.path
if(!is.null(data.path))
div.attr["data-set"] <- data.path
if(is.null(style) && !is.null(div.width))
style <- paste0("width:", div.width, "; margin:0 auto")
if(!is.null(style))
div.attr["style"] <- style
quoted.div.attr <- paste0("\"", div.attr, "\"")
div.attr.str <- paste(names(div.attr), quoted.div.attr, sep = "=", collapse= "\n ")
div.html <- paste0("<div ", div.attr.str, "></div>")
return(div.html)
}
##' Generate HTML for multiple DIV elements corresponding to a paths list
##'
##' This function is meant to work with the return value of \code{\link{static.analysis.page}}
##' That function returns an object with a \code{$paths.list} element which
##' contains the relative paths to each of the plots and datasets. You pass that
##' through as the first argument to this function and it will make divs corresponding
##' to those plots. The other arguments are either vectors or lists of corresponding
##' lengths to pass through to \code{\link{aps.one.dataset.div}}.
##' @title aps.dataset.divs
##' @param paths.list List of lists. The outer list corresponds to data sets
##' and the inner lists have names in \code{$plot} and \code{$data}, giving
##' relative paths to the SVG and JSON files (OK to omit one). Or a list
##' with a \code{$paths.list} element, which would be used (this lets you
##' pass the return value of \code{static.analysis.page} directly to this function).
##' @param show.sidebar Logical vector of same length as \code{paths.list} to
##' pass through corresponding elements to \code{\link{aps.one.dataset.div}}.
##' Default: all TRUE.
##' @param show.table Logical vector of same length as \code{paths.list} to
##' pass through corresponding elements to \code{\link{aps.one.dataset.div}}.
##' Default: all TRUE.
##' @param num.table.rows Number of table rows to show. Default: 10.
##' Recycled to \code{length(paths.list)}.
##' @param extra.html.class List (of charvecs) of same length as \code{paths.list} to
##' pass through corresponding elements to \code{\link{aps.one.dataset.div}}.
##' Default: All empty charvec.
##' @param extra.div.attr List (of named charvecs or NULLs) of same length as \code{paths.list} to
##' pass through corresponding elements to \code{\link{aps.one.dataset.div}}.
##' Default: all NULL.
##' @param ... Passed through to \code{\link{aps.one.dataset.div}}
##' @return Charvec of HTML divs corresponding to datasets in \code{paths.list}.
##' @author Brad Friedman
##' @export
aps.dataset.divs <- function(paths.list,
show.sidebar = rep(TRUE, length(paths.list)),
show.table = rep(TRUE, length(paths.list)),
num.table.rows = 10,
extra.html.class = rep(list(character()), length(paths.list)),
extra.div.attr = rep(list(NULL), length(paths.list)),
...) {
stopifnot(is.list(paths.list))
if("paths.list" %in% names(paths.list))
paths.list <- paths.list$paths.list
stopifnot(names(unlist(paths.list)) %in% c("plot", "data"))
n.ds <- length(paths.list)
stopifnot(is.logical(show.sidebar))
stopifnot(is.logical(show.table))
show.sidebar <- rep(show.sidebar, length = n.ds)
show.table <- rep(show.table, length = n.ds)
stopifnot(is.list(extra.html.class))
stopifnot(is.list(extra.div.attr))
extra.html.class <- rep(extra.html.class, length = n.ds)
extra.div.attr <- rep(extra.div.attr, length = n.ds)
num.table.rows <- rep(num.table.rows, length = n.ds)
divs <- sapply(1:n.ds, function(i.ds) {
aps.one.dataset.div(svg.path = paths.list[[i.ds]]$plot,
data.path = paths.list[[i.ds]]$data,
show.sidebar = show.sidebar[i.ds],
show.table = show.table[i.ds],
num.table.rows = num.table.rows[i.ds],
extra.html.class = extra.html.class[[i.ds]],
extra.div.attr = extra.div.attr[[i.ds]],
...)
})
return(divs)
}
##' Return custom attributes required for body element
##'
##' This attribute must be included in the <body> element.
##' @title custom.body.attr
##' @return Name charvec of attributes for body
##' @author Brad Friedman
##' @export
custom.body.attr <- function() {
c(`data-env` = "analysis-page-server")
}
##' Generate a <body> HTML line including attributes for APS
##'
##' Generate a <body> HTML line including attributes for APS.
##' Your <body> element must have the special attribute returned by
##' the \code{\link{custom.body.attr}()}. This function
##' makes a line of HTML code containing that, and any other
##' attributes you want to include. It just opens the
##' <body> element, but does not close it.
##' @title custom.body.html
##' @param extra.attr Other attributes, provided in a named charvec.
##' @return One line of HTML with a <body> element opening tag.
##' @author Brad Friedman
##' @export
custom.body.html <- function(extra.attr = NULL) {
attr <- c(custom.body.attr(), extra.attr)
quoted.attr <- paste0("\"", attr, "\"")
attr.str <- paste(names(attr), quoted.attr, sep = "=", collapse= "\n ")
html <- paste0("<body ", attr.str, ">")
return(html)
}
Try the AnalysisPageServer package in your browser
Any scripts or data that you put into this service are public.
AnalysisPageServer documentation built on April 28, 2020, 6:32 p.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions custom.body.html custom.body.attr aps.dataset.divs aps.one.dataset.div getScriptName custom.html.headers default.stylesheets
Documented in aps.dataset.divs aps.one.dataset.div custom.body.attr custom.body.html custom.html.headers default.stylesheets
## This file contains function to help build custom HTML that embeds AnalysisPageServer elements
##' Default stylesheets for HTML headers
##'
##' Default stylesheets for HTML headers
##' @title default.stylesheets
##' @return character vector
##' @author Brad Friedman
default.stylesheets <- function() {
getScriptName(filename = "bundle.css", type= c('apss'))
}
##' Generate HTML for custom headers to load AnalysisPageServer CSS and viewport
##'
##' Generate HTML for custom headers to load AnalysisPageServer CSS and viewport.
##' To be honest I don't understand how all this works. The main thing is that it you put this stuff
##' up top, in the header section. The only argument you should consider touching is \code{libbase.prefix},
##' if you are going to put your common libraries in a shared area instead making a copy next to each
##' dataset.
##' @title custom.html.headers
##' @param libbase.prefix Prefix where your shared CSS files will be located. Default: \code{get.APS.libbase.prefix()}.
##' @param viewport Default: "width=device-width, initial-scale=1.0". This will be used in a \code{<meta name="viewport">} tag.
##' @param stylesheets Charvec of stylesheets to load. Default is \code{default.stylesheets()}.
##' @param ep.svg.styles ep-svg-styles stylesheet. Default: NULL.
##' @return HTML string to be included in \code{<head>} section.
##' @author Brad Friedman
##' @export
custom.html.headers <- function(libbase.prefix = get.APS.libbase.prefix(),
viewport = "width=device-width, initial-scale=1.0",
stylesheets = default.stylesheets(),
ep.svg.styles = NULL) {
meta.viewport <- paste0('<meta name="viewport" content="', viewport, '">')
stylesheets.html <- paste0('<link href="', libbase.prefix, stylesheets, '" rel="stylesheet" type="text/css" />')
if(!is.null(ep.svg.styles)) {
stylesheets.html <- c(stylesheets.html,
paste0('<link id="ep-svg-styles" href="', libbase.prefix, ep.svg.styles, '" type="text/css" rel="stylesheet">'))
}
script.name.1 <- getScriptName(filename = "config.js", type= c('apss'))
script.name.2 <- getScriptName(filename = "bundle.js", type= c('apss'))
main.scripts <- paste0('<script id="ep-entry-script" src="', libbase.prefix, script.name.1, '"></script>', '\n',
'<script id="ep-entry-script" src="', libbase.prefix, script.name.2, '"></script>')
return(paste(c(meta.viewport, stylesheets.html, main.scripts), collapse= "\n"))
}
# Get script name from rev-manifest.json
getScriptName <- function(filename, type= c('aps', 'apss')){
stopifnot(length(filename) == 1)
if(missing(filename)) stop('filename is missing')
type <- match.arg(type)
type.path <- if(type == 'apss') 'dist-apss' else 'dist-aps'
rev.manifest <- rjson::fromJSON(file = file.path(
system.file(package='AnalysisPageServer'),
'htdocs', 'client', type.path,
'rev-manifest.json'))
if(filename %in% names(rev.manifest))
filename <- rev.manifest[[filename]]
return(filename)
}
##' Create HTML for a div element to contain one AnalysisPageServer data set
##'
##' Create HTML for a div element to contain one AnalysisPageServer data set.
##' This function does not created, modify, or even check for existance of
##' the SVG and JSON files. You provide paths and this function just includes
##' those paths, however awful, in the HTML returned.
##' @title aps.one.dataset.div
##' @param svg.path Path (could be relative to index.html) to (annotated) SVG file. NULL
##' to only have data table and no picture.
##' @param data.path Path (could be relative to index.html) to JSON file containing data set.
##' NULL to only have SVG and no table
##' @param show.sidebar Boolean. If TRUE (default) then show sidebar. If FALSE then omit it.
##' @param show.table Boolean. If TRUE (default) then show sidebar. If FALSE then omit it.
##' @param allow.zoom If TRUE (default) then allow zooming and panning. IF FALSE then
##' do not allow it.
##' @param plot.height If NULL (default) then do not specify 'data-plot-height' attribute.
##' Otherwise, use this number as 'data-plot-height' attribute, which will specify
##' the plot height (in pixels)
##' @param div.width If NULL (default) then do not specify div width in style.
##' Otherwise, supply a valid CSS width (e.g. "200px" or "60%")
##' and this will be rolled into the inline-style
##' @param style String specifying inline style of this div or NULL (default).
##' If NULL then and \code{div.width}
##' is also NULL then do not specfiy any inline style. If NULL and \code{div.width} is
##' non-NULL then create a centered div of \code{div.width} pixels wide with
##' \code{style="width:100px; margin:0 auto"} (or whatever div.width is, instead of "100px").
##' If non-NULL then use the string directly as the style attribute of the div.
##' @param num.table.rows Number of table rows to show. Default: 10
##' @param extra.html.class Thesee are extra classes to add to the div. This could be used for
##' whatever extended purpose you want, like extra styling or logic. Should be an unnamed charvec.
##' Default is \code{character()}, just use the basic required for APS.
##' @param extra.div.attr These are extra attributes to add to the div. For example you could
##' add an \code{id} attribute. It should be a named charvec, or NULL (default) to not anything
##' extra beyond that required for APS.
##' @return HTML string
##' @author Brad Friedman
##' @seealso \code{\link{aps.dataset.divs}}, a convenience wrapper for this
##' function to create multple divs at once.
##' @export
aps.one.dataset.div <- function(svg.path = NULL,
data.path = NULL,
show.sidebar = TRUE,
show.table = TRUE,
allow.zoom = TRUE,
plot.height = NULL,
div.width = NULL,
style = NULL,
num.table.rows = 10,
extra.html.class = character(),
extra.div.attr = NULL) {
basic.html.class <- c("ep-analysis-page-data-set","container-fluid")
class.string <- paste(collapse= " ", c(basic.html.class, extra.html.class))
length(extra.div.attr) == 0 || (is.character(extra.div.attr) && is.vector(extra.div.attr) && !is.null(names(extra.div.attr))) || stop("extra.div.attr must be NULL or a named charvec")
stopifnot(!is.null(svg.path) || !is.null(data.path))
if(is.null(data.path)) show.table <- FALSE
div.attr <- c(class = class.string,
`data-sidebar-visible` = if(show.sidebar) "yes" else "no",
`data-table-visible` = if(show.table) "yes" else "no",
extra.div.attr)
if(show.table)
div.attr["data-table-rows"] <- as.character(num.table.rows)
if(!allow.zoom)
div.attr["data-plot-zoomable"] <- "no"
if(!is.null(plot.height))
div.attr["data-plot-height"] <- plot.height
if(!is.null(svg.path))
div.attr["data-svg"] <- svg.path
if(!is.null(data.path))
div.attr["data-set"] <- data.path
if(is.null(style) && !is.null(div.width))
style <- paste0("width:", div.width, "; margin:0 auto")
if(!is.null(style))
div.attr["style"] <- style
quoted.div.attr <- paste0("\"", div.attr, "\"")
div.attr.str <- paste(names(div.attr), quoted.div.attr, sep = "=", collapse= "\n ")
div.html <- paste0("<div ", div.attr.str, "></div>")
return(div.html)
}
##' Generate HTML for multiple DIV elements corresponding to a paths list
##'
##' This function is meant to work with the return value of \code{\link{static.analysis.page}}
##' That function returns an object with a \code{$paths.list} element which
##' contains the relative paths to each of the plots and datasets. You pass that
##' through as the first argument to this function and it will make divs corresponding
##' to those plots. The other arguments are either vectors or lists of corresponding
##' lengths to pass through to \code{\link{aps.one.dataset.div}}.
##' @title aps.dataset.divs
##' @param paths.list List of lists. The outer list corresponds to data sets
##' and the inner lists have names in \code{$plot} and \code{$data}, giving
##' relative paths to the SVG and JSON files (OK to omit one). Or a list
##' with a \code{$paths.list} element, which would be used (this lets you
##' pass the return value of \code{static.analysis.page} directly to this function).
##' @param show.sidebar Logical vector of same length as \code{paths.list} to
##' pass through corresponding elements to \code{\link{aps.one.dataset.div}}.
##' Default: all TRUE.
##' @param show.table Logical vector of same length as \code{paths.list} to
##' pass through corresponding elements to \code{\link{aps.one.dataset.div}}.
##' Default: all TRUE.
##' @param num.table.rows Number of table rows to show. Default: 10.
##' Recycled to \code{length(paths.list)}.
##' @param extra.html.class List (of charvecs) of same length as \code{paths.list} to
##' pass through corresponding elements to \code{\link{aps.one.dataset.div}}.
##' Default: All empty charvec.
##' @param extra.div.attr List (of named charvecs or NULLs) of same length as \code{paths.list} to
##' pass through corresponding elements to \code{\link{aps.one.dataset.div}}.
##' Default: all NULL.
##' @param ... Passed through to \code{\link{aps.one.dataset.div}}
##' @return Charvec of HTML divs corresponding to datasets in \code{paths.list}.
##' @author Brad Friedman
##' @export
aps.dataset.divs <- function(paths.list,
show.sidebar = rep(TRUE, length(paths.list)),
show.table = rep(TRUE, length(paths.list)),
num.table.rows = 10,
extra.html.class = rep(list(character()), length(paths.list)),
extra.div.attr = rep(list(NULL), length(paths.list)),
...) {
stopifnot(is.list(paths.list))
if("paths.list" %in% names(paths.list))
paths.list <- paths.list$paths.list
stopifnot(names(unlist(paths.list)) %in% c("plot", "data"))
n.ds <- length(paths.list)
stopifnot(is.logical(show.sidebar))
stopifnot(is.logical(show.table))
show.sidebar <- rep(show.sidebar, length = n.ds)
show.table <- rep(show.table, length = n.ds)
stopifnot(is.list(extra.html.class))
stopifnot(is.list(extra.div.attr))
extra.html.class <- rep(extra.html.class, length = n.ds)
extra.div.attr <- rep(extra.div.attr, length = n.ds)
num.table.rows <- rep(num.table.rows, length = n.ds)
divs <- sapply(1:n.ds, function(i.ds) {
aps.one.dataset.div(svg.path = paths.list[[i.ds]]$plot,
data.path = paths.list[[i.ds]]$data,
show.sidebar = show.sidebar[i.ds],
show.table = show.table[i.ds],
num.table.rows = num.table.rows[i.ds],
extra.html.class = extra.html.class[[i.ds]],
extra.div.attr = extra.div.attr[[i.ds]],
...)
})
return(divs)
}
##' Return custom attributes required for body element
##'
##' This attribute must be included in the <body> element.
##' @title custom.body.attr
##' @return Name charvec of attributes for body
##' @author Brad Friedman
##' @export
custom.body.attr <- function() {
c(`data-env` = "analysis-page-server")
}
##' Generate a <body> HTML line including attributes for APS
##'
##' Generate a <body> HTML line including attributes for APS.
##' Your <body> element must have the special attribute returned by
##' the \code{\link{custom.body.attr}()}. This function
##' makes a line of HTML code containing that, and any other
##' attributes you want to include. It just opens the
##' <body> element, but does not close it.
##' @title custom.body.html
##' @param extra.attr Other attributes, provided in a named charvec.
##' @return One line of HTML with a <body> element opening tag.
##' @author Brad Friedman
##' @export
custom.body.html <- function(extra.attr = NULL) {
attr <- c(custom.body.attr(), extra.attr)
quoted.attr <- paste0("\"", attr, "\"")
attr.str <- paste(names(attr), quoted.attr, sep = "=", collapse= "\n ")
html <- paste0("<body ", attr.str, ">")
return(html)
}
Try the AnalysisPageServer package in your browser
Any scripts or data that you put into this service are public.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.