R/linevis.R

In linevis: Interactive Time Series Visualizations

#' Create a graph2d visualization
#'
#' \code{linevis} lets you create rich and fully interactive graph2d visualizations.
#' graph2ds can be included in Shiny apps or R markdown documents.
#' \code{linevis} Includes an extensive
#' API to manipulate a graph2d after creation, and supports getting data out of
#' the visualization into R. Based on the \href{https://visjs.github.io/vis-timeline/docs/graph2d/}{'visjs'}
#' graph2d JavaScript library.\cr\cr
#' To see the full details on what the graph2d can support, please read the
#' official documentation of visjs graph2d.
#'
#' @param data A dataframe (or \link[crosstalk]{SharedData} object for \{crosstalk\} support) containing the graph2d items.
#' Each item on the graph2d is represented by a row in the dataframe. \code{x} and
#' \code{y} are the only two required columns.
#' See the \strong{Data format} section below for more
#' details. For a full list of all supported columns, see the Data Format section in the
#' \href{https://visjs.github.io/vis-timeline/docs/graph2d/#Data_Format}{official
#' visjs graph2d documentation}.
#' @param groups A dataframe containing the groups data (optional). See the
#' \strong{Groups} section below for more details.
#' buttons on the widget.
#' @param zoomFactor How much to zoom when zooming out. A zoom factor of 0.5
#' means that when zooming out the graph2d will show 50\% more content. For
#' example, if the graph2d currently shows 20 days, then after zooming out with
#' a \code{zoomFactor} of 0.5, the graph2d will show 30 days, and zooming out
#' again will show 45 days. Similarly, zooming out from 20 days with a
#' \code{zoomFactor} of 1 will results in showing 40 days.
#' @param fit If \code{TRUE}, then fit all the data on the graph2d when the
#' graph2d initializes. Otherwise, the graph2d will be set to show the
#' current date.
#' @param log_scale If \code{TRUE}, use log scaling on vertical axis.
#' @param options A named list containing any extra configuration options to
#' customize the graph2d. All available options can be found in the
#' \href{https://visjs.github.io/vis-timeline/docs/graph2d/#Configuration_Options}{official
#' graph2d documentation}. Note that any options that define a JavaScript
#' function must be wrapped in a call to \code{htmlwidgets::JS()}. See the
#' examples section below to see example usage. If using \{crosstalk\}, it's recommended
#' to use `list(multiselect = TRUE)`.
#' @param width Fixed width for graph2d (in css units). Ignored when used in a
#' Shiny app -- use the \code{width} parameter in
#' \code{\link[linevis]{linevisOutput}}.
#' It is not recommended to use this parameter because the widget knows how to
#' adjust its width automatically.
#' @param height Fixed height for graph2d (in css units). It is recommended to
#' not use this parameter since the widget knows how to adjust its height
#' automatically.
#' @param elementId Use an explicit element ID for the widget (rather than an
#' automatically generated one). Ignored when used in a Shiny app.
#' @param loadDependencies Whether to load JQuery and bootstrap
#' dependencies (you should only set to \code{FALSE} if you manually include
#' them)
#' @param timezone By default, the linevis widget displays times in the local
#' time of the browser rendering it. You can set linevis to display times in
#' another time zone by providing a number between -15 to 15 to specify the
#' number of hours offset from UTC. For example, use `0` to display in UTC,
#' and use `-4` to display in a timezone that is 4 hours behind UTC.
#' @return A graph2d visualization \code{htmlwidgets} object
#' @section Data format:
#' The \code{data} parameter supplies the input dataframe that describes the
#' items in the graph2d. The following is a subset of the variables supported
#' in the items dataframe. \strong{The full list of supported variables can be found in
#' the \href{https://visjs.github.io/vis-timeline/docs/graph2d/#Data_Format}{official
#' visjs documentation}}.
#' \itemize{
#'   \item{\strong{\code{id}}} - A unique ID for the item. If not provided,
#'   then the row names will be used as IDs.
#'   \item{\strong{\code{title}}} - Add a title for the item, displayed when
#'   hovering the mouse over the item. The title can only contain plain text.
#'   \item{\strong{\code{group}}} - The ID of a group. When a \code{group} is
#'   provided, all items with the same group are placed on one line. A vertical
#'   axis is displayed showing the group names. See more details in the
#'   \strong{Groups} section below.
#'   \item{\strong{\code{className}}} - A className can be used to give items an
#'   individual CSS style.
#'   \item{\strong{\code{style}}} - A CSS text string to apply custom styling
#'   for an individual item, for example \code{color: red;}.
#' }
#' @section Groups:
#' The \code{groups} parameter must be provided if the data items have groups
#' (i.e. if any of the items have a \code{group} variable). 
#' The following is a subset of the variables supported in
#' the groups dataframe. \strong{The full list of supported variables can be found in
#' the \href{https://visjs.github.io/vis-timeline/docs/graph2d/#groups}{official
#' visjs documentation}}.
#' \itemize{
#'   \item{\strong{\code{id}}} - (required) An ID for the group. The group will
#'   display all items having a \code{group} variable which matches this ID.
#'   \item{\strong{\code{content}}} - (required) The contents of the group. This
#'   can be plain text or HTML code.
#'   \item{\strong{\code{className}}} - A className can be used to give groups
#'   an individual CSS style.
#'   \item{\strong{\code{style}}} - A CSS text string to apply custom styling
#'   for an individual group label, for example \code{color: red;}.
#' }
#' \code{id} and \code{content} are the only required variables for each group,
#' while the rest of the variables are optional. If you include a variable that
#' is only used for some rows, you can use \code{NA} for the rows where it's
#' not used. The groups data of a graph2d can either be set by supplying the
#' \code{groups} argument to \code{linevis()}, or by calling the
#' \code{\link[linevis]{setGroups}} function.
#' @section Getting data out of a graph2d in Shiny:
#' When a graph2d widget is created in a Shiny app, there are four pieces of
#' information that are always accessible as Shiny inputs. These inputs have
#' special names based on the graph2d's ID. Suppose that a graph2d is created
#' with an \code{outputId} of \strong{"mytime"}, then the following four input
#' variables will be available:
#' \itemize{
#'   \item{\strong{\code{input$mytime_data}}} - will return a data.frame containing
#'   the data of the items in the graph2d. The input is updated every time
#'   an item is modified, added, or removed.
#'   \item{\strong{\code{input$mytime_ids}}} - will return the IDs (a vector) of
#'   all the items in the graph2d. The input is updated every time an item
#'   is added or removed from the graph2d.
#'   \item{\strong{\code{input$mytime_window}}} - will return a 2-element vector
#'   containing the minimum and maximum dates currently visible in the graph2d.
#'   The input is updated every time the viewable window of dates is updated
#'   (by zooming or moving the window).
#'   \item{\strong{\code{input$mytime_visible}}} - will return a list of IDs of items currently
#'   visible in the graph2d.
#' }
#' All four inputs will return a value upon initialization of the graph2d and
#' every time the corresponding value is updated.
#' @section Extending linevis:
#' If you need to perform any actions on the graph2d object that are not
#' supported by this package's API, you may be able to do so by manipulating the
#' graph2d's JavaScript object directly. The graph2d object is available via
#' \code{document.getElementById("id").widget.graph2d} (replace \code{id} with
#' the graph2d's ID).\cr\cr
#' This graph2d object is the direct widget that \code{vis.js} creates, and you
#' can see the \href{https://visjs.github.io/vis-timeline/docs/graph2d/}{visjs documentation} to
#' see what actions you can perform on that object.
#' @section Customizing the linevis look and style using CSS:
#' To change the styling of individual items or group labels, use the
#' \code{className} and \code{style} columns in the \code{data} or \code{groups}
#' dataframes.\cr\cr
#' When running a Shiny app, you can use CSS files to apply custom styling to
#' other components of the linevis widget.
#' @examples
#' \dontrun{
#'
#' #----------------------- Most basic -----------------
#' linevis()
#'
#' #----------------------- Minimal data -----------------
#' df_data = data.frame(x = c('2014-06-11',
#'                            '2014-06-12',
#'                            '2014-06-13',
#'                            '2014-06-14',
#'                            '2014-06-15',
#'                            '2014-06-16'),
#'                      y = c(0,
#'                            1,
#'                            30000,
#'                            10,
#'                            150,
#'                            30000,
#'                            20,
#'                            20))
#'
#' linevis(df_data)
#' 
#' #----------------------- Using groups -----------------
#' df_data = rbind(df_data, data.frame(x = c('2014-06-09', '2014-06-18'),
#'                                     y = c(20, 20)))
#' df_data$group = c(rep(0, 6), 1, 1)
#'
#' df_grp = data.frame(id = 0:1, content = c('ESR', 'threshold'),
#'                     className = c('grp1', 'grp2'))
#'
#' linevis(df_data, df_grp)
#'
#' #----------------------- Getting data out of the graph2d into Shiny -----------------
#' if (interactive()) {
#' library(shiny)
#'
#' ui <- fluidPage(
#'   linevisOutput("appts"),
#'   div("Visible window:", textOutput("window", inline = TRUE)),
#'   tableOutput("table")
#' )
#'
#' server <- function(input, output) {
#'   output$appts <- renderLinevis(
#'     linevis(df_data)
#'   )
#'
#'   output$window <- renderText(
#'     paste(input$appts_window[1], "to", input$appts_window[2])
#'   )
#'
#'   output$table <- renderTable(
#'     input$appts_data
#'   )
#' }
#' shinyApp(ui, server)
#' }
#' }
#'
#' @export
linevis <- function(data, groups, zoomFactor = 0.5, fit = TRUE,
                    log_scale = FALSE, options = list(),
                    width = NULL, height = NULL, elementId = NULL,
                    loadDependencies = TRUE, timezone = NULL) {

  # Validate the input data
  if (missing(data)) {
    data <- data.frame()
  }
  if (crosstalk::is.SharedData(data)) {
    crosstalk_opts <- list(
      key = data$key(),
      group = data$groupName()
    )
    data <- data$origData()

    if ("id" %in% names(data) && !isTRUE(all.equal(data$id, crosstalk_opts$key))) {
      warning("linevis: the `id` column of the data was overwritten by the SharedData key.")
    }
    data$id <- crosstalk_opts$key
  } else {
    crosstalk_opts <- NULL
  }
  if (!is.data.frame(data)) {
    stop("linevis: 'data' must be a data.frame",
         call. = FALSE)
  }
  if (!missing(groups) && !is.data.frame(groups)) {
    stop("linevis: 'groups' must be a data.frame",
         call. = FALSE)
  }
  if (!missing(groups) && nrow(groups) > 0 &&
      (!"id" %in% colnames(groups) || !"content" %in% colnames(groups) )) {
    stop("linevis: 'groups' must contain a 'content' and 'id' variables",
         call. = FALSE)
  }
  if (!is.numeric(zoomFactor) || length(zoomFactor) > 1 || zoomFactor <= 0) {
    stop("linevis: 'zoomFactor' must be a positive number",
         call. = FALSE)
  }
  if (!is.bool(fit)) {
    stop("linevis: 'fit' must be either 'TRUE' or 'FALSE'",
         call. = FALSE)
  }
  if (is.null(options)) {
    options <- list()
  }
  if (!is.list(options)) {
    stop("linevis: 'options' must be a named list",
         call. = FALSE)
  }
  if (!is.null(timezone)) {
    if (!is.numeric(timezone) || length(timezone) != 1 ||
        timezone < -15 || timezone > 15) {
      stop("linevis: 'timezone' must be a number between -15 and 15",
           call. = FALSE)
    }
  }

  if (!"id" %in% names(data)) {
    data$id <- row.names(data)
  }

  if (log_scale) {
    data$y = log(data$y + 1)
    options$log_scale = TRUE
  }

  items <- dataframeToD3(data)
  if (missing(groups)) {
    groups <- NULL
  } else {
    groups <- dataframeToD3(groups)
  }

  if (!is.null(options[["start"]]) || !is.null(options[["end"]])) {
    fit <- FALSE
  }

  # forward options using x
  x = list(
    items = items,
    groups = groups,
    zoomFactor = zoomFactor,
    fit = fit,
    options = options,
    height = height,
    timezone = timezone,
    crosstalk = crosstalk_opts
  )

  # Allow a list of API functions to be called on the linevis after
  # initialization
  x$api <- list()

  deps <- NULL

  if (!is.null(crosstalk_opts)) {
    deps <- crosstalk::crosstalkLibs()
  }
  # add dependencies so that the zoom buttons will work in non-Shiny mode
  if (loadDependencies) {
    deps <- append(
      deps,
      list(
        rmarkdown::html_dependency_jquery(),
        rmarkdown::html_dependency_bootstrap("default")
      )
    )
  }

  # create widget
  htmlwidgets::createWidget(
    name = 'linevis',
    x,
    width = width,
    height = height,
    package = 'linevis',
    elementId = elementId,
    dependencies = deps
  )
}

#' Shiny bindings for linevis
#'
#' Output and render functions for using linevis within Shiny
#' applications and interactive Rmd documents.
#'
#' @param outputId output variable to read from
#' @param width,height Must be a valid CSS unit (like \code{'100\%'},
#'   \code{'400px'}, \code{'auto'}) or a number, which will be coerced to a
#'   string and have \code{'px'} appended. \code{height} will probably not
#'   have an effect; instead, use the \code{height} parameter in
#'   \code{\link[linevis]{linevis}}.
#' @param expr An expression that generates a linevis
#' @param env The environment in which to evaluate \code{expr}.
#' @param quoted Is \code{expr} a quoted expression (with \code{quote()})? This
#'   is useful if you want to save an expression in a variable.
#'
#' @return Htmlwidgets render and output objects
#'
#' @name linevis-shiny
#' @seealso \code{\link[linevis]{linevis}}.
#'
#' @examples
#' if (interactive()) {
#' library(shiny)
#'
#' #----------------------- Most basic example -----------------
#' shinyApp(
#'   ui = fluidPage(linevisOutput("graph2d")),
#'   server = function(input, output) {
#'     output$graph2d <- renderLinevis(
#'       linevis()
#'     )
#'   }
#' )
#'
#'
#' #----------------------- More advanced example -----------------
#' df_data = data.frame(x = c('2014-06-11',
#'                            '2014-06-12',
#'                            '2014-06-13',
#'                            '2014-06-14',
#'                            '2014-06-15',
#'                            '2014-06-16'),
#'                      y = c(0,
#'                            1,
#'                            30000,
#'                            10,
#'                            150,
#'                            30000,
#'                            20,
#'                            20))
#'
#' ui <- fluidPage(
#'   linevisOutput("appts"),
#'   div("Visible window:", textOutput("window", inline = TRUE)),
#'   tableOutput("table")
#' )
#'
#' server <- function(input, output) {
#'   output$appts <- renderLinevis(
#'     linevis(df_data)
#'   )
#'
#'   output$window <- renderText(
#'     paste(input$appts_window[1], "to", input$appts_window[2])
#'   )
#'
#'   output$table <- renderTable(
#'     input$appts_data
#'   )
#' }
#' shinyApp(ui, server)
#' }
#'
#' @export
linevisOutput <- function(outputId, width = '100%', height = 'auto') {
  htmlwidgets::shinyWidgetOutput(outputId, 'linevis', width, height,
                                 package = 'linevis')
}

#' @rdname linevis-shiny
#' @export
renderLinevis <- function(expr, env = parent.frame(), quoted = FALSE) {
  if (!quoted) { expr <- substitute(expr) } # force quoted
  htmlwidgets::shinyRenderWidget(expr, linevisOutput, env, quoted = TRUE)
}