Commit 839d28ac authored by Dorchies David's avatar Dorchies David
Browse files

fix(CreateInputsCrit): wrong Qobs in Lavenne criteria (temporary fix)

- This temporary fix cannot manage extra arguments in CreateInputsCrit (i.e. "...")
- Looking forward better solution. See: https://stackoverflow.com/questions/69016698/is-there-a-bug-on-closures-embedded-in-a-list-in-r

Refs #57
parent 56f2680c
......@@ -85,12 +85,19 @@ getInputsCrit_Lavenne <- function(id, OutputsModel, InputsCrit) {
stop("'InputsCrit[[id]]' must be of class InputsCritLavenneFunction")
}
AprioriId <- attr(InputsCrit[[id]], "AprioriId")
Lavenne_FUN <- attr(InputsCrit[[id]], "Lavenne_FUN")
Lavenne_DATA <- attr(InputsCrit[[id]], "Lavenne_DATA")
AprParamR <- OutputsModel[[AprioriId]]$Param
if(!inherits(OutputsModel[[AprioriId]], "SD")) {
# Add neutral velocity parameter for upstream catchment
AprParamR <- c(NA, AprParamR)
}
AprCrit <- ErrorCrit(InputsCrit[[AprioriId]], OutputsModel[[AprioriId]])$CritValue
return(Lavenne_FUN(AprParamR, AprCrit))
CreateInputsCrit_Lavenne(FUN_CRIT = Lavenne_DATA$FUN_CRIT,
InputsModel = Lavenne_DATA$InputsModel,
RunOptions = Lavenne_DATA$RunOptions,
Obs = Lavenne_DATA$Obs,
AprParamR = AprParamR,
AprCrit = AprCrit,
k = Lavenne_DATA$k,
transfo = Lavenne_DATA$transfo)
}
......@@ -6,6 +6,7 @@ CreateInputsCrit.GRiwrmInputsModel <- function(InputsModel,
Obs,
AprioriIds = NULL,
k = 0.15,
transfo = "",
...) {
# Parameter checks
......@@ -65,32 +66,18 @@ CreateInputsCrit.GRiwrmInputsModel <- function(InputsModel,
)
if (!is.null(AprioriIds) && IM$id %in% names(AprioriIds)) {
# De Lavenne regularisation for this sub-catchment
attr(InputsCrit[[IM$id]], "Lavenne_FUN") <-
CreateLavenneFunction(
attr(InputsCrit[[IM$id]], "Lavenne_DATA") <-
list(
InputsModel = IM,
FUN_CRIT = FUN_CRIT,
RunOptions = RunOptions[[IM$id]],
Obs = Obs[, IM$id],
k = k,
...
transfo = transfo
)
attr(InputsCrit[[IM$id]], "AprioriId") <- AprioriIds[IM$id]
class(InputsCrit[[IM$id]]) <- c("InputsCritLavenneFunction", class(InputsCrit[[IM$id]]))
}
}
return(InputsCrit)
}
CreateLavenneFunction <- function(InputsModel, FUN_CRIT, RunOptions, Obs, k, ...) {
function(AprParamR, AprCrit) {
CreateInputsCrit_Lavenne(FUN_CRIT = FUN_CRIT,
InputsModel = InputsModel,
RunOptions = RunOptions,
Obs = Obs,
AprParamR = AprParamR,
AprCrit = AprCrit,
k = k,
...)
}
}
Markdown is supported
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