dyplot.default.R 2.48 KB
Newer Older
1
2
3
dyplot.default <- function(x, col.Precip = "royalblue", col.Q = c("black", "orangered"),
                           xlab = "Time", ylab = c("precip. [mm]", "flow [mm]"), main = NULL,
                           RangeSelector = TRUE, Roller = FALSE, LegendShow = c("follow", "auto", "always", "onmouseover", "never"), ...) {
unknown's avatar
unknown committed
4
5

  if (! any(class(x) %in% c("ObsGR", "CalGR", "SimGR"))) {
6
    stop("Non convenient data for x argument. Must be of class \"ObsGR\", \"CalGR\" or \"SimGR\"")
unknown's avatar
unknown committed
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
  }
  
  if (any(class(x) %in% "ObsGR")) {
    data <- data.frame(DatesR = x$InputsModel$DatesR,
                       Precip = x$InputsModel$Precip,
                       Qobs   = x$Qobs)
  } 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)
    }
  }
  data.xts <- xts(data[, -1L], order.by = data$DatesR)
  
  graphOut <- dygraph(data.xts, main = main)
25
  graphOut <- dyAxis(dygraph = graphOut, name = "y", label = ylab[2L],
unknown's avatar
unknown committed
26
                     valueRange = range(data.xts[, grep("^Q", colnames(data.xts))], na.rm = TRUE) * c(0.01, 1.59))
27
  graphOut <- dyAxis(dygraph = graphOut, name = "y2", label = ylab[1L], independentTicks = FALSE,
unknown's avatar
unknown committed
28
                     valueRange = rev(range(data.xts[, "Precip"], na.rm = TRUE) * c(0.01, 2.99)))
29
  graphOut <- dySeries(dygraph = graphOut, tail(grep("^Q", colnames(data.xts), value = TRUE), 1), axis = 'y' , color = col.Q[seq_along(grep("^Q", colnames(data.xts)))])
unknown's avatar
unknown committed
30
31
  graphOut <- dySeries(dygraph = graphOut, "Precip", axis = 'y2', stepPlot = TRUE, fillGraph = TRUE, color = col.Precip)
  # if (ModelPeriod) {
32
  #   graphOut <- dyShading(dygraph = graphOut, from = x$PeriodModel$WarmUp[1L], to = x$PeriodModel$WarmUp[2L], color = "orangered")
unknown's avatar
unknown committed
33
34
35
36
37
  #   graphOut <- dyShading(dygraph = graphOut, from = x$PeriodModel$Run[1L]   , to = x$PeriodModel$Run[2L]   , color = "blue")
  # }
  if (RangeSelector) {
    graphOut <- dyRangeSelector(dygraph = graphOut, height = 15)
  }
38
39
40
41
42
43
44
45
  if (Roller) {
    graphOut <- dyRoller(dygraph = graphOut, rollPeriod = 5)
  }
  if (is.numeric(Roller)) {
    graphOut <- dyRoller(dygraph = graphOut, rollPeriod = Roller)
  }
  if (any(LegendShow %in% c("follow", "auto", "always", "onmouseover", "never"))) {
    graphOut <- dyLegend(dygraph = graphOut, show = LegendShow[1L])
unknown's avatar
unknown committed
46
47
48
49
50
  }  
  graphOut <- dyOptions(dygraph = graphOut, useDataTimezone = TRUE)
  return(graphOut)
  
}