htmlwidgets: HTML Widgets for R

Documented in sizingPolicy

#' Create a widget sizing policy
#'
#' Define the policy by which HTML widgets will be sized in various containers
#' (e.g. Browser, RStudio Viewer, R Markdown, Shiny). Note that typically
#' widgets can accept the default sizing policy (or override only one or two
#' aspects of it) and get satisfactory sizing behavior via the automatic sizing
#' logic built into the htmlwidgets framework (see the notes below for the most
#' typical exceptions to this).
#'
#' @param defaultWidth The default width used to display the widget. This
#'   parameter specifies the default width for viewing in all contexts (browser,
#'   viewer, and knitr) unless it is specifically overridden with e.g.
#'   `browser.defaultWidth`.
#' @param viewer.defaultWidth The default width used to display the widget
#'   within the RStudio Viewer.
#' @param browser.defaultWidth The default width used to display the widget
#'   within a standalone web browser.
#' @param knitr.defaultWidth The default width used to display the widget within
#'   documents generated by knitr (e.g. R Markdown).
#' @param defaultHeight The default height used to display the widget. This
#'   parameter specifies the default height for viewing in all contexts
#'   (browser, viewer, and knitr) unless it is specifically overridden with e.g.
#'   \code{browser.defaultHeight}.
#' @param viewer.defaultHeight The default height used to display the widget
#'   within the RStudio Viewer.
#' @param browser.defaultHeight The default height used to display the widget
#'   within a standalone web browser.
#' @param knitr.defaultHeight The default height used to display the widget
#'   within documents generated by knitr (e.g. R Markdown).
#' @param padding Padding around the widget (in pixels). This parameter
#'   specifies the padding for viewing in all contexts (browser and viewer)
#'   unless it is specifically overriden by e.g. `browser.padding`.
#' @param browser.padding Padding around the widget when displayed in a
#'   standalone browser (defaults to 40 pixels).
#' @param viewer.padding Padding around the widget when displayed in the RStudio
#'   Viewer (defaults to 15 pixels).
#' @param viewer.fill When displayed in the RStudio Viewer, automatically size
#'   the widget to the viewer dimensions (note that `viewer.padding` is
#'   still applied). Default to `TRUE`.
#' @param browser.fill When displayed in a standalone web browser, automatically
#'   size the widget to the browser dimensions (note that `browser.padding`
#'   is still applied). Defaults to `FALSE`.
#' @param browser.external When displaying in a browser, always use an external
#'   browser (via [browseURL()]). Defaults to `FALSE``, which will
#'   result in the use of an internal browser within RStudio v1.1 and higher.
#' @param viewer.paneHeight Request that the RStudio Viewer be forced to a
#'   specific height when displaying this widget.
#' @param viewer.suppress Never display the widget within the RStudio Viewer
#'   (useful for widgets that require a large amount of space for rendering).
#'   Defaults to `FALSE`.
#' @param knitr.figure Apply the default knitr fig.width and fig.height to the
#'   widget when it's rendered within R Markdown documents. Defaults to
#'   `TRUE`.
#' @param fill Whether or not the widget's container should be treated as a fill
#'   item, meaning that its `height` is allowed to grow/shrink to fit a fill
#'   container with an opinionated height (see [htmltools::bindFillRole()] for
#'   more). Examples of fill containers include `bslib::card()` and
#'   `bslib::card_body_fill()`.
#'
#' @return A widget sizing policy
#'
#' @details
#'
#' The default HTML widget sizing policy treats the widget with the same sizing
#' semantics as an R plot. When printed at the R console the widget is displayed
#' within the RStudio Viewer and sized to fill the Viewer pane (modulo any
#' padding). When rendered inside an R Markdown document the widget is sized
#' based on the default size of figures in the document.
#'
#' You might need to change the default behavior if your widget is extremely
#' large. In this case you might specify `viewer.suppress = TRUE` and
#' `knitr.figure = FALSE` as well provide for a larger default width and
#' height for knitr.
#'
#' You also might need to change the default behavior if you widget already
#' incorporates padding. In this case you might specify `viewer.padding = 0`.
#'
#' For additional details on widget sizing:
#'
#' `vignette("develop_sizing", package = "htmlwidgets")`
#'
#'
#' @export
#' @md
sizingPolicy <- function(
  defaultWidth = NULL, defaultHeight = NULL, padding = NULL,
  viewer.defaultWidth = NULL, viewer.defaultHeight = NULL,
  viewer.padding = NULL, viewer.fill = TRUE, viewer.suppress = FALSE,
  viewer.paneHeight = NULL,
  browser.defaultWidth = NULL, browser.defaultHeight = NULL,
  browser.padding = NULL, browser.fill = FALSE, browser.external = FALSE,
  knitr.defaultWidth = NULL, knitr.defaultHeight = NULL,
  knitr.figure = TRUE, fill = NULL) {

  list(
    defaultWidth = defaultWidth,
    defaultHeight = defaultHeight,
    padding = padding,
    fill = fill,
    viewer = list(
      defaultWidth = viewer.defaultWidth,
      defaultHeight = viewer.defaultHeight,
      padding = viewer.padding,
      fill = viewer.fill,
      suppress = viewer.suppress,
      paneHeight = viewer.paneHeight
    ),
    browser = list(
      defaultWidth = browser.defaultWidth,
      defaultHeight = browser.defaultHeight,
      padding = browser.padding,
      fill = browser.fill,
      external = browser.external
    ),
    knitr = list(
      defaultWidth = knitr.defaultWidth,
      defaultHeight = knitr.defaultHeight,
      figure = knitr.figure
    )
  )
}


DEFAULT_WIDTH <- 960
DEFAULT_HEIGHT <- 500
DEFAULT_PADDING <- 40
DEFAULT_WIDTH_VIEWER <- 450
DEFAULT_HEIGHT_VIEWER <- 350
DEFAULT_PADDING_VIEWER <- 15

#' Resolve widget sizing policy
#'
#' Take a widget object and sizing policy, and some other contextual details,
#' and figure out what width/height to use, if possible. Some decisions may need
#' to be deferred until runtime; include any metadata that's needed for that
#' decision in the result as well.
#'
#' @param x The widget object whose size is to be determined. It may have $width
#'   and $height directly on it, which means we should obey those.
#' @param sp The sizing policy to use.
#' @param standalone Logical value indicating whether the widget is being
#'   rendered in a standalone context (where it's the only thing on the page;
#'   this is usually via `print.htmlwidget()`).
#' @param knitrOptions Object representing the knitr options passed to us via
#'   `knit_print`. If we're not doing a `knit_print` right now, then the value
#'   should be `NULL`.
#' @return A list that is guaranteed to have `width` and `height` values, each of
#'   which is either a number or CSS unit string. If `standalone=TRUE` then the
#'   list will also have a `runtime` value that is a list, that contains two
#'   nested lists `viewer` and `browser`. Each of those in turn has `width`,
#'   `height`, `padding` (between 1 and 4 numbers), and `fill` (`TRUE`/`FALSE`).
#' @keywords internal
#' @examples
#' x <- list(
#'   sizingPolicy = list(
#'     defaultWidth = 800,
#'     defaultHeight = 500,
#'     padding = 15,
#'     viewer = list(
#'       fill = TRUE,
#'       padding = 0
#'     ),
#'     browser = list(
#'       fill = FALSE,
#'       defaultWidth = 960,
#'       defaultHeight = 600,
#'       padding = 20
#'     ),
#'     knitr = list(
#'       # Actually knitr$defaultWidth and knitr$defaultHeight
#'       # are ignored if figure = TRUE
#'       defaultWidth = 800,
#'       defaultHeight = 600,
#'       figure = TRUE
#'     )
#'   )
#' )
#'
#' # Sizing for standalone mode
#' str(resolveSizing(x, x$sizingPolicy, TRUE, NULL))
#' # Sizing for knitr
#' str(resolveSizing(x, x$sizingPolicy, FALSE,
#'   list(out.width.px = 150, out.height.px = 100)))
#'
#' # Explicit width/height provided by user--overrides any
#' # default width/height
#' x$width <- 300
#' x$height <- 250
#' str(resolveSizing(x, x$sizingPolicy, FALSE,
#'   list(out.width.px = 150, out.height.px = 100)))
#' @keywords internal
#' @noRd
resolveSizing <- function(x, sp, standalone, knitrOptions = NULL) {
  userSized <- !is.null(x$width) || !is.null(x$height)
  viewerScopes <- list(sp$viewer, sp)
  viewerFill <- !userSized && any_prop(viewerScopes, "fill") %||% TRUE

  if (isTRUE(standalone)) {
    browserScopes <- list(sp$browser, sp)
    # Precompute the width, height, padding, and fill for each scenario.
    return(list(
      runtime = list(
        viewer = list(
          width = x$width %||% any_prop(viewerScopes, "defaultWidth") %||% DEFAULT_WIDTH_VIEWER,
          height = x$height %||% any_prop(viewerScopes, "defaultHeight") %||% DEFAULT_HEIGHT_VIEWER,
          padding = any_prop(viewerScopes, "padding") %||% DEFAULT_PADDING_VIEWER,
          fill = viewerFill
        ),
        browser = list(
          width = x$width %||% any_prop(browserScopes, "defaultWidth") %||% DEFAULT_WIDTH,
          height = x$height %||% any_prop(browserScopes, "defaultHeight") %||% DEFAULT_HEIGHT,
          padding = any_prop(browserScopes, "padding") %||% DEFAULT_PADDING,
          fill = !userSized && any_prop(browserScopes, "fill") %||% FALSE
        )
      ),
      width = x$width %||% prop(sp, "defaultWidth") %||% DEFAULT_WIDTH,
      height = x$height %||% prop(sp, "defaultHeight") %||% DEFAULT_HEIGHT,
      fill = prop(sp, "fill") %||% viewerFill
    ))
  }

  if (!is.null(knitrOptions)) {
    knitrScopes <- list(sp$knitr, sp)
    isFigure <- any_prop(knitrScopes, "figure")
    # flexdashboard actually adds on another fig.width for intelligent sizing of static
    # figures in desktop/mobile mode
    # https://github.com/rstudio/flexdashboard/blob/02207b7/R/flex_dashboard.R#L262
    # flexdashboard should really only be doing this for static plots, but we make sure
    # to just take the first (desktop) sizing to make this "just work" for flexdashboard
    # (or really anyone else that provides a vector of widths/heights for a widget by
    # just taking the 1st value)
    figWidth <- if (isFigure) knitrOptions$out.width.px[[1L]] else NULL
    figHeight <- if (isFigure) knitrOptions$out.height.px[[1L]] else NULL
    # Compute the width and height
    return(list(
      width = x$width %||% figWidth %||% any_prop(knitrScopes, "defaultWidth") %||% DEFAULT_WIDTH,
      height = x$height %||% figHeight %||% any_prop(knitrScopes, "defaultHeight") %||% DEFAULT_HEIGHT,
      fill = prop(knitrScopes, "fill") %||% viewerFill
    ))
  }

  # Some non-knitr, non-print scenario.
  # Just resolve the width/height vs. defaultWidth/defaultHeight
  list(
    width = x$width %||% prop(sp, "defaultWidth") %||% DEFAULT_WIDTH,
    height = x$height %||% prop(sp, "defaultHeight") %||% DEFAULT_HEIGHT,
    fill = prop(sp, "fill") %||% viewerFill
  )
}