R/event.R

In dygraphs: Interface to 'Dygraphs' Interactive Time Series Charting Library

#' dygraph event line
#' 
#' Add a vertical event line to a dygraph
#' 
#' @param dygraph Dygraph to add event line to
#' @param x Either numeric or date/time for the event, depending on the format
#'   of the x-axis of the dygraph. (For date/time must be a \code{POSIXct}
#'   object or another object convertible to \code{POSIXct} via
#'   \code{as.POSIXct})
#' @param label Label for event. Defaults to blank.
#' @param labelLoc Location for label (top or bottom)
#' @param color Color of event line. This can be of the form "#AABBCC" or 
#'   "rgb(255,100,200)" or "yellow". Defaults to black.
#' @param strokePattern A predefined stroke pattern type ("dotted", "dashed",
#'   "dotdash", or "solid") or a custom pattern array where the even index is 
#'   a draw and odd is a space in pixels. Defaults to dashed.
#' @param date (deprecated) See argument \code{x}.
#'   
#' @return A dygraph with the specified event line.
#'   
#' @note See the \href{https://rstudio.github.io/dygraphs/gallery-event-lines.html}{online 
#'   documentation} for additional details and examples.
#'   
#' @examples 
#' library(dygraphs)
#' 
#' dygraph(presidents, main = "Presidential Approval") %>%
#'   dyAxis("y", valueRange = c(0, 100)) %>%
#'   dyEvent("1950-6-30", "Korea", labelLoc = "bottom") %>%
#'   dyEvent("1965-2-09", "Vietnam", labelLoc = "bottom")

#' dygraph(presidents, main = "Presidential Approval") %>%
#'   dyAxis("y", valueRange = c(0, 100)) %>%
#'   dyEvent(c("1950-6-30", "1965-2-09"), c("Korea", "Vietnam"), labelLoc = "bottom") 
#'  
#' @export
dyEvent <- function(dygraph, 
                    x,
                    label = NULL, 
                    labelLoc = c("top", "bottom"),
                    color = "black", 
                    strokePattern = "dashed",
                    date) {
  
  # Check usage of deprecated argument 'date'
  if (!missing(date)) {
    x <- date
    warning("Argument 'date' is deprecated, please use argument 'x' instead")
  }
  
  # create events
  if (!is.null(label) && length(x) != length(label))
    stop("Length of 'x' and 'label' does not match")
  events <-
    lapply(
      seq_along(x), function(i)
      {
        if (is.null(label))
          eventLabel <- NULL
        else
          eventLabel <- label[i]
        list(
          pos = ifelse(dygraph$x$format == "date", asISO8601Time(x[i]), x[i])
         ,label = eventLabel
         ,labelLoc = match.arg(labelLoc, c("top", "bottom"))
         ,color = color
         ,strokePattern = resolveStrokePattern(strokePattern)
         ,axis = "x"
        )
      }
    )
 
  # add it to list of events
  dygraph$x$events <- c(dygraph$x$events, events)
  
  # return modified dygraph
  dygraph
}

#' dygraph limit line
#' 
#' Add a horizontal limit line to a dygraph
#' 
#' @param dygraph Dygraph to add limit line to
#' @param limit Numeric position of limit.
#' @param label Label for limit. Defaults to blank.
#' @param labelLoc Location for label (left or right).
#' @param color Color of limit line. This can be of the form "#AABBCC" or 
#'   "rgb(255,100,200)" or "yellow". Defaults to black.
#' @param strokePattern A predefined stroke pattern type ("dotted", "dashed",
#'   "dotdash", or "solid") or a custom pattern array where the even index is 
#'   a draw and odd is a space in pixels. Defaults to dashed.
#'   
#' @return A dygraph with the specified limit line.
#'   
#' @note See the \href{https://rstudio.github.io/dygraphs/gallery-event-lines.html}{online 
#'   documentation} for additional details and examples.
#'   
#' @examples 
#' library(dygraphs)
#' 
#' dygraph(presidents, main = "Presidential Approval") %>%
#'   dyAxis("y", valueRange = c(0, 100)) %>% 
#'   dyLimit(max(presidents, na.rm = TRUE), "Max",
#'           strokePattern = "solid", color = "blue")
#'  
#' @export
dyLimit <- function(dygraph, 
                    limit,
                    label = NULL, 
                    labelLoc = c("left", "right"),
                    color = "black", 
                    strokePattern = "dashed") {
  
  # create event
  event <- list()
  event$pos <- limit
  event$label <- label
  event$labelLoc <- match.arg(labelLoc)
  event$color <- color
  event$strokePattern <- resolveStrokePattern(strokePattern)
  event$axis <- "y"
  
  # add it to list of events
  dygraph$x$events[[length(dygraph$x$events) + 1]] <- event
  
  # return modified dygraph
  dygraph
}