v0.1.6.12 dyplot now allows to draw an additionnal time series of flow

DESCRIPTION

 Package: airGRteaching
 Type: Package
 Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Interface)
-Version: 0.1.6.11
+Version: 0.1.6.12
 Date: 2017-09-28
 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)

R/dyplot.default.R

-dyplot.default <- function(x, col.Precip = c("royalblue", "lightblue"), col.Q = c("black", "orangered"), col.na = "lightgrey",
+dyplot.default <- function(x, Qsup = NULL, Qsup.name = "Qsup",
+                           col.Precip = c("royalblue", "lightblue"), col.Q = c("black", "orangered", "grey"), col.na = "lightgrey",
                            xlab = NULL, ylab = NULL, main = NULL,
                            plot.na = TRUE, RangeSelector = TRUE, Roller = FALSE,
                            LegendShow = c("follow", "auto", "always", "onmouseover", "never"), ...) {
   
-  barChartPrecip <- scan(file = system.file("plugins/barChartPrecip.js", package = "airGRteaching"),
-                         what = "character", quiet = TRUE)
+  # barChartPrecip <- scan(file = system.file("plugins/barChartPrecip.js", package = "airGRteaching"),
+  #                        what = "character", quiet = TRUE)
   
   if (! any(class(x) %in% c("ObsGR", "CalGR", "SimGR"))) {
     stop("Non convenient data for x argument. Must be of class \"ObsGR\", \"CalGR\" or \"SimGR\"")
@@ -22,12 +23,26 @@ dyplot.default <- function(x, col.Precip = c("royalblue", "lightblue"), col.Q =
     }
   } 
   
-  
+  if (is.null(Qsup)) {
+    Qsup <- as.numeric(rep(NA, length.out = length(x$Qobs)))
+  } 
+  if (!is.numeric(Qsup)) {
+    stop("'Qsup' must be numeric")
+  }
+  if (length(Qsup) != length(x$Qobs)) {
+    stop("Incorrect length of 'Qsup', must be of length ", length(x$Qobs))
+  }
+  if (!is.character(Qsup.name)) {
+    Qsup.name <- as.character(Qsup.name)
+  }
+
+
   if (any(class(x) %in% "ObsGR")) {
     data <- data.frame(DatesR = x$InputsModel$DatesR,
                        Precip = x$InputsModel$Precip,
                        Qobs   = x$Qobs,
-                       Qsim   = NA)
+                       Qsim   = NA,
+                       Qsup   = Qsup)
     if (grepl("CemaNeige", x$TypeModel)) {
       data$Psol <- rowMeans(as.data.frame(x$InputsModel$LayerPrecip) * as.data.frame(x$InputsModel$LayerFracSolidPrecip), na.rm = TRUE)
       data$Pliq <- data$Precip - data$Psol
@@ -37,7 +52,8 @@ dyplot.default <- function(x, col.Precip = c("royalblue", "lightblue"), col.Q =
     data <- data.frame(DatesR = x$OutputsModel$DatesR,
                        Precip = x$OutputsModel$Precip,
                        Qobs   = x$Qobs,
-                       Qsim   = x$OutputsModel$Qsim)
+                       Qsim   = x$OutputsModel$Qsim,
+                       Qsup   = Qsup)
     if (grepl("CemaNeige", x$TypeModel)) {
       data$Psol <- rowMeans(sapply(x$OutputsModel$CemaNeigeLayers, function(x) x$Psol))
       data$Pliq <- rowMeans(sapply(x$OutputsModel$CemaNeigeLayers, function(x) x$Pliq))
@@ -50,8 +66,11 @@ dyplot.default <- function(x, col.Precip = c("royalblue", "lightblue"), col.Q =
   rgba <- function(x, alpha = 1) {
     sprintf("rgba(%s, %f)", paste0(col2rgb(x), collapse = ", "), alpha)
   }
-  if (length(col.Q) < 2) {
-    col.Q <- c(rgba(col.Q), rgba(col.Q, alpha = 0.5))
+  if (length(col.Q) == 1) {
+    col.Q <- c(rgba(col.Q), rgba(col.Q, alpha = 0.5), rgba(col.Q, alpha = 0.3))
+  }
+  if (length(col.Q) == 2) {
+    col.Q <- c(rgba(col.Q[1L]), rgba(col.Q[2L]), rgba(col.Q[2L], alpha = 0.5))
   }
   if (length(col.Precip) < 2) {
     col.Precip <- c(rgba(col.Precip), rgba(col.Precip, alpha = 0.5))
@@ -69,6 +88,7 @@ dyplot.default <- function(x, col.Precip = c("royalblue", "lightblue"), col.Q =
   dg <- dygraph(data.xts, main = main)
   dg <- dySeries(dygraph = dg, name = "Qobs", axis = 'y' , color = col.Q[1L], drawPoints = TRUE)
   dg <- dySeries(dygraph = dg, name = "Qsim", axis = 'y' , color = col.Q[2L])
+  dg <- dySeries(dygraph = dg, name = "Qsup", axis = 'y' , color = col.Q[3L], label = Qsup.name, strokePattern = "dashed")
   dg <- dyStackedBarGroup(dygraph = dg, name = grep("^P", colnames(data.xts), value = TRUE), axis = "y2", color = rev(col.Precip))
   dg <- 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))

man/dyplot.default.Rd

@@ -9,8 +9,9 @@
 
 
 \usage{
-\method{dyplot}{default}(x, col.Precip = c("royalblue", "lightblue"),
-  col.Q = c("black", "orangered"), col.na = "lightgrey",
+\method{dyplot}{default}(x, Qsup = NULL, Qsup.name = "Qsup",
+  col.Precip = c("royalblue", "lightblue"),
+  col.Q = c("black", "orangered", "grey"), col.na = "lightgrey",
   xlab = NULL, ylab = NULL, main = NULL,
   plot.na = TRUE, RangeSelector = TRUE, Roller = FALSE,
   LegendShow = c("follow", "auto", "always", "onmouseover", "never"), ...)
@@ -20,6 +21,10 @@
 \arguments{
   \item{x}{[object of class \emph{ObsGR}, \emph{CalGR} or \emph{SimGR}] see \code{\link{ObsGR}}, \code{\link{CalGR}}, \code{\link{SimGR}} for details}
 
+  \item{Qsup}{(optional) [numeric] time series of flow (for the same time steps than observed or simulated) [mm/time step]}
+  
+  \item{Qsup.name}{(optional) [character] a label for the legend of Qsup}
+  
   \item{col.Precip}{(optional) [character] vector of 1 (total precip.) or 2  (liquid and sol precip. with CemaNeige) color codes or names for precipitation (these can be of the form \code{"#AABBCC"} or \code{"rgb(255, 100, 200)"} or \code{"yellow"}), see \code{\link{par}} and \code{\link{rgb}}}
 
   \item{col.Q}{(optional) [character] vector of 2 color codes or names for observed and simulated flows, respectively (these can be of the form \code{"#AABBCC"} or \code{"rgb(255, 100, 200)"} or \code{"yellow"}), see \code{\link{par}} and \code{\link{rgb}}}