Commit 5f086b4e authored by Dorchies David's avatar Dorchies David
Browse files

feat(CreateInputsModel): Qobs with only necessary columns works

Refs #60
parent 7e27e077
......@@ -77,19 +77,24 @@ CreateInputsModel.GRiwrm <- function(x, DatesR,
names(varNames) <- varNames
lapply(varNames, function(varName) {
v <- get(varName)
if(!is.null(v)) {
if(is.matrix(v) || is.data.frame(v)) {
if(is.null(colnames(v))) {
if (!is.null(v)) {
if (is.matrix(v) || is.data.frame(v)) {
if (is.null(colnames(v))) {
stop(sprintf(
"'%s' must have column names",
varName
))
} else if(!all(colnames(v) %in% x$id)) {
} else if (!all(colnames(v) %in% x$id)) {
stop(sprintf(
"'%s' column names must be included in 'id's of the GRiwrm object",
varName
))
}
if (!varName %in% c("ZInputs", "NLayers", "HypsoData") && nrow(v) != length(DatesR)) {
stop("'%s' number of rows and the length of 'DatesR' must be equal",
varName)
}
} else if (!varName %in% c("ZInputs", "NLayers")) {
stop(sprintf("'%s' must be a matrix or a data.frame", varName))
}
......@@ -121,8 +126,8 @@ CreateInputsModel.GRiwrm <- function(x, DatesR,
if (is.null(Qobs)) {
Qobs <- Qobs0
} else {
missingIDs <- which(!x$id %in% colnames(Qobs))
Qobs0[, colnames(Qobs)] <- Qobs
Qobs <- Qobs0
}
for(id in getNodeRanking(x)) {
......
......@@ -87,6 +87,19 @@ test_that("throw error on missing column in inputs", {
regexp = "Precip is missing")
})
test_that("throw error on wrong number of rows in inputs", {
l$Precip <- l$Precip[-1, ]
expect_error(CreateInputsModel(l$griwrm,
DatesR = l$DatesR,
Precip = l$Precip,
PotEvap = l$PotEvap,
TempMean = l$TempMean,
ZInputs = l$ZInputs,
HypsoData = l$HypsoData),
regexp = "number of rows and the length of 'DatesR' must be equal")
})
test_that("throws error when missing CemaNeige data", {
expect_error(CreateInputsModel(l$griwrm,
DatesR = l$DatesR,
......@@ -102,4 +115,28 @@ test_that("throws error when missing Qobs on node not related to an hydrological
Precip = l$Precip,
PotEvap = l$PotEvap),
regexp = "'Qobs' column names must at least contain")
expect_error(CreateInputsModel(l$griwrm,
DatesR = l$DatesR,
Precip = l$Precip,
PotEvap = l$PotEvap,
Qobs = l$Qobs[, -1]),
regexp = "'Qobs' column names must at least contain")
})
test_that("must works with node not related to an hydrological model", {
l$griwrm$model[1] <- NA
IM <- suppressWarnings(CreateInputsModel(
l$griwrm,
DatesR = l$DatesR,
Precip = l$Precip,
PotEvap = l$PotEvap,
Qobs = l$Qobs[, 1, drop = FALSE],
TempMean = l$TempMean,
ZInputs = l$ZInputs,
HypsoData = l$HypsoData
))
expect_equal(IM[[2]]$Qupstream[, "Up1"], l$Qobs[, "Up1"] * l$griwrm[1, "area"] * 1E3)
expect_equal(colnames(IM[[2]]$Qupstream), c("Up1", "Up2"))
})
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