From a03b252096009293615836798f35933c339c7ffa Mon Sep 17 00:00:00 2001
From: Delaigue Olivier <olivier.delaigue@irstea.priv>
Date: Thu, 2 May 2019 16:46:00 +0200
Subject: [PATCH] v1.2.15.1 NEW: plot.OutputsModel can no drawn error ts
---
DESCRIPTION | 2 +-
NEWS.rmd | 4 +-
R/plot.OutputsModel.R | 115 +++++++++++++++++++++++++++++-------------
3 files changed, 84 insertions(+), 37 deletions(-)
diff --git a/DESCRIPTION b/DESCRIPTION
index e8b597bd..2b8e3710 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 10c94f89..07b54258 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 05258173..479edb7e 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
--
GitLab