dygraphs point fun

supplement to Stack Overflow

Code

library(dygraphs)
library(scales)

lungDeaths <- xts::as.xts(cbind(mdeaths, fdeaths))

p <- dygraph(lungDeaths) %>%
  dygraphs::dyRangeSelector() %>% 
  dyOptions(drawPoints = TRUE)

addRadius <- function(x) {
  x$radius_mdeaths <- runif(nrow(x),1,100)
  x$scaled_radius_mdeaths <- scales::rescale(
    as.vector(x$radius_mdeaths),
    to=c(0,4)
  )
  x$radius_fdeaths <- runif(nrow(x),1,100)
  x$scaled_radius_fdeaths <- scales::rescale(
    as.vector(x$radius_fdeaths),
    to=c(0,4)
  )
  x
}

p %>%
  dyCallbacks("drawPointCallback" = sprintf(
"
function(g, name, ctx, canvasx, canvasy, color, radius, index) {
debugger
  var drat = %s;
  radius = drat[index]['scaled_radius_' + name];
  return Dygraph.Circles.DEFAULT(g, name, ctx, canvasx, canvasy, color, radius)
}
",
    jsonlite::toJSON(as.data.frame(addRadius(lungDeaths)), dataframe="rows")
  )
)

Working with Bigger Data

If your time series is large, ideally we would not want to pass the data in the dygraphs instance and in our callback. To get around this, we can implement a little trick.

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)
  }

}

# verify our function works as expected
identical(unname(xtsToDygraph(lungDeaths)), p$x$data)

# make the data with the radius and scaled radius
lungdeaths_with_radius <- addRadius(lungDeaths)

# trick our dygraph into getting data from JavaScript
p$x$data <- htmlwidgets::JS("(function(){return convert(lungdeaths, ['month', 'mdeaths', 'fdeaths'])})()")

# now we can rewrite our point callback function
p2 <- p %>%
  dyCallbacks("drawPointCallback" = "
function(g, name, ctx, canvasx, canvasy, color, radius, index) {
  radius = lungdeaths['scaled_radius_' + name][index];
  return Dygraph.Circles.DEFAULT(g, name, ctx, canvasx, canvasy, color, radius)
}
"
  )

# now provide our data as a global variable in JavaScript
library(htmltools)
browsable(
  tagList(
    p2,
    tags$script(HTML(
      sprintf(
"
var lungdeaths = %s;
// convert function in JavaScript
function convert(data, cols) {
  return cols.map(function(col) {
    return data[col]
  })
}
",
        jsonlite::toJSON(xtsToDygraph(lungdeaths_with_radius))
      )
    ))
  )
)

what about irregular data such that there is not a point for each variable/column

I believe Dygraphs will skip NA points and not call the draw point callback. However, if I am not correct, we can create a hash for each series and use that.

makeSomeNA <- function (dat, n=5, cols=2) {
  dat[sample(nrow(dat), n), cols] <- rep(NA, n)
  dat
}

# let's assume we are ok with duplicating and using method 1
lungdeaths_with_na <- makeSomeNA(lungDeaths)
p3 <- dygraph(lungdeaths_with_na) %>%
  dygraphs::dyRangeSelector() %>% 
  dyOptions(drawPoints = TRUE)


p3 %>%
  dyCallbacks("drawPointCallback" = sprintf(
"
function(g, name, ctx, canvasx, canvasy, color, radius, index) {
  console.log(name + ':' + index)
  var drat = %s;
  radius = drat[index]['scaled_radius_' + name];
  return Dygraph.Circles.DEFAULT(g, name, ctx, canvasx, canvasy, color, radius)
}
",
      jsonlite::toJSON(as.data.frame(addRadius(lungdeaths_with_na)), dataframe="rows")
    )
  )