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
f8cd6e3b
Commit
f8cd6e3b
authored
Oct 25, 2016
by
unknown
Browse files
Code simplification for the "Calibration_Michel" function
parent
b5e51b81
Changes
1
Hide whitespace changes
Inline
Side-by-side
R/Calibration_Michel.R
View file @
f8cd6e3b
...
...
@@ -94,10 +94,11 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU
##Creation_of_new_candidates_______________________________________________
OptimParam
<-
is.na
(
CalibOptions
$
FixedParam
)
if
(
PrefilteringType
==
1
){
CandidatesParamR
<-
CalibOptions
$
StartParamList
;
}
if
(
PrefilteringType
==
2
){
DistribParamR
<-
CalibOptions
$
StartParamDistrib
;
DistribParamR
[,
!
CalibOptions
$
OptimParam
]
<-
NA
;
CandidatesParamR
<-
ProposeCandidatesGrid
(
DistribParamR
)
$
NewCandidates
;
}
if
(
PrefilteringType
==
2
){
DistribParamR
<-
CalibOptions
$
StartParamDistrib
;
DistribParamR
[,
!
OptimParam
]
<-
NA
;
CandidatesParamR
<-
ProposeCandidatesGrid
(
DistribParamR
)
$
NewCandidates
;
}
##Remplacement_of_non_optimised_values_____________________________________
CandidatesParamR
<-
apply
(
CandidatesParamR
,
1
,
function
(
x
){
x
[
!
CalibOptions
$
OptimParam
]
<-
CalibOptions
$
FixedParam
[
!
CalibOptions
$
OptimParam
];
return
(
x
);
});
CandidatesParamR
<-
apply
(
CandidatesParamR
,
1
,
function
(
x
){
x
[
!
OptimParam
]
<-
CalibOptions
$
FixedParam
[
!
OptimParam
];
return
(
x
);
});
if
(
NParam
>
1
){
CandidatesParamR
<-
t
(
CandidatesParamR
);
}
else
{
CandidatesParamR
<-
cbind
(
CandidatesParamR
);
}
##Loop_to_test_the_various_candidates______________________________________
...
...
@@ -214,10 +215,10 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU
##Creation_of_new_candidates______________________________________________
CandidatesParamT
<-
ProposeCandidatesLoc
(
NewParamOptimT
,
OldParamOptimT
,
RangesT
,
CalibOptions
$
OptimParam
,
Pace
)
$
NewCandidatesT
;
CandidatesParamT
<-
ProposeCandidatesLoc
(
NewParamOptimT
,
OldParamOptimT
,
RangesT
,
OptimParam
,
Pace
)
$
NewCandidatesT
;
CandidatesParamR
<-
FUN_TRANSFO
(
CandidatesParamT
,
"TR"
);
##Remplacement_of_non_optimised_values_____________________________________
CandidatesParamR
<-
apply
(
CandidatesParamR
,
1
,
function
(
x
){
x
[
!
CalibOptions
$
OptimParam
]
<-
CalibOptions
$
FixedParam
[
!
CalibOptions
$
OptimParam
];
return
(
x
);
});
CandidatesParamR
<-
apply
(
CandidatesParamR
,
1
,
function
(
x
){
x
[
!
OptimParam
]
<-
CalibOptions
$
FixedParam
[
!
OptimParam
];
return
(
x
);
});
if
(
NParam
>
1
){
CandidatesParamR
<-
t
(
CandidatesParamR
);
}
else
{
CandidatesParamR
<-
cbind
(
CandidatesParamR
);
}
...
...
@@ -250,7 +251,7 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU
}
##We_update_PaceDiag
VectPace
<-
NewParamOptimT
-
OldParamOptimT
;
for
(
iC
in
1
:
NParam
){
if
(
CalibOptions
$
OptimParam
[
iC
]
==
TRUE
){
for
(
iC
in
1
:
NParam
){
if
(
OptimParam
[
iC
]){
if
(
VectPace
[
iC
]
!=
0
){
PaceDiag
[
iC
]
<-
CLG
*
PaceDiag
[
iC
]
+
(
1
-
CLG
)
*
VectPace
[
iC
];
}
if
(
VectPace
[
iC
]
==
0
){
PaceDiag
[
iC
]
<-
CLG
*
PaceDiag
[
iC
];
}
}
}
...
...
@@ -268,7 +269,7 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU
iNewOptim
<-
0
;
iNew
<-
1
;
CandidatesParamT
<-
NewParamOptimT
+
PaceDiag
;
if
(
!
is.matrix
(
CandidatesParamT
)){
CandidatesParamT
<-
matrix
(
CandidatesParamT
,
nrow
=
1
);
}
##If_we_exit_the_range_of_possible_values_we_go_back_on_the_boundary
for
(
iC
in
1
:
NParam
){
if
(
CalibOptions
$
OptimParam
[
iC
]
==
TRUE
){
for
(
iC
in
1
:
NParam
){
if
(
OptimParam
[
iC
]){
if
(
CandidatesParamT
[
iNew
,
iC
]
<
RangesT
[
1
,
iC
]){
CandidatesParamT
[
iNew
,
iC
]
<-
RangesT
[
1
,
iC
];
}
if
(
CandidatesParamT
[
iNew
,
iC
]
>
RangesT
[
2
,
iC
]){
CandidatesParamT
[
iNew
,
iC
]
<-
RangesT
[
2
,
iC
];
}
}
}
...
...
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