Commit da1999bb authored by unknown's avatar unknown
Browse files

v0.2.0.2 embeded dygraphs function are no private

Showing with 49 additions and 31 deletions
+49 -31
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
......
......@@ -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)
......
......@@ -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
......
......@@ -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,
......
......@@ -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
......
......@@ -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
......@@ -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)) {
......
......@@ -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
}
......@@ -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)
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment