Skip to content
GitLab
Commit 0d1fc708 authored by unknown's avatar unknown
Browse files

#4445 CreateInputsModel() stop if NLayers <= 0

parent 3e9132b7
dev 115-add-pcict-date-format-managment 118-plot-outputsmodel-remove-case-sensitivity-to-the-which-argument 136-decreased-performance-of-calibration-execution-time 60-migrate-transfoparam-functions-and-createcaliboptions-to-s3-methods 96-parallelize-the-grid-screening-step-during-calibration airGRplus cleanAirGRplus master CRAN_v1.7.0 CRAN_v1.6.12 CRAN_v1.6.11 CRAN_v1.6.10.4 CRAN_v1.6.9.27 CRAN_v1.6.9.24 CRAN_v1.6.9.23 CRAN_v1.6.9.21 CRAN_v1.4.3.65 CRAN_v1.4.3.60 CRAN_v1.4.3.52 CRAN_v1.3.2.42 CRAN_v1.3.2.41 CRAN_v1.3.2.40 CRAN_v1.3.2.39 CRAN_v1.3.2.23 CRAN_v1.3.2.17 CRAN_v1.2.13.16 CRAN_v1.2.13.13 CRAN_v1.0.14.1 CRAN_v1.0.13.19 CRAN_v1.0.10.11 CRAN_v1.0.9.64 CRAN_v1.0.5.12 CRAN_v1.0.5.11 CRAN_v1.0.5.10
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Showing
with 83 additions and 71 deletions
+83 -71
R/CreateInputsModel.R
+ 83
− 71
View file @ 0d1fc708
CreateInputsModel <- function(FUN_MOD,DatesR,Precip,PotEvap=NULL,TempMean=NULL,TempMin=NULL,TempMax=NULL,ZInputs=NULL,HypsoData=NULL,NLayers=5, verbose = TRUE){ CreateInputsModel <- function(FUN_MOD,DatesR,Precip,PotEvap=NULL,TempMean=NULL,TempMin=NULL,TempMax=NULL,ZInputs=NULL,HypsoData=NULL,NLayers=5, verbose = TRUE) {
ObjectClass <- NULL; ObjectClass <- NULL
##check_FUN_MOD ##check_FUN_MOD
BOOL <- FALSE; BOOL <- FALSE
if(identical(FUN_MOD,RunModel_GR4H)){ if(identical(FUN_MOD,RunModel_GR4H)) {
ObjectClass <- c(ObjectClass,"hourly","GR"); ObjectClass <- c(ObjectClass,"hourly","GR");
TimeStep <- as.integer(60*60); TimeStep <- as.integer(60*60);
BOOL <- TRUE; BOOL <- TRUE
} }
if(identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_GR5J) | identical(FUN_MOD,RunModel_GR6J)){ if(identical(FUN_MOD,RunModel_GR4J) | identical(FUN_MOD,RunModel_GR5J) | identical(FUN_MOD,RunModel_GR6J)) {
ObjectClass <- c(ObjectClass,"daily","GR"); ObjectClass <- c(ObjectClass,"daily","GR");
TimeStep <- as.integer(24*60*60); TimeStep <- as.integer(24*60*60);
BOOL <- TRUE; BOOL <- TRUE
} }
if(identical(FUN_MOD,RunModel_GR2M)){ if(identical(FUN_MOD,RunModel_GR2M)) {
ObjectClass <- c(ObjectClass,"GR","monthly"); ObjectClass <- c(ObjectClass,"GR","monthly");
TimeStep <- as.integer(c(28,29,30,31)*24*60*60); TimeStep <- as.integer(c(28,29,30,31)*24*60*60);
BOOL <- TRUE; BOOL <- TRUE
} }
if(identical(FUN_MOD,RunModel_GR1A)){ if(identical(FUN_MOD,RunModel_GR1A)) {
ObjectClass <- c(ObjectClass,"GR","yearly"); ObjectClass <- c(ObjectClass,"GR","yearly");
TimeStep <- as.integer(c(365,366)*24*60*60); TimeStep <- as.integer(c(365,366)*24*60*60);
BOOL <- TRUE; BOOL <- TRUE
} }
if(identical(FUN_MOD,RunModel_CemaNeige)){ if(identical(FUN_MOD,RunModel_CemaNeige)) {
ObjectClass <- c(ObjectClass,"daily","CemaNeige"); ObjectClass <- c(ObjectClass,"daily","CemaNeige");
TimeStep <- as.integer(24*60*60); TimeStep <- as.integer(24*60*60);
BOOL <- TRUE; BOOL <- TRUE
} }
if(identical(FUN_MOD,RunModel_CemaNeigeGR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)){ if(identical(FUN_MOD,RunModel_CemaNeigeGR4J) | identical(FUN_MOD,RunModel_CemaNeigeGR5J) | identical(FUN_MOD,RunModel_CemaNeigeGR6J)) {
ObjectClass <- c(ObjectClass,"daily","GR","CemaNeige"); ObjectClass <- c(ObjectClass,"daily","GR","CemaNeige");
TimeStep <- as.integer(24*60*60); TimeStep <- as.integer(24*60*60);
BOOL <- TRUE; BOOL <- TRUE
} }
if(!BOOL){ stop("incorrect FUN_MOD for use in CreateInputsModel \n"); return(NULL); } if(!BOOL) {
stop("incorrect FUN_MOD for use in CreateInputsModel \n")
return(NULL)
}
##check_arguments ##check_arguments
if("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass){ if("GR" %in% ObjectClass | "CemaNeige" %in% ObjectClass) {
if(is.null(DatesR)){ stop("DatesR is missing \n"); return(NULL); } if(is.null(DatesR)) { stop("DatesR is missing \n"); return(NULL); }
if("POSIXlt" %in% class(DatesR) == FALSE & "POSIXct" %in% class(DatesR) == FALSE){ stop("DatesR must be defined as POSIXlt or POSIXct \n"); return(NULL); } if("POSIXlt" %in% class(DatesR) == FALSE & "POSIXct" %in% class(DatesR) == FALSE) { stop("DatesR must be defined as POSIXlt or POSIXct \n"); return(NULL); }
if("POSIXlt" %in% class(DatesR) == FALSE){ DatesR <- as.POSIXlt(DatesR); } if("POSIXlt" %in% class(DatesR) == FALSE) { DatesR <- as.POSIXlt(DatesR); }
if(difftime(tail(DatesR,1),tail(DatesR,2),units="secs")[[1]] %in% TimeStep==FALSE){ stop(paste("the time step of the model inputs must be ",TimeStep," seconds \n",sep="")); return(NULL); } if(difftime(tail(DatesR,1),tail(DatesR,2),units="secs")[[1]] %in% TimeStep==FALSE) { stop(paste("the time step of the model inputs must be ",TimeStep," seconds \n",sep="")); return(NULL); }
LLL <- length(DatesR); LLL <- length(DatesR);
} }
if("GR" %in% ObjectClass){ if("GR" %in% ObjectClass) {
if(is.null(Precip )){ stop("Precip is missing \n" ); return(NULL); } if(is.null(Precip )) { stop("Precip is missing \n" ); return(NULL); }
if(is.null(PotEvap )){ stop("PotEvap is missing \n" ); return(NULL); } if(is.null(PotEvap )) { stop("PotEvap is missing \n" ); return(NULL); }
if(!is.vector( Precip) | !is.vector( PotEvap)){ stop("Precip and PotEvap must be vectors of numeric values \n"); return(NULL); } if(!is.vector( Precip) | !is.vector( PotEvap)) { stop("Precip and PotEvap must be vectors of numeric values \n"); return(NULL); }
if(!is.numeric(Precip) | !is.numeric(PotEvap)){ stop("Precip and PotEvap must be vectors of numeric values \n"); return(NULL); } if(!is.numeric(Precip) | !is.numeric(PotEvap)) { stop("Precip and PotEvap must be vectors of numeric values \n"); return(NULL); }
if(length(Precip)!=LLL | length(PotEvap)!=LLL){ stop("Precip, PotEvap and DatesR must have the same length \n"); return(NULL); } if(length(Precip)!=LLL | length(PotEvap)!=LLL) { stop("Precip, PotEvap and DatesR must have the same length \n"); return(NULL); }
} }
if("CemaNeige" %in% ObjectClass){ if("CemaNeige" %in% ObjectClass) {
if(is.null(Precip )){ stop("Precip is missing \n" ); return(NULL); } if(is.null(Precip )) { stop("Precip is missing \n" ); return(NULL); }
if(is.null(TempMean)){ stop("TempMean is missing \n"); return(NULL); } if(is.null(TempMean)) { stop("TempMean is missing \n"); return(NULL); }
if(!is.vector( Precip) | !is.vector( TempMean)){ stop("Precip and TempMean must be vectors of numeric values \n"); return(NULL); } if(!is.vector( Precip) | !is.vector( TempMean)) { stop("Precip and TempMean must be vectors of numeric values \n"); return(NULL); }
if(!is.numeric(Precip) | !is.numeric(TempMean)){ stop("Precip and TempMean must be vectors of numeric values \n"); return(NULL); } if(!is.numeric(Precip) | !is.numeric(TempMean)) { stop("Precip and TempMean must be vectors of numeric values \n"); return(NULL); }
if(length(Precip)!=LLL | length(TempMean)!=LLL){ stop("Precip, TempMean and DatesR must have the same length \n"); return(NULL); } if(length(Precip)!=LLL | length(TempMean)!=LLL) { stop("Precip, TempMean and DatesR must have the same length \n"); return(NULL); }
if(is.null(TempMin)!=is.null(TempMax)){ stop("TempMin and TempMax must be both defined if not null \n"); return(NULL); } if(is.null(TempMin)!=is.null(TempMax)) { stop("TempMin and TempMax must be both defined if not null \n"); return(NULL); }
if(!is.null(TempMin) & !is.null(TempMax)){ if(!is.null(TempMin) & !is.null(TempMax)) {
if(!is.vector( TempMin) | !is.vector( TempMax)){ stop("TempMin and TempMax must be vectors of numeric values \n"); return(NULL); } if(!is.vector( TempMin) | !is.vector( TempMax)) { stop("TempMin and TempMax must be vectors of numeric values \n"); return(NULL); }
if(!is.numeric(TempMin) | !is.numeric(TempMax)){ stop("TempMin and TempMax must be vectors of numeric values \n"); return(NULL); } if(!is.numeric(TempMin) | !is.numeric(TempMax)) { stop("TempMin and TempMax must be vectors of numeric values \n"); return(NULL); }
if(length(TempMin)!=LLL | length(TempMax)!=LLL){ stop("TempMin, TempMax and DatesR must have the same length \n"); return(NULL); } if(length(TempMin)!=LLL | length(TempMax)!=LLL) { stop("TempMin, TempMax and DatesR must have the same length \n"); return(NULL); }
} }
if(!is.null(HypsoData)){ if(!is.null(HypsoData)) {
if(!is.vector( HypsoData)){ stop("HypsoData must be a vector of numeric values if not null \n"); return(NULL); } if(!is.vector( HypsoData)) { stop("HypsoData must be a vector of numeric values if not null \n"); return(NULL); }
if(!is.numeric(HypsoData)){ stop("HypsoData must be a vector of numeric values if not null \n"); return(NULL); } if(!is.numeric(HypsoData)) { stop("HypsoData must be a vector of numeric values if not null \n"); return(NULL); }
if(length(HypsoData)!=101){ stop("HypsoData must be of length 101 if not null \n"); return(NULL); } if(length(HypsoData)!=101) { stop("HypsoData must be of length 101 if not null \n"); return(NULL); }
if(sum(is.na(HypsoData))!=0 & sum(is.na(HypsoData))!=101){ stop("HypsoData must not contain any NA if not null \n"); return(NULL); } if(sum(is.na(HypsoData))!=0 & sum(is.na(HypsoData))!=101) { stop("HypsoData must not contain any NA if not null \n"); return(NULL); }
} }
if(!is.null(ZInputs)){ if(!is.null(ZInputs)) {
if(length(ZInputs)!=1 ){ stop("\t ZInputs must be a single numeric value if not null \n"); return(NULL); } if(length(ZInputs)!=1 ) { stop("\t ZInputs must be a single numeric value if not null \n"); return(NULL); }
if(is.na(ZInputs) | !is.numeric(ZInputs)){ stop("\t ZInputs must be a single numeric value if not null \n"); return(NULL); } if(is.na(ZInputs) | !is.numeric(ZInputs)) { stop("\t ZInputs must be a single numeric value if not null \n"); return(NULL); }
} }
if(is.null(HypsoData)){ if(is.null(HypsoData)) {
if(verbose){ warning("\t HypsoData is missing => a single layer is used and no extrapolation is made \n"); } if(verbose) { warning("\t HypsoData is missing => a single layer is used and no extrapolation is made \n"); }
HypsoData <- as.numeric(rep(NA,101)); ZInputs <- as.numeric(NA); NLayers <- as.integer(1); HypsoData <- as.numeric(rep(NA,101)); ZInputs <- as.numeric(NA); NLayers <- as.integer(1);
} }
if(is.null(ZInputs)){ if(is.null(ZInputs)) {
if(verbose & !identical(HypsoData,as.numeric(rep(NA,101)))){ warning("\t ZInputs is missing => HypsoData[51] is used \n"); } if(verbose & !identical(HypsoData,as.numeric(rep(NA,101)))) { warning("\t ZInputs is missing => HypsoData[51] is used \n"); }
ZInputs <- HypsoData[51L]; ZInputs <- HypsoData[51L];
} }
if(NLayers <= 0) {
stop("NLayers must be a positive integer value \n")
return(NULL)
}
} }
##check_NA_values ##check_NA_values
BOOL_NA <- rep(FALSE,length(DatesR)); BOOL_NA <- rep(FALSE,length(DatesR));
if("GR" %in% ObjectClass){ if("GR" %in% ObjectClass) {
BOOL_NA_TMP <- (Precip < 0) | is.na(Precip ); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose){ warning("\t Values < 0 or NA values detected in Precip series \n"); } } BOOL_NA_TMP <- (Precip < 0) | is.na(Precip ); if(sum(BOOL_NA_TMP)!=0) { BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose) { warning("\t Values < 0 or NA values detected in Precip series \n"); } }
BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose){ warning("\t Values < 0 or NA values detected in PotEvap series \n"); } } BOOL_NA_TMP <- (PotEvap < 0) | is.na(PotEvap); if(sum(BOOL_NA_TMP)!=0) { BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose) { warning("\t Values < 0 or NA values detected in PotEvap series \n"); } }
} }
if("CemaNeige" %in% ObjectClass){ if("CemaNeige" %in% ObjectClass) {
BOOL_NA_TMP <- (Precip < 0 ) | is.na(Precip ); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose){ warning("\t Values < 0 or NA values detected in Precip series \n"); } } BOOL_NA_TMP <- (Precip < 0 ) | is.na(Precip ); if(sum(BOOL_NA_TMP)!=0) { BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose) { warning("\t Values < 0 or NA values detected in Precip series \n"); } }
BOOL_NA_TMP <- (TempMean<(-150)) | is.na(TempMean); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose){ warning("\t Values < -150) or NA values detected in TempMean series \n"); } } BOOL_NA_TMP <- (TempMean<(-150)) | is.na(TempMean); if(sum(BOOL_NA_TMP)!=0) { BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose) { warning("\t Values < -150) or NA values detected in TempMean series \n"); } }
if(!is.null(TempMin) & !is.null(TempMax)){ if(!is.null(TempMin) & !is.null(TempMax)) {
BOOL_NA_TMP <- (TempMin<(-150)) | is.na(TempMin); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose){ warning("\t Values < -150) or NA values detected in TempMin series \n"); } } BOOL_NA_TMP <- (TempMin<(-150)) | is.na(TempMin); if(sum(BOOL_NA_TMP)!=0) { BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose) { warning("\t Values < -150) or NA values detected in TempMin series \n"); } }
BOOL_NA_TMP <- (TempMax<(-150)) | is.na(TempMax); if(sum(BOOL_NA_TMP)!=0){ BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose){ warning("\t Values < -150) or NA values detected in TempMax series \n"); } } } BOOL_NA_TMP <- (TempMax<(-150)) | is.na(TempMax); if(sum(BOOL_NA_TMP)!=0) { BOOL_NA <- BOOL_NA | BOOL_NA_TMP; if(verbose) { warning("\t Values < -150) or NA values detected in TempMax series \n"); } } }
} }
if(sum(BOOL_NA)!=0){ if(sum(BOOL_NA)!=0) {
WTxt <- NULL; WTxt <- NULL;
WTxt <- paste(WTxt,"\t Missing values are not allowed in InputsModel \n",sep=""); WTxt <- paste(WTxt,"\t Missing values are not allowed in InputsModel \n",sep="");
Select <- (max(which(BOOL_NA))+1):length(BOOL_NA); Select <- (max(which(BOOL_NA))+1):length(BOOL_NA);
if(Select[1L]>Select[2L]){ stop(paste("time series could not be trunced since missing values were detected at the list time-step \n",sep="")); return(NULL); } if(Select[1L]>Select[2L]) { stop(paste("time series could not be trunced since missing values were detected at the list time-step \n",sep="")); return(NULL); }
if("GR" %in% ObjectClass){ if("GR" %in% ObjectClass) {
Precip <- Precip[Select]; PotEvap <- PotEvap[Select]; } Precip <- Precip[Select]; PotEvap <- PotEvap[Select]; }
if("CemaNeige" %in% ObjectClass){ if("CemaNeige" %in% ObjectClass) {
Precip <- Precip[Select]; TempMean <- TempMean[Select]; if(!is.null(TempMin) & !is.null(TempMax)){ TempMin <- TempMin[Select]; TempMax <- TempMax[Select]; } } Precip <- Precip[Select]; TempMean <- TempMean[Select]; if(!is.null(TempMin) & !is.null(TempMax)) { TempMin <- TempMin[Select]; TempMax <- TempMax[Select]; } }
DatesR <- DatesR[Select]; DatesR <- DatesR[Select];
WTxt <- paste(WTxt,"\t -> data were trunced to keep the most recent available time-steps \n",sep=""); WTxt <- paste(WTxt,"\t -> data were trunced to keep the most recent available time-steps \n",sep="");
WTxt <- paste(WTxt,"\t -> ",length(Select)," time-steps were kept \n",sep=""); WTxt <- paste(WTxt,"\t -> ",length(Select)," time-steps were kept \n",sep="");
if(!is.null(WTxt) & verbose){ warning(WTxt); } if(!is.null(WTxt) & verbose) { warning(WTxt); }
} }
##DataAltiExtrapolation_Valery ##DataAltiExtrapolation_Valery
if("CemaNeige" %in% ObjectClass){ if("CemaNeige" %in% ObjectClass) {
RESULT <- DataAltiExtrapolation_Valery(DatesR=DatesR,Precip=Precip,TempMean=TempMean,TempMin=TempMin,TempMax=TempMax,ZInputs=ZInputs,HypsoData=HypsoData,NLayers=NLayers, verbose = verbose); RESULT <- DataAltiExtrapolation_Valery(DatesR=DatesR,Precip=Precip,TempMean=TempMean,TempMin=TempMin,TempMax=TempMax,ZInputs=ZInputs,HypsoData=HypsoData,NLayers=NLayers, verbose = verbose);
if(verbose){ if(NLayers==1){ cat(paste("\t Input series were successfully created on 1 elevation layer for use by CemaNeige \n",sep="")); if(verbose) {
} else { cat(paste("\t Input series were successfully created on ",NLayers," elevation layers for use by CemaNeige \n",sep="")); } } if(NLayers == 1) {
message("\t Input series were successfully created on 1 elevation layer for use by CemaNeige")
} else {
message("\t Input series were successfully created on ", NLayers, " elevation layers for use by CemaNeige")
}
}
} }
##Create_InputsModel ##Create_InputsModel
InputsModel <- list(DatesR=DatesR); InputsModel <- list(DatesR=DatesR)
if("GR" %in% ObjectClass){ if("GR" %in% ObjectClass) {
InputsModel <- c(InputsModel,list(Precip=as.double(Precip),PotEvap=as.double(PotEvap))); } InputsModel <- c(InputsModel,list(Precip=as.double(Precip),PotEvap=as.double(PotEvap))); }
if("CemaNeige" %in% ObjectClass){ if("CemaNeige" %in% ObjectClass) {
InputsModel <- c(InputsModel,list(LayerPrecip=RESULT$LayerPrecip,LayerTempMean=RESULT$LayerTempMean, InputsModel <- c(InputsModel,list(LayerPrecip=RESULT$LayerPrecip,LayerTempMean=RESULT$LayerTempMean,
LayerFracSolidPrecip=RESULT$LayerFracSolidPrecip,ZLayers=RESULT$ZLayers)); } LayerFracSolidPrecip=RESULT$LayerFracSolidPrecip,ZLayers=RESULT$ZLayers)); }
......
Supports Markdown
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