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

  if (! any(class(x) %in% c("ObsGR", "CalGR", "SimGR"))) {
7
    stop("Non convenient data for x argument. Must be of class \"ObsGR\", \"CalGR\" or \"SimGR\"")
unknown's avatar
unknown committed
8
9
  }
  
10
11
12
13
14
15
16
17
18
19
20
21
22
  if (is.null(xlab)) {
    xlab <- "Time"
  }
  if (is.null(ylab)) {
    yunit <- .TypeModelGR(x)$TimeUnit
    ylab  <- paste0(c("flow [mm/", "precip. [mm/"), yunit, "]")
  } else {
    if (length(ylab) < 2) {
      ylab <- c(ylab, "")
    }
  } 
  
    if (any(class(x) %in% "ObsGR")) {
unknown's avatar
unknown committed
23
24
25
26
27
28
29
30
31
32
33
34
    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)
    }
  }
35
36

  
unknown's avatar
unknown committed
37
38
39
  data.xts <- xts(data[, -1L], order.by = data$DatesR)
  
  graphOut <- dygraph(data.xts, main = main)
40
  graphOut <- dyAxis(dygraph = graphOut, name = "y", label = ylab[1L],
unknown's avatar
unknown committed
41
                     valueRange = range(data.xts[, grep("^Q", colnames(data.xts))], na.rm = TRUE) * c(0.01, 1.59))
42
  graphOut <- dyAxis(dygraph = graphOut, name = "y2", label = ylab[2L], independentTicks = FALSE,
unknown's avatar
unknown committed
43
                     valueRange = rev(range(data.xts[, "Precip"], na.rm = TRUE) * c(0.01, 2.99)))
44
  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
45
46
  graphOut <- dySeries(dygraph = graphOut, "Precip", axis = 'y2', stepPlot = TRUE, fillGraph = TRUE, color = col.Precip)
  # if (ModelPeriod) {
47
  #   graphOut <- dyShading(dygraph = graphOut, from = x$PeriodModel$WarmUp[1L], to = x$PeriodModel$WarmUp[2L], color = "orangered")
unknown's avatar
unknown committed
48
49
50
51
52
  #   graphOut <- dyShading(dygraph = graphOut, from = x$PeriodModel$Run[1L]   , to = x$PeriodModel$Run[2L]   , color = "blue")
  # }
  if (RangeSelector) {
    graphOut <- dyRangeSelector(dygraph = graphOut, height = 15)
  }
53
54
55
56
57
58
59
60
61
62
63
64
  if (plot.na) {
    naQ_rle <- rle(is.na(data$Qobs))
    naQ_ide <- cumsum(naQ_rle$lengths)[naQ_rle$values] +1
    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,
                            from = as.character(data$DatesR)[IDna[i, "start"]],
                            to   = as.character(data$DatesR)[IDna[i, "end"  ]],
                            color = col.na)
    }
  }
65
66
67
68
69
70
71
72
  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])
73
74
  }

unknown's avatar
unknown committed
75
76
77
78
  graphOut <- dyOptions(dygraph = graphOut, useDataTimezone = TRUE)
  return(graphOut)
  
}