Commit ee79917e authored by unknown's avatar unknown
Browse files

v0.1.6.9 dyplot now plot Pliq and Psol when CemaNeige is used...

v0.1.6.9 dyplot now plot Pliq and Psol when CemaNeige is used (dyStackedBarGroup instead of the plotter argument)
parent aa6dccd0
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.8
Version: 0.1.6.9
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)
......
dyplot.default <- function(x, col.Precip = "royalblue", col.Q = c("black", "orangered"), col.na = "lightgrey",
dyplot.default <- function(x, col.Precip = c("royalblue", "lightblue"), col.Q = c("black", "orangered"), col.na = "lightgrey",
xlab = NULL, ylab = NULL, main = NULL,
plot.na = TRUE, RangeSelector = TRUE, Roller = FALSE,
LegendShow = c("follow", "auto", "always", "onmouseover", "never"), ...) {
......@@ -28,54 +28,52 @@ dyplot.default <- function(x, col.Precip = "royalblue", col.Q = c("black", "oran
Precip = x$InputsModel$Precip,
Qobs = x$Qobs,
Qsim = NA)
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
data$Precip <- NULL
}
} else {
data <- data.frame(DatesR = x$OutputsModel$DatesR,
Precip = x$OutputsModel$Precip,
Qobs = x$Qobs,
Qsim = x$OutputsModel$Qsim)
if (length(col.Q) < 2) {
col.Q <- rep(col.Q, 2)
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))
data$Precip <- NULL
}
}
data.xts <- xts(data[, -1L], order.by = data$DatesR)
Plim <- c(-1e-3, max(data$Precip, na.rm = TRUE))
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.Precip) < 2) {
col.Precip <- c(rgba(col.Precip), rgba(col.Precip, alpha = 0.5))
}
# if (any(names(x$InputsModel) == "LayerPrecip")) {
# data$Psol <- rowMeans(as.data.frame(x$InputsModel$LayerPrecip) * as.data.frame(x$InputsModel$LayerFracSolidPrecip))
# data$Pliq <- data$Precip - data$Psol
# data$Precip <- NULL
# }
data.xts <- xts(data[, -1L], order.by = data$DatesR)
if (grepl("CemaNeige", x$TypeModel)) {
Plim <- c(-1e-3, max(data$Psol+data$Pliq, na.rm = TRUE))
} else {
Plim <- c(-1e-3, max(data$Precip, na.rm = TRUE))
col.Precip <- col.Precip[1L]
}
dg <- dygraph(data.xts, main = main)
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 = "Precip", axis = 'y2', plotter = barChartPrecip, color = col.Precip)
dg <- dyAxis(dygraph = dg, name = "y", label = ylab[1L],
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))
dg <- dyAxis(dygraph = dg, name = "y2", label = ylab[2L], independentTicks = FALSE,
valueRange = rev(Plim) * c(2.99, 0.01))
# if (any(names(x$InputsModel) == "LayerPrecip")) {
# dg <- dyStackedBarGroup(dygraph = dg, name = c("Psol", "Pliq"), axis = "y2", color = c("lightblue", col.Precip))
# dg <- dyAxis(dygraph = dg, name = "y2", label = ylab[2L], independentTicks = FALSE,
# valueRange = rev(Plim))# * c(0.01, 2.99))
# } else {
# dg <- dySeries(dygraph = dg, name = "Precip", axis = 'y2', plotter = barChartPrecip, color = col.Precip)
# dg <- dyStackedBarGroup(dygraph = dg, name = c("Precip"), axis = "y2", color = col.Precip)
# dg <- dyAxis(dygraph = dg, name = "y2", label = ylab[2L], independentTicks = FALSE,
# valueRange = rev(Plim) * c(0.01, 2.99))
# }
# if (ModelPeriod) {
# dg <- dyShading(dygraph = dg, from = x$PeriodModel$WarmUp[1L], to = x$PeriodModel$WarmUp[2L], color = "orangered")
# dg <- dyShading(dygraph = dg, from = x$PeriodModel$Run[1L] , to = x$PeriodModel$Run[2L] , color = "blue")
# }
valueRange = rev(Plim) * c(2.99, 0.01))
if (RangeSelector) {
dg <- dyRangeSelector(dygraph = dg, height = 15)
}
......@@ -86,9 +84,9 @@ dyplot.default <- function(x, col.Precip = "royalblue", col.Q = c("black", "oran
IDna <- data.frame(start = naQ_ids, end = naQ_ide)
for (i in seq_len(nrow(IDna))) {
dg <- dyShading(dygraph = dg,
from = as.character(data$DatesR)[IDna[i, "start"]],
to = as.character(data$DatesR)[IDna[i, "end" ]],
color = col.na)
from = as.character(data$DatesR)[IDna[i, "start"]],
to = as.character(data$DatesR)[IDna[i, "end" ]],
color = col.na)
}
}
if (Roller) {
......@@ -100,8 +98,8 @@ dyplot.default <- function(x, col.Precip = "royalblue", col.Q = c("black", "oran
if (any(LegendShow %in% c("follow", "auto", "always", "onmouseover", "never"))) {
dg <- dyLegend(dygraph = dg, show = LegendShow[1L])
}
dg <- dyOptions(dygraph = dg, useDataTimezone = TRUE)
return(dg)
}
Markdown is supported
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