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
67ce1ead
Commit
67ce1ead
authored
Jun 04, 2020
by
Dorchies David
Browse files
V1.6.1.16: refactor: use vectors for LengthHydro and BasinAreas instead of matrices
Refs
#34
parent
e974451b
Pipeline
#13361
passed with stages
in 11 minutes and 53 seconds
Changes
4
Pipelines
1
Hide whitespace changes
Inline
Side-by-side
DESCRIPTION
View file @
67ce1ead
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.6.1.1
5
Version: 1.6.1.1
6
Date: 2020-06-04
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
...
...
R/CreateInputsModel.R
View file @
67ce1ead
...
...
@@ -194,24 +194,21 @@ CreateInputsModel <- function(FUN_MOD,
if
(
!
(
"daily"
%in%
ObjectClass
)
&
!
(
"hourly"
%in%
ObjectClass
))
{
stop
(
"Only daily and hourly time steps can be used in a semi-distributed mode"
)
}
if
(
!
is.matrix
(
Qupstream
)
|
!
is.
matrix
(
LengthHydro
)
|
!
is.matrix
(
BasinA
rea
s
))
{
stop
(
"'Qupstream'
, 'LengthHydro' and 'BasinAreas'
must be matrice
s
of numeric values"
)
if
(
!
is.matrix
(
Qupstream
)
|
!
is.
numeric
(
Qupst
rea
m
))
{
stop
(
"'Qupstream' must be
a
matrice of numeric values"
)
}
if
(
!
is.
numeric
(
Qupst
rea
m
)
|
!
is.numeric
(
LengthHydro
)
|
!
is.numeric
(
BasinAreas
))
{
stop
(
"
'Qupstream',
'LengthHydro' and 'BasinAreas' must be
matrice
s of numeric values"
)
if
(
!
is.
vector
(
LengthHydro
)
|
!
is.vector
(
BasinA
rea
s
)
|
!
is.numeric
(
LengthHydro
)
|
!
is.numeric
(
BasinAreas
))
{
stop
(
"'LengthHydro' and 'BasinAreas' must be
vector
s of numeric values"
)
}
if
(
ncol
(
Qupstream
)
!=
ncol
(
LengthHydro
))
{
stop
(
"'Qupstream'
and 'LengthHydro' must have the same number of columns
"
)
if
(
ncol
(
Qupstream
)
!=
length
(
LengthHydro
))
{
stop
(
"'Qupstream'
number of columns and 'LengthHydro' length must be equal
"
)
}
if
(
ncol
(
Qupstream
)
+1
!=
ncol
(
BasinAreas
))
{
stop
(
"'BasinAreas' must have one
column more than 'Qupstream'
an
d
'LengthHydro'"
)
if
(
length
(
LengthHydro
)
+
1
!=
length
(
BasinAreas
))
{
stop
(
"'BasinAreas' must have one
more element th
an 'LengthHydro'"
)
}
if
(
nrow
(
Qupstream
)
!=
LLL
)
{
stop
(
"'Qupstream' must have same number of rows as 'DatesR' length"
)
}
if
(
nrow
(
LengthHydro
)
!=
1
|
nrow
(
BasinAreas
)
!=
1
)
{
stop
(
"'LengthHydro' and 'BasinAreas' must have only one row"
)
}
if
(
any
(
is.na
(
Qupstream
)))
{
stop
(
"'Qupstream' cannot contain any NA value"
)
}
...
...
R/RunModel.R
View file @
67ce1ead
...
...
@@ -18,7 +18,7 @@ RunModel <- function (InputsModel, RunOptions, Param, FUN_MOD) {
AreaTot
<-
sum
(
InputsModel
$
BasinAreas
)
# propagation time from upstream meshes to outlet
PT
<-
InputsModel
$
LengthHydro
[
1
,
]
/
Param
[
length
(
Param
)]
/
TimeStep
PT
<-
InputsModel
$
LengthHydro
/
Param
[
length
(
Param
)]
/
TimeStep
HUTRANS
<-
rbind
(
1
-
(
PT
-
floor
(
PT
)),
PT
-
floor
(
PT
))
NbUpBasins
<-
length
(
InputsModel
$
LengthHydro
)
...
...
tests/testthat/test-RunModel_LAG.R
View file @
67ce1ead
...
...
@@ -3,7 +3,7 @@ context("RunModel_LAG")
data
(
L0123001
)
test_that
(
"'BasinAreas' must have one
column more than 'Qupstream'
an
d
'LengthHydro'"
,
{
test_that
(
"'BasinAreas' must have one
more element th
an 'LengthHydro'"
,
{
expect_error
(
InputsModel
<-
CreateInputsModel
(
FUN_MOD
=
RunModel_GR4J
,
...
...
@@ -11,14 +11,14 @@ test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHy
Precip
=
BasinObs
$
P
,
PotEvap
=
BasinObs
$
E
,
Qupstream
=
matrix
(
BasinObs
$
Qmm
,
ncol
=
1
),
LengthHydro
=
matrix
(
c
(
1
),
nrow
=
1
)
,
BasinAreas
=
matrix
(
c
(
1
),
nrow
=
1
)
LengthHydro
=
1
,
BasinAreas
=
1
),
regexp
=
"'BasinAreas' must have one
column more than 'Qupstream'
an
d
'LengthHydro'"
regexp
=
"'BasinAreas' must have one
more element th
an 'LengthHydro'"
)
})
test_that
(
"'
BasinA
rea
s
'
must have one column more than 'Qupstream' and 'LengthHydro'
"
,
{
test_that
(
"'
Qupst
rea
m
'
cannot contain any NA value
"
,
{
expect_error
(
InputsModel
<-
CreateInputsModel
(
FUN_MOD
=
RunModel_GR4J
,
...
...
@@ -26,8 +26,8 @@ test_that("'BasinAreas' must have one column more than 'Qupstream' and 'LengthHy
Precip
=
BasinObs
$
P
,
PotEvap
=
BasinObs
$
E
,
Qupstream
=
matrix
(
BasinObs
$
Qmm
,
ncol
=
1
),
LengthHydro
=
matrix
(
c
(
1
),
nrow
=
1
)
,
BasinAreas
=
matrix
(
c
(
1
,
2
),
nrow
=
1
)
LengthHydro
=
1
,
BasinAreas
=
c
(
1
,
2
)
),
regexp
=
"'Qupstream' cannot contain any NA value"
)
...
...
@@ -42,10 +42,8 @@ InputsModel <- CreateInputsModel(
Precip
=
BasinObs
$
P
,
PotEvap
=
BasinObs
$
E
,
Qupstream
=
matrix
(
Qupstream
,
ncol
=
1
),
LengthHydro
=
matrix
(
c
(
1000
),
nrow
=
1
),
BasinAreas
=
matrix
(
c
(
BasinInfo
$
BasinArea
*
2
,
BasinInfo
$
BasinArea
),
nrow
=
1
)
LengthHydro
=
1000
,
BasinAreas
=
c
(
BasinInfo
$
BasinArea
*
2
,
BasinInfo
$
BasinArea
)
)
Ind_Run
<-
seq
(
which
(
format
(
BasinObs
$
DatesR
,
format
=
"%Y-%m-%d"
)
==
"1990-01-01"
),
...
...
@@ -64,15 +62,15 @@ OutputsGR4JOnly <-
test_that
(
"Upstream basin with nil area should return same Qdown as GR4J alone"
,
{
UpstBasinArea
=
InputsModel
$
BasinAreas
[
1
,
1
]
InputsModel
$
BasinAreas
[
1
,
1
]
<<-
0
UpstBasinArea
=
InputsModel
$
BasinAreas
[
1
]
InputsModel
$
BasinAreas
[
1
]
<<-
0
OutputsSD
<-
RunModel
(
InputsModel
,
RunOptions
,
Param
=
c
(
Param
,
1
),
FUN_MOD
=
RunModel_GR4J
)
expect_equal
(
OutputsGR4JOnly
$
Qsim
,
OutputsSD
$
Qsim
)
InputsModel
$
BasinAreas
[
1
,
1
]
<<-
UpstBasinArea
InputsModel
$
BasinAreas
[
1
]
<<-
UpstBasinArea
})
test_that
(
...
...
@@ -84,8 +82,8 @@ test_that(
Precip
=
BasinObs
$
P
,
PotEvap
=
BasinObs
$
E
,
Qupstream
=
matrix
(
Qupstream
,
ncol
=
1
),
LengthHydro
=
matrix
(
c
(
0
),
nrow
=
1
)
,
BasinAreas
=
matrix
(
c
(
BasinInfo
$
BasinArea
,
0
)
,
nrow
=
1
)
LengthHydro
=
0
,
BasinAreas
=
c
(
BasinInfo
$
BasinArea
,
0
)
)
OutputsSD
<-
RunModel
(
InputsModelZeroDown
,
...
...
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