ShinyGR.R

ShinyGR <- function(ObsDF = NULL, DatesR = NULL, Precip = NULL, PotEvap = NULL, Qobs = NULL, TempMean = NULL, 
                    ZInputs = NULL, HypsoData = NULL, NLayers = 5, SimPer, NamesObsBV = NULL,
                    theme = "RStudio") {

  theme <- match.arg(arg = theme,
                     choices = c("RStudio", "Cerulean", "Cyborg", "Flatly", "Inrae", "Saclay", "United", "Yeti"))
  
  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.null(ObsDF)) {
    if (!is.list(ObsDF) | inherits(ObsDF, "PrepGR")) {
      stop("'ObsDF' must be a (list of) 'data.frame'.")
    }
  }
  if (is.data.frame(ObsDF)) {
    ObsDF <- list(ObsDF)
  }
  
  if (!is.list(HypsoData)) {
    HypsoData <- list(HypsoData)
  }
  
  if (!is.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(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
  } else if (!is.null(names(ObsDF)) & !is.null(ObsDF)) {
    NamesObsBV <- names(ObsDF)
  } else if (is.null(ObsDF)) {
    NamesObsBV <- ifelse(is.null(NamesObsBV), "Unnamed watershed", NamesObsBV[1L])
  }
  if (!is.null(NamesObsBV)) {
    if (any(nchar(NamesObsBV) == 0)) {
      stop("NamesObsBV must be a string vector of at least one character.")
    }
  }  
  
  if (is.null(ObsDF)) {
    if (length(ZInputs) > 1) {
      warning("Too long 'ZInputs'. Only the first element(s) of 'ZInputs' argument used.")
      ZInputs <- list(ZInputs[[1L]])
    }
    if (length(HypsoData) > 1) {
      warning("Too long 'HypsoData'. Only the first element(s) of 'HypsoData' argument used.")
      HypsoData <- list(HypsoData[[1L]])