From 363b74a392e49ca95a695efcd93b8920d1687c80 Mon Sep 17 00:00:00 2001 From: Delaigue Olivier <olivier.delaigue@irstea.fr> Date: Fri, 8 Jan 2021 05:12:42 +0100 Subject: [PATCH] v1.6.8.44 style: remove extra spaces in ErrorCrit function --- DESCRIPTION | 4 ++-- NEWS.md | 2 +- R/ErrorCrit.R | 38 +++++++++++++++++++------------------- 3 files changed, 22 insertions(+), 22 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d4c4c6ea..09f5f69e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,8 +1,8 @@ Package: airGR Type: Package Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling -Version: 1.6.8.43 -Date: 2021-01-07 +Version: 1.6.8.44 +Date: 2021-01-08 Authors@R: c( person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")), person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"), diff --git a/NEWS.md b/NEWS.md index ead887a8..f67f3c56 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,7 +2,7 @@ -### 1.6.8.43 Release Notes (2021-01-07) +### 1.6.8.44 Release Notes (2021-01-08) #### New features diff --git a/R/ErrorCrit.R b/R/ErrorCrit.R index 28e9368a..e6ef4b4e 100644 --- a/R/ErrorCrit.R +++ b/R/ErrorCrit.R @@ -1,22 +1,22 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbose = TRUE) { - - + + ## ---------- Arguments check - + if (!inherits(InputsCrit, "InputsCrit")) { stop("InputsCrit must be of class 'InputsCrit'") - } + } if (!inherits(OutputsModel, "OutputsModel")) { stop("OutputsModel must be of class 'OutputsModel'") - } + } if (!missing(FUN_CRIT)) { warning("deprecated 'FUN_CRIT' argument. The error criterion function is now automatically get from the 'InputsCrit' object", call. = FALSE) } - - - + + + ## ---------- Criterion computation - + ## ----- Single criterion if (inherits(InputsCrit, "Single")) { FUN_CRIT <- match.fun(InputsCrit$FUN_CRIT) @@ -25,10 +25,10 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo warnings = warnings, verbose = verbose) } - - + + ## ----- Multiple criteria or Composite criterion - + if (inherits(InputsCrit, "Multi") | inherits(InputsCrit, "Compo")) { listOutputsCrit <- lapply(InputsCrit, FUN = function(iInputsCrit) { FUN_CRIT <- match.fun(iInputsCrit$FUN_CRIT) @@ -37,12 +37,12 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo warnings = warnings, verbose = verbose) }) - + listValCrit <- sapply(listOutputsCrit, function(x) x[["CritValue"]]) listNameCrit <- sapply(listOutputsCrit, function(x) x[["CritName"]]) listweights <- unlist(lapply(InputsCrit, function(x) x[["Weights"]])) - listweights <- listweights / sum(listweights) - + listweights <- listweights / sum(listweights) + if (inherits(InputsCrit, "Compo")) { CritValue <- sum(listValCrit * listweights) OutputsCritCompo <- list(MultiCritValues = listValCrit, @@ -61,7 +61,7 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo message("Crit. Composite = ", sprintf("%.4f", CritValue)) msgForm <- paste(sprintf("%.2f", listweights), listNameCrit, sep = " * ", collapse = ", ") msgForm <- unlist(strsplit(msgForm, split = ",")) - msgFormSep <- rep(c(",", ",", ",\n\t\t "), times = ceiling(length(msgForm)/3))[1: length(msgForm)] + msgFormSep <- rep(c(",", ",", ",\n\t\t "), times = ceiling(length(msgForm)/3))[1:length(msgForm)] msgForm <- paste(msgForm, msgFormSep, sep = "", collapse = "") msgForm <- gsub("\\,\\\n\\\t\\\t $|\\,$", "", msgForm) message("\tFormula: sum(", msgForm, ")\n") @@ -70,10 +70,10 @@ ErrorCrit <- function(InputsCrit, OutputsModel, FUN_CRIT, warnings = TRUE, verbo OutputsCrit <- listOutputsCrit class(OutputsCrit) <- c("Multi", "ErrorCrit") } - + } - + return(OutputsCrit) - + } -- GitLab