Commit 1d5b751f authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v0.2.3.0 now depends on dygraphs 1.1.1.6 (previous embeded dygraphs functions have been removed)

parent 581c88e2
Package: airGRteaching
Type: Package
Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
Version: 0.2.2.5
Version: 0.2.3.0
Date: 2018-05-22
Authors@R: c(person("Olivier", "Delaigue", role = c("aut", "cre"), email = "airGR@irstea.fr"), person("Laurent", "Coron", role = c("aut")), person("Pierre", "Brigode", role = c("aut")), person("Guillaume", "Thirel", role = c("ctb")))
Depends: airGR (>= 1.0.9.43)
Imports: dygraphs (>= 1.1.1.4), htmlwidgets (>= 1.0), markdown, plotrix, shiny, shinyjs, xts
Imports: dygraphs (>= 1.1.1.6), htmlwidgets (>= 1.2), markdown, plotrix, shiny (>= 1.1.0), shinyjs (>= 1.0), xts
Suggests: knitr
Description: Add-on package to the 'airGR' package that simplifies its use and is aimed at being used for teaching hydrology. The package provides 1) three functions that allow to complete very simply a hydrological modelling exercise 2) plotting functions to help students to explore observed data and to interpret the results of calibration and simulation of the GR ('Génie rural') models 3) a 'Shiny' graphical interface that allows for displaying the impact of model parameters on hydrographs and models internal variables.
License: GPL-2
......
......@@ -34,20 +34,6 @@ export(.TypeModelGR)
#####################################
## Export dygraphs ##
#####################################
export(.computeYaxisRange)
export(.dyBarSeries)
export(.dyGroup)
export(.dyStackedBarGroup)
export(.dyStackedRibbonGroup)
export(.mergeLists)
export(.resolveStemPlot)
export(.resolveStrokePattern)
#####################################
## Import ##
#####################################
......
############# Release History of the airGRteaching Package
## 0.2.2.5 Release Notes (2018-05-22)
## 0.2.3.0 Release Notes (2018-08-08)
CRAN-compatibility updates
- now depends on the latest version (1.1.1.6) of the dygraphs package from CRAN (embeded dygraphs functions have been removed)
Major user-visible changes
- the article reference is updated
## 0.2.2.2 Release Notes (2018-03-21)
......
## =================================================================================
## function to generate a message to reinstall the dygraph package
## =================================================================================
## =================================================================================
## commands to avoid warnings during package checking when global variables are used
## =================================================================================
......
......@@ -86,7 +86,7 @@ dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup",
dg <- dygraphs::dySeries(dygraph = dg, name = "Qobs", axis = 'y' , color = col.Q[1L], drawPoints = TRUE)
dg <- dygraphs::dySeries(dygraph = dg, name = "Qsim", axis = 'y' , color = col.Q[2L])
dg <- dygraphs::dySeries(dygraph = dg, name = "Qsup", axis = 'y' , color = col.Q[3L], label = Qsup.name, strokePattern = "dashed")
dg <- .dyStackedBarGroup(dygraph = dg, name = rev(grep("^P", colnames(data.xts), value = TRUE)), axis = "y2", color = (col.Precip))
dg <- dygraphs::dyStackedBarGroup(dygraph = dg, name = rev(grep("^P", colnames(data.xts), value = TRUE)), axis = "y2", color = (col.Precip))
dg <- dygraphs::dyAxis(dygraph = dg, name = "y" , label = ylab[1L],
valueRange = range(data.xts[, grep("^Q", colnames(data.xts))], na.rm = TRUE) * c(0.01, 1.59))
dg <- dygraphs::dyAxis(dygraph = dg, name = "y2", label = ylab[2L], independentTicks = FALSE,
......
## Code from the last version of the 'dygraphs' package that is only available on GitHub
## Will be removed from airGRteaching when the last ‘dygraphs’ version will be available on the CRAN
## https://github.com/rstudio/dygraphs
## License MIT
## RStudio Team
## Many thanks to J.J. Allaire and Petr Shevtsov
#' dygraph series group
#'
#' Add a data series group to a dygraph plot. Note that options will use the default
#' global setting (as determined by \code{\link{dyOptions}}) when not specified
#' explicitly. Importantly, any dySeries options passed can be passed as a vector of values
#' and will be replicated across all series named as part of the group. If arguments differ in
#' length than the number of series named, then the argument vector will be
#' cycled across the named series.
#'
#' NOTE: dyGroup will turn off \code{stackedGraph}, as the option will calculated cumulatives using
#' all series in the underlying dygraph, not just a subset.
#'
#' The dyGroup function can also replicated similar arguments across multiple series, or
#' be used to apply a grouped custom plotter - i.e., multi-column plotter - to a subset of the
#' dygraph data series.
#'
#' @inheritParams dySeries
#' @inheritParams dyOptions
#'
#' @param dygraph Dygraph to add a series definition to
#' @param name character vector of the series within data set. If no name is specified then
#' series are bound to implicitly based on their order within the underlying
#' time series object. This parameter can also be a character vector of length
#' 3 that specifies a set of input column names to use as the lower, value,
#' and upper for a series with a shaded bar drawn around it.
#' @param label Labels to display for series (uses name if no label defined)
#' @param color Colors for series. These can be of the form "#AABBCC" or
#' "rgb(255,100,200)" or "yellow", etc. Note that if you specify a custom
#' color for one series then you must specify one for all series. If not
#' specified then the global colors option (typically based on equally-spaced
#' points around a color wheel). Note also that global and per-series color
#' specification cannot be mixed.
#' @param axis Y-axis to associate the series with ("y" or "y2")
#' @param stepPlot When set, display the graph as a step plot instead of a line
#' plot.
#' @param stemPlot When set, display the graph as a stem plot instead of a line
#' plot.
#' @param fillGraph Should the area underneath the graph be filled? This option
#' is not compatible with error bars.
#' @param drawPoints Draw a small dot at each point, in addition to a line going
#' through the point. This makes the individual data points easier to see, but
#' can increase visual clutter in the chart.
#' @param pointSize The size of the dot to draw on each point in pixels. A dot
#' is always drawn when a point is "isolated", i.e. there is a missing point
#' on either side of it. This also controls the size of those dots.
#' @param pointShape The shape of the dot to draw. Can be one of the following:
#' "dot" (default), "triangle", "square", "diamond", "pentagon", "hexagon",
#' "circle", "star", "plus" or "ex".
#' @param strokeWidth The width of the lines connecting data points. This can be
#' used to increase the contrast or some graphs.
#' @param strokePattern A predefined stroke pattern type ("dotted", "dashed", or
#' "dotdash") or a custom pattern array where the even index is a draw and odd
#' is a space in pixels. If \code{NULL} then it draws a solid line. The array
#' should have an even length as any odd length array could be expressed as
#' a smaller even length array.
#' @param strokeBorderWidth Draw a border around graph lines to make crossing
#' lines more easily distinguishable. Useful for graphs with many lines.
#' @param strokeBorderColor Color for the line border used if
#' \code{strokeBorderWidth} is set.
#'
#' @param plotter A function which plots the series group. See the
#' \href{http://dygraphs.com/tests/plotters.html}{dygraphs documentation} for
#' additional details on plotting functions.
#'
#' @return Dygraph with additional series
#'
#' @examples
#' \dontrun{
#' library(dygraphs)
#'
#' lungDeaths <- cbind(ldeaths, mdeaths, fdeaths)
#'
#' dygraph(lungDeaths, main = "Deaths from Lung Disease (UK)") %>%
#' dySeries("fdeaths", stepPlot = TRUE, color = "red") %>%
#' dyGroup(c("mdeaths", "ldeaths"), drawPoints = TRUE, color = c("blue", "green"))
#' }
#'
#' @note See the
#' \href{https://rstudio.github.io/dygraphs/gallery-series-options.html}{online
#' documentation} for additional details and examples.
#'
#' @export
.dyGroup <- function(dygraph,
name = NULL,
label = NULL,
color = NULL,
axis = "y",
stepPlot = NULL,
stemPlot = NULL,
fillGraph = NULL,
drawPoints = NULL,
pointSize = NULL,
pointShape = NULL,
strokeWidth = NULL,
strokePattern = NULL,
strokeBorderWidth = NULL,
strokeBorderColor = NULL,
plotter = NULL) {
# get a reference to the underlying data and labels
data <- attr(dygraph$x, "data")
labels <- names(data)
if (length(plotter)>1) message('dyGroup: pass only a single plotter option')
# auto-bind name if necessary
autobind <- attr(dygraph$x, "autoSeries")
if (length(name) == 1) {
dygraph<-dySeries(dygraph = dygraph,
name = name,
label = label,
color = color,
plotter = plotter)
return(dygraph)
}
# Plotter-mod! Added the plotter != NULL test to keep base capability while
# expanding to include group plotters
# Get the cols where this series is located and verify that they are
# available within the underlying dataset
cols <- which(labels %in% name)
if (length(cols) != length(name)) {
stop("One or more of the specified series were not found. ",
"Valid series names are: ", paste(labels[-1], collapse = ", "))
}
# Data series named here are "consumed" from the automatically generated
# list of series (they'll be added back in below)
cols <- which(dygraph$x$attrs$labels %in% name)
dygraph$x$data <- dygraph$x$data[-c(cols)]
dygraph$x$attrs$labels <- dygraph$x$attrs$labels[-c(cols)]
# MUST turn off native stacking option, as underlying dygraph
# will include custom-plotted points in the stacked calculation
if (length(dygraph$x$attrs$stackedGraph)>0) {
if (dygraph$x$attrs$stackedGraph) warning(
"dyGroup is incompatible with stackedGraph... stackedGraph now FALSE")
dygraph$x$attrs$stackedGraph <- FALSE;
}
# Resolve stemPlot into a custom plotter if necessary
plotter <- .resolveStemPlot(stemPlot, plotter)
if (!is.null(pointShape))
dygraph$x$pointShape <- list()
l<-length(name)
# add color if specified
if (!is.null(color)) {
#grab the names of all named series
names_ <- names(dygraph$x$attrs$series)
#grab any colors already set
colors_ <- dygraph$x$attrs$colors
# if no colors passed thus far, set up the color vector for
# the series defined previously
if(is.null(colors_)) {
colors_ <- vector('character', length(names_))
}
names(colors_) <- names_
for(i in 1:l) colors_[[name[i]]] <- rep(color, length.out = l)[i]
# all options must be unnamed vectors
names(colors_) <- NULL
# attrs$colors <- as.list(c(attrs$colors, color))
dygraph$x$attrs$colors <- colors_
}
# repeat (most of) the steps from dySeries, just in a loop
for (i in 1:l) {
# copy attrs for modification
attrs <- dygraph$x$attrs
# create series object
series <- list()
series$name <- name[i]
# take the passed options and extend to the length of the name vector; it's
# up to the User to make sure the vectors are of the desired length
suppressWarnings({
# for the axis, however, we enforce the same axis across all series named
# in the group. We can't stop the user from changing the axis of one or more
# series later, but at least we can control for some mistakes here
series$options$axis <- rep(match.arg(axis, c("y", "y2")),
length.out = l)[1]
if(!is.null(stepPlot)) series$options$stepPlot <- rep(
stepPlot, length.out = l)[i]
if(!is.null(fillGraph)) series$options$fillGraph <- rep(
fillGraph, length.out = l)[i]
if(!is.null(drawPoints)) series$options$drawPoints <- rep(
drawPoints, length.out = l)[i]
if(!is.null(pointSize)) series$options$pointSize <- rep(
pointSize, length.out = l)[i]
if(!is.null(strokeWidth)) series$options$strokeWidth <- rep(
strokeWidth, length.out = l)[i]
if(!is.null(strokePattern)) series$options$strokePattern <- rep(
.resolveStrokePattern(strokePattern), length.out = l)[i]
if(!is.null(strokeBorderWidth)) series$options$strokeBorderWidth <- rep(
strokeBorderWidth, length.out = l)[i]
if(!is.null(strokeBorderColor)) series$options$strokeBorderColor <- rep(
strokeBorderColor, length.out = l)[i]
# one can use this to pass a group plotter or any combination of individual series plotters
series$options$plotter <- htmlwidgets::JS(plotter)
})
# KEY! Adding a group designator to aid in group plotters
# By concatenating the names provided in the name age, it becomes
# a unique identifier than won't be duplicated unless the entire group of names
# passed gets re-passed together a second time, which would obviously override
# the first set of options
series$options$group <- paste0(name, collapse = "")
seriesData <- data[[series$name]]
# default the label if we need to
if (is.null(series$label))
series$label <- series$name
# add label
attrs$labels <- c(attrs$labels, series$label)
# get whatever options might have previously existed for the series, then merge
base <- attrs$series[[series$label]]
series$options <- .mergeLists(base, series$options)
# set options
attrs$series[[series$label]] <- series$options
# set attrs
dygraph$x$attrs <- attrs
# set point shape
if (!is.null(pointShape[i])) {
shapes <- c("dot", "triangle", "square", "diamond", "pentagon",
"hexagon", "circle", "star", "plus", "ex")
if (!is.element(pointShape[i], shapes)) {
stop("Invalid value for pointShape parameter. ",
"Should be one of the following: ",
"'dot', 'triangle', 'square', 'diamond', 'pentagon', ",
"'hexagon', 'circle', 'star', 'plus' or 'ex'")
}
if (pointShape[i] != "dot") {
dygraph$x$pointShape[[series$label]] <- rep(pointShape, length.out = l)
}
}
# add data
dygraph$x$data[[length(dygraph$x$data) + 1]] <- seriesData
}
# return modified dygraph
dygraph
}
## Code from the last version of the 'dygraphs' package that is only available on GitHub
## Will be removed from airGRteaching when the last ‘dygraphs’ version will be available on the CRAN
## https://github.com/rstudio/dygraphs
## License MIT
## RStudio Team
## Many thanks to J.J. Allaire and Petr Shevtsov
#' @rdname Plotters
#' @export
#'
.dyStackedBarGroup <- function(dygraph, name, ...) {
dots <- list(...)
if(length(name) < 2) {
dygraph <- do.call(.dyBarSeries, c(list(dygraph = dygraph, name = unlist(name)), dots))
return(dygraph)
}
file <- system.file("plotters/stackedbargroup.js", package = "airGRteaching")
plotter_ <- paste0(readLines(file, skipNul = TRUE), collapse = "\n")
dygraph <- do.call(.dyGroup, c(list(dygraph = dygraph, name = name, plotter = plotter_), dots))
dygraph <- .computeYaxisRange(dygraph, name)
dygraph
}
#' @rdname Plotters
#' @export
.dyBarSeries <- function(dygraph, name, ...) {
file <- system.file("plotters/barseries.js", package = "airGRteaching")
plotter_ <- paste0(readLines(file, skipNul = TRUE), collapse = "\n")
dots <- list(...)
do.call(dygraphs::dySeries, c(list(dygraph = dygraph, name = name, plotter = plotter_), dots))
}
#' @rdname Plotters
#' @export
.dyStackedRibbonGroup <- function(dygraph, name, ...) {
dots <- list(...)
if(length(name) < 2) {
dygraph <- do.call('dyFilledLine', c(list(dygraph = dygraph, name = name), dots))
return(dygraph)
}
file <- system.file("plotters/stackedribbongroup.js", package = "airGRteaching")
plotter_ <- paste0(readLines(file, skipNul = TRUE), collapse = "\n")
dygraph <- do.call(.dyGroup, c(list(dygraph = dygraph, name = name, plotter = plotter_), dots))
dygraph <- .computeYaxisRange(dygraph, name)
dygraph
}
.computeYaxisRange <- function(dygraph, name) {
# most of what happens from here on out is a simplified version of the
# stackPoints and computeYaxis functions in the underlying dygraph package.
# Since we can't modify the Yaxis range from within the specialized plotter,
# we need to calculate an appropriate valueRange for the group's axis here, then
# reconcile that against user-provided ranges and then pass into the widget... this
# way we ensure that the newly stacked data (but initially unstacked to the widget)
# doesn't get cutoff by an axis range - computed by the widget - that won't consider
# the points stacked
attrs <- dygraph$x$attrs
data <- attr(dygraph$x, "data")
cols <- which(names(data) %in% name)
#get all the series, minus the x axis, that are not part of the group
data_ <- data[-c(1, cols)]
name_ <- names(data)[which(!names(data) %in% name)][-1]
#grab the axis for the group, we'll calculate the new range only on this axis
series <- attrs$series[[name[1]]]
axisNm <- series$axis
if (!is.null(axisNm)) {
axis <- attrs$axes[[axisNm]]
valueRange <- axis$valueRange
} else {
axisNm<-"y"
axis <- attrs$axes[[axisNm]] <- NULL
valueRange <- NULL
}
if(is.null(valueRange)) {
valueRange <- c(0, 0)
}
# get the group data fields
data <- data[cols]
for(i in 1:length(data)) {
# get the data points
points <- data[i][[1]]
# fill NAs... we're not saving this data back into the graph, so this is OK
is.na(points) <- 0
# add to cumulativeList
if(!exists('cumulativeYval')) cumulativeYval <- points
else cumulativeYval <- cumulativeYval + points
# calculate extremes
extremes <- range(cumulativeYval)
}
for(i in 1:length(data_)) {
if (length(data_)==0) break
# ranges are calcuated separately, so skip those from other axes
series_ <- attrs$series[[name_[i]]]
if (!is.null(series_$axis) && series_$axis != axisNm) next
points <- data_[i][[1]]
# fill NAs
is.na(points) <- 0
# getExtremes
extremes_ <- range(points)
extremes[1] <- min(extremes[1], extremes_[1])
extremes[2] <- max(extremes[2], extremes_[2])
}
valueRange[1] <- min(extremes[1], valueRange[1])
valueRange[2] <- max(extremes[2], valueRange[2])
# add a little padding since we're hard-setting the range
valueRange[2] <- valueRange[2] + 0.05 * abs(valueRange[2] - valueRange[1])
axis$options$valueRange <- valueRange
attrs$axes[[axisNm]] <- axis$options
# return modified dygraph
dygraph$x$attrs <- .mergeLists(dygraph$x$attrs, attrs)
return (dygraph)
}
\ No newline at end of file
## Code from the last version of the 'dygraphs' package that is only available on GitHub
## Will be removed from airGRteaching when the last ‘dygraphs’ version will be available on the CRAN
## https://github.com/rstudio/dygraphs
## License MIT
## RStudio Team
## Many thanks to J.J. Allaire and Petr Shevtsov
# provide a custom plotter if stemPlot has been specified
.resolveStemPlot <- function(stemPlot, plotter) {
# check for stemPlot argument
if (isTRUE(stemPlot)) {
# verify that a custom plotter hasn't been specified
if (!is.null(plotter)) {
stop("stemPlot provides it's own plotter so is incompatible with ",
"specifying a custom plotter", call. = FALSE)
}
# provide custom plotter JS
"function stemPlotter(e) {
var ctx = e.drawingContext;
var points = e.points;
var y_bottom = e.dygraph.toDomYCoord(0);
ctx.fillStyle = e.color;
for (var i = 0; i < points.length; i++) {
var p = points[i];
var center_x = p.canvasx;
var center_y = p.canvasy;
ctx.beginPath();
ctx.moveTo(center_x, y_bottom);
ctx.lineTo(center_x, center_y);
ctx.stroke();
ctx.beginPath();
ctx.arc(center_x, center_y, 3, 0, 2*Math.PI);
ctx.stroke();
}
}"
} else {
# specified plotter
plotter
}
}
\ No newline at end of file
## Code from the last version of the 'dygraphs' package that is only available on GitHub
## Will be removed from airGRteaching when the last ‘dygraphs’ version will be available on the CRAN
## https://github.com/rstudio/dygraphs
## License MIT
## RStudio Team
## Many thanks to J.J. Allaire and Petr Shevtsov
.mergeLists <- function (base_list, overlay_list, recursive = TRUE) {
if (length(base_list) == 0)
overlay_list
else if (length(overlay_list) == 0)
base_list
else {
merged_list <- base_list
for (name in names(overlay_list)) {
base <- base_list[[name]]
overlay <- overlay_list[[name]]
if (is.list(base) && is.list(overlay) && recursive)
merged_list[[name]] <- .mergeLists(base, overlay)
else {
merged_list[[name]] <- NULL
merged_list <- append(merged_list,
overlay_list[which(names(overlay_list) %in% name)])
}
}
merged_list
}
}
.resolveStrokePattern <- function (strokePattern) {
if (is.character(strokePattern)) {
if (strokePattern == "dotted")
strokePattern <- c(2, 2)
else if (strokePattern == "dashed")
strokePattern <- c(7, 3)
else if (strokePattern == "dotdash")
strokePattern <- c(7, 2, 2, 2)
else if (strokePattern == "solid")
strokePattern <- c(1, 0)
else stop("Invalid stroke pattern: valid values are dotted, ",
"dashed, and dotdash")
}
strokePattern
}
......@@ -538,7 +538,7 @@ shinyServer(function(input, output, session) {
dg3 <- dygraphs::dyOptions(dg3, fillAlpha = 1.0,
axisLineColor = op$fg, axisLabelColor = op$fg,
titleHeight = 10, retainDateWindow = FALSE)
dg3 <- .dyStackedRibbonGroup(dg3, name = names,
dg3 <- dygraphs::dyStackedRibbonGroup(dg3, name = names,
color = colors, strokeBorderColor = "black")
dg3 <- dygraphs::dySeries(dg3, name = "Qobs", fillGraph = FALSE, drawPoints = TRUE, color = op$fg)
dg3 <- dygraphs::dySeries(dg3, name = "Qsim", fillGraph = FALSE, color = "orangered")
......@@ -562,7 +562,7 @@ shinyServer(function(input, output, session) {
dg4 <- dygraphs::dygraph(data.xts, group = "mod_diag", ylab = paste0("precip. [mm/", getPrep()$TMGR$TimeUnit, "]"))
dg4 <- dygraphs::dyOptions(dg4, colors = "#428BCA", drawXAxis = FALSE, retainDateWindow = FALSE)