Commit 5a69e19e authored by Dorchies David's avatar Dorchies David
Browse files

Merge branch '25-set-griwrm-rownames-with-id' into 'master'

Resolve "Set GRiwrm rownames with ID"

Closes #25

See merge request !12
Showing with 37 additions and 1 deletion
+37 -1
...@@ -36,10 +36,46 @@ GRiwrm <- function(db, ...@@ -36,10 +36,46 @@ GRiwrm <- function(db,
if (!keep_all) { if (!keep_all) {
db <- dplyr::select(db, names(cols)) 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)) class(db) <- c("GRiwrm", class(db))
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. #' Sort the nodes from upstream to downstream.
#' #'
#' @param griwrm See \code{[GRiwrm]}. #' @param griwrm See \code{[GRiwrm]}.
...@@ -51,7 +87,7 @@ getNodeRanking <- function(griwrm) { ...@@ -51,7 +87,7 @@ getNodeRanking <- function(griwrm) {
stop("getNodeRanking: griwrm argument should be of class GRiwrm") stop("getNodeRanking: griwrm argument should be of class GRiwrm")
} }
# Remove nodes without model (direct flow connections treated as upstream flows only) # 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 1
rank <- setdiff(griwrm$id, griwrm$down) rank <- setdiff(griwrm$id, griwrm$down)
ranking <- rank ranking <- rank
......
Supports Markdown
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