From ea15a215b5808647ce4e99b4e520b7752a4839da Mon Sep 17 00:00:00 2001
From: Dorchies David <david.dorchies@irstea.fr>
Date: Wed, 27 Jul 2022 15:14:09 +0200
Subject: [PATCH] refactor: Rename column "gauged" to "donor" in the GRiwrm
object
Refs #42
---
R/Calibration.GRiwrmInputsModel.R | 6 +++---
R/CreateGRiwrm.R | 4 ++--
R/CreateInputsModel.GRiwrm.R | 6 +++---
3 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/R/Calibration.GRiwrmInputsModel.R b/R/Calibration.GRiwrmInputsModel.R
index d55042f..2be6f14 100644
--- a/R/Calibration.GRiwrmInputsModel.R
+++ b/R/Calibration.GRiwrmInputsModel.R
@@ -71,7 +71,7 @@ Calibration.GRiwrmInputsModel <- function(InputsModel,
if (hasUngauged) {
# Select nodes with model in the sub-network
g <- attr(IM, "GRiwrm")
- Ids <- g$id[g$gauged == id & !is.na(g$model)]
+ Ids <- g$id[g$donor == id & !is.na(g$model)]
# Extract the X4 calibrated for the whole intermediate basin
PS <- attr(IM[[id]], "ParamSettings")
if(PS$hasX4) {
@@ -169,7 +169,7 @@ updateParameters4Ungauged <- function(GaugedId,
### Set the reduced network of the basin containing ungauged nodes ###
# Select nodes identified with the current node as gauged node
griwrm <- attr(InputsModel, "GRiwrm")
- g <- griwrm[griwrm$gauged == GaugedId, ]
+ g <- griwrm[griwrm$donor == GaugedId, ]
# Add upstream nodes for routing upstream flows
upIds <- griwrm$id[griwrm$down %in% g$id & !griwrm$id %in% g$id]
g <- rbind(griwrm[griwrm$id %in% upIds, ], g)
@@ -183,7 +183,7 @@ updateParameters4Ungauged <- function(GaugedId,
# Update griwrm
attr(InputsModel, "GRiwrm") <- g
# Update Qupstream of reduced network upstream nodes
- g2 <- griwrm[griwrm$gauged == GaugedId,]
+ g2 <- griwrm[griwrm$donor == GaugedId,]
upIds2 <- g2$id[!g2$id %in% g2$down]
for (id in upIds2) {
if(useUpstreamQsim && any(InputsModel[[id]]$UpstreamIsRunoff)) {
diff --git a/R/CreateGRiwrm.R b/R/CreateGRiwrm.R
index acfd37e..b0a8fd3 100644
--- a/R/CreateGRiwrm.R
+++ b/R/CreateGRiwrm.R
@@ -66,7 +66,7 @@ CreateGRiwrm <- function(db,
area = "double"),
keep_all)
checkNetworkConsistency(griwrm)
- griwrm$gauged <- sapply(griwrm$id, getGaugedId, griwrm = griwrm)
+ griwrm$donor <- sapply(griwrm$id, getGaugedId, griwrm = griwrm)
class(griwrm) <- c("GRiwrm", class(griwrm))
griwrm
}
@@ -149,7 +149,7 @@ checkNetworkConsistency <- function(db) {
}
-#' Get the Id of the gauged model
+#' Get the Id of the nearest gauged model at downstream
#'
#' @param id [character] Id of the current node
#' @param griwrm See [CreateGRiwrm])
diff --git a/R/CreateInputsModel.GRiwrm.R b/R/CreateInputsModel.GRiwrm.R
index 9d8897c..e316f7a 100644
--- a/R/CreateInputsModel.GRiwrm.R
+++ b/R/CreateInputsModel.GRiwrm.R
@@ -127,7 +127,7 @@ CreateEmptyGRiwrmInputsModel <- function(griwrm) {
InputsModel <- list()
class(InputsModel) <- c("GRiwrmInputsModel", class(InputsModel))
# Update griwrm in case of manual change in model column
- griwrm$gauged <- sapply(griwrm$id, getGaugedId, griwrm = griwrm)
+ griwrm$donor <- sapply(griwrm$id, getGaugedId, griwrm = griwrm)
attr(InputsModel, "GRiwrm") <- griwrm
return(InputsModel)
}
@@ -147,7 +147,7 @@ CreateEmptyGRiwrmInputsModel <- function(griwrm) {
#' @noRd
CreateOneGRiwrmInputsModel <- function(id, griwrm, ..., Qobs) {
node <- griwrm[griwrm$id == id,]
- FUN_MOD <- griwrm$model[griwrm$id == griwrm$gauged[griwrm$id == id]]
+ FUN_MOD <- griwrm$model[griwrm$id == griwrm$donor[griwrm$id == id]]
# Set hydraulic parameters
UpstreamNodes <- griwrm$id[griwrm$down == id & !is.na(griwrm$down)]
@@ -195,7 +195,7 @@ CreateOneGRiwrmInputsModel <- function(id, griwrm, ..., Qobs) {
# Add the model function
InputsModel$FUN_MOD <- FUN_MOD
InputsModel$isUngauged <- griwrm$model[griwrm$id == id] == "Ungauged"
- InputsModel$gaugedId <- griwrm$gauged[griwrm$id == id]
+ InputsModel$gaugedId <- griwrm$donor[griwrm$id == id]
InputsModel$hasUngaugedNodes <- hasUngaugedNodes(id, griwrm)
return(InputsModel)
--
GitLab