.gitlab-ci.yml

@@ -29,15 +29,16 @@ before_script:
 .check:
   stage: checks
   script:
-    - R -e 'devtools::check(check_dir = Sys.getenv("CHECK_DIR"), cran = !as.logical(Sys.getenv("NOT_CRAN")))'
+    - if [ $AS_CRAN = "false" ]; then sudo apt-get install -y qpdf; fi
+    - R -e 'devtools::check(check_dir = Sys.getenv("CHECK_DIR"), cran = !as.logical(Sys.getenv("AS_CRAN")), env_vars = c(NOT_CRAN = "true"))'
     - R -e 'if (length(devtools::check_failures(path = Sys.getenv("BUILD_LOGS_DIR"), note = FALSE)) > 0) stop()'
 
 check_not_cran:
   variables:
-    NOT_CRAN: "true"
+    AS_CRAN: "false"
   extends: .check
 
 check_as_cran:
   variables:
-    NOT_CRAN: "true"
+    AS_CRAN: "true"
   extends: .check

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