R/dplot3_ts.R

In egenn/rtemis: Machine Learning and Visualization

# dplot3_ts.R
# ::rtemis::
# 2022 E.D. Gennatas www.lambdamd.org

# => recalc limits for fn = "sum"

#' Interactive Timeseries Plots
#'
#' Draw interactive timeseries plots using `plotly`
#'
#' @param x Numeric vector of values to plot or list of vectors
#' @param time Numeric or Date vector of time corresponding to values of `x`
#' @param window Integer: apply `roll.fn` over this many units of time
#' @param group Factor defining groups
#' @param roll.fn Character: "mean", "median", "max", or "sum": Function to apply on
#' rolling windows of `x`
#' @param roll.col Color for rolling line
#' @param roll.alpha Numeric: transparency for rolling line
#' @param roll.lwd Numeric: width of rolling line
#' @param roll.name Rolling function name (for annotation)
#' @param alpha Numeric \[0, 1\]: Transparency
#' @param align Character: "center", "right", or "left"
#' @param group.names Character vector of group names
#' @param xlab Character: x-axis label
#' @param n.xticks Integer: number of x-axis ticks to use (approximately)
#  @param tickmode
#' @param scatter.type Character: "scatter" or "lines"
#' @param legend Logical: If TRUE, show legend
#' @param x.showspikes Logical: If TRUE, show x-axis spikes on hover
#' @param y.showspikes Logical: If TRUE, show y-axis spikes on hover
#' @param spikedash Character: dash type string ("solid", "dot", "dash",
#' "longdash", "dashdot", or "longdashdot") or a dash length list in px
#' (eg "5px,10px,2px,2px")
#' @param displayModeBar Logical: If TRUE, display plotly's modebar
#' @param theme Character: theme name or list of theme parameters
#' @param palette Character: palette name, or list of colors
#' @param filename Character: Path to filename to save plot
#' @param spikemode Character: If "toaxis", spike line is drawn from the data
#' point to the axis the series is plotted on. If "across", the line is drawn
#' across the entire plot area, and supercedes "toaxis". If "marker", then a
#' marker dot is drawn on the axis the series is plotted on
#' @param spikesnap Character: "data", "cursor", "hovered data". Determines
#' whether spikelines are stuck to the cursor or to the closest datapoints.
#' @param spikecolor Color for spike lines
#' @param spikethickness Numeric: spike line thickness
#' @param modeBar.file.format Character: modeBar image export file format
#' @param file.width Numeric: image export width
#' @param file.height Numeric: image export height
#' @param file.scale Numeric: image export scale
#' @param ... Additional arguments to be passed to [dplot3_xy]
#'
#' @author E.D. Gennatas
#' @export
#'
#' @examples
#' \dontrun{
#' time <- sample(seq(as.Date("2020-03-01"), as.Date("2020-09-23"), length.out = 140))
#' x1 <- rnorm(140)
#' x2 <- rnorm(140, 1, 1.2)
#' # Single timeseries
#' dplot3_ts(x1, time)
#' # Multiple timeseries input as list
#' dplot3_ts(list(Alpha = x1, Beta = x2), time)
#' # Multiple timeseries grouped by group, different lengths
#' time1 <- sample(seq(as.Date("2020-03-01"), as.Date("2020-07-23"), length.out = 100))
#' time2 <- sample(seq(as.Date("2020-05-01"), as.Date("2020-09-23"), length.out = 140))
#' time <- c(time1, time2)
#' x <- c(rnorm(100), rnorm(140, 1, 1.5))
#' group <- c(rep("Alpha", 100), rep("Beta", 140))
#' dplot3_ts(x, time, 7, group)
#' }
#'
dplot3_ts <- function(x, time,
                      window = 7L,
                      group = NULL,
                      roll.fn = c("mean", "median", "max", "none"),
                      roll.col = NULL,
                      roll.alpha = 1,
                      roll.lwd = 2,
                      roll.name = NULL,
                      alpha = NULL,
                      align = "center",
                      group.names = NULL,
                      xlab = "Time",
                      n.xticks = 12,
                      #   tickmode = "array",
                      scatter.type = "scatter",
                      legend = TRUE,
                      x.showspikes = TRUE,
                      y.showspikes = FALSE,
                      spikedash = "solid",
                      spikemode = "across",
                      spikesnap = "hovered data",
                      spikecolor = NULL,
                      spikethickness = 1,
                      displayModeBar = TRUE,
                      modeBar.file.format = "svg",
                      theme = rtTheme,
                      palette = rtPalette,
                      filename = NULL,
                      file.width = 500,
                      file.height = 500,
                      file.scale = 1, ...) {
  # Arguments ----
  roll.fn <- match.arg(roll.fn)
  if (roll.fn == "none") window <- NULL

  # Timeseries ----
  if (!is.null(group)) {
    x <- split(x, group)
    time <- split(time, group)
  }

  if (is.data.frame(x)) {
    x <- as.list(x)
  }

  if (!is.list(x)) {
    x <- list(x)
  }

  if (is.data.frame(time)) {
    time <- as.list(time)
  }

  if (!is.list(time)) {
    time <- list(time)
  }

  if (is.null(group.names)) {
    group.names <- if (!is.null(names(x))) {
      names(x)
    } else {
      paste("Group", seq_along(x))
    }
  }

  idx <- lapply(time, order)
  time <- lapply(seq_along(time), \(i) time[[i]][idx[[i]]])
  if (length(time) < length(x)) {
    time <- rep(time, length(x) / length(time))
    idx <- rep(idx, length(x) / length(idx))
  }
  x <- lapply(seq_along(x), \(i) x[[i]][idx[[i]]])
  # xtl <- lapply(seq_along(x), \(i) zoo::zoo(x[[i]], time[[i]]))

  if (!is.null(window) && window > 0) {
    avg_line <- switch(roll.fn,
      mean = lapply(x, \(xt) data.table::frollmean(xt, n = window, align = align)),
      median = lapply(x, \(xt) data.table::frollapply(xt, n = window, median, align = align)),
      max = lapply(x, \(xt) data.table::frollapply(xt, n = window, max, align = align)),
      sum = lapply(x, \(xt) data.table::frollsum(xt, n = window, align = align))
    )
  }

  # Palette ----
  if (is.character(palette)) palette <- rtpalette(palette)
  if (is.null(roll.col)) roll.col <- palette[seq_along(x)]

  # dplot3_xy ----
  plt <- dplot3_xy(time, x,
    xlab = xlab,
    theme = theme,
    palette = palette,
    alpha = alpha,
    group.names = group.names,
    legend = legend,
    scatter.type = scatter.type,
    x.showspikes = x.showspikes,
    y.showspikes = y.showspikes,
    spikedash = spikedash,
    spikemode = spikemode,
    spikesnap = spikesnap,
    spikecolor = spikecolor,
    spikethickness = spikethickness, ...
  )

  # Rolling function line ----
  if (is.null(roll.name)) {
    roll.name <- paste0("Rolling ", roll.fn, " (window=", window, ")")
  }

  if (!is.null(window)) {
    for (i in seq_along(x)) {
      plt <- plt |> plotly::add_trace(
        x = time[[i]], y = avg_line[[i]],
        type = "scatter",
        mode = "lines",
        line = list(
          color = plotly::toRGB(roll.col[[i]], alpha = roll.alpha),
          width = roll.lwd
        ),
        name = roll.name
      )
    }
  }

  # Config
  plt <- plotly::config(plt,
    displaylogo = FALSE,
    displayModeBar = displayModeBar,
    toImageButtonOptions = list(
      format = modeBar.file.format,
      width = file.width,
      height = file.height
    )
  )

  # Write to file ----
  if (!is.null(filename)) {
    plotly::save_image(
      plt,
      file = file.path(filename),
      width = file.width,
      height = file.height,
      scale = file.scale
    )
  }

  plt
} # rtemis::dplot3_ts