Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Contribute to GitLab
Sign in / Register
Toggle navigation
Menu
Open sidebar
HYCAR-Hydro
airGR
Commits
c97be9fb
Commit
c97be9fb
authored
Oct 15, 2020
by
Delaigue Olivier
Browse files
v1.6.3.14 style(test): minor typo revisions
parent
d5ac0907
Pipeline
#16669
canceled with stages
in 1 minute and 8 seconds
Changes
3
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
DESCRIPTION
View file @
c97be9fb
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.3.1
3
Date: 2020-10-1
4
Version: 1.6.3.1
4
Date: 2020-10-1
5
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"),
...
...
NEWS.md
View file @
c97be9fb
...
...
@@ -2,7 +2,7 @@
### 1.6.3.1
3
Release Notes (2020-10-1
4
)
### 1.6.3.1
4
Release Notes (2020-10-1
5
)
#### New features
...
...
tests/testthat/test-RunModel_LAG.R
View file @
c97be9fb
...
...
@@ -35,7 +35,7 @@ test_that("'Qupstream' cannot contain any NA value", {
})
# Qupstream = sinusoid synchronised on hydrological year from 0 mm to mean value of Qobs
Qupstream
=
floor
((
sin
((
1
:
length
(
BasinObs
$
Qmm
)
/
365
*
2
*
3.14
))
+1
)
*
mean
(
BasinObs
$
Qmm
,
na.rm
=
T
))
Qupstream
<-
floor
((
sin
((
seq_along
(
length
(
BasinObs
$
Qmm
)
)
/
365
*
2
*
3.14
))
+1
)
*
mean
(
BasinObs
$
Qmm
,
na.rm
=
T
RUE
))
InputsModel
<-
CreateInputsModel
(
FUN_MOD
=
RunModel_GR4J
,
...
...
@@ -56,23 +56,22 @@ RunOptions <- CreateRunOptions(FUN_MOD = RunModel_GR4J,
test_that
(
"InputsModel parameter should contain an OutputsModel key"
,
{
expect_error
(
RunModel_Lag
(
InputsModel
,
RunOptions
,
1
),
RunModel_Lag
(
InputsModel
=
InputsModel
,
RunOptions
=
RunOptions
,
Param
=
1
),
regexp
=
"'InputsModel' should contain an 'OutputsModel' key"
)
})
Param
=
c
(
257.237556
,
1.012237
,
88.234673
,
2.207958
)
# From vignettes/V01_get_started
Param
<-
c
(
257.237556
,
1.012237
,
88.234673
,
2.207958
)
# From vignettes/V01_get_started
OutputsGR4JOnly
<-
RunModel_GR4J
(
InputsModel
=
InputsModel
,
RunOptions
=
RunOptions
,
Param
=
Param
)
OutputsGR4JOnly
<-
RunModel_GR4J
(
InputsModel
=
InputsModel
,
RunOptions
=
RunOptions
,
Param
=
Param
)
test_that
(
"InputsModel$OutputsModel should contain a Qsim key"
,
{
InputsModel
$
OutputsModel
<-
OutputsGR4JOnly
InputsModel
$
OutputsModel
$
Qsim
<-
NULL
expect_error
(
RunModel_Lag
(
InputsModel
,
RunOptions
,
1
),
RunModel_Lag
(
InputsModel
=
InputsModel
,
RunOptions
=
RunOptions
,
Param
=
1
),
regexp
=
"should contain a key 'Qsim'"
)
})
...
...
@@ -81,67 +80,57 @@ test_that("'InputsModel$OutputsModel$Qim' should have the same lenght as 'RunOpt
InputsModel
$
OutputsModel
<-
OutputsGR4JOnly
InputsModel
$
OutputsModel
$
Qsim
<-
c
(
InputsModel
$
OutputsModel
$
Qsim
,
0
)
expect_error
(
RunModel_Lag
(
InputsModel
,
RunOptions
,
1
),
RunModel_Lag
(
InputsModel
=
InputsModel
,
RunOptions
=
RunOptions
,
Param
=
1
),
regexp
=
"should have the same lenght as"
)
})
test_that
(
"'InputsModel$OutputsModel$Qim' should contain no NA'"
,
{
InputsModel
$
OutputsModel
<-
OutputsGR4JOnly
InputsModel
$
OutputsModel
$
Qsim
[
10
]
<-
NA
InputsModel
$
OutputsModel
$
Qsim
[
10
L
]
<-
NA
expect_error
(
RunModel_Lag
(
InputsModel
,
RunOptions
,
1
),
RunModel_Lag
(
InputsModel
=
InputsModel
,
RunOptions
=
RunOptions
,
Param
=
1
),
regexp
=
"contain no NA"
)
})
test_that
(
"Upstream basin with nil area should return same Qdown as GR4J alone"
,
{
UpstBasinArea
=
InputsModel
$
BasinAreas
[
1
]
InputsModel
$
BasinAreas
[
1
]
<-
0
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
c
(
1
,
Param
),
FUN_MOD
=
RunModel_GR4J
)
UpstBasinArea
<-
InputsModel
$
BasinAreas
[
1L
]
InputsModel
$
BasinAreas
[
1L
]
<-
0
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
c
(
1
,
Param
),
FUN_MOD
=
RunModel_GR4J
)
expect_equal
(
OutputsGR4JOnly
$
Qsim
,
OutputsSD
$
Qsim
)
})
test_that
(
"Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone"
,
{
InputsModel
$
LengthHydro
<-
0
InputsModel
$
BasinAreas
<-
c
(
BasinInfo
$
BasinArea
,
0
)
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
c
(
1
,
Param
),
FUN_MOD
=
RunModel_GR4J
)
expect_equal
(
OutputsSD
$
Qsim
,
Qupstream
[
Ind_Run
])
}
)
test_that
(
"Downstream basin with nil area and nul upstream length should return same Qdown as Qupstream alone"
,
{
InputsModel
$
LengthHydro
<-
0
InputsModel
$
BasinAreas
<-
c
(
BasinInfo
$
BasinArea
,
0
)
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
c
(
1
,
Param
),
FUN_MOD
=
RunModel_GR4J
)
expect_equal
(
OutputsSD
$
Qsim
,
Qupstream
[
Ind_Run
])
})
ParamSD
=
c
(
InputsModel
$
LengthHydro
/
(
24
*
60
*
60
),
Param
)
# Speed corresponding to one time step delay
ParamSD
<-
c
(
InputsModel
$
LengthHydro
/
(
24
*
60
*
60
),
Param
)
# Speed corresponding to one time step delay
QlsGR4Only
<-
OutputsGR4JOnly
$
Qsim
*
InputsModel
$
BasinAreas
[
2
]
*
1E6
/
86400
QlsGR4Only
<-
OutputsGR4JOnly
$
Qsim
*
InputsModel
$
BasinAreas
[
2L
]
*
1e6
/
86400
test_that
(
"1 input with lag of 1 time step delay out gives an output delayed of one time step"
,
{
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
ParamSD
,
FUN_MOD
=
RunModel_GR4J
)
QlsSdSim
<-
OutputsSD
$
Qsim
*
sum
(
InputsModel
$
BasinAreas
)
*
1E6
/
86400
QlsUpstLagObs
<-
c
(
0
,
Qupstream
[
Ind_Run
[
1
:
(
length
(
Ind_Run
)
-
1
)]])
*
InputsModel
$
BasinAreas
[
1
]
*
1E6
/
86400
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
ParamSD
,
FUN_MOD
=
RunModel_GR4J
)
QlsSdSim
<-
OutputsSD
$
Qsim
*
sum
(
InputsModel
$
BasinAreas
)
*
1e6
/
86400
QlsUpstLagObs
<-
c
(
0
,
Qupstream
[
Ind_Run
[
1
:
(
length
(
Ind_Run
)
-
1
)]])
*
InputsModel
$
BasinAreas
[
1L
]
*
1e6
/
86400
expect_equal
(
QlsSdSim
-
QlsGR4Only
,
QlsUpstLagObs
)
})
test_that
(
"1 input with lag of 0.5 time step delay out gives an output delayed of 0.5 time step"
,
{
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
c
(
InputsModel
$
LengthHydro
/
(
12
*
3600
),
Param
),
FUN_MOD
=
RunModel_GR4J
)
QlsSdSim
<-
OutputsSD
$
Qsim
*
sum
(
InputsModel
$
BasinAreas
)
*
1E6
/
86400
QlsUpstLagObs
<-
(
Qupstream
[
Ind_Run
]
+
c
(
0
,
Qupstream
[
Ind_Run
[
1
:
(
length
(
Ind_Run
)
-
1
)]]))
/
2
*
InputsModel
$
BasinAreas
[
1
]
*
1E6
/
86400
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
c
(
InputsModel
$
LengthHydro
/
(
12
*
3600
),
Param
),
FUN_MOD
=
RunModel_GR4J
)
QlsSdSim
<-
OutputsSD
$
Qsim
*
sum
(
InputsModel
$
BasinAreas
)
*
1e6
/
86400
QlsUpstLagObs
<-
(
Qupstream
[
Ind_Run
]
+
c
(
0
,
Qupstream
[
Ind_Run
[
1
:
(
length
(
Ind_Run
)
-
1
)]]))
/
2
*
InputsModel
$
BasinAreas
[
1L
]
*
1e6
/
86400
expect_equal
(
QlsSdSim
-
QlsGR4Only
,
QlsUpstLagObs
)
})
...
...
@@ -153,8 +142,8 @@ test_that("Params from calibration with simulated data should be similar to init
RunOptions
=
RunOptions
,
VarObs
=
"Q"
,
Obs
=
(
c
(
0
,
Qupstream
[
Ind_Run
[
1
:
(
length
(
Ind_Run
)
-
1
)]])
*
BasinAreas
[
1
]
+
BasinObs
$
Qmm
[
Ind_Run
]
*
BasinAreas
[
2
]
c
(
0
,
Qupstream
[
Ind_Run
[
1
:
(
length
(
Ind_Run
)
-
1
)]])
*
BasinAreas
[
1
L
]
+
BasinObs
$
Qmm
[
Ind_Run
]
*
BasinAreas
[
2
L
]
)
/
sum
(
BasinAreas
)
)
CalibOptions
<-
CreateCalibOptions
(
...
...
@@ -169,26 +158,23 @@ test_that("Params from calibration with simulated data should be similar to init
CalibOptions
=
CalibOptions
,
FUN_MOD
=
RunModel_GR4J
)
expect_equal
(
OutputsCalib
$
ParamFinalR
[
2
:
5
]
/
ParamSD
[
2
:
5
],
rep
(
1
,
4
),
tolerance
=
1
E
-2
)
expect_equal
(
OutputsCalib
$
ParamFinalR
[
1
],
ParamSD
[
1
],
tolerance
=
2
E
-3
)
expect_equal
(
OutputsCalib
$
ParamFinalR
[
2
:
5
]
/
ParamSD
[
2
:
5
],
rep
(
1
,
4
),
tolerance
=
1
e
-2
)
expect_equal
(
OutputsCalib
$
ParamFinalR
[
1
L
],
ParamSD
[
1
L
],
tolerance
=
2
e
-3
)
})
test_that
(
"1 no area input with lag of 1 time step delay out gives an output delayed of one time step converted to mm"
,
{
Qm3GR4Only
<-
OutputsGR4JOnly
$
Qsim
*
BasinAreas
[
2
]
*
1E3
Qm3GR4Only
<-
OutputsGR4JOnly
$
Qsim
*
BasinAreas
[
2L
]
*
1e3
# Specify that upstream flow is not related to an area
InputsModel
$
BasinAreas
=
c
(
NA
,
BasinAreas
[
2
])
InputsModel
$
BasinAreas
<-
c
(
NA
,
BasinAreas
[
2
L
])
# Convert upstream flow to m3/day
InputsModel
$
Qupstream
<-
matrix
(
Qupstream
,
ncol
=
1
)
*
BasinAreas
[
1
]
*
1E3
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
ParamSD
,
FUN_MOD
=
RunModel_GR4J
)
InputsModel
$
Qupstream
<-
matrix
(
Qupstream
,
ncol
=
1
)
*
BasinAreas
[
1L
]
*
1e3
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
ParamSD
,
FUN_MOD
=
RunModel_GR4J
)
expect_false
(
any
(
is.na
(
OutputsSD
$
Qsim
)))
Qm3SdSim
<-
OutputsSD
$
Qsim
*
sum
(
InputsModel
$
BasinAreas
,
na.rm
=
TRUE
)
*
1E3
Qm3UpstLagObs
<-
c
(
0
,
InputsModel
$
Qupstream
[
Ind_Run
[
1
:
(
length
(
Ind_Run
)
-
1
)]])
Qm3SdSim
<-
OutputsSD
$
Qsim
*
sum
(
InputsModel
$
BasinAreas
,
na.rm
=
TRUE
)
*
1e3
Qm3UpstLagObs
<-
c
(
0
,
InputsModel
$
Qupstream
[
Ind_Run
[
1
:
(
length
(
Ind_Run
)
-
1
)]])
expect_equal
(
Qm3SdSim
-
Qm3GR4Only
,
Qm3UpstLagObs
)
})
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment