diff --git a/DESCRIPTION b/DESCRIPTION index cb9bcaa4dadb675a031836f6cbd9024530bf520b..71f677dd1923a687a3329f00cfa1a0e1eab88860 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.12.22 +Version: 1.2.12.23 Date: 2019-04-01 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 c0c48ddcce7befb81dc9dfe8679ad14010b3921e..3acd26e6637d2811cb701f97f94a2322a27b90d4 100644 --- a/NEWS.rmd +++ b/NEWS.rmd @@ -13,7 +13,7 @@ output: -### 1.2.12.22 Release Notes (2019-04-01) +### 1.2.12.23 Release Notes (2019-04-01) @@ -33,7 +33,7 @@ output: - <code>CreateInputsCrit()</code> now can prepare an <code>InputsCrit</code> object in order to compute a single criterion (<code>Single</code> class), multiple criteria (<code>Multi</code> class) with the <code>ErrorCrit()</code> function. So it is now possible to set the following arguments as atomic (as before) or as list: <code>FUN_CRIT</code>, <code>Obs</code>, <code>BoolCrit</code>, <code>transfo</code>, <code>weights</code>. If the list format is chosen, all the lists must have the same length. -- <code>CreateInputsCrit()</code> now presents a <code>varObs</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order run a criterion on other variable than observed discharges with the <code>ErrorCrit()</code> function (e.g. SCA, SWE). +- <code>CreateInputsCrit()</code> now presents a <code>VarObs</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order run a criterion on other variable than observed discharges with the <code>ErrorCrit()</code> function (e.g. SCA, SWE). - <code>CreateInputsCrit()</code> now presents a <code>weights</code> argument in order to allow to prepare an <code>InputsCrit</code> object in order to compute a composite criterion (<code>Compo</code> class) with <code>ErrorCrit()</code> or <code>Calibration_Michel()</code>. diff --git a/R/CreateInputsCrit.R b/R/CreateInputsCrit.R index 6da2b1fdcb5011dfbbfc57be111c873f02632a67..355b868187e114b0271b7040117abb0e6d7d5376 100644 --- a/R/CreateInputsCrit.R +++ b/R/CreateInputsCrit.R @@ -3,7 +3,7 @@ CreateInputsCrit <- function(FUN_CRIT, RunOptions, Qobs, # deprecated Obs, - varObs = "Q", + VarObs = "Q", BoolCrit = NULL, transfo = "", weights = NULL, @@ -21,10 +21,10 @@ CreateInputsCrit <- function(FUN_CRIT, if (!missing(Qobs)) { if (missing(Obs)) { if (warnings) { - warning("argument 'Qobs' is deprecated. Please use 'Obs' and 'varObs' instead") + warning("argument 'Qobs' is deprecated. Please use 'Obs' and 'VarObs' instead") } Obs <- Qobs - # varObs <- "Qobs" + # VarObs <- "Qobs" } else { warning("argument 'Qobs' is deprecated. The values set in 'Obs' will be used instead") } @@ -70,7 +70,7 @@ CreateInputsCrit <- function(FUN_CRIT, ## create list of arguments listArgs <- list(FUN_CRIT = FUN_CRIT, Obs = Obs, - varObs = varObs, + VarObs = VarObs, BoolCrit = BoolCrit, idLayer = idLayer, transfo = transfo, @@ -85,7 +85,7 @@ CreateInputsCrit <- function(FUN_CRIT, listArgs[[iArgs]] <- lapply(seq_along(listArgs$FUN_CRIT), function(x) NULL) } } - if (iArgs %in% c("FUN_CRIT", "varObs", "transfo", "weights") & length(listArgs[[iArgs]]) > 1L) { + if (iArgs %in% c("FUN_CRIT", "VarObs", "transfo", "weights") & length(listArgs[[iArgs]]) > 1L) { listArgs[[iArgs]] <- as.list(listArgs[[iArgs]]) } if (!is.list(listArgs[[iArgs]])) { @@ -97,26 +97,26 @@ CreateInputsCrit <- function(FUN_CRIT, listArgs$FUN_CRIT <- lapply(listArgs$FUN_CRIT, FUN = match.fun) - ## check 'varObs' - if (missing(varObs)) { - listArgs$varObs <- as.list(rep("Q", times = length(listArgs$Obs))) + ## check 'VarObs' + if (missing(VarObs)) { + listArgs$VarObs <- as.list(rep("Q", times = length(listArgs$Obs))) # if (warnings) { - # warning("'varObs' automatically set to \"Q\"") + # warning("'VarObs' automatically set to \"Q\"") # } } - ## check 'varObs' + 'RunOptions' - if ("Q" %in% varObs & !inherits(RunOptions, "GR")) { - stop("'varObs' cannot contain Q if a GR rainfall-runoff model is not used") + ## check 'VarObs' + 'RunOptions' + if ("Q" %in% VarObs & !inherits(RunOptions, "GR")) { + stop("'VarObs' cannot contain Q if a GR rainfall-runoff model is not used") } - if (any(c("SCA", "SWE") %in% varObs) & !inherits(RunOptions, "CemaNeige")) { - stop("'varObs' cannot contain SCA or SWE if CemaNeige is not used") + if (any(c("SCA", "SWE") %in% VarObs) & !inherits(RunOptions, "CemaNeige")) { + stop("'VarObs' cannot contain SCA or SWE if CemaNeige is not used") } - if ("SCA" %in% varObs & inherits(RunOptions, "CemaNeige") & !"Gratio" %in% RunOptions$Outputs_Sim) { + if ("SCA" %in% VarObs & inherits(RunOptions, "CemaNeige") & !"Gratio" %in% RunOptions$Outputs_Sim) { stop("'Gratio' is missing in 'Outputs_Sim' of 'RunOptions', which is necessary to output SCA with CemaNeige") } - if ("SWE" %in% varObs & inherits(RunOptions, "CemaNeige") & !"SnowPack" %in% RunOptions$Outputs_Sim) { + if ("SWE" %in% VarObs & inherits(RunOptions, "CemaNeige") & !"SnowPack" %in% RunOptions$Outputs_Sim) { stop("'SnowPack' is missing in 'Outputs_Sim' of 'RunOptions', which is necessary to output SWE with CemaNeige") } @@ -155,7 +155,7 @@ CreateInputsCrit <- function(FUN_CRIT, ## preparation of warning messages inVarObs <- c("Q", "SCA", "SWE") - msgVarObs <- "'varObs' must be a (list of) character vector(s) and one of %s" + msgVarObs <- "'VarObs' must be a (list of) character vector(s) and one of %s" msgVarObs <- sprintf(msgVarObs, paste(sapply(inVarObs, shQuote), collapse = ", ")) inTransfo <- c("", "sqrt", "log", "inv", "sort") msgTransfo <- "'transfo' must be a (list of) character vector(s) and one of %s" @@ -191,14 +191,14 @@ CreateInputsCrit <- function(FUN_CRIT, stop("'BoolCrit' and 'InputsModel' series must have the same length", call. = FALSE) } - ## check 'varObs' - if (!is.vector(iListArgs2$varObs) | length(iListArgs2$varObs) != 1 | !is.character(iListArgs2$varObs) | !all(iListArgs2$varObs %in% inVarObs)) { + ## check 'VarObs' + if (!is.vector(iListArgs2$VarObs) | length(iListArgs2$VarObs) != 1 | !is.character(iListArgs2$VarObs) | !all(iListArgs2$VarObs %in% inVarObs)) { stop(msgVarObs, call. = FALSE) } - ## check 'varObs' + 'Obs' - if (any(iListArgs2$varObs %in% "SCA")) { - idSCA <- which(iListArgs2$varObs == "SCA") + ## check 'VarObs' + 'Obs' + if (any(iListArgs2$VarObs %in% "SCA")) { + idSCA <- which(iListArgs2$VarObs == "SCA") if (length(idSCA) == 1L) { vecSCA <- iListArgs2$Obs } else { @@ -209,15 +209,15 @@ CreateInputsCrit <- function(FUN_CRIT, } } inPosVarObs <- c("Q", "SWE") - if (any(iListArgs2$varObs %in% inPosVarObs)) { - idQSS <- which(iListArgs2$varObs %in% inPosVarObs) + if (any(iListArgs2$VarObs %in% inPosVarObs)) { + idQSS <- which(iListArgs2$VarObs %in% inPosVarObs) if (length(idQSS) == 1L) { vecQSS <- iListArgs2$Obs } else { vecQSS <- unlist(iListArgs2$Obs[idQSS]) } if (min(vecQSS, na.rm = TRUE) < 0) { - stop(sprintf("'Obs' outside [0,Inf[ for \"%s\"", iListArgs2$varObs), call. = FALSE) + stop(sprintf("'Obs' outside [0,Inf[ for \"%s\"", iListArgs2$VarObs), call. = FALSE) } } @@ -257,7 +257,7 @@ CreateInputsCrit <- function(FUN_CRIT, ## Create InputsCrit iInputsCrit <- list(FUN_CRIT = iListArgs2$FUN_CRIT, Obs = iListArgs2$Obs, - varObs = iListArgs2$varObs, + VarObs = iListArgs2$VarObs, BoolCrit = iListArgs2$BoolCrit, idLayer = iListArgs2$idLayer, transfo = iListArgs2$transfo, @@ -270,22 +270,22 @@ CreateInputsCrit <- function(FUN_CRIT, names(InputsCrit) <- paste0("IC", seq_along(InputsCrit)) - listVarObs <- sapply(InputsCrit, FUN = "[[", "varObs") + listVarObs <- sapply(InputsCrit, FUN = "[[", "VarObs") inCnVarObs <- c("SCA", "SWE") if (!"ZLayers" %in% names(InputsModel)) { if(any(listVarObs %in% inCnVarObs)) { - stop(sprintf("'varObs' can not be equal to %i if CemaNeige is not used", + stop(sprintf("'VarObs' can not be equal to %i if CemaNeige is not used", paste(sapply(inCnVarObs, shQuote), collapse = " or "))) } } else { listGroupLayer0 <- sapply(InputsCrit, FUN = "[[", "idLayer") listGroupLayer <- rep(listVarObs, times = listGroupLayer0) tabGroupLayer <- as.data.frame(table(listGroupLayer)) - colnames(tabGroupLayer) <- c("varObs", "freq") + colnames(tabGroupLayer) <- c("VarObs", "freq") nLayers <- length(InputsModel$ZLayers) for (iInCnVarObs in inCnVarObs) { if (any(listVarObs %in% iInCnVarObs)) { - if (tabGroupLayer[tabGroupLayer$varObs %in% iInCnVarObs, "freq"] != nLayers) { + if (tabGroupLayer[tabGroupLayer$VarObs %in% iInCnVarObs, "freq"] != nLayers) { stop(sprintf("'Obs' must contain %i vector(s) about %s", nLayers, iInCnVarObs)) } }