Commit 68ce1825 authored by Dorchies David's avatar Dorchies David
Browse files

feat(Lag): allow NAs in Qupstream

Refs #100
Showing with 41 additions and 30 deletions
+41 -30
...@@ -210,7 +210,7 @@ CreateInputsModel <- function(FUN_MOD, ...@@ -210,7 +210,7 @@ CreateInputsModel <- function(FUN_MOD,
stop("'Qupstream' must have same number of rows as 'DatesR' length") stop("'Qupstream' must have same number of rows as 'DatesR' length")
} }
if(any(is.na(Qupstream))) { if(any(is.na(Qupstream))) {
stop("'Qupstream' cannot contain any NA value") warning("'Qupstream' contains NA values: model outputs will contain NAs")
} }
if(any(LengthHydro > 1000)) { if(any(LengthHydro > 1000)) {
warning("The unit of 'LengthHydro' has changed from m to km in v1.7 of airGR: values superior to 1000 km seem unrealistic") warning("The unit of 'LengthHydro' has changed from m to km in v1.7 of airGR: values superior to 1000 km seem unrealistic")
......
...@@ -83,10 +83,16 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param) { ...@@ -83,10 +83,16 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param) {
Qupstream[2:(1 + LengthTs)] * HUTRANS[1, upstream_basin] + Qupstream[2:(1 + LengthTs)] * HUTRANS[1, upstream_basin] +
Qupstream[1:LengthTs] * HUTRANS[2, upstream_basin] Qupstream[1:LengthTs] * HUTRANS[2, upstream_basin]
} }
# Warning for negative flows # Warning for negative flows or NAs only in extended outputs
if (any(OutputsModel$Qsim < 0)) { if(length(RunOptions$Outputs_Sim <3)) {
warning(length(which(OutputsModel$Qsim < 0)), " time steps with negative flow, set to zero.") if (any(OutputsModel$Qsim[!is.na(OutputsModel$Qsim)] < 0)) {
OutputsModel$Qsim[OutputsModel$Qsim < 0] <- 0 warning(length(which(OutputsModel$Qsim < 0)), " time steps with negative flow, set to zero.")
OutputsModel$Qsim[OutputsModel$Qsim < 0] <- 0
}
# Warning for NAs
if (any(is.na(OutputsModel$Qsim))) {
warning(length(which(is.na(OutputsModel$Qsim))), " time steps with NA values")
}
} }
# Convert back Qsim to mm # Convert back Qsim to mm
OutputsModel$Qsim <- OutputsModel$Qsim / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3 OutputsModel$Qsim <- OutputsModel$Qsim / sum(InputsModel$BasinAreas, na.rm = TRUE) / 1e3
......
...@@ -19,21 +19,6 @@ test_that("'BasinAreas' must have one more element than 'LengthHydro'", { ...@@ -19,21 +19,6 @@ test_that("'BasinAreas' must have one more element than 'LengthHydro'", {
BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea) BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea)
test_that("'Qupstream' cannot contain any NA value", {
expect_error(
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E,
Qupstream = matrix(BasinObs$Qmm, ncol = 1),
LengthHydro = 1,
BasinAreas = BasinAreas
),
regexp = "'Qupstream' cannot contain any NA value"
)
})
# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs # Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs
Qupstream <- floor((sin((seq_along(BasinObs$Qmm)/365*2*3.14))+1) * mean(BasinObs$Qmm, na.rm = TRUE)) Qupstream <- floor((sin((seq_along(BasinObs$Qmm)/365*2*3.14))+1) * mean(BasinObs$Qmm, na.rm = TRUE))
...@@ -85,7 +70,7 @@ test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOpt ...@@ -85,7 +70,7 @@ test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOpt
) )
}) })
test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", { test_that("'InputsModel$OutputsModel$Qsim' should contain no NA'", {
InputsModel$OutputsModel <- OutputsGR4JOnly InputsModel$OutputsModel <- OutputsGR4JOnly
InputsModel$OutputsModel$Qsim[10L] <- NA InputsModel$OutputsModel$Qsim[10L] <- NA
expect_error( expect_error(
...@@ -94,6 +79,31 @@ test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", { ...@@ -94,6 +79,31 @@ test_that("'InputsModel$OutputsModel$Qim' should contain no NA'", {
) )
}) })
test_that("'Qupstream' contain NA values", {
expect_warning(
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E,
Qupstream = matrix(BasinObs$Qmm, ncol = 1),
LengthHydro = 1,
BasinAreas = BasinAreas
),
regexp = "'Qupstream' contains NA values: model outputs will contain NAs"
)
RunOptions <- suppressWarnings(CreateRunOptions(FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
IndPeriod_Run = Ind_Run))
InputsModel$OutputsModel <- OutputsGR4JOnly
expect_warning(
RunModel_Lag(InputsModel = InputsModel, RunOptions = RunOptions, Param = 1),
regexp = "time steps with NA values"
)
})
test_that("Upstream basin with nil area should return same Qdown as GR4J alone", { test_that("Upstream basin with nil area should return same Qdown as GR4J alone", {
UpstBasinArea <- InputsModel$BasinAreas[1L] UpstBasinArea <- InputsModel$BasinAreas[1L]
InputsModel$BasinAreas[1L] <- 0 InputsModel$BasinAreas[1L] <- 0
......
...@@ -12,7 +12,6 @@ vignette: > ...@@ -12,7 +12,6 @@ vignette: >
```{r, include=FALSE, fig.keep='none', results='hide'} ```{r, include=FALSE, fig.keep='none', results='hide'}
library(airGR) library(airGR)
options(digits = 3) options(digits = 3)
library(imputeTS)
``` ```
# Introduction # Introduction
...@@ -56,7 +55,9 @@ For the observed flow at the downstream outlet, we generate it with the assumpti ...@@ -56,7 +55,9 @@ For the observed flow at the downstream outlet, we generate it with the assumpti
```{r} ```{r}
QObsDown <- (BasinObs$Qmm + c(0, 0, BasinObs$Qmm[1:(length(BasinObs$Qmm)-2)])) / 2 QObsDown <- (BasinObs$Qmm + c(0, 0, BasinObs$Qmm[1:(length(BasinObs$Qmm)-2)])) / 2
summary(cbind(QObsUp = BasinObs$Qmm, QObsDown), digits = 3) options(digits = 5)
summary(cbind(QObsUp = BasinObs$Qmm, QObsDown))
options(digits = 3)
``` ```
# Calibration of the upstream subcatchment # Calibration of the upstream subcatchment
...@@ -91,19 +92,13 @@ OutputsModelUp <- RunModel_GR4J(InputsModel = InputsModelUp, RunOptions = RunOpt ...@@ -91,19 +92,13 @@ OutputsModelUp <- RunModel_GR4J(InputsModel = InputsModelUp, RunOptions = RunOpt
# Calibration of the downstream subcatchment with upstream flow observations # Calibration of the downstream subcatchment with upstream flow observations
Observed flow data contain `NA` values and a complete time series is mandatory for running the Lag model. We propose to complete the observed upstream flow with linear interpolation:
```{r}
QObsUp <- imputeTS::na_interpolation(BasinObs$Qmm)
```
we need to create the `InputsModel` object completed with upstream information: we need to create the `InputsModel` object completed with upstream information:
```{r} ```{r}
InputsModelDown1 <- CreateInputsModel( InputsModelDown1 <- CreateInputsModel(
FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR, FUN_MOD = RunModel_GR4J, DatesR = BasinObs$DatesR,
Precip = BasinObs$P, PotEvap = BasinObs$E, Precip = BasinObs$P, PotEvap = BasinObs$E,
Qupstream = matrix(QObsUp, ncol = 1), # upstream observed flow Qupstream = matrix(BasinObs$Qmm, ncol = 1), # upstream observed flow
LengthHydro = 100, # distance between upstream catchment outlet & the downstream one [km] LengthHydro = 100, # distance between upstream catchment outlet & the downstream one [km]
BasinAreas = c(180, 180) # upstream and downstream areas [km²] BasinAreas = c(180, 180) # upstream and downstream areas [km²]
) )
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment