Commit 3880f5bd authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v1.6.9.30 style: clean typo of various files

parent 47f142ec
Pipeline #19602 passed with stages
in 35 minutes and 3 seconds
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.9.29
Version: 1.6.9.30
Date: 2021-01-25
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
......
......@@ -219,10 +219,10 @@ Calibration_Michel <- function(InputsModel,
PotentialCandidateT[1, I] <- NewParamOptimT[I] + Sign * Pace
##If_we_exit_the_range_of_possible_values_we_go_back_on_the_boundary
if (PotentialCandidateT[1, I] < RangesT[1, I] ) {
PotentialCandidateT[1,I] <- RangesT[1, I]
PotentialCandidateT[1, I] <- RangesT[1, I]
}
if (PotentialCandidateT[1, I] > RangesT[2, I]) {
PotentialCandidateT[1,I] <- RangesT[2,I]
PotentialCandidateT[1, I] <- RangesT[2, I]
}
##We_check_the_set_is_not_outside_the_range_of_possible_values
if (NewParamOptimT[I] == RangesT[1, I] & Sign < 0) {
......
......@@ -179,7 +179,7 @@ CreateCalibOptions <- function(FUN_MOD,
}
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
ParamOut[, 1:(NParam - 4) ] <- FUN_GR(ParamIn[, 1:(NParam - 4) ], Direction)
ParamOut[, 1:(NParam - 4) ] <- FUN_GR(ParamIn[, 1:(NParam - 4)], Direction)
ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction)
if (!Bool) {
ParamOut <- ParamOut[1, ]
......@@ -198,7 +198,7 @@ CreateCalibOptions <- function(FUN_MOD,
if (NParam <= 3) {
ParamOut[, 1:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 1:(NParam - 2)]), Direction)
} else {
ParamOut[, 1:(NParam - 2)] <- FUN_GR( ParamIn[, 1:(NParam - 2)], Direction)
ParamOut[, 1:(NParam - 2)] <- FUN_GR(ParamIn[, 1:(NParam - 2)], Direction)
}
ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction)
if (!Bool) {
......@@ -215,9 +215,9 @@ CreateCalibOptions <- function(FUN_MOD,
}
ParamOut <- NA * ParamIn
NParam <- ncol(ParamIn)
ParamOut[, 2:(NParam - 4) ] <- FUN_GR( ParamIn[, 2:(NParam - 4) ], Direction)
ParamOut[, (NParam - 3):NParam] <- FUN_SNOW( ParamIn[, (NParam - 3):NParam], Direction)
ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1 ]), Direction)
ParamOut[, 2:(NParam - 4) ] <- FUN_GR(ParamIn[, 2:(NParam - 4)], Direction)
ParamOut[, (NParam - 3):NParam] <- FUN_SNOW(ParamIn[, (NParam - 3):NParam], Direction)
ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
if (!Bool) {
ParamOut <- ParamOut[1, ]
}
......@@ -235,9 +235,9 @@ CreateCalibOptions <- function(FUN_MOD,
if (NParam <= 3) {
ParamOut[, 2:(NParam - 2)] <- FUN_GR(cbind(ParamIn[, 2:(NParam - 2)]), Direction)
} else {
ParamOut[, 2:(NParam - 2)] <- FUN_GR( ParamIn[, 2:(NParam - 2)], Direction)
ParamOut[, 2:(NParam - 2)] <- FUN_GR(ParamIn[, 2:(NParam - 2)], Direction)
}
ParamOut[, (NParam - 1):NParam] <- FUN_SNOW( ParamIn[, (NParam - 1):NParam], Direction)
ParamOut[, (NParam - 1):NParam] <- FUN_SNOW(ParamIn[, (NParam - 1):NParam], Direction)
ParamOut[, 1 ] <- FUN_LAG(as.matrix(ParamIn[, 1]), Direction)
if (!Bool) {
ParamOut <- ParamOut[1, ]
......
RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
## Initialization of variables
NParam <- 5
FortranOutputs <- .FortranOutputs(GR = "GR5H")$GR
......@@ -10,24 +10,24 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
} else {
Imax <- -99
}
## Arguments check
if (!inherits(InputsModel, "InputsModel")) {
stop("'InputsModel' must be of class 'InputsModel'")
}
}
if (!inherits(InputsModel, "hourly" )) {
stop("'InputsModel' must be of class 'hourly' ")
}
}
if (!inherits(InputsModel, "GR" )) {
stop("'InputsModel' must be of class 'GR' ")
}
}
if (!inherits(RunOptions, "RunOptions" )) {
stop("'RunOptions' must be of class 'RunOptions' ")
}
}
if (!inherits(RunOptions, "GR" )) {
stop("'RunOptions' must be of class 'GR' ")
}
}
if (!is.vector(Param) | !is.numeric(Param)) {
stop("'Param' must be a numeric vector")
}
......@@ -35,7 +35,7 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
stop(paste("'Param' must be a vector of length ", NParam, " and contain no NA", sep = ""))
}
Param <- as.double(Param)
Param_X1X3_threshold <- 1e-2
Param_X4_threshold <- 0.5
if (Param[1L] < Param_X1X3_threshold) {
......@@ -49,24 +49,25 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
if (Param[4L] < Param_X4_threshold) {
warning(sprintf("Param[4] (X4: unit hydrograph time constant [h]) < %.2f\n X4 set to %.2f", Param_X4_threshold, Param_X4_threshold))
Param[4L] <- Param_X4_threshold
}
}
## Input data preparation
if (identical(RunOptions$IndPeriod_WarmUp, 0L)) {
RunOptions$IndPeriod_WarmUp <- NULL
}
IndPeriod1 <- c(RunOptions$IndPeriod_WarmUp, RunOptions$IndPeriod_Run)
LInputSeries <- as.integer(length(IndPeriod1))
if ("all" %in% RunOptions$Outputs_Sim) { IndOutputs <- as.integer(1:length(FortranOutputs))
if ("all" %in% RunOptions$Outputs_Sim) {
IndOutputs <- as.integer(1:length(FortranOutputs))
} else {
IndOutputs <- which(FortranOutputs %in% RunOptions$Outputs_Sim)
}
## Output data preparation
IndPeriod2 <- (length(RunOptions$IndPeriod_WarmUp)+1):LInputSeries
ExportDatesR <- "DatesR" %in% RunOptions$Outputs_Sim
ExportStateEnd <- "StateEnd" %in% RunOptions$Outputs_Sim
## Use of IniResLevels
if (!is.null(RunOptions$IniResLevels)) {
RunOptions$IniStates[1] <- RunOptions$IniResLevels[1]*Param[1] ### production store level (mm)
......@@ -75,9 +76,9 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
RunOptions$IniStates[4] <- RunOptions$IniResLevels[4] * Imax ### interception store level (mm)
}
}
## Call GR model Fortan
RESULTS <- .Fortran("frun_gr5h", PACKAGE = "airGR",
RESULTS <- .Fortran("frun_gr5h", PACKAGE = "airGR",
## inputs
LInputs = LInputSeries, ### length of input and output series
InputsPrecip = InputsModel$Precip[IndPeriod1], ### input series of total precipitation [mm/h]
......@@ -97,14 +98,14 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
RESULTS$StateEnd[round(RESULTS$StateEnd, 3) == -999.999] <- NA
if (ExportStateEnd) {
RESULTS$StateEnd[-3L] <- ifelse(RESULTS$StateEnd[-3L] < 0, 0, RESULTS$StateEnd[-3L]) ### remove negative values except for the ExpStore location
RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel,
ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
IntStore = RESULTS$StateEnd[4L],
UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
RESULTS$StateEnd <- CreateIniStates(FUN_MOD = RunModel_GR5H, InputsModel = InputsModel,
ProdStore = RESULTS$StateEnd[1L], RoutStore = RESULTS$StateEnd[2L], ExpStore = NULL,
IntStore = RESULTS$StateEnd[4L],
UH1 = NULL, UH2 = RESULTS$StateEnd[(1:(40*24))+(7+20*24)],
GCemaNeigeLayers = NULL, eTGCemaNeigeLayers = NULL,
verbose = FALSE)
}
## Output data preparation
## OutputsModel only
if (!ExportDatesR & !ExportStateEnd) {
......@@ -113,30 +114,30 @@ RunModel_GR5H <- function(InputsModel, RunOptions, Param) {
}
## DatesR and OutputsModel only
if (ExportDatesR & !ExportStateEnd) {
OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]))
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs])
}
## OutputsModel and StateEnd only
if (!ExportDatesR & ExportStateEnd) {
OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
OutputsModel <- c(lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd))
names(OutputsModel) <- c(FortranOutputs[IndOutputs], "StateEnd")
}
## DatesR and OutputsModel and StateEnd
if ((ExportDatesR & ExportStateEnd) | "all" %in% RunOptions$Outputs_Sim) {
OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
OutputsModel <- c(list(InputsModel$DatesR[RunOptions$IndPeriod_Run]),
lapply(seq_len(RESULTS$NOutputs), function(i) RESULTS$Outputs[IndPeriod2, i]),
list(RESULTS$StateEnd))
names(OutputsModel) <- c("DatesR", FortranOutputs[IndOutputs], "StateEnd")
}
## End
rm(RESULTS)
rm(RESULTS)
class(OutputsModel) <- c("OutputsModel", "hourly", "GR")
if (IsIntStore) {
class(OutputsModel) <- c(class(OutputsModel), "interception")
}
return(OutputsModel)
}
......@@ -50,8 +50,7 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param) {
NbUpBasins <- length(InputsModel$LengthHydro)
LengthTs <- length(OutputsModel$QsimDown)
OutputsModel$Qsim <-
OutputsModel$QsimDown * InputsModel$BasinAreas[length(InputsModel$BasinAreas)] * 1e3
OutputsModel$Qsim <- OutputsModel$QsimDown * InputsModel$BasinAreas[length(InputsModel$BasinAreas)] * 1e3
IniSD <- RunOptions$IniStates[grep("SD", names(RunOptions$IniStates))]
if (length(IniSD) > 0) {
......@@ -78,12 +77,10 @@ RunModel_Lag <- function(InputsModel, RunOptions, Param) {
}
for (upstream_basin in seq_len(NbUpBasins)) {
Qupstream <-
InputsModel$Qupstream[RunOptions$IndPeriod_Run, upstream_basin]
Qupstream <- InputsModel$Qupstream[RunOptions$IndPeriod_Run, upstream_basin]
if (!is.na(InputsModel$BasinAreas[upstream_basin])) {
# Upstream flow with area needs to be converted to m3 by time step
Qupstream <-
Qupstream * InputsModel$BasinAreas[upstream_basin] * 1e3
Qupstream <- Qupstream * InputsModel$BasinAreas[upstream_basin] * 1e3
}
OutputsModel$Qsim <- OutputsModel$Qsim +
c(IniStates[[upstream_basin]][-length(IniStates[[upstream_basin]])],
......
......@@ -2,7 +2,7 @@
#include <stdlib.h> // for NULL
#include <R_ext/Rdynload.h>
/* FIXME:
/* FIXME:
Check these declarations against the C/Fortran source code.
*/
......@@ -26,7 +26,7 @@ static const R_FortranMethodDef FortranEntries[] = {
{"frun_gr4j", (DL_FUNC) &F77_NAME(frun_gr4j), 11},
{"frun_gr5j", (DL_FUNC) &F77_NAME(frun_gr5j), 11},
{"frun_gr6j", (DL_FUNC) &F77_NAME(frun_gr6j), 11},
{"frun_pe_oudin", (DL_FUNC) &F77_NAME(frun_pe_oudin), 5},
{"frun_pe_oudin", (DL_FUNC) &F77_NAME(frun_pe_oudin), 5},
{NULL, NULL, 0}
};
......
StoreStableExampleResults <- function(
package = "airGR",
package = "airGR",
path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "stable"),
...) {
install.packages(package, repos = "http://cran.r-project.org")
......@@ -7,8 +7,8 @@ StoreStableExampleResults <- function(
}
StoreDevExampleResults <- function(
package = "airGR",
path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "dev"),
package = "airGR",
path = file.path("tests/tmp", Sys.getenv("R_VERSION"), "dev"),
...) {
StoreExampleResults(package = package, path = path, ...)
}
......@@ -75,7 +75,9 @@ StoreTopicResults <- function(topic, package, path, run.dontrun = TRUE, run.dont
}
CompareStableDev <- function() {
res = testthat::test_file("tests/testthat/regression.R")
dRes = as.data.frame(res)
if(any(dRes[,"failed"]>0) | any(dRes[,"error"])) quit(status = 1)
res <- testthat::test_file("tests/testthat/regression.R")
dRes <- as.data.frame(res)
if(any(dRes[, "failed"] > 0) | any(dRes[, "error"])) {
quit(status = 1)
}
}
# Execute Regression test by comparing RD files stored in folders /tests/tmp/ref and /tests/tmp/test
Args = commandArgs(trailingOnly=TRUE)
Args <- commandArgs(trailingOnly = TRUE)
source("tests/testthat/helper_regression.R")
......@@ -15,7 +15,7 @@ if(Args %in% names(lActions)) {
stop("This script should be run with one argument in the command line:\n",
"`Rscript tests/regression_tests.R [stable|dev|compare]`.\n",
"Available arguments are:\n",
"- stable: install stable version from CRAN, run and store examples\n",
"- stable: install stable version from CRAN, run and store examples\n",
"- dev: install dev version from current directory, run and store examples\n",
"- compare: stored results of both versions")
}
......@@ -3,25 +3,23 @@ context("CreateIniStates on SD model")
data(L0123001)
test_that("Error: SD argument provided on non-SD 'InputsModel'", {
InputsModel <-
CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E
)
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J,
DatesR = BasinObs$DatesR,
Precip = BasinObs$P,
PotEvap = BasinObs$E
)
expect_error(
IniStates <-
CreateIniStates(
FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
ProdStore = 0,
RoutStore = 0,
ExpStore = NULL,
UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
SD = list(rep(0, 10))
),
IniStates <- CreateIniStates(
FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
ProdStore = 0,
RoutStore = 0,
ExpStore = NULL,
UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
SD = list(rep(0, 10))
),
regexp = "'SD' argument provided and"
)
})
......@@ -29,10 +27,9 @@ test_that("Error: SD argument provided on non-SD 'InputsModel'", {
BasinAreas <- c(BasinInfo$BasinArea, BasinInfo$BasinArea)
# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs
Qupstream <-
floor((sin((
seq_along(BasinObs$Qmm) / 365 * 2 * 3.14
)) + 1) * mean(BasinObs$Qmm, na.rm = TRUE))
Qupstream <- floor((sin((
seq_along(BasinObs$Qmm) / 365 * 2 * 3.14
)) + 1) * mean(BasinObs$Qmm, na.rm = TRUE))
InputsModel <- CreateInputsModel(
FUN_MOD = RunModel_GR4J,
......@@ -46,8 +43,27 @@ InputsModel <- CreateInputsModel(
test_that("Error: Non-list 'SD' argument", {
expect_error(
IniStates <-
CreateIniStates(
IniStates <- CreateIniStates(
FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
ProdStore = 0,
RoutStore = 0,
ExpStore = NULL,
UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
SD = rep(0, 10)
),
regexp = "'SD' argument must be a list"
)
})
test_that("Error: Non-numeric items in 'SD' list argument", {
lapply(list(list(list(rep(
0, 10
))), list(toto = NULL)),
function(x) {
expect_error(
IniStates <- CreateIniStates(
FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
ProdStore = 0,
......@@ -55,47 +71,27 @@ test_that("Error: Non-list 'SD' argument", {
ExpStore = NULL,
UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
SD = rep(0, 10)
SD = x
),
regexp = "'SD' argument must be a list"
)
})
test_that("Error: Non-numeric items in 'SD' list argument", {
lapply(list(list(list(rep(0, 10))), list(toto = NULL)),
function(x) {
expect_error(
IniStates <-
CreateIniStates(
FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
ProdStore = 0,
RoutStore = 0,
ExpStore = NULL,
UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
SD = x
),
regexp = "Each item of 'SD' list argument must be numeric"
)
})
regexp = "Each item of 'SD' list argument must be numeric"
)
})
})
test_that("Error: Number of items not equal to number of upstream connections", {
lapply(list(list(), list(rep(0, 10), rep(0, 10))),
function(x) {
expect_error(
IniStates <-
CreateIniStates(
FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
ProdStore = 0,
RoutStore = 0,
ExpStore = NULL,
UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
SD = x
),
IniStates <- CreateIniStates(
FUN_MOD = RunModel_GR4J,
InputsModel = InputsModel,
ProdStore = 0,
RoutStore = 0,
ExpStore = NULL,
UH1 = c(0.52, 0.54, 0.15, rep(0, 17)),
UH2 = c(0.057, 0.042, 0.015, 0.005, rep(0, 36)),
SD = x
),
regexp = "list argument must be the same as the number of upstream"
)
})
......
......@@ -33,7 +33,6 @@ test_that("V03_param_sets_GR4J works", {
skip_on_cran()
rm(list = ls())
expect_true(RunVignetteChunks("V03_param_sets_GR4J"))
})
test_that("V04_cemaneige_hysteresis works", {
......
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