Skip to content
GitLab
Select Git revision
Find file BlameHistoryPermalink
  • Guillaume Blanchy's avatar
    Updates for working webinterface with new process_commands() · d0fde750
    Guillaume Blanchy authored 
    - fix passing sequence with new process_commands
- update process_commands as json.loads() parse recursively
- update index.html pseudo-section (+ hover info)
- comment double info log in run_sequence_async
- fix update_settings by adding '_settings' to common cmd_id with set_sequence (from http_interface)
    d0fde750
plot.OutputsModel.R 30.36 KiB
1 
plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = NULL, which = "all", log_scale = FALSE,
2 
                              cex.axis = 1, cex.lab = 0.9, cex.leg = 0.9, lwd = 1, verbose = TRUE, ...) {
3
4 
  OutputsModel <- x
5
6 
  if (!inherits(OutputsModel, "GR") & !inherits(OutputsModel, "CemaNeige")) {
7 
    stop(paste("OutputsModel not in the correct format for default plotting \n", sep = ""))
8 
    return(NULL)
9 
  }
10
11
12 
  BOOL_Dates <- FALSE;
13 
      if ("DatesR" %in% names(OutputsModel)) { BOOL_Dates <- TRUE; }
14 
  BOOL_Pobs <- FALSE;
15 
      if ("Precip" %in% names(OutputsModel)) { BOOL_Pobs <- TRUE; }
16 
  BOOL_Qsim <- FALSE;
17 
      if ("Qsim"   %in% names(OutputsModel)) { BOOL_Qsim <- TRUE; }
18 
  BOOL_Qobs <- FALSE;
19 
      if (BOOL_Qsim & length(Qobs) == length(OutputsModel$Qsim)) {
20 
        if (sum(is.na(Qobs)) != length(Qobs)) {
21 
          BOOL_Qobs <- TRUE
22 
        }
23 
      } else if (inherits(OutputsModel, "GR")) {
24 
        warning("Incorrect length of Qobs. Time series of observed flow not drawn.")
25 
      }
26 
  BOOL_Snow <- FALSE;
27 
      if ("CemaNeigeLayers" %in% names(OutputsModel)) { if ("SnowPack" %in% names(OutputsModel$CemaNeigeLayers[[1]])) { BOOL_Snow <- TRUE; } }
28 
  BOOL_Psol <- FALSE;
29 
      if ("CemaNeigeLayers" %in% names(OutputsModel)) { if ("Psol"     %in% names(OutputsModel$CemaNeigeLayers[[1]])) { BOOL_Psol <- TRUE; } }
30
31
32 
  if ( is.null(     which)) { stop("which must be a vector of character \n"); return(NULL); }
33 
  if (!is.vector(   which)) { stop("which must be a vector of character \n"); return(NULL); }
34 
  if (!is.character(which)) { stop("which must be a vector of character \n"); return(NULL); }
35 
  if (any(!which %in% c("all", "Precip", 'Temp', "SnowPack", "Flows", "Regime", "CumFreq", "CorQQ"))) {
36 
    stop("Incorrect element found in argument which:\nit can only contain 'all', 'Precip', 'Temp', 'SnowPack', 'Flows', 'Regime', 'CumFreq' or 'CorQQ'")
37 
    return(NULL)
38 
  }
39 
  if (all(which %in% c("Temp", "SnowPack")) & !inherits(OutputsModel, "CemaNeige")) {
40 
    stop("Incorrect element found in argument which:\nwithout CemaNeige it can only contain 'all', 'Precip', 'Flows', 'Regime', 'CumFreq' or 'CorQQ'")
41 
    return(NULL)
42 
  }
43 
  if (length(unique(which %in% c("Temp", "SnowPack"))) == 2 & !inherits(OutputsModel, "CemaNeige")) {
44 
    warning("Incorrect element found in argument which:\nit can only contain 'all', 'Precip', 'Flows', 'Regime', 'CumFreq' or 'CorQQ'\nwithout CemaNeige 'Temp' and 'SnowPack' are not available")
45 
  }
46
47 
  if ("all" %in% which) {
48 
    which <- c("Precip", "Temp", "SnowPack", "Flows", "Regime", "CumFreq", "CorQQ")
49 
  }
50
51
52 
  if (!BOOL_Dates) {
53 
    stop(paste("OutputsModel must contain at least DatesR to allow plotting \n", sep = "")); return(NULL); }
54 
  if (inherits(OutputsModel, "GR") & !BOOL_Qsim) {
55 
    stop(paste("OutputsModel must contain at least Qsim to allow plotting \n", sep = "")); return(NULL); }
56
57 
  if (BOOL_Dates) {
58 
    MyRollMean1 <- function(x, n) {
59 
      return(filter(x, rep(1/n, n), sides = 2)); }
60 
    MyRollMean2 <- function(x, n) {
61 
      return(filter(c(tail(x, n%/%2), x, x[1:(n%/%2)]), rep(1/n, n), sides = 2)[(n%/%2+1):(length(x)+n%/%2)]); }
62 
    MyRollMean3 <- function(x, n) {
63 
      return(filter(x, filter = rep(1/n, n), sides = 2, circular = TRUE))
64 
    }
65 
    BOOL_TS  <- FALSE;
66 
    TimeStep <- difftime(tail(OutputsModel$DatesR, 1), tail(OutputsModel$DatesR, 2), units = "secs")[[1]];
67 
    if (inherits(OutputsModel, "hourly" ) & TimeStep %in% (                  60*60)) { BOOL_TS <- TRUE; NameTS <- "hour" ; plotunit <- "[mm/h]";     formatAxis <- "%m/%Y"; }
68 
    if (inherits(OutputsModel, "daily"  ) & TimeStep %in% (               24*60*60)) { BOOL_TS <- TRUE; NameTS <- "day"  ; plotunit <- "[mm/d]";     formatAxis <- "%m/%Y"; }
69 
    if (inherits(OutputsModel, "monthly") & TimeStep %in% (c(28, 29, 30, 31)*24*60*60)) { BOOL_TS <- TRUE; NameTS <- "month"; plotunit <- "[mm/month]"; formatAxis <- "%m/%Y"; }
70 
    if (inherits(OutputsModel, "yearly" ) & TimeStep %in% (    c(365, 366)*24*60*60)) { BOOL_TS <- TRUE; NameTS <- "year" ; plotunit <- "[mm/y]";     formatAxis <- "%Y"   ; }
7172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140
if (!BOOL_TS) { stop(paste("the time step of the model inputs could not be found \n", sep = "")); return(NULL); } } if (length(IndPeriod_Plot) == 0) { IndPeriod_Plot <- 1:length(OutputsModel$DatesR); } if (inherits(OutputsModel, "CemaNeige")) { NLayers <- length(OutputsModel$CemaNeigeLayers); } PsolLayerMean <- NULL; if (BOOL_Psol) { for(iLayer in 1:NLayers) { if (iLayer == 1) { PsolLayerMean <- OutputsModel$CemaNeigeLayers[[iLayer]]$Psol/NLayers; } else { PsolLayerMean <- PsolLayerMean + OutputsModel$CemaNeigeLayers[[iLayer]]$Psol/NLayers; } } } BOOL_QobsZero <- FALSE; if (BOOL_Qobs) { SelectQobsNotZero <- (round(Qobs[IndPeriod_Plot] , 4) != 0); BOOL_QobsZero <- sum(!SelectQobsNotZero, na.rm = TRUE)>0; } BOOL_QsimZero <- FALSE; if (BOOL_Qsim) { SelectQsimNotZero <- (round(OutputsModel$Qsim[IndPeriod_Plot], 4) != 0); BOOL_QsimZero <- sum(!SelectQsimNotZero, na.rm = TRUE)>0; } if (BOOL_QobsZero & verbose) { warning("\t zeroes detected in Qobs -> some plots in the log space will not be created using all time-steps \n"); } if (BOOL_QsimZero & verbose) { warning("\t zeroes detected in Qsim -> some plots in the log space will not be created using all time-steps \n"); } BOOL_FilterZero <- TRUE; ##Plots_choices BOOLPLOT_Precip <- ( "Precip" %in% which & BOOL_Pobs ) BOOLPLOT_Temp <- ( "Temp" %in% which & BOOL_Snow ) BOOLPLOT_SnowPack <- ( "SnowPack" %in% which & BOOL_Snow ) BOOLPLOT_Flows <- ( "Flows" %in% which & (BOOL_Qsim | BOOL_Qobs) ) BOOLPLOT_Regime <- ( "Regime" %in% which & BOOL_TS & BOOL_Qsim & (NameTS %in% c("hour", "day", "month")) ) BOOLPLOT_CumFreq <- ( "CumFreq" %in% which & (BOOL_Qsim | BOOL_Qobs) & BOOL_FilterZero ) BOOLPLOT_CorQQ <- ( "CorQQ" %in% which & (BOOL_Qsim & BOOL_Qobs) & BOOL_FilterZero ) ##Options BLOC <- TRUE if (BLOC) { lwdk <- 1.8 line <- 2.6 bg <- NA matlayout <- NULL; iPlot <- 0; Sum1 <- sum(c(BOOLPLOT_Precip, BOOLPLOT_SnowPack, BOOLPLOT_Flows)) Sum2 <- sum(c(BOOLPLOT_Regime, BOOLPLOT_CumFreq, BOOLPLOT_CorQQ)) if (BOOLPLOT_Precip) { matlayout <- rbind(matlayout, c(iPlot+1, iPlot+1, iPlot+1)); iPlot <- iPlot+1; } if (BOOLPLOT_Temp) { matlayout <- rbind(matlayout, c(iPlot+1, iPlot+1, iPlot+1), c(iPlot+1, iPlot+1, iPlot+1)); iPlot <- iPlot+1; } if (BOOLPLOT_SnowPack) { matlayout <- rbind(matlayout, c(iPlot+1, iPlot+1, iPlot+1), c(iPlot+1, iPlot+1, iPlot+1)); iPlot <- iPlot+1; } if (BOOLPLOT_Flows) { matlayout <- rbind(matlayout, c(iPlot+1, iPlot+1, iPlot+1), c(iPlot+1, iPlot+1, iPlot+1)); iPlot <- iPlot+1; } if ((Sum1 >= 1 & Sum2 != 0) | (Sum1 == 0 & Sum2 == 3)) { matlayout <- rbind(matlayout, c(iPlot+1, iPlot+2, iPlot+3), c(iPlot+1, iPlot+2, iPlot+3)); iPlot <- iPlot+3; } if (Sum1 == 0 & Sum2 == 2) { matlayout <- rbind(matlayout, c(iPlot+1, iPlot+2)); iPlot <- iPlot+2; } if (Sum1 == 0 & Sum2 == 1) { matlayout <- rbind(matlayout, iPlot+1); iPlot <- iPlot+1; } iPlotMax <- iPlot; # isRStudio <- Sys.getenv("RSTUDIO") == "1"; # if (!isRStudio) { # if (Sum1 == 1 & Sum2 == 0) { width = 10; height = 05; } # if (Sum1 == 1 & Sum2 != 0) { width = 10; height = 07; } # if (Sum1 == 2 & Sum2 == 0) { width = 10; height = 05; } # if (Sum1 == 2 & Sum2 != 0) { width = 10; height = 07; } # if (Sum1 == 3 & Sum2 == 0) { width = 10; height = 07; } # if (Sum1 == 3 & Sum2 != 0) { width = 10; height = 10; } # if (Sum1 == 0 & Sum2 == 1) { width = 05; height = 05; } # if (Sum1 == 0 & Sum2 == 2) { width = 10; height = 04; } # if (Sum1 == 0 & Sum2 == 3) { width = 10; height = 03; } # dev.new(width = width, height = height) # } layout(matlayout); Xaxis <- 1:length(IndPeriod_Plot); if (BOOL_Dates) { if (NameTS %in% c("hour", "day", "month")) { Seq1 <- which(OutputsModel$DatesR[IndPeriod_Plot]$mday == 1 & OutputsModel$DatesR[IndPeriod_Plot]$mon %in% c(0, 3, 6, 9)) Seq2 <- which(OutputsModel$DatesR[IndPeriod_Plot]$mday == 1 & OutputsModel$DatesR[IndPeriod_Plot]$mon == 0)
141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210
Labels2 <- format(OutputsModel$DatesR[IndPeriod_Plot], format = formatAxis)[Seq2] } if (NameTS %in% c("year")) { Seq1 <- 1:length(OutputsModel$DatesR[IndPeriod_Plot]) Seq2 <- 1:length(OutputsModel$DatesR[IndPeriod_Plot]) Labels2 <- format(OutputsModel$DatesR[IndPeriod_Plot], format = formatAxis)[Seq2] } } if (!is.null(BasinArea)) { Factor_MMH_M3S <- 60 * 60 Factor_MMD_M3S <- 60 * 60 * 24 Factor_MMM_M3S <- 60 * 60 * 24 * 365.25 / 12 Factor_MMY_M3S <- 60 * 60 * 24 * 365.25 if (NameTS == "hour" ) Factor_UNIT_M3S <- Factor_MMH_M3S if (NameTS == "day" ) Factor_UNIT_M3S <- Factor_MMD_M3S if (NameTS == "month") Factor_UNIT_M3S <- Factor_MMM_M3S if (NameTS == "year" ) Factor_UNIT_M3S <- Factor_MMY_M3S Factor_UNIT_M3S <- BasinArea / (Factor_UNIT_M3S / 1000) } } kPlot <- 0 ## vector of Q values for the y-axis when it is expressed in Factor <- ifelse(!is.null(BasinArea), Factor_UNIT_M3S, 1) seqDATA0 <- c(0.01, 0.02, 0.05, 0.1, 0.2, 0.5, 1, 2, 5, 10, 20, 50, 100, 200, 500, 1000, 2000, 5000, 10000) seqDATA1 <- log(seqDATA0) seqDATA2 <- exp(seqDATA1) if (!is.null(BasinArea)) { seqDATA1ba <- log(seqDATA0 * Factor_UNIT_M3S) seqDATA2ba <- round(exp(seqDATA1ba), digits = 2) } ##Precip if (BOOLPLOT_Precip) { kPlot <- kPlot + 1 mar <- c(3, 5, 1, 5) par(new = FALSE, mar = mar, las = 0) ylim1 <- range(OutputsModel$Precip[IndPeriod_Plot], na.rm = TRUE) ylim2 <- ylim1 * c(1.0, 1.1) ylim2 <- rev(ylim2) lwdP <- lwd * 0.7 if (NameTS %in% c("month", "year")) { lwdP <- lwd * 2 } plot(Xaxis, OutputsModel$Precip[IndPeriod_Plot], type = "h", xaxt = "n", yaxt = "n", yaxs = "i", ylim = ylim2, col = "royalblue", lwd = lwdP * lwdk, lend = 1, xlab = "", ylab = "", ...) axis(side = 2, at = pretty(ylim1), labels = pretty(ylim1), cex.axis = cex.axis, ...) par(las = 0) mtext(side = 2, paste0("precip. ", plotunit), cex = cex.lab, adj = 1, line = line) par(las = 0) if (BOOL_Psol) { legend("bottomright", legend = c("solid","liquid"), col = c("lightblue", "royalblue"), lty = c(1, 1), lwd = c(lwd, lwd), bty = "o", bg = bg, box.col = bg, cex = cex.leg) par(new = TRUE) plot(Xaxis, PsolLayerMean[IndPeriod_Plot], type = "h", xaxt = "n", yaxt = "n", yaxs = "i", ylim = ylim2, col = "lightblue", lwd = lwdP * lwdk, lend = 1, xlab = "", ylab = "", ...) } if (BOOL_Dates) { axis(side = 1, at = Seq1, labels = FALSE, cex.axis = cex.axis, ...) axis(side = 1, at = Seq2, labels = Labels2, lwd.ticks = 1.5, cex.axis = cex.axis, ...)