Commit 66225097 authored by Delaigue Olivier's avatar Delaigue Olivier
Browse files

v0.2.10.87 refactor: force to index by integer values in the server file of the GUI

- use [1L] instead of [1] fo example
parent 692e5145
Pipeline #18212 passed with stages
in 1 minute and 42 seconds
Package: airGRteaching
Type: Package
Title: Teaching Hydrological Modelling with the GR Rainfall-Runoff Models ('Shiny' Interface Included)
Version: 0.2.10.86
Date: 2020-12-04
Version: 0.2.10.87
Date: 2020-12-08
Authors@R: c(
person("Olivier", "Delaigue", role = c("aut", "cre"), comment = c(ORCID = "0000-0002-7668-8468"), email = "airGR@inrae.fr"),
person("Laurent", "Coron", role = c("aut"), comment = c(ORCID = "0000-0002-1503-6204")),
......
......@@ -88,22 +88,22 @@ shinyServer(function(input, output, session) {
CemaNeige = input$SnowModel == "CemaNeige")
## old value: bad time zone management
#WUPPER <- c(PREP$InputsModel$DatesR[1L], input$Period[1]-.TypeModelGR(PREP)$TimeLag)
#WUPPER <- c(PREP$InputsModel$DatesR[1L], input$Period[1L]-.TypeModelGR(PREP)$TimeLag)
## patch from Juan Camilo Peña <juancamilopec@gmail.com>
#WUPPER <- c(format(PREP$InputsModel$DatesR[1L], format = "%Y-%m-%d", tz = "UTC"), format(input$Period[1]-.TypeModelGR(PREP)$TimeLag, format = "%Y-%m-%d", tz = "UTC"))
#WUPPER <- c(format(PREP$InputsModel$DatesR[1L], format = "%Y-%m-%d", tz = "UTC"), format(input$Period[1L]-.TypeModelGR(PREP)$TimeLag, format = "%Y-%m-%d", tz = "UTC"))
## new value
WUPPER <- as.POSIXlt(c(as.character(PREP$InputsModel$DatesR[1L]), as.character(input$Period[1]-.TypeModelGR(PREP)$TimeLag)), tz = "UTC")
WUPPER <- as.POSIXlt(c(as.character(PREP$InputsModel$DatesR[1L]), as.character(input$Period[1L]-.TypeModelGR(PREP)$TimeLag)), tz = "UTC")
if (HydroModel == "GR2M") {
WUPPER <- trunc(WUPPER, units = "months")
} else {
WUPPER <- trunc(WUPPER, units = "days")
}
if (WUPPER[2] < WUPPER[1]) {
WUPPER[2] <- WUPPER[1]
if (WUPPER[2L] < WUPPER[1L]) {
WUPPER[2L] <- WUPPER[1L]
}
## Enable or disable automatic calibration (if there is Qobs or not)
isQobs <- !all(is.na(PREP$Qobs[PREP$InputsModel$Dates >= input$Period[1] & PREP$InputsModel$Dates <= input$Period[2]]))
isQobs <- !all(is.na(PREP$Qobs[PREP$InputsModel$Dates >= input$Period[1L] & PREP$InputsModel$Dates <= input$Period[2L]]))
# if ( isQobs | input$Period[1L] != input$Period[2L]) {
# shinyjs::enable("CalButton")
# }
......@@ -135,7 +135,7 @@ shinyServer(function(input, output, session) {
Transfo = gsub("1", "inv", gsub("(\\D{3} \\[)(\\w{0,4})(\\W*Q\\W*\\])", "\\2", input$TypeCrit)))
CAL <- CalGR(PrepGR = getPrep()$PREP, CalCrit = CAL_opt$Crit, transfo = CAL_opt$Transfo,
WupPer = substr(getPrep()$WUPPER, 1, 10),
CalPer = c(substr(input$Period[1], 1, 10), substr(input$Period[2], 1, 10)),
CalPer = c(substr(input$Period[1L], 1, 10), substr(input$Period[2L], 1, 10)),
verbose = FALSE)
PARAM <- CAL$OutputsCalib$ParamFinalR
......@@ -223,7 +223,7 @@ shinyServer(function(input, output, session) {
}
SIM <- SimGR(PrepGR = PREP, Param = PARAM,
WupPer = substr(getPrep()$WUPPER, 1, 10),
SimPer = c(substr(SimPer[1], 1, 10), substr(SimPer[2], 1, 10)),
SimPer = c(substr(SimPer[1L], 1, 10), substr(SimPer[2L], 1, 10)),
verbose = FALSE)
## Criteria computation
......@@ -261,22 +261,22 @@ shinyServer(function(input, output, session) {
duplicated(sapply(.GlobalEnv$.ShinyGR.hist, function(x) x$TypeModel), fromLast = TRUE))]
.GlobalEnv$.ShinyGR.hist <- tail(.GlobalEnv$.ShinyGR.hist, n = 2)
if (length(.GlobalEnv$.ShinyGR.hist) == 2 & is.null(names(.GlobalEnv$.ShinyGR.hist[[1]]))) {
.GlobalEnv$.ShinyGR.hist[[1]] <- NULL
if (length(.GlobalEnv$.ShinyGR.hist) == 2 & is.null(names(.GlobalEnv$.ShinyGR.hist[[1L]]))) {
.GlobalEnv$.ShinyGR.hist[[1L]] <- NULL
}
if (length(.GlobalEnv$.ShinyGR.hist) == 2) {
if (.GlobalEnv$.ShinyGR.hist[[1]]$Dataset != .GlobalEnv$.ShinyGR.hist[[2]]$Dataset) { # reset Qold when new dataset
.GlobalEnv$.ShinyGR.hist[[1]] <- NULL
if (.GlobalEnv$.ShinyGR.hist[[1L]]$Dataset != .GlobalEnv$.ShinyGR.hist[[2L]]$Dataset) { # reset Qold when new dataset
.GlobalEnv$.ShinyGR.hist[[1L]] <- NULL
}
}
if (length(.GlobalEnv$.ShinyGR.hist) == 2 & !is.null(names(.GlobalEnv$.ShinyGR.hist[[1]]))) {
isEqualSumQsim <- !identical(sum(.GlobalEnv$.ShinyGR.hist[[1]]$Crit$Value), sum(.GlobalEnv$.ShinyGR.hist[[2]]$Crit$Value))
isEqualTypeModel <- .GlobalEnv$.ShinyGR.hist[[1]]$TypeModel == .GlobalEnv$.ShinyGR.hist[[2]]$TypeModel
isEqualPeriod <- !identical(.GlobalEnv$.ShinyGR.hist[[1]]$Period, .GlobalEnv$.ShinyGR.hist[[2]]$Period)
if (length(.GlobalEnv$.ShinyGR.hist[[1]]$Qsim) != length(.GlobalEnv$.ShinyGR.hist[[2]]$Qsim) |
if (length(.GlobalEnv$.ShinyGR.hist) == 2 & !is.null(names(.GlobalEnv$.ShinyGR.hist[[1L]]))) {
isEqualSumQsim <- !identical(sum(.GlobalEnv$.ShinyGR.hist[[1L]]$Crit$Value), sum(.GlobalEnv$.ShinyGR.hist[[2L]]$Crit$Value))
isEqualTypeModel <- .GlobalEnv$.ShinyGR.hist[[1L]]$TypeModel == .GlobalEnv$.ShinyGR.hist[[2L]]$TypeModel
isEqualPeriod <- !identical(.GlobalEnv$.ShinyGR.hist[[1L]]$Period, .GlobalEnv$.ShinyGR.hist[[2L]]$Period)
if (length(.GlobalEnv$.ShinyGR.hist[[1L]]$Qsim) != length(.GlobalEnv$.ShinyGR.hist[[2L]]$Qsim) |
(isEqualSumQsim & isEqualTypeModel) | isEqualPeriod) {
OBSold <- getPrep()$PREP
OBSold$TypeModel <- .GlobalEnv$.ShinyGR.hist[[1]]$TypeModel
OBSold$TypeModel <- .GlobalEnv$.ShinyGR.hist[[1L]]$TypeModel
if (.TypeModelGR(OBSold)$CemaNeige & !.TypeModelGR(getPrep()$PREP)$CemaNeige | # present: No CemaNeige ; old: CemaNeige
isEqualSumQsim & isEqualTypeModel) {
if (input$Dataset == "Unnamed watershed") {
......@@ -301,9 +301,9 @@ shinyServer(function(input, output, session) {
SimPer <- trunc(input$Period, units = "days")
}
SIMold <- SimGR(PrepGR = OBSold,
Param = .GlobalEnv$.ShinyGR.hist[[1]]$Param,
Param = .GlobalEnv$.ShinyGR.hist[[1L]]$Param,
WupPer = substr(getPrep()$WUPPER, 1, 10),
SimPer = substr(c(SimPer[1], SimPer[2]), 1, 10),
SimPer = substr(c(SimPer[1L], SimPer[2L]), 1, 10),
verbose = FALSE)
if (!getPrep()$isUngauged) {
InputsCritMultiold <- CreateInputsCrit(FUN_CRIT = CRIT_opt$Crit,
......@@ -323,8 +323,8 @@ shinyServer(function(input, output, session) {
} else {
CRITold <- data.frame(Criterion = NA, Value = NA)
}
.GlobalEnv$.ShinyGR.hist[[1]]$Crit <- CRITold
.GlobalEnv$.ShinyGR.hist[[1]]$Qsim <- SIMold$OutputsModel$Qsim
.GlobalEnv$.ShinyGR.hist[[1L]]$Crit <- CRITold
.GlobalEnv$.ShinyGR.hist[[1L]]$Qsim <- SIMold$OutputsModel$Qsim
}
}
......@@ -396,7 +396,7 @@ shinyServer(function(input, output, session) {
# QrExp = rep(NA, length(OutputsModel2$DatesR)))
if (length(.GlobalEnv$.ShinyGR.hist) == 2 & input$ShowOldQsim == "Yes") {
data$QsimOld <- .GlobalEnv$.ShinyGR.hist[[1]]$Qsim[seq_len(nrow(data))]
data$QsimOld <- .GlobalEnv$.ShinyGR.hist[[1L]]$Qsim[seq_len(nrow(data))]
}
if (input$HydroModel == "GR6J") {
data$'exp.' <- NULL
......@@ -597,7 +597,7 @@ shinyServer(function(input, output, session) {
return(NULL)
}
if (length(getSim()$SIMold) == 2 & input$ShowOldQsim == "Yes") {
QsimOld <- getSim()$SIMold[[1]]$Qsim
QsimOld <- getSim()$SIMold[[1L]]$Qsim
} else {
QsimOld <- NULL
}
......@@ -621,7 +621,7 @@ shinyServer(function(input, output, session) {
return(NULL)
}
if (length(getSim()$SIMold) == 2 & input$ShowOldQsim == "Yes") {
ErrorOld <- getSim()$SIMold[[1]]$Qsim - getSim()$SIM$Qobs
ErrorOld <- getSim()$SIMold[[1L]]$Qsim - getSim()$SIM$Qobs
} else {
ErrorOld <- NA
}
......@@ -814,7 +814,7 @@ shinyServer(function(input, output, session) {
return(NULL)
}
# if (length(getSim()$SIMold) == 2 & input$ShowOldQsim == "Yes") {
# QsimOld <- getSim()$SIMold[[1]]$Qsim
# QsimOld <- getSim()$SIMold[[1L]]$Qsim
# } else {
# QsimOld <- NA
# }
......@@ -900,7 +900,7 @@ shinyServer(function(input, output, session) {
ID = 1:7, stringsAsFactors = FALSE)
if (length(getSim()$SIMold) == 2 & input$ShowOldQsim == "Yes") {
tabCrit_old <- getSim()$SIMold[[1]]$Crit$Value
tabCrit_old <- getSim()$SIMold[[1L]]$Crit$Value
tabCrit_val <- cbind(getSim()$Crit, tabCrit_old)
colnames(tabCrit_val) <- c(colnames(getSim()$Crit), "Qold")
CellColHisto <- '<div style="color: #808080;"><span>9999</span></div>'
......@@ -970,7 +970,7 @@ shinyServer(function(input, output, session) {
ParamTitle <- c("X1", "X2" , "X3", "X4", "X5", "X6")[seq_len(getPrep()$TMGR$NbParam)]
ParamUnits <- c("mm", "mm/%s", "mm", "%s", "", "mm")
if (input$HydroModel == "GR2M") {
ParamUnits[2] <- "[-]%s"
ParamUnits[2L] <- "[-]%s"
}
ParamUnits <- ParamUnits[seq_len(getPrep()$TMGR$NbParam)]
if (input$SnowModel == "CemaNeige") {
......
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