Skip to content

GitLab

Commit 9c6d0581 authored by unknown's avatar unknown
Browse files

#4434 ErrorCrit gains a wrinings argument and the verbose argument print the criteria value

parent 09c95221
Hide whitespace changes
Inline Side-by-side
R/Calibration_Michel.R
View file @ 9c6d0581
...@@ -117,7 +117,7 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU ...@@ -117,7 +117,7 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU
Param <- CandidatesParamR[iNew,]; Param <- CandidatesParamR[iNew,];
OutputsModel <- FUN_MOD(InputsModel,RunOptions,Param); OutputsModel <- FUN_MOD(InputsModel,RunOptions,Param);
##Calibration_criterion_computation ##Calibration_criterion_computation
OutputsCrit <- FUN_CRIT(InputsCrit,OutputsModel); OutputsCrit <- FUN_CRIT(InputsCrit,OutputsModel, verbose = FALSE);
if(!is.na(OutputsCrit$CritValue)){ if(OutputsCrit$CritValue*OutputsCrit$Multiplier < CritOptim){ if(!is.na(OutputsCrit$CritValue)){ if(OutputsCrit$CritValue*OutputsCrit$Multiplier < CritOptim){
CritOptim <- OutputsCrit$CritValue*OutputsCrit$Multiplier; CritOptim <- OutputsCrit$CritValue*OutputsCrit$Multiplier;
iNewOptim <- iNew; iNewOptim <- iNew;
...@@ -229,7 +229,7 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU ...@@ -229,7 +229,7 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU
Param <- CandidatesParamR[iNew,]; Param <- CandidatesParamR[iNew,];
OutputsModel <- FUN_MOD(InputsModel,RunOptions,Param); OutputsModel <- FUN_MOD(InputsModel,RunOptions,Param);
##Calibration_criterion_computation ##Calibration_criterion_computation
OutputsCrit <- FUN_CRIT(InputsCrit,OutputsModel); OutputsCrit <- FUN_CRIT(InputsCrit,OutputsModel, verbose = FALSE);
if(!is.na(OutputsCrit$CritValue)){ if(OutputsCrit$CritValue*OutputsCrit$Multiplier < CritOptim){ if(!is.na(OutputsCrit$CritValue)){ if(OutputsCrit$CritValue*OutputsCrit$Multiplier < CritOptim){
CritOptim <- OutputsCrit$CritValue*OutputsCrit$Multiplier; CritOptim <- OutputsCrit$CritValue*OutputsCrit$Multiplier;
iNewOptim <- iNew; iNewOptim <- iNew;
...@@ -278,7 +278,7 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU ...@@ -278,7 +278,7 @@ Calibration_Michel <- function(InputsModel,RunOptions,InputsCrit,CalibOptions,FU
Param <- CandidatesParamR[iNew,]; Param <- CandidatesParamR[iNew,];
OutputsModel <- FUN_MOD(InputsModel,RunOptions,Param); OutputsModel <- FUN_MOD(InputsModel,RunOptions,Param);
##Calibration_criterion_computation ##Calibration_criterion_computation
OutputsCrit <- FUN_CRIT(InputsCrit,OutputsModel); OutputsCrit <- FUN_CRIT(InputsCrit,OutputsModel, verbose = FALSE);
if(OutputsCrit$CritValue*OutputsCrit$Multiplier < CritOptim){ if(OutputsCrit$CritValue*OutputsCrit$Multiplier < CritOptim){
CritOptim <- OutputsCrit$CritValue*OutputsCrit$Multiplier; CritOptim <- OutputsCrit$CritValue*OutputsCrit$Multiplier;
iNewOptim <- iNew; iNewOptim <- iNew;
......
R/ErrorCrit.R
View file @ 9c6d0581
ErrorCrit <- function(InputsCrit,OutputsModel,FUN_CRIT, verbose = TRUE){ ErrorCrit <- function(InputsCrit,OutputsModel,FUN_CRIT, warnings = TRUE, verbose = TRUE){
return( FUN_CRIT(InputsCrit,OutputsModel, verbose = verbose) ) return( FUN_CRIT(InputsCrit,OutputsModel, warnings = warnings, verbose = verbose) )
} }
R/ErrorCrit_KGE.R
View file @ 9c6d0581
ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, warnings = TRUE, verbose = TRUE){
##Arguments_check________________________________ ##Arguments_check________________________________
...@@ -44,7 +44,7 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -44,7 +44,7 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){
if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; } if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; }
if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; } if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; }
if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; } if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; }
if(sum(!TS_ignore)<WarningTS & verbose){ warning(paste("\t criterion computed on less than ",WarningTS," time-steps \n",sep="")); } if(sum(!TS_ignore)<WarningTS & warnings){ warning("\t criterion computed on less than ", WarningTS, " time-steps ") }
##Other_variables_preparation ##Other_variables_preparation
meanVarObs <- mean(VarObs[!TS_ignore]); meanVarObs <- mean(VarObs[!TS_ignore]);
meanVarSim <- mean(VarSim[!TS_ignore]); meanVarSim <- mean(VarSim[!TS_ignore]);
...@@ -56,7 +56,7 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -56,7 +56,7 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){
##SubErrorCrit_____KGE_rPearson__________________ ##SubErrorCrit_____KGE_rPearson__________________
iCrit <- iCrit+1; iCrit <- iCrit+1;
SubCritNames[iCrit] <- paste(CritName," rPEARSON(sim vs. obs)",sep=""); SubCritNames[iCrit] <- paste(CritName," cor(sim, obs, \"pearson\") =", sep = "")
SubCritValues[iCrit] <- NA; SubCritValues[iCrit] <- NA;
Numer <- sum( (VarObs[!TS_ignore]-meanVarObs)*(VarSim[!TS_ignore]-meanVarSim) ); Numer <- sum( (VarObs[!TS_ignore]-meanVarObs)*(VarSim[!TS_ignore]-meanVarSim) );
Deno1 <- sqrt( sum((VarObs[!TS_ignore]-meanVarObs)^2) ); Deno1 <- sqrt( sum((VarObs[!TS_ignore]-meanVarObs)^2) );
...@@ -68,7 +68,7 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -68,7 +68,7 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){
##SubErrorCrit_____KGE_alpha_____________________ ##SubErrorCrit_____KGE_alpha_____________________
iCrit <- iCrit+1; iCrit <- iCrit+1;
SubCritNames[iCrit] <- paste(CritName," STDEVsim/STDEVobs",sep=""); SubCritNames[iCrit] <- paste(CritName," sd(sim)/sd(obs) =", sep = "")
SubCritValues[iCrit] <- NA; SubCritValues[iCrit] <- NA;
Numer <- sd(VarSim[!TS_ignore]); Numer <- sd(VarSim[!TS_ignore]);
Denom <- sd(VarObs[!TS_ignore]); Denom <- sd(VarObs[!TS_ignore]);
...@@ -78,11 +78,11 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -78,11 +78,11 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){
##SubErrorCrit_____KGE_beta______________________ ##SubErrorCrit_____KGE_beta______________________
iCrit <- iCrit+1; iCrit <- iCrit+1;
SubCritNames[iCrit] <- paste(CritName," MEANsim/MEANobs",sep=""); SubCritNames[iCrit] <- paste(CritName," mean(sim)/mean(obs) =", sep = "")
SubCritValues[iCrit] <- NA; SubCritValues[iCrit] <- NA;
if(meanVarSim==0 & meanVarObs==0){ Crit <- 1; } else { Crit <- meanVarSim/meanVarObs ; } if(meanVarSim==0 & meanVarObs==0){ Crit <- 1; } else { Crit <- meanVarSim/meanVarObs ; }
if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; } if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; }
##ErrorCrit______________________________________ ##ErrorCrit______________________________________
if(sum(is.na(SubCritValues))==0){ if(sum(is.na(SubCritValues))==0){
...@@ -90,10 +90,18 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -90,10 +90,18 @@ ErrorCrit_KGE <- function(InputsCrit,OutputsModel, verbose = TRUE){
} }
##Verbose______________________________________
if(verbose) {
message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue))
message(paste("\tSubCrit.", SubCritNames, sprintf("%.4f", SubCritValues), "\n", sep = " "))
}
##Output_________________________________________ ##Output_________________________________________
OutputsCrit <- list(CritValue,CritName,SubCritValues,SubCritNames,CritBestValue,Multiplier,Ind_TS_ignore); OutputsCrit <- list(CritValue = CritValue, CritName = CritName,
names(OutputsCrit) <- c("CritValue","CritName","SubCritValues","SubCritNames","CritBestValue","Multiplier","Ind_notcomputed"); SubCritValues = SubCritValues, SubCritNames = SubCritNames, CritBestValue = CritBestValue,
return(OutputsCrit); Multiplier = Multiplier, Ind_notcomputed = Ind_TS_ignore)
return(OutputsCrit)
} }
......
R/ErrorCrit_KGE2.R
View file @ 9c6d0581
ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, verbose = TRUE){ ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, warnings = TRUE, verbose = TRUE){
##Arguments_check________________________________ ##Arguments_check________________________________
...@@ -44,7 +44,7 @@ ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -44,7 +44,7 @@ ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, verbose = TRUE){
if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; } if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; }
if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; } if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; }
if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; } if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; }
if(sum(!TS_ignore)<WarningTS & verbose){ warning(paste("\t criterion computed on less than ",WarningTS," time-steps \n",sep="")); } if(sum(!TS_ignore)<WarningTS & warnings){ warning("\t criterion computed on less than ", WarningTS, " time-steps") }
##Other_variables_preparation ##Other_variables_preparation
meanVarObs <- mean(VarObs[!TS_ignore]); meanVarObs <- mean(VarObs[!TS_ignore]);
meanVarSim <- mean(VarSim[!TS_ignore]); meanVarSim <- mean(VarSim[!TS_ignore]);
...@@ -55,7 +55,7 @@ ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -55,7 +55,7 @@ ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, verbose = TRUE){
##SubErrorCrit_____KGE_rPearson__________________ ##SubErrorCrit_____KGE_rPearson__________________
iCrit <- iCrit+1; iCrit <- iCrit+1;
SubCritNames[iCrit] <- paste(CritName," rPEARSON(sim vs. obs)",sep=""); SubCritNames[iCrit] <- paste(CritName," cor(sim, obs, \"pearson\") =", sep = "")
SubCritValues[iCrit] <- NA; SubCritValues[iCrit] <- NA;
Numer <- sum( (VarObs[!TS_ignore]-meanVarObs)*(VarSim[!TS_ignore]-meanVarSim) ); Numer <- sum( (VarObs[!TS_ignore]-meanVarObs)*(VarSim[!TS_ignore]-meanVarSim) );
Deno1 <- sqrt( sum((VarObs[!TS_ignore]-meanVarObs)^2) ); Deno1 <- sqrt( sum((VarObs[!TS_ignore]-meanVarObs)^2) );
...@@ -67,7 +67,7 @@ ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -67,7 +67,7 @@ ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, verbose = TRUE){
##SubErrorCrit_____KGE_gama______________________ ##SubErrorCrit_____KGE_gama______________________
iCrit <- iCrit+1; iCrit <- iCrit+1;
SubCritNames[iCrit] <- paste(CritName," CVsim/CVobs",sep=""); SubCritNames[iCrit] <- paste(CritName," sd(sim)/sd(obs) =", sep = "")
SubCritValues[iCrit] <- NA; SubCritValues[iCrit] <- NA;
if(meanVarSim==0){ if(sd(VarSim[!TS_ignore])==0){ CVsim <- 1; } else { CVsim <- 99999; } } else { CVsim <- sd(VarSim[!TS_ignore])/meanVarSim; } if(meanVarSim==0){ if(sd(VarSim[!TS_ignore])==0){ CVsim <- 1; } else { CVsim <- 99999; } } else { CVsim <- sd(VarSim[!TS_ignore])/meanVarSim; }
if(meanVarObs==0){ if(sd(VarObs[!TS_ignore])==0){ CVobs <- 1; } else { CVobs <- 99999; } } else { CVobs <- sd(VarObs[!TS_ignore])/meanVarObs; } if(meanVarObs==0){ if(sd(VarObs[!TS_ignore])==0){ CVobs <- 1; } else { CVobs <- 99999; } } else { CVobs <- sd(VarObs[!TS_ignore])/meanVarObs; }
...@@ -77,22 +77,30 @@ ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -77,22 +77,30 @@ ErrorCrit_KGE2 <- function(InputsCrit,OutputsModel, verbose = TRUE){
##SubErrorCrit_____KGE_beta______________________ ##SubErrorCrit_____KGE_beta______________________
iCrit <- iCrit+1; iCrit <- iCrit+1;
SubCritNames[iCrit] <- paste(CritName," MEANsim/MEANobs",sep=""); SubCritNames[iCrit] <- paste(CritName," mean(sim)/mean(obs) =", sep = "")
SubCritValues[iCrit] <- NA; SubCritValues[iCrit] <- NA;
if(meanVarSim==0 & meanVarObs==0){ Crit <- 1; } else { Crit <- meanVarSim/meanVarObs ; } if(meanVarSim==0 & meanVarObs==0){ Crit <- 1; } else { Crit <- meanVarSim/meanVarObs ; }
if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; } if(is.numeric(Crit) & is.finite(Crit)){ SubCritValues[iCrit] <- Crit; }
##ErrorCrit______________________________________ ##ErrorCrit______________________________________
if(sum(is.na(SubCritValues))==0){ if(sum(is.na(SubCritValues))==0){
CritValue <- ( 1 - sqrt( (SubCritValues[1]-1)^2 + (SubCritValues[2]-1)^2 + (SubCritValues[3]-1)^2 ) ); CritValue <- ( 1 - sqrt( (SubCritValues[1]-1)^2 + (SubCritValues[2]-1)^2 + (SubCritValues[3]-1)^2 ) );
} }
##Verbose______________________________________
if(verbose) {
message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue))
message(paste("\tSubCrit.", SubCritNames, sprintf("%.4f", SubCritValues), "\n", sep = " "))
}
##Output_________________________________________ ##Output_________________________________________
OutputsCrit <- list(CritValue,CritName,SubCritValues,SubCritNames,CritBestValue,Multiplier,Ind_TS_ignore); OutputsCrit <- list(CritValue = CritValue, CritName = CritName,
names(OutputsCrit) <- c("CritValue","CritName","SubCritValues","SubCritNames","CritBestValue","Multiplier","Ind_notcomputed"); SubCritValues = SubCritValues, SubCritNames = SubCritNames, CritBestValue = CritBestValue,
return(OutputsCrit); Multiplier = Multiplier, Ind_notcomputed = Ind_TS_ignore)
return(OutputsCrit)
} }
......
R/ErrorCrit_NSE.R
View file @ 9c6d0581
ErrorCrit_NSE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ErrorCrit_NSE <- function(InputsCrit,OutputsModel, warnings = TRUE, verbose = TRUE){
##Arguments_check________________________________ ##Arguments_check________________________________
...@@ -43,12 +43,12 @@ ErrorCrit_NSE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -43,12 +43,12 @@ ErrorCrit_NSE <- function(InputsCrit,OutputsModel, verbose = TRUE){
if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; } if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; }
if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; } if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; }
if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; } if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; }
if(sum(!TS_ignore)<WarningTS & verbose){ warning(paste("\t criterion computed on less than ",WarningTS," time-steps \n",sep="")); } if(sum(!TS_ignore)<WarningTS & warnings){ warning("\t criterion computed on less than ", WarningTS, " time-steps") }
##Other_variables_preparation ##Other_variables_preparation
meanVarObs <- mean(VarObs[!TS_ignore]); meanVarObs <- mean(VarObs[!TS_ignore]);
meanVarSim <- mean(VarSim[!TS_ignore]); meanVarSim <- mean(VarSim[!TS_ignore]);
##ErrorCrit______________________________________ ##ErrorCrit______________________________________
Emod <- sum((VarSim[!TS_ignore]-VarObs[!TS_ignore])^2); Emod <- sum((VarSim[!TS_ignore]-VarObs[!TS_ignore])^2);
Eref <- sum((VarObs[!TS_ignore]-mean(VarObs[!TS_ignore]))^2); Eref <- sum((VarObs[!TS_ignore]-mean(VarObs[!TS_ignore]))^2);
...@@ -56,10 +56,17 @@ ErrorCrit_NSE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -56,10 +56,17 @@ ErrorCrit_NSE <- function(InputsCrit,OutputsModel, verbose = TRUE){
if(is.numeric(Crit) & is.finite(Crit)){ CritValue <- Crit; } if(is.numeric(Crit) & is.finite(Crit)){ CritValue <- Crit; }
##Verbose______________________________________
if(verbose) {
message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue))
}
##Output_________________________________________ ##Output_________________________________________
OutputsCrit <- list(CritValue,CritName,CritBestValue,Multiplier,Ind_TS_ignore); OutputsCrit <- list(CritValue = CritValue, CritName = CritName,
names(OutputsCrit) <- c("CritValue","CritName","CritBestValue","Multiplier","Ind_notcomputed"); CritBestValue = CritBestValue,
return(OutputsCrit); Multiplier = Multiplier, Ind_notcomputed = Ind_TS_ignore)
return(OutputsCrit)
} }
......
R/ErrorCrit_RMSE.R
View file @ 9c6d0581
ErrorCrit_RMSE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ErrorCrit_RMSE <- function(InputsCrit,OutputsModel, warnings = TRUE, verbose = TRUE){
##Arguments_check________________________________ ##Arguments_check________________________________
...@@ -44,20 +44,26 @@ ErrorCrit_RMSE <- function(InputsCrit,OutputsModel, verbose = TRUE){ ...@@ -44,20 +44,26 @@ ErrorCrit_RMSE <- function(InputsCrit,OutputsModel, verbose = TRUE){
if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; } if(inherits(OutputsModel,"daily" )){ WarningTS <- 365; }
if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; } if(inherits(OutputsModel,"monthly")){ WarningTS <- 12; }
if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; } if(inherits(OutputsModel,"yearly" )){ WarningTS <- 3; }
if(sum(!TS_ignore)<WarningTS & verbose){ warning(paste("\t criterion computed on less than ",WarningTS," time-steps \n",sep="")); } if(sum(!TS_ignore)<WarningTS & warnings){ warning("\t criterion computed on less than ", WarningTS, " time-steps") }
##ErrorCrit______________________________________ ##ErrorCrit______________________________________
Numer <- sum((VarSim-VarObs)^2,na.rm=TRUE); Numer <- sum((VarSim-VarObs)^2,na.rm=TRUE);
Denom <- sum(!is.na(VarObs)); Denom <- sum(!is.na(VarObs));
if(Numer==0){ Crit <- 0; } else { Crit <- sqrt(Numer/Denom); } if(Numer==0){ Crit <- 0; } else { Crit <- sqrt(Numer/Denom); }
if(is.numeric(Crit) & is.finite(Crit)){ CritValue <- Crit; } if(is.numeric(Crit) & is.finite(Crit)){ CritValue <- Crit; }
##Verbose______________________________________
if(verbose) {
message("Crit. ", CritName, " = ", sprintf("%.4f", CritValue))
}
##Output_________________________________________ ##Output_________________________________________
OutputsCrit <- list(CritValue,CritName,CritBestValue,Multiplier,Ind_TS_ignore); OutputsCrit <- list(CritValue = CritValue, CritName = CritName, CritBestValue = CritBestValue,
names(OutputsCrit) <- c("CritValue","CritName","CritBestValue","Multiplier","Ind_notcomputed"); Multiplier = Multiplier, Ind_notcomputed = Ind_TS_ignore)
return(OutputsCrit); return(OutputsCrit)
} }
......
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