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
3f94e3e1
Commit
3f94e3e1
authored
Aug 29, 2018
by
Delaigue Olivier
Browse files
vv1.0.13.4 ErrorCrit_RMSE cleaned
parent
52e9d535
Changes
3
Hide whitespace changes
Inline
Side-by-side
DESCRIPTION
View file @
3f94e3e1
Package: airGR
Type: Package
Title: Suite of GR Hydrological Models for Precipitation-Runoff Modelling
Version: 1.0.13.
3
Version: 1.0.13.
4
Date: 2018-08-29
Authors@R: c(
person("Laurent", "Coron", role = c("aut", "trl"), comment = c(ORCID = "0000-0002-1503-6204")),
...
...
NEWS.rmd
View file @
3f94e3e1
...
...
@@ -14,7 +14,7 @@ output:
### 1.0.13.
3
Release Notes (2018-08-29)
### 1.0.13.
4
Release Notes (2018-08-29)
#### Deprectated and defunct
...
...
R/ErrorCrit_RMSE.R
View file @
3f94e3e1
ErrorCrit_RMSE
<-
function
(
InputsCrit
,
OutputsModel
,
warnings
=
TRUE
,
verbose
=
TRUE
){
##Arguments_check________________________________
if
(
inherits
(
InputsCrit
,
"InputsCrit"
)
==
FALSE
){
stop
(
"InputsCrit must be of class 'InputsCrit' \n"
);
return
(
NULL
);
}
if
(
inherits
(
OutputsModel
,
"OutputsModel"
)
==
FALSE
){
stop
(
"OutputsModel must be of class 'OutputsModel' \n"
);
return
(
NULL
);
}
##Initialisation_________________________________
CritName
<-
NA
;
if
(
InputsCrit
$
transfo
==
""
){
CritName
<-
"RMSE[Q]"
;
}
if
(
InputsCrit
$
transfo
==
"sqrt"
){
CritName
<-
"RMSE[sqrt(Q)]"
;
}
if
(
InputsCrit
$
transfo
==
"log"
){
CritName
<-
"RMSE[log(Q)]"
;
}
if
(
InputsCrit
$
transfo
==
"inv"
){
CritName
<-
"RMSE[1/Q]"
;
}
if
(
InputsCrit
$
transfo
==
"sort"
){
CritName
<-
"RMSE[sort(Q)]"
;
}
CritValue
<-
NA
;
CritBestValue
<-
+1
;
Multiplier
<-
+1
;
### must be equal to -1 or +1 only
##Data_preparation_______________________________
VarObs
<-
InputsCrit
$
Qobs
;
VarObs
[
!
InputsCrit
$
BoolCrit
]
<-
NA
;
VarSim
<-
OutputsModel
$
Qsim
;
VarSim
[
!
InputsCrit
$
BoolCrit
]
<-
NA
;
##Data_transformation
if
(
"Ind_zeroes"
%in%
names
(
InputsCrit
)
&
"epsilon"
%in%
names
(
InputsCrit
)){
if
(
length
(
InputsCrit
$
Ind_zeroes
)
>
0
){
VarObs
<-
VarObs
+
InputsCrit
$
epsilon
;
VarSim
<-
VarSim
+
InputsCrit
$
epsilon
;
}
}
if
(
InputsCrit
$
transfo
==
"sqrt"
){
VarObs
<-
sqrt
(
VarObs
);
VarSim
<-
sqrt
(
VarSim
);
}
if
(
InputsCrit
$
transfo
==
"log"
){
VarObs
<-
log
(
VarObs
)
;
VarSim
<-
log
(
VarSim
)
;
VarSim
[
VarSim
<
-1E100
]
<-
NA
;
}
if
(
InputsCrit
$
transfo
==
"inv"
){
VarObs
<-
1
/
VarObs
;
VarSim
<-
1
/
VarSim
;
VarSim
[
abs
(
VarSim
)
>
1E+100
]
<-
NA
;
}
if
(
InputsCrit
$
transfo
==
"sort"
){
VarSim
[
is.na
(
VarObs
)]
<-
NA
VarSim
<-
sort
(
VarSim
,
na.last
=
TRUE
)
VarObs
<-
sort
(
VarObs
,
na.last
=
TRUE
)
InputsCrit
$
BoolCrit
<-
sort
(
InputsCrit
$
BoolCrit
,
decreasing
=
TRUE
)
ErrorCrit_RMSE
<-
function
(
InputsCrit
,
OutputsModel
,
warnings
=
TRUE
,
verbose
=
TRUE
)
{
##Arguments_check________________________________
if
(
inherits
(
InputsCrit
,
"InputsCrit"
)
==
FALSE
)
{
stop
(
"InputsCrit must be of class 'InputsCrit' \n"
)
return
(
NULL
)
}
if
(
inherits
(
OutputsModel
,
"OutputsModel"
)
==
FALSE
)
{
stop
(
"OutputsModel must be of class 'OutputsModel' \n"
)
return
(
NULL
)
}
##Initialisation_________________________________
CritName
<-
NA
if
(
InputsCrit
$
transfo
==
""
)
{
CritName
<-
"RMSE[Q]"
}
if
(
InputsCrit
$
transfo
==
"sqrt"
)
{
CritName
<-
"RMSE[sqrt(Q)]"
}
if
(
InputsCrit
$
transfo
==
"log"
)
{
CritName
<-
"RMSE[log(Q)]"
}
if
(
InputsCrit
$
transfo
==
"inv"
)
{
CritName
<-
"RMSE[1/Q]"
}
if
(
InputsCrit
$
transfo
==
"sort"
)
{
CritName
<-
"RMSE[sort(Q)]"
}
CritValue
<-
NA
CritBestValue
<-
+1
Multiplier
<-
+1
### must be equal to -1 or +1 only
##Data_preparation_______________________________
VarObs
<-
InputsCrit
$
Qobs
VarObs
[
!
InputsCrit
$
BoolCrit
]
<-
NA
VarSim
<-
OutputsModel
$
Qsim
VarSim
[
!
InputsCrit
$
BoolCrit
]
<-
NA
##Data_transformation
if
(
"Ind_zeroes"
%in%
names
(
InputsCrit
)
&
"epsilon"
%in%
names
(
InputsCrit
))
{
if
(
length
(
InputsCrit
$
Ind_zeroes
)
>
0
)
{
VarObs
<-
VarObs
+
InputsCrit
$
epsilon
VarSim
<-
VarSim
+
InputsCrit
$
epsilon
}
}
if
(
InputsCrit
$
transfo
==
"sqrt"
)
{
VarObs
<-
sqrt
(
VarObs
)
VarSim
<-
sqrt
(
VarSim
)
}
if
(
InputsCrit
$
transfo
==
"log"
)
{
VarObs
<-
log
(
VarObs
)
VarSim
<-
log
(
VarSim
)
VarSim
[
VarSim
<
-1e100
]
<-
NA
}
if
(
InputsCrit
$
transfo
==
"inv"
)
{
VarObs
<-
1
/
VarObs
VarSim
<-
1
/
VarSim
VarSim
[
abs
(
VarSim
)
>
1e+100
]
<-
NA
}
if
(
InputsCrit
$
transfo
==
"sort"
)
{
VarSim
[
is.na
(
VarObs
)]
<-
NA
VarSim
<-
sort
(
VarSim
,
na.last
=
TRUE
)
VarObs
<-
sort
(
VarObs
,
na.last
=
TRUE
)
InputsCrit
$
BoolCrit
<-
sort
(
InputsCrit
$
BoolCrit
,
decreasing
=
TRUE
)
}
##TS_ignore
TS_ignore
<-
!
is.finite
(
VarObs
)
|
!
is.finite
(
VarSim
)
|
!
InputsCrit
$
BoolCrit
Ind_TS_ignore
<-
which
(
TS_ignore
)
if
(
length
(
Ind_TS_ignore
)
==
0
)
{
Ind_TS_ignore
<-
NULL
}
if
(
sum
(
!
TS_ignore
)
==
0
)
{
OutputsCrit
<-
list
(
NA
)
names
(
OutputsCrit
)
<-
c
(
"CritValue"
)
return
(
OutputsCrit
)
}
if
(
inherits
(
OutputsModel
,
"hourly"
))
{
WarningTS
<-
365
}
if
(
inherits
(
OutputsModel
,
"daily"
))
{
WarningTS
<-
365
}
if
(
inherits
(
OutputsModel
,
"monthly"
))
{
WarningTS
<-
12
}
if
(
inherits
(
OutputsModel
,
"yearly"
))
{
WarningTS
<-
3
}
if
(
sum
(
!
TS_ignore
)
<
WarningTS
&
warnings
)
{
warning
(
"\t criterion computed on less than "
,
WarningTS
,
" time-steps"
)
}
##ErrorCrit______________________________________
Numer
<-
sum
((
VarSim
-
VarObs
)
^
2
,
na.rm
=
TRUE
)
Denom
<-
sum
(
!
is.na
(
VarObs
))
if
(
Numer
==
0
)
{
Crit
<-
0
}
else
{
Crit
<-
sqrt
(
Numer
/
Denom
)
}
if
(
is.numeric
(
Crit
)
&
is.finite
(
Crit
))
{
CritValue
<-
Crit
}
##Verbose______________________________________
if
(
verbose
)
{
message
(
"Crit. "
,
CritName
,
" = "
,
sprintf
(
"%.4f"
,
CritValue
))
}
##Output_________________________________________
OutputsCrit
<-
list
(
CritValue
=
CritValue
,
CritName
=
CritName
,
CritBestValue
=
CritBestValue
,
Multiplier
=
Multiplier
,
Ind_notcomputed
=
Ind_TS_ignore
)
return
(
OutputsCrit
)
}
##TS_ignore
TS_ignore
<-
!
is.finite
(
VarObs
)
|
!
is.finite
(
VarSim
)
|
!
InputsCrit
$
BoolCrit
;
Ind_TS_ignore
<-
which
(
TS_ignore
);
if
(
length
(
Ind_TS_ignore
)
==
0
){
Ind_TS_ignore
<-
NULL
;
}
if
(
sum
(
!
TS_ignore
)
==
0
){
OutputsCrit
<-
list
(
NA
);
names
(
OutputsCrit
)
<-
c
(
"CritValue"
);
return
(
OutputsCrit
);
}
if
(
inherits
(
OutputsModel
,
"hourly"
)){
WarningTS
<-
365
;
}
if
(
inherits
(
OutputsModel
,
"daily"
)){
WarningTS
<-
365
;
}
if
(
inherits
(
OutputsModel
,
"monthly"
)){
WarningTS
<-
12
;
}
if
(
inherits
(
OutputsModel
,
"yearly"
)){
WarningTS
<-
3
;
}
if
(
sum
(
!
TS_ignore
)
<
WarningTS
&
warnings
){
warning
(
"\t criterion computed on less than "
,
WarningTS
,
" time-steps"
)
}
##ErrorCrit______________________________________
Numer
<-
sum
((
VarSim
-
VarObs
)
^
2
,
na.rm
=
TRUE
);
Denom
<-
sum
(
!
is.na
(
VarObs
));
if
(
Numer
==
0
){
Crit
<-
0
;
}
else
{
Crit
<-
sqrt
(
Numer
/
Denom
);
}
if
(
is.numeric
(
Crit
)
&
is.finite
(
Crit
)){
CritValue
<-
Crit
;
}
##Verbose______________________________________
if
(
verbose
)
{
message
(
"Crit. "
,
CritName
,
" = "
,
sprintf
(
"%.4f"
,
CritValue
))
}
##Output_________________________________________
OutputsCrit
<-
list
(
CritValue
=
CritValue
,
CritName
=
CritName
,
CritBestValue
=
CritBestValue
,
Multiplier
=
Multiplier
,
Ind_notcomputed
=
Ind_TS_ignore
)
return
(
OutputsCrit
)
}
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