Commit a8ecc249 authored by unknown's avatar unknown
Browse files

v0.1.4.1 dyplot.default now draws precipitation as a true bar plot and not a step plot

parent 67ff09e0
Package: airGRteaching
Type: Package
Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Application)
Version: 0.1.4.0
Date: 2017-07-13
Version: 0.1.4.1
Date: 2017-07-18
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.8.0)
Imports: xts, dygraphs, shiny, plotrix, markdown
......
......@@ -2,7 +2,10 @@ dyplot.default <- function(x, col.Precip = "royalblue", col.Q = c("black", "oran
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("ShinyGR/www/js/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\"")
}
......@@ -36,20 +39,21 @@ dyplot.default <- function(x, col.Precip = "royalblue", col.Q = c("black", "oran
data.xts <- xts(data[, -1L], order.by = data$DatesR)
graphOut <- dygraph(data.xts, main = main)
graphOut <- dyAxis(dygraph = graphOut, name = "y", label = ylab[1L],
dg <- dygraph(data.xts, main = main)
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))
graphOut <- dyAxis(dygraph = graphOut, name = "y2", label = ylab[2L], independentTicks = FALSE,
dg <- dyAxis(dygraph = dg, name = "y2", label = ylab[2L], independentTicks = FALSE,
valueRange = rev(range(data.xts[, "Precip"], na.rm = TRUE) * c(0.01, 2.99)))
graphOut <- dySeries(dygraph = graphOut, name = "Qobs", drawPoints = TRUE)
graphOut <- dySeries(dygraph = graphOut, name = tail(grep("^Q", colnames(data.xts), value = TRUE), 1), axis = 'y' , color = col.Q[seq_along(grep("^Q", colnames(data.xts)))])
graphOut <- dySeries(dygraph = graphOut, name = "Precip", axis = 'y2', stepPlot = TRUE, fillGraph = TRUE, color = col.Precip)
dg <- dySeries(dygraph = dg, name = "Qobs", drawPoints = TRUE)
dg <- dySeries(dygraph = dg, name = tail(grep("^Q", colnames(data.xts), value = TRUE), 1),
axis = 'y' , color = col.Q[seq_along(grep("^Q", colnames(data.xts)))])
dg <- dySeries(dygraph = dg, name = "Precip", axis = 'y2', plotter = barChartPrecip, color = col.Precip)
# if (ModelPeriod) {
# graphOut <- dyShading(dygraph = graphOut, from = x$PeriodModel$WarmUp[1L], to = x$PeriodModel$WarmUp[2L], color = "orangered")
# graphOut <- dyShading(dygraph = graphOut, from = x$PeriodModel$Run[1L] , to = x$PeriodModel$Run[2L] , color = "blue")
# 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")
# }
if (RangeSelector) {
graphOut <- dyRangeSelector(dygraph = graphOut, height = 15)
dg <- dyRangeSelector(dygraph = dg, height = 15)
}
if (plot.na) {
naQ_rle <- rle(is.na(data$Qobs))
......@@ -57,23 +61,23 @@ dyplot.default <- function(x, col.Precip = "royalblue", col.Q = c("black", "oran
naQ_ids <- naQ_ide - naQ_rle$lengths[naQ_rle$values] -1
IDna <- data.frame(start = naQ_ids, end = naQ_ide)
for (i in seq_len(nrow(IDna))) {
graphOut <- dyShading(dygraph = graphOut,
dg <- dyShading(dygraph = dg,
from = as.character(data$DatesR)[IDna[i, "start"]],
to = as.character(data$DatesR)[IDna[i, "end" ]],
color = col.na)
}
}
if (Roller) {
graphOut <- dyRoller(dygraph = graphOut, rollPeriod = 5)
dg <- dyRoller(dygraph = dg, rollPeriod = 5)
}
if (is.numeric(Roller)) {
graphOut <- dyRoller(dygraph = graphOut, rollPeriod = Roller)
dg <- dyRoller(dygraph = dg, rollPeriod = Roller)
}
if (any(LegendShow %in% c("follow", "auto", "always", "onmouseover", "never"))) {
graphOut <- dyLegend(dygraph = graphOut, show = LegendShow[1L])
dg <- dyLegend(dygraph = dg, show = LegendShow[1L])
}
graphOut <- dyOptions(dygraph = graphOut, useDataTimezone = TRUE)
return(graphOut)
dg <- dyOptions(dygraph = dg, useDataTimezone = TRUE)
return(dg)
}
"function barChartPrecip(e) {
var ctx = e.drawingContext;
var points = e.points;
var y_bottom = - e.dygraph.toDomYCoord(0);
// This should really be based on the minimum gap
var bar_width = 3.0/3 * (points[1].canvasx - points[0].canvasx);
ctx.fillStyle = e.color;
// Do the actual plotting.
for (var i = 0; i < points.length; i++) {
var p = points[i];
var center_x = p.canvasx; // center of the bar
ctx.fillRect(center_x - bar_width / 2, p.canvasy,
bar_width, y_bottom - p.canvasy);
ctx.strokeRect(center_x - bar_width / 2, p.canvasy,
bar_width, y_bottom - p.canvasy);
}
}"
\ No newline at end of file
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