diff --git a/DESCRIPTION b/DESCRIPTION index 209d29d07f97f75e9ac74575cf15307799e86559..07d9c8c8327756cfc645337b1c9033acdfdfa677 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: airGRteaching Type: Package Title: Teaching hydrological modelling with {GR} (shiny interface included) -Version: 0.2.0.1 -Date: 2018-03-13 +Version: 0.2.0.2 +Date: 2018-03-14 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: devtools, dygraphs (>= 1.1.1.4), htmlwidgets (>= 1.1), markdown, plotrix, shiny, shinyjs, xts diff --git a/NAMESPACE b/NAMESPACE index 10998b841cb5f0f120621b0bcb46fa1407e7e316..d4eb68ad8ec9cecd53c977fe147132dc1fa92465 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -36,13 +36,14 @@ export(.TypeModelGR) ##################################### ## Export dygraphs ## ##################################### -export(computeYaxisRange) -export(dyBarSeries) -export(dyGroup) -export(dyStackedBarGroup) -export(dyStackedRibbonGroup) -export(mergeLists) -export(resolveStemPlot) +export(.computeYaxisRange) +export(.dyBarSeries) +export(.dyGroup) +export(.dyStackedBarGroup) +export(.dyStackedRibbonGroup) +export(.mergeLists) +export(.resolveStemPlot) +export(.resolveStrokePattern) diff --git a/NEWS b/NEWS index fd1695bf7dbf762556d3d62df552fb2f2f87f4dd..96aad54772f406f0241254e19e7cdd115085bc98 100644 --- a/NEWS +++ b/NEWS @@ -2,7 +2,7 @@ -## 0.2.0.1 Release Notes (2018-03-13) +## 0.2.0.2 Release Notes (2018-03-13) CRAN-compatibility updates - embeding dygraphs functions to avoid user to install the last version of this package from GitHub diff --git a/R/dyplot.default.R b/R/dyplot.default.R index 3458664e336e47b2181e0947ac8a4dfd68f6ca57..a040bc1a478411d06d65d20f25f7a55efed2e355 100644 --- a/R/dyplot.default.R +++ b/R/dyplot.default.R @@ -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 <- airGRteaching::dyStackedBarGroup(dygraph = dg, name = rev(grep("^P", colnames(data.xts), value = TRUE)), axis = "y2", color = (col.Precip)) + dg <- .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, diff --git a/R/zz_dygraphs_group.R b/R/zz_dygraphs_group.R index 971f1aa2d54cd527c399e4fb4cabf660f7bf4fec..5f35d5e0e436431b063ed5d99ca0beeeaf7c19ad 100644 --- a/R/zz_dygraphs_group.R +++ b/R/zz_dygraphs_group.R @@ -90,7 +90,7 @@ #' documentation} for additional details and examples. #' #' @export -dyGroup <- function(dygraph, +.dyGroup <- function(dygraph, name = NULL, label = NULL, color = NULL, @@ -152,7 +152,7 @@ dyGroup <- function(dygraph, } # Resolve stemPlot into a custom plotter if necessary - plotter <- airGRteaching::resolveStemPlot(stemPlot, plotter) + plotter <- .resolveStemPlot(stemPlot, plotter) if (!is.null(pointShape)) dygraph$x$pointShape <- list() @@ -212,7 +212,7 @@ dyGroup <- function(dygraph, 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] + .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( @@ -240,7 +240,7 @@ dyGroup <- function(dygraph, # get whatever options might have previously existed for the series, then merge base <- attrs$series[[series$label]] - series$options <- airGRteaching::mergeLists(base, series$options) + series$options <- .mergeLists(base, series$options) # set options attrs$series[[series$label]] <- series$options diff --git a/R/zz_dygraphs_plotters.R b/R/zz_dygraphs_plotters.R index a8370733ffe0c50c40987383c41140519af79e98..913b6da4acacd44f21acc4ea0c9032835ad80ead 100644 --- a/R/zz_dygraphs_plotters.R +++ b/R/zz_dygraphs_plotters.R @@ -10,27 +10,27 @@ #' @rdname Plotters #' @export #' -dyStackedBarGroup <- function(dygraph, name, ...) { +.dyStackedBarGroup <- function(dygraph, name, ...) { dots <- list(...) if(length(name) < 2) { - dygraph <- do.call(airGRteaching::dyBarSeries, c(list(dygraph = dygraph, name = unlist(name)), dots)) + 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(airGRteaching::dyGroup, c(list(dygraph = dygraph, name = name, plotter = plotter_), dots)) + dygraph <- do.call(.dyGroup, c(list(dygraph = dygraph, name = name, plotter = plotter_), dots)) - dygraph <- airGRteaching::computeYaxisRange(dygraph, name) + dygraph <- .computeYaxisRange(dygraph, name) dygraph } #' @rdname Plotters #' @export -dyBarSeries <- function(dygraph, name, ...) { +.dyBarSeries <- function(dygraph, name, ...) { file <- system.file("plotters/barseries.js", package = "airGRteaching") plotter_ <- paste0(readLines(file, skipNul = TRUE), collapse = "\n") @@ -42,7 +42,7 @@ dyBarSeries <- function(dygraph, name, ...) { #' @rdname Plotters #' @export -dyStackedRibbonGroup <- function(dygraph, name, ...) { +.dyStackedRibbonGroup <- function(dygraph, name, ...) { dots <- list(...) if(length(name) < 2) { @@ -53,14 +53,14 @@ dyStackedRibbonGroup <- function(dygraph, name, ...) { file <- system.file("plotters/stackedribbongroup.js", package = "airGRteaching") plotter_ <- paste0(readLines(file, skipNul = TRUE), collapse = "\n") - dygraph <- do.call(airGRteaching::dyGroup, c(list(dygraph = dygraph, name = name, plotter = plotter_), dots)) + dygraph <- do.call(.dyGroup, c(list(dygraph = dygraph, name = name, plotter = plotter_), dots)) - dygraph <- airGRteaching::computeYaxisRange(dygraph, name) + dygraph <- .computeYaxisRange(dygraph, name) dygraph } -computeYaxisRange <- function(dygraph, name) { +.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, @@ -138,6 +138,6 @@ computeYaxisRange <- function(dygraph, name) { attrs$axes[[axisNm]] <- axis$options # return modified dygraph - dygraph$x$attrs <- airGRteaching::mergeLists(dygraph$x$attrs, attrs) + dygraph$x$attrs <- .mergeLists(dygraph$x$attrs, attrs) return (dygraph) } \ No newline at end of file diff --git a/R/zz_dygraphs_series.R b/R/zz_dygraphs_series.R index 7b128b22f3d11335a2bec72d8ec8ea3515400f01..4a759151f23daab8b45d76886264876372503b7e 100644 --- a/R/zz_dygraphs_series.R +++ b/R/zz_dygraphs_series.R @@ -8,7 +8,7 @@ # provide a custom plotter if stemPlot has been specified -resolveStemPlot <- function(stemPlot, plotter) { +.resolveStemPlot <- function(stemPlot, plotter) { # check for stemPlot argument if (isTRUE(stemPlot)) { diff --git a/R/zz_dygraphs_utils.R b/R/zz_dygraphs_utils.R index a31342d26a57394e154b765814efe838f17872d7..611f520fb02ac6e146b70ae99d9412918421d168 100644 --- a/R/zz_dygraphs_utils.R +++ b/R/zz_dygraphs_utils.R @@ -7,7 +7,7 @@ -mergeLists <- function (base_list, overlay_list, recursive = TRUE) { +.mergeLists <- function (base_list, overlay_list, recursive = TRUE) { if (length(base_list) == 0) overlay_list else if (length(overlay_list) == 0) @@ -18,7 +18,7 @@ mergeLists <- function (base_list, overlay_list, recursive = TRUE) { base <- base_list[[name]] overlay <- overlay_list[[name]] if (is.list(base) && is.list(overlay) && recursive) - merged_list[[name]] <- mergeLists(base, overlay) + merged_list[[name]] <- .mergeLists(base, overlay) else { merged_list[[name]] <- NULL merged_list <- append(merged_list, @@ -27,4 +27,21 @@ mergeLists <- function (base_list, overlay_list, recursive = TRUE) { } merged_list } -} \ No newline at end of file +} + + +.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 +} diff --git a/inst/ShinyGR/server.R b/inst/ShinyGR/server.R index c00c236b56c04d628970b7e9e2ff728e79a6b4a3..dadd132f3af17fb8b32a802e11e8bdf831799a7c 100644 --- a/inst/ShinyGR/server.R +++ b/inst/ShinyGR/server.R @@ -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 <- airGRteaching::dyStackedRibbonGroup(dg3, name = names, + dg3 <- .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) - dg4 <- airGRteaching::dyBarSeries(dg4, name = "precip.") + dg4 <- .dyBarSeries(dg4, name = "precip.") dg4 <- dygraphs::dyAxis(dg4, name = "y", valueRange = c(max(data.xts[, "precip."], na.rm = TRUE), -1e-3)) dg4 <- dygraphs::dyEvent(dg4, input$Event, color = "orangered") dg4 <- dygraphs::dyLegend(dg4, show = "onmouseover", width = 225)