# downloadablePlot Shiny Module --
#' downloadablePlot UI
#'
#' Creates a custom plot output that is paired with a linked downloadFile
#' button. This module is compatible with ggplot2, grob and lattice
#' produced graphics.
#'
#' @param id character id for the object
#' @param downloadtypes vector of values for download types
#' @param download_hovertext download button tooltip hover text
#' @param width plot width (any valid css size value)
#' @param height plot height (any valid css size value)
#' @param btn_halign horizontal position of the download button ("left", "center", "right")
#' @param btn_valign vertical position of the download button ("top", "bottom")
#' @param btn_overlap whether the button should appear on top of the bottom of
#' the plot area to save on vertical space \emph{(there is often a blank area
#' where a button can be overlayed instead of utilizing an entire horizontal
#' row for the button below the plot area)}
#' @param clickOpts NULL or an object created by the \link[shiny]{clickOpts} function
#' @param hoverOpts NULL or an object created by the \link[shiny]{hoverOpts} function
#' @param brushOpts NULL or an object created by the \link[shiny]{brushOpts} function
#'
#' @section Example:
#' \code{downloadablePlotUI("myplotID", c("png", "csv"),
#' "Download Plot or Data", "300px")}
#'
#' @section Notes:
#' When there is nothing to download in any of the linked downloadfxns the
#' button will be hidden as there is nothing to download.
#'
#' This module is NOT compatible with the built-in (base) graphics \emph{(such as
#' basic plot, etc.)} because they cannot be saved into an object and are directly
#' output by the system at the time of creation.
#'
#' @section Shiny Usage:
#' Call this function at the place in ui.R where the plot should be placed.
#'
#' Paired with a call to \code{downloadablePlot(id, ...)}
#' in server.R
#'
#' @seealso \link[periscope]{downloadablePlot}
#' @seealso \link[periscope]{downloadFileButton}
#' @seealso \link[shiny]{clickOpts}
#' @seealso \link[shiny]{hoverOpts}
#' @seealso \link[shiny]{brushOpts}
#'
#' @examples
#' # Inside ui_body.R or ui_sidebar.R
#' downloadablePlotUI("object_id1",
#' downloadtypes = c("png", "csv"),
#' download_hovertext = "Download the plot and data here!",
#' height = "500px",
#' btn_halign = "left")
#'
#' @export
downloadablePlotUI <- function(id,
downloadtypes = c("png"),
download_hovertext = NULL,
width = "100%",
height = "400px",
btn_halign = "right",
btn_valign = "bottom",
btn_overlap = TRUE,
clickOpts = NULL,
hoverOpts = NULL,
brushOpts = NULL) {
ns <- shiny::NS(id)
styleval <- "display:none; padding: 5px"
if (btn_halign == "left") {
styleval <- paste(styleval, "float:left", sep = ";")
}
else if (btn_halign == "center") {
styleval <- paste(styleval, "float:none", "margin-left:45%", sep = ";")
}
else if (btn_halign != "right") {
msg <- paste(btn_halign, " is not a valid btn_halign input - using default",
"value. Valid values: <'left', 'center', 'right'>")
warning(msg)
btn_halign <- "right"
}
if (!(btn_valign %in% c("top", "bottom"))) {
msg <- paste(btn_valign, " is not a valid btn_valign input - using default",
"value. Valid values: <'top', 'bottom'>")
warning(msg)
btn_valign <- "bottom"
}
if (btn_overlap) {
styleval <- ifelse(btn_valign == "bottom",
paste(styleval, "top: -50px", sep = ";"),
paste(styleval, paste0("top: -", height), "position:relative", sep = ";"))
}
else {
styleval <- ifelse(btn_valign == "bottom",
paste(styleval, "top: 5px", sep = ";"),
paste(styleval, "top: -5px", sep = ";"))
# paste(styleval, "top: -1050px", "position: relative", sep = ";"))
}
btn_item <- shiny::span(id = ns("dplotButtonDiv"),
class = "periscope-downloadable-plot-button",
style = styleval,
periscope::downloadFileButton(
ns("dplotButtonID"),
downloadtypes,
download_hovertext))
plot_item <- shiny::plotOutput(outputId = ns("dplotOutputID"),
width = width,
height = height,
click = clickOpts,
hover = hoverOpts,
brush = brushOpts)
if (!btn_overlap && (btn_valign == "top")) {
list(btn_item, plot_item)
}
else {
list(plot_item, btn_item)
}
}
#' downloadablePlot Module
#'
#' Server-side function for the downloadablePlotUI. This is a custom
#' plot output paired with a linked downloadFile button.
#'
#' @param ... free parameters list for shiny to pass session variables based on the module call(session, input, output)
#' variables. \emph{Note}: The first argument of this function must be the ID of the Module's UI element
#' @param logger logger to use
#' @param filenameroot the base text used for user-downloaded file - can be
#' either a character string or a reactive expression returning a character
#' string
#' @param aspectratio the downloaded chart image width:height ratio (ex:
#' 1 = square, 1.3 = 4:3, 0.5 = 1:2). Where not applicable for a download type
#' it is ignored (e.g. data, html downloads)
#' @param downloadfxns a \strong{named} list of functions providing download
#' images or data tables as return values. The names for the list should be
#' the same names that were used when the plot UI was created.
#' @param visibleplot function or reactive expression providing the plot to
#' display as a return value. This function should require no input parameters.
#'
#' @section Notes:
#' When there are no values to download in any of the linked downloadfxns the
#' button will be hidden as there is nothing to download.
#'
#' @section Shiny Usage:
#' This function is not called directly by consumers - it is accessed in
#' server.R using the same id provided in \code{downloadablePlotUI}:
#'
#' \strong{\code{downloadablePlot(id, logger, filenameroot,
#' downloadfxns, visibleplot)}}
#'
#' @seealso \link[periscope]{downloadablePlotUI}
#'
#' @examples
#' # Inside server_local.R
#'
#' # downloadablePlot("object_id1",
#' # logger = ss_userAction.Log,
#' # filenameroot = "mydownload1",
#' # aspectratio = 1.33,
#' # downloadfxns = list(png = myplotfxn, tsv = mydatafxn),
#' # visibleplot = myplotfxn)
#'
#' @export
downloadablePlot <- function(...,
logger,
filenameroot,
aspectratio = 1,
downloadfxns = list(),
visibleplot) {
call <- match.call()
params <- list(...)
param_index <- 1
params_length <- length(params)
old_style_call <- call[[1]] == "module" || "periscope" %in% as.character(call[[1]])
if (old_style_call) {
input <- params[[param_index]]
param_index <- param_index + 1
output <- params[[param_index]]
param_index <- param_index + 1
session <- params[[param_index]]
param_index <- param_index + 1
} else {
id <- params[[param_index]]
param_index <- param_index + 1
}
if (missing(logger) && params_length >= param_index) {
logger <- params[[param_index]]
param_index <- param_index + 1
}
if (missing(filenameroot) && params_length >= param_index) {
filenameroot <- params[[param_index]]
param_index <- param_index + 1
}
if (missing(aspectratio) && params_length >= param_index) {
aspectratio <- params[[param_index]]
param_index <- param_index + 1
}
if (missing(downloadfxns) && params_length >= param_index) {
downloadfxns <- params[[param_index]]
param_index <- param_index + 1
}
if (missing(visibleplot) && params_length >= param_index) {
visibleplot <- params[[param_index]]
param_index <- param_index + 1
}
if (old_style_call) {
download_plot(input,
output,
session,
logger,
filenameroot,
aspectratio,
downloadfxns,
visibleplot)
}
else {
shiny::moduleServer(
id,
function(input, output, session) {
download_plot(input,
output,
session,
logger,
filenameroot,
aspectratio,
downloadfxns,
visibleplot)
})
}
}
download_plot <- function(input,
output,
session,
logger,
filenameroot,
aspectratio = 1,
downloadfxns = list(),
visibleplot) {
downloadFile("dplotButtonID", logger, filenameroot, downloadfxns, aspectratio)
dpInfo <- shiny::reactiveValues(visibleplot = NULL,
downloadfxns = NULL)
shiny::observe({
dpInfo$visibleplot <- visibleplot()
output$dplotOutputID <- shiny::renderPlot({
plot <- dpInfo$visibleplot
if (inherits(plot, "grob")) {
plot <- grid::grid.draw(plot)
}
plot
})
})
shiny::observe({
if (!is.null(downloadfxns) && (length(downloadfxns) > 0)) {
dpInfo$downloadfxns <- lapply(downloadfxns, do.call, list())
rowct <- lapply(dpInfo$downloadfxns, is.null)
session$sendCustomMessage(
"downloadbutton_toggle",
message = list(btn = session$ns("dplotButtonDiv"),
rows = sum(unlist(rowct) == FALSE)) )
}
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.