Commit ce4293dc authored by unknown's avatar unknown
Browse files

v0.1.11.19 checked of inputs updated in ShinyGR

parent cf0f6d62
Package: airGRteaching
Type: Package
Title: Tools to Simplify the Use of the airGR Hydrological Package for Education (Including a Shiny Interface)
Version: 0.1.11.18
Version: 0.1.11.19
Date: 2018-02-01
Authors@R: c(person("Olivier", "Delaigue", role = c("aut", "cre"), email = "airGR@irstea.fr"), person("Laurent", "Coron", role = c("aut")), person("Pierre", "Brigode", role = c("aut")), person("Guillaume", "Thirel", role = c("ctb")))
Depends: airGR (>= 1.0.9.43)
......
......@@ -2,26 +2,38 @@ ShinyGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL,
ZInputs = NULL, HypsoData = NULL, NLayers = 5, SimPer, NamesObsBV = NULL,
theme = "RStudio") {
if ((is.null(ObsDF) | any(sapply(ObsDF, is.null))) && (is.null(DatesR) | is.null(Precip) | is.null(PotEvap) | is.null(Qobs))) {
stop("Missing input data")
}
if (is.null(SimPer) | any(sapply(SimPer, is.null))) {
stop("Null values non suitable for 'SimPer'.")
}
if (is.data.frame(ObsDF)) {
ObsDF <- list(ObsDF)
ObsDF <- list(ObsDF)
}
ZInputs <- as.list(ZInputs)
HypsoData <- as.list(HypsoData)
NLayers <- as.list(NLayers)
if (!is.list(SimPer)) {
SimPer <- list(SimPer)
SimPer <- list(SimPer)
}
if (is.null(ObsDF)) {
lenObsDF <- 1L
} else {
lenObsDF <- length(ObsDF)
}
if (is.null(names(ObsDF)) & !is.null(ObsDF)) {
if (is.null(NamesObsBV)) {
NamesObsBV <- paste0("%s %0", nchar(length(ObsDF)), "d")
NamesObsBV <- sprintf(NamesObsBV, rep("Unnamed watershed", times = length(ObsDF)), seq_along(ObsDF))
} else if (length(ObsDF) > length(NamesObsBV)) {
warning("Not enough 'NamesObsBV' values. Basin automatically renamed.")
NamesObsBV <- paste0("%s %0", nchar(length(ObsDF)), "d")
NamesObsBV <- sprintf(NamesObsBV, rep("Unnamed watershed", times = length(ObsDF)), seq_along(ObsDF))
} else if (length(ObsDF) < length(NamesObsBV)) {
warning("To long 'NamesObsBV'. First(s) element(s) used of 'NamesObsBV' argument.")
NamesObsBV <- paste0("%s %0", nchar(lenObsDF), "d")
NamesObsBV <- sprintf(NamesObsBV, rep("Unnamed watershed", times = lenObsDF), seq_along(ObsDF))
} else if (lenObsDF > length(NamesObsBV)) {
warning("Not enough 'NamesObsBV' elements. Elements recycled.")
NamesObsBV <- paste0("%s %0", nchar(lenObsDF), "d")
NamesObsBV <- sprintf(NamesObsBV, rep("Unnamed watershed", times = lenObsDF), seq_along(ObsDF))
} else if (lenObsDF < length(NamesObsBV)) {
warning("Too long 'NamesObsBV'. Only the first element(s) of 'NamesObsBV' argument used.")
}
NamesObsBV <- NamesObsBV[seq_along(ObsDF)]
names(ObsDF) <- NamesObsBV
......@@ -30,46 +42,89 @@ ShinyGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL,
} else if (is.null(ObsDF)) {
NamesObsBV <- ifelse(is.null(NamesObsBV), "Unnamed watershed", NamesObsBV[1L])
}
if (is.null(ObsDF)) {
if (length(ZInputs) > 1) {
warning("To long 'ZInputs'. First element used of 'ZInputs' argument.")
warning("Too long 'ZInputs'. Only the first element(s) of 'ZInputs' argument used.")
ZInputs <- list(ZInputs[[1L]])
}
if (length(HypsoData) > 1) {
warning("To long 'HypsoData'. First element used of 'HypsoData' argument.")
warning("Too long 'HypsoData'. Only the first element(s) of 'HypsoData' argument used.")
HypsoData <- list(HypsoData[[1L]])
}
if (length(NLayers) > 1) {
warning("To long 'NLayers'. First element used of 'NLayers' argument.")
warning("Too long 'NLayers'. Only the first element(s) of 'NLayers' argument used.")
NLayers <- list(NLayers[[1L]])
}
if (length(SimPer) > 1 & !is.list(SimPer)) {
warning("To long 'SimPer'. First element used of 'SimPer' argument.")
warning("Too long 'SimPer'. Only the first element(s) of 'SimPer' argument used.")
SimPer <- SimPer[[1L]]
}
}
if (!is.null(ObsDF) & length(ObsDF) != length(ZInputs)) {
stop(sprintf("Not enough 'ZInputs' values. Length must be %i.", length(ObsDF)))
if (is.null(ZInputs)) {
ZInputs <- vector(mode = "list", length = lenObsDF)
} else {
names(ZInputs) <- NamesObsBV
ZInputs <- as.list(ZInputs)
if (length(ZInputs) == lenObsDF) {
ZInputs <- as.list(ZInputs)
} else if(length(ZInputs) > lenObsDF) {
ZInputs <- as.list(ZInputs)[seq_along(ObsDF)]
warning("Too long 'ZInputs'. Only the first element(s) of 'ZInputs' argument used.")
} else if(length(ZInputs) < lenObsDF) {
ZInputs <- as.list(rep(ZInputs, lenObsDF))[seq_along(ObsDF)]
if (lenObsDF > 1) {
warning("Not enough 'ZInputs' elements. Elements of the list recycled.")
}
}
}
if (!is.null(ObsDF) & length(ObsDF) != length(HypsoData)) {
stop(sprintf("Not enough 'HypsoData' values. Length must be %i.", length(ObsDF)))
names(ZInputs) <- NamesObsBV
if (is.null(HypsoData)) {
HypsoData <- vector(mode = "list", length = lenObsDF)
} else {
names(HypsoData) <- NamesObsBV
HypsoData <- as.list(HypsoData)
if (length(HypsoData) == lenObsDF) {
HypsoData <- as.list(HypsoData)
} else if(length(HypsoData) > lenObsDF) {
HypsoData <- as.list(HypsoData)[seq_along(ObsDF)]
warning("Too long 'HypsoData'. Only the first element(s) of 'HypsoData' argument used.")
} else if(length(HypsoData) < lenObsDF) {
HypsoData <- as.list(rep(HypsoData, lenObsDF))[seq_along(ObsDF)]
if (lenObsDF > 1) {
warning("Not enough 'HypsoData' elements. Elements of the list recycled.")
}
}
}
if (!is.null(ObsDF) & length(ObsDF) != length(NLayers)) {
stop(sprintf("Not enough 'NLayers' values. Length must be %i.", length(ObsDF)))
names(HypsoData) <- NamesObsBV
if (is.null(NLayers)) {
NLayers <- vector(mode = "list", length = lenObsDF)
} else {
names(NLayers) <- NamesObsBV
if (length(NLayers) == lenObsDF) {
NLayers <- as.list(NLayers)
} else if(length(NLayers) > lenObsDF) {
NLayers <- as.list(NLayers)[seq_along(ObsDF)]
warning("Too long 'NLayers'. Only the first element(s) of 'NLayers' argument used.")
} else if(length(NLayers) < lenObsDF) {
NLayers <- as.list(rep(NLayers, lenObsDF))[seq_along(ObsDF)]
if (lenObsDF > 1) {
warning("Not enough 'NLayers' elements. Elements of the list recycled.")
}
}
}
if (!is.null(ObsDF) & length(ObsDF) != length(SimPer)) {
stop(sprintf("Not enough 'SimPer' values. Length must be %i.", length(ObsDF)))
} else {
names(SimPer) <- NamesObsBV
names(NLayers) <- NamesObsBV
if (length(SimPer) > lenObsDF) {
SimPer <- as.list(SimPer)[seq_along(ObsDF)]
warning("Too long 'SimPer'. Only the first element(s) of 'SimPer' argument used.")
} else if(length(SimPer) < lenObsDF) {
SimPer <- as.list(rep(SimPer, lenObsDF))[seq_along(ObsDF)]
if (lenObsDF > 1) {
warning("Not enough 'SimPer' elements. Elements of the list recycled.")
}
}
names(SimPer) <- NamesObsBV
.GlobalEnv$.ShinyGR.hist <- list(list())#list(Param = list(), TypeModel = lsit(), Crit = list(), Qsim = list())
......
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