diff --git a/DESCRIPTION b/DESCRIPTION index e8b597bde1f51637cddc6700e7b2fec18650e0de..2b8e37107376634ca25746f4deaea8da5ac90090 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,7 +1,7 @@ Package: airGR Type: Package Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling -Version: 1.2.15.0 +Version: 1.2.15.1 Date: 2019-05-02 Authors@R: c( person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), diff --git a/NEWS.rmd b/NEWS.rmd index 10c94f899a08b41aa085defcf7ac99c088bf9f8c..07b5425865f484e10f8284e5a6d9bd3606007c29 100644 --- a/NEWS.rmd +++ b/NEWS.rmd @@ -14,7 +14,7 @@ output: -### 1.2.15.0 Release Notes (2019-05-02) +### 1.2.15.1 Release Notes (2019-05-02) #### New features @@ -24,7 +24,7 @@ output: #### Major user-visible changes -- <code>plot.OutputsModel()</code> can no drawn PET time serie if <code>which = "all"</code> or <code>"PotEvap"</code>. +- <code>plot.OutputsModel()</code> can no drawn PET or error time serie if <code>which = "all"</code> or <code>"PotEvap"</code> or <code>"Error"</code>. #### Minor user-visible changes diff --git a/R/plot.OutputsModel.R b/R/plot.OutputsModel.R index 05258173ed7b5d4da9e459673b8c8fd8417999b7..479edb7eeb82db5ca4ff281bfcf1259cd2834894 100644 --- a/R/plot.OutputsModel.R +++ b/R/plot.OutputsModel.R @@ -36,14 +36,19 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = } else if (inherits(OutputsModel, "GR") & !is.null(Qobs)) { warning("incorrect length of 'Qobs'. Time series of observed flow not drawn") } - BOOL_Snow <- FALSE + BOOL_Error <- FALSE + if (BOOL_Qsim & BOOL_Qobs) { + BOOL_Error <- TRUE + } + BOOL_Snow <- FALSE if ("CemaNeigeLayers" %in% names(OutputsModel)) { if ("SnowPack" %in% names(OutputsModel$CemaNeigeLayers[[1]])) { BOOL_Snow <- TRUE } } + BOOL_Psol <- FALSE if ("CemaNeigeLayers" %in% names(OutputsModel)) { if ("Psol" %in% names(OutputsModel$CemaNeigeLayers[[1]])) { @@ -61,18 +66,28 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = if (!is.character(which)) { stop("'which' must be a vector of character") } - if (any(!which %in% c("all", "PotEvap", "Precip", 'Temp', "SnowPack", "Flows", "Regime", "CumFreq", "CorQQ"))) { - stop("incorrect element found in argument 'which':\nit can only contain 'all', 'Precip', 'PotEvap', 'Temp', 'SnowPack', 'Flows', 'Regime', 'CumFreq' or 'CorQQ'") + if (any(!which %in% c("all", "PotEvap", "Precip", 'Temp', "SnowPack", "Flows", "Error", "Regime", "CumFreq", "CorQQ"))) { + stop("incorrect element found in argument 'which':\nit can only contain 'all', 'Precip', 'PotEvap', 'Temp', 'SnowPack', 'Error', 'Flows', 'Regime', 'CumFreq' or 'CorQQ'") } if (all(which %in% c("Temp", "SnowPack")) & !inherits(OutputsModel, "CemaNeige")) { - stop("Incorrect element found in argument 'which':\nwithout CemaNeige it can only contain 'all', 'Precip', 'PotEvap', 'Flows', 'Regime', 'CumFreq' or 'CorQQ'") + stop("Incorrect element found in argument 'which':\nwithout CemaNeige it can only contain 'all', 'Precip', 'PotEvap', 'Flows', 'Error', 'Regime', 'CumFreq' or 'CorQQ'") } if (length(unique(which %in% c("Temp", "SnowPack"))) == 2 & !inherits(OutputsModel, "CemaNeige")) { - warning("Incorrect element found in argument 'which':\nit can only contain 'all', 'Precip', 'PotEvap', 'Flows', 'Regime', 'CumFreq' or 'CorQQ'\nwithout CemaNeige 'Temp' and 'SnowPack' are not available") + warning("Incorrect element found in argument 'which':\nit can only contain 'all', 'Precip', 'PotEvap', 'Flows', 'Error', 'Regime', 'CumFreq' or 'CorQQ'\nwithout CemaNeige 'Temp' and 'SnowPack' are not available") } if ("all" %in% which) { - which <- c("Precip", "PotEvap", "Temp", "SnowPack", "Flows", "Regime", "CumFreq", "CorQQ") + which <- c("Precip", "PotEvap", "Temp", "SnowPack", "Flows", "Error", "Regime", "CumFreq", "CorQQ") + } + + if (is.null(Qobs)) { + if (length(which) == 1 & any(which %in% "Error")) { + stop("the 'Error' time srie cannot be draw if there is no 'Qobs'") + } + if (length(which) != 1 & any(which %in% c("Error", "all"))) { + BOOL_Error <- FALSE + warning("the 'Error' time serie cannot be draw if there is no 'Qobs'") + } } @@ -170,6 +185,7 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = BOOLPLOT_Temp <- ( "Temp" %in% which & BOOL_Snow ) BOOLPLOT_SnowPack <- ( "SnowPack" %in% which & BOOL_Snow ) BOOLPLOT_Flows <- ( "Flows" %in% which & (BOOL_Qsim | BOOL_Qobs) ) + BOOLPLOT_Error <- ( "Error" %in% which & BOOL_Error ) 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 ) @@ -197,7 +213,7 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = } if (BOOLPLOT_Temp) { matlayout <- rbind(matlayout, c(iPlot+1, iPlot+1, iPlot+1), c(iPlot+1, iPlot+1, iPlot+1)) - iPlot <- 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)) @@ -207,6 +223,10 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = matlayout <- rbind(matlayout, c(iPlot + 1, iPlot + 1, iPlot + 1), c(iPlot + 1, iPlot + 1, iPlot + 1)) iPlot <- iPlot + 1 } + if (BOOLPLOT_Error) { + 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 @@ -321,6 +341,32 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = } + ## PotEvap + if (BOOLPLOT_PotEvap) { + kPlot <- kPlot + 1 + mar <- c(3, 5, 1, 5) + + par(new = FALSE, mar = mar, las = 0) + ylim1 <- range(OutputsModel$PotEvap[IndPeriod_Plot], na.rm = TRUE) + ylim2 <- ylim1 #* c(1.0, 1.1) + + plot(Xaxis, OutputsModel$PotEvap[IndPeriod_Plot], + type = "l", xaxt = "n", yaxt = "n", ylim = ylim2, + col = "green3", lwd = lwd * lwdk, + xlab = "", ylab = "", ...) + axis(side = 2, at = pretty(ylim1), labels = pretty(ylim1), cex.axis = cex.axis, ...) + par(las = 0) + mtext(side = 2, paste("pot. evap.", plotunit), cex = cex.lab, line = line) + par(las = 0) + 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, ...) + } else { + axis(side = 1, at = pretty(Xaxis), labels = pretty(Xaxis), cex.axis = cex.axis, ...) + } + } + + ## Temp if (BOOLPLOT_Temp) { kPlot <- kPlot + 1 @@ -357,33 +403,7 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = axis(side = 1, at = pretty(Xaxis), labels = pretty(Xaxis), cex.axis = cex.axis, ...) } } - - - ## PotEvap - if (BOOLPLOT_PotEvap) { - kPlot <- kPlot + 1 - mar <- c(3, 5, 1, 5) - - par(new = FALSE, mar = mar, las = 0) - ylim1 <- range(OutputsModel$PotEvap[IndPeriod_Plot], na.rm = TRUE) - ylim2 <- ylim1 #* c(1.0, 1.1) - - plot(Xaxis, OutputsModel$PotEvap[IndPeriod_Plot], - type = "l", xaxt = "n", yaxt = "n", ylim = ylim2, - col = "green3", lwd = lwd * lwdk, - xlab = "", ylab = "", ...) - axis(side = 2, at = pretty(ylim1), labels = pretty(ylim1), cex.axis = cex.axis, ...) - par(las = 0) - mtext(side = 2, paste("pot. evap.", plotunit), cex = cex.lab, line = line) - par(las = 0) - 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, ...) - } else { - axis(side = 1, at = pretty(Xaxis), labels = pretty(Xaxis), cex.axis = cex.axis, ...) - } - } - + ## SnowPack if (BOOLPLOT_SnowPack) { @@ -518,6 +538,33 @@ plot.OutputsModel <- function(x, Qobs = NULL, IndPeriod_Plot = NULL, BasinArea = } + ## Error + if (BOOLPLOT_Error) { + kPlot <- kPlot + 1 + mar <- c(3, 5, 1, 5) + + errorQ <- OutputsModel$Qsim / Qobs + par(new = FALSE, mar = mar, las = 0) + ylim1 <- range(errorQ[IndPeriod_Plot], na.rm = TRUE) + + plot(Xaxis, errorQ[IndPeriod_Plot], + type = "l", xaxt = "n", yaxt = "n", ylim = ylim1, + col = "grey50", lwd = lwd * lwdk, + xlab = "", ylab = "", log = ifelse(log_scale, "y", ""), + panel.first = abline(h = 1, col = "grey", lty = 2), ...) + axis(side = 2, at = pretty(ylim1), labels = pretty(ylim1), cex.axis = cex.axis, ...) + par(las = 0) + mtext(side = 2, paste("flow err.", plotunit), cex = cex.lab, line = line) + par(las = 0) + 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, ...) + } else { + axis(side = 1, at = pretty(Xaxis), labels = pretty(Xaxis), cex.axis = cex.axis, ...) + } + } + + ## Regime if (BOOLPLOT_Regime) { kPlot <- kPlot + 1