diff --git a/R/GRiwrm.R b/R/GRiwrm.R index 2241a8cfa9492f256ed493acc686eebd8d90fc39..6ee029720809f731753bcffc46c66953b6f8ec04 100644 --- a/R/GRiwrm.R +++ b/R/GRiwrm.R @@ -36,10 +36,46 @@ GRiwrm <- function(db, if (!keep_all) { db <- dplyr::select(db, names(cols)) } + CheckColumnTypes(db, + list(id = "character", + down = "character", + length = "double", + model = "character", + area = "double")) + rownames(db) <- db$id class(db) <- c("GRiwrm", class(db)) db } +#' Check the column types of a [data.frame] +#' +#' @param df [data.frame] to check +#' @param coltypes named [list] with the name of the columns to check as key and the required type as value +#' +#' @return [NULL] or throw an error if a wrong type is detected. +#' @export +#' @examples +#' CheckColumnTypes( +#' data.frame(string = c("A"), numeric = c(1), stringsAsFactors = FALSE), +#' list(string = "character", numeric = "double") +#' ) +#' +CheckColumnTypes <- function(df, coltypes) { + lapply(names(df), function(x) { + if (typeof(df[[x]]) != coltypes[[x]]) { + stop( + sprintf( + "The '%s' column is of type %s, a column of type %s is required", + x, + typeof(df[[x]]), + coltypes[[x]] + ) + ) + } + }) + return(NULL) +} + #' Sort the nodes from upstream to downstream. #' #' @param griwrm See \code{[GRiwrm]}. @@ -51,7 +87,7 @@ getNodeRanking <- function(griwrm) { stop("getNodeRanking: griwrm argument should be of class GRiwrm") } # Remove nodes without model (direct flow connections treated as upstream flows only) - griwrm <- griwrm[!is.na(griwrm$model), ] + griwrm <- griwrm[!is.na(griwrm$model),] # Rank 1 rank <- setdiff(griwrm$id, griwrm$down) ranking <- rank