dygraphs R with external data

With bigger data, copying and duplicating that data with htmlwidgets is an expensive operation. There are some hacks and tricks for working around the typical htmlwidgets pattern. Here is an example with dygraphs using custom point sizes.

library(htmltools)
library(dygraphs)
library(xts)

set.seed(123)
N <- 10000
prices <- 100 + cumsum(rnorm(N, 0.05, 0.05))
sizes <- sample(1:4, N, replace=TRUE)
times <- as.POSIXct("2018-07-06 08:30:00") + cumsum(abs(rnorm(N, 10, 5)))

dat <- xts(cbind(prices=prices, sizes=sizes), order.by=times)

xtsToDygraph <- function(dat, cols=NULL, periodicity=NULL) {
  # pulled mostly from https://github.com/rstudio/dygraphs/blob/master/R/dygraph.R
  # Test whether x-axis are dates or numeric
  if(!is.null(cols)) {
    data <- dat[,cols]
  } else {
    data <- dat
  }
  if (xts::xtsible(data)) {

    if (!xts::is.xts(data))
      data <- xts::as.xts(data)
    format <- "date"

  } else if (is.list(data) && is.numeric(data[[1]])) {

    if (is.null(names(data)))
      stop("For numeric values, 'data' must be a named list or data frame")
    format <- "numeric"

  } else {
    stop("Unsupported type passed to argument 'data'.")
  }

  if (format == "date") {

    # auto-detect periodicity if not otherwise specified
    if (is.null(periodicity)) {
      if (nrow(data) < 2) {
        periodicity <- defaultPeriodicity(data)
      } else {
        periodicity <- xts::periodicity(data)
      }
    }

    # extract time
    time <- time(data)

    # get data as a named list
    data <- zoo::coredata(data)
    data <- unclass(as.data.frame(data))

    # merge time back into list and convert to JS friendly string
    timeColumn <- list()
    timeColumn[[periodicity$label]] <- dygraphs:::asISO8601Time(time)
    data <- append(timeColumn, data)
  } else {
    # Convert data to list if it was data frame
    data <- as.list(data)
  }
  data
}

# use lung deaths as test
# verify our function works as expected
lungDeaths <- xts::as.xts(cbind(mdeaths, fdeaths))
identical(unname(xtsToDygraph(lungDeaths)), dygraph(lungDeaths)$x$data)


dy <- dygraph(dat[,1]) %>% #use dat to initialize and setup dygraphs but remove later
  dySeries(drawPoints = TRUE) %>%
  {
    .$x$attrs$retainDateWindow <- NULL
    .$x$attrs$axisLabelColor <- NULL
    .$x$attrs$mobileDisableYTouch <- NULL
    .$x$attrs$disableZoom <- NULL
    .
  }

# let's see how we can use JS data instead of data supplied through R
# trick our dygraph into getting data from JavaScript
# use global dat data in JavaScript set with tags$script
#   but this could just as easily come from a database or websocket connection
dy$x$data <- htmlwidgets::JS("dat")
browsable(
  tagList(
    tags$script(sprintf("var dat = %s", jsonlite::toJSON(unname(xtsToDygraph(dat[,1]))))),
    dy
  )
)

# so if we want to include point size
#   but not have to replicate the data
#   and potentially reuse the data for other graphs or components
dy$x$data <- htmlwidgets::JS("convert(dat, ['second','prices'])")

browsable(
  tagList(
    tags$script(
      sprintf(
"
// convert function in JavaScript
function convert(data, cols) {
  return cols.map(function(col) {
    return data[col]
  })
}
var dat = %s
",
        jsonlite::toJSON(xtsToDygraph(dat))
      )
    ),
    dy %>%
      dyCallbacks("drawPointCallback" = "
function(g, name, ctx, canvasx, canvasy, color, radius, index) {
  radius = dat['sizes'][index];
  return Dygraph.Circles.DEFAULT(g, name, ctx, canvasx, canvasy, color, radius)
}
"
      )
  )
)