#' Interactive time series
#'
#' This function plots an interactive time series using \code{dygraph} package.
#'
#' @param df A dataframe containing variables to plot in a wide format.
#' @param x Name of the variable to plot as x axis. Default is "date". Note that
#' the this does not have to be a \code{Date} or \code{POSIXct} class variable.
#' Regular numeric variable is also supported, such as year 2010, 2011, ...
#' @param vars The name of variables to plot. If not supplied, all the numeric
#' variables will be plotted.
#' @param normalise Should the data be normalised. This is suitable for plotting
#' variables of different scales. Default is \code{FALSE}.
#' @param dy.label This specify the column containing additional info to add the
#' dygraph. Default is \code{NA}.
#' @param draw.points Draw points in the series? The default is \code{FALSE}.
#' @param point.size Default value is 2, which is generally appropriate. A value
#' of 0.5 is very subtle.
#' @param line.width Default value is 0.5.
#' @param connect.points Force the line to be drawn between points with gap.
#' Default is \code{TRUE}.
#' @param tz Time zone of the time series data.
#' @param dy.group This specifies the group of the dygraphs.
#' If multiple dygraphs are plotted and you want zooming in one of the graphs to be synced with other graphs,
#' then set all the dygraphs to the same group.
#' @param ylab Name of y axis.
#' @param ylim Set the vertical range of the graph to c(low, high). See \code{\link[dygraphs]{dyAxis}}.
#' @param ... other arguements passed to \code{\link[dygraphs]{dygraph}}.
#' @param highlight.individual Logical. If individual series should be highlighted
#' when hovering.
#'
#' @examples
#'
#' @import dygraphs
#'
#' @export
#'
plot_dygraph <- function(df, x = "date", vars, normalise = FALSE, dy.label = NA, tz = "UTC",
draw.points = FALSE, point.size = 2, line.width = 0.5,
connect.points = TRUE,
highlight.individual = FALSE,
dy.group = NA, ylab = NULL, ylim = NULL, ...) {
# the Data
if (missing(vars)) {
num_id <- sapply(df, is.numeric)
theData <- df[num_id] %>%
select(-one_of(x)) # exlcude the x var if x is also numeric
} else {
theData <- tryCatch(df[vars],
error = function(e) {
# if vars contains column names not in df,
# choose the ones exist in df
df[intersect(vars, names(df))]
})
}
# normalise data
if (normalise) theData <- theData %>% mutate_all(funs(./mean(., na.rm = TRUE)))
# the Date
theDate <- df[[x]]
# create time series data
## check if x is date or numeric data
if (is.numeric(theDate)) {
ts <- cbind(theDate, theData)
} else {
ts <- xts::xts(theData, order.by = theDate, tz = tz)
}
# plot dygraph
colour_vector <- ggplot2_colours(NCOL(theData))
plot <- dygraph(ts, group = dy.group, ...) %>%
dyOptions(colors = colour_vector,
useDataTimezone = TRUE,
drawPoints = draw.points,
pointSize = point.size,
strokeWidth = line.width,
connectSeparatedPoints = connect.points) %>%
dyAxis("y", label = ylab, valueRange = ylim) %>%
dyLegend(width = 400) %>%
dyRangeSelector()
# additional label in the legend?
if (!is.na(dy.label)) {
plot <- plot %>%
# add label to the hover text
# taken from https://stackoverflow.com/questions/27671576/how-can-i-get-tooltips-showing-in-dygraphs-without-annotation
dyCallbacks(
highlightCallback = sprintf(
'function(e, x, pts, row) {
// added to illustrate what is happening
// remove once satisfied with your code
debugger;
var customLegend = %s
// should get our htmlwidget
var legendel = e.target.parentNode.parentNode
.querySelectorAll(".dygraph-legend")[0];
// should get our htmlwidget
legendel.innerHTML = legendel.innerHTML + "<br>" + customLegend[row];
}'
,# supply a vector or text that you would like
jsonlite::toJSON(df[[dy.label]])
)
)
}
# Highlight individual time sereis?
if (highlight.individual) {
plot <- plot %>%
dyLegend(width = 300) %>%
# the following copied from https://stackoverflow.com/questions/35943583/plain-dygraphs-javascript-options-in-r-shiny
dyHighlight(highlightSeriesOpts = list(strokeWidth = 3)) %>%
dyCSS(textConnection("
.dygraph-legend > span { display: none; }
.dygraph-legend > span.highlight { display: inline; }
"))
}
# return
plot
}
#' Extract colour codes in ggplot2
#'
#' no export
#'
#' @param n Number of colours
ggplot2_colours <- function (n = 2) {
hues <- seq(15, 375, length = n + 1)
hcl(h = hues, l = 65, c = 100)[1:n]
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.