convertMeteoBVI2BV.R

#' Conversion of meteorological data from sub-basin scale to basin scale
#'
#' @details
#' If `x` is a [data.frame], the first column should a [POSIXct] containing the date and the other columns the time series data.
#'
#' @param x either a `GRiwrm` network description (See [CreateGRiwrm]), a [character] id of a node, or a [matrix] or a [data.frame] containing meteorological data (See details)
#' @param ... Parameters passed to the methods
#'
#' @return [matrix] a matrix containing the converted meteorological data or a [data.frame] if `x` is a [data.frame].
#' @export
#' @rdname convertMeteoBVI2BV
#'
convertMeteoBVI2BV <- function(x, ...) {
    UseMethod("convertMeteoBVI2BV", x)
}

#' @export
#' @rdname convertMeteoBVI2BV
convertMeteoBVI2BV.data.frame <- function(x, griwrm, ...) {
    if (!inherits(x[[1L]], "POSIXt")) {
        stop("'x' first column must be a vector of class 'POSIXlt' or 'POSIXct'")
    }
    DatesR <- x[[1L]]
    m <- convertMeteoBVI2BV(griwrm, as.matrix(x[, -1]))
    df <- cbind(DatesR, as.data.frame(m))
    names(df) <- names(x)
    return(df)
}

#' @param meteo [matrix] or [data.frame] containing meteorological data. Its [colnames] should be equal to the ID of the basins
#' @export
#' @rdname convertMeteoBVI2BV
convertMeteoBVI2BV.GRiwrm <- function(x, meteo, ...) {
    meteo <- as.matrix(meteo)
    output <- lapply(colnames(meteo), convertMeteoBVI2BV , griwrm = x, meteo = meteo)
    meteoOut <- do.call(cbind,output)
    dimnames(meteoOut)[[2]] <- colnames(meteo)
    return(meteoOut)
}

#' @param griwrm `GRiwrm` object describing the semi-distributed network (See [CreateGRiwrm])
#' @export
#' @rdname convertMeteoBVI2BV
convertMeteoBVI2BV.character <- function(x, griwrm, meteo, ...) {
    upperBasins <- !is.na(griwrm$down) & griwrm$down == x
    if(all(!upperBasins)) {
        return(meteo[,x])
    }
    upperIDs <- griwrm$id[upperBasins]
    areas <- griwrm$area[match(c(x, upperIDs), griwrm$id)]
    output <- convertMeteoBVI2BV(
        meteo[,c(x, upperIDs), drop = FALSE],
        areas = areas
    )
    return(output)
}

#' @param areas [numeric] vector with the total area of the basin followed by the areas of the upstream basins in km2
#' @param temperature [logical] `TRUE` if the meteorological data contain air temperature. If `FALSE` minimum output values are bounded to zero
#' @export
#' @rdname convertMeteoBVI2BV
convertMeteoBVI2BV.matrix <- function(x, areas, temperature = FALSE, ...) {
    # Check arguments
    if(nrow(x) < 2) {
        stop("Meteorological data matrix should contain more than one row")
    }
    if(length(areas) != ncol(x)) {
        stop("'areas' length and meteo data matrix number of columns should be equal")
    }
    if(areas[1] <= sum(areas[-1])) {