Merge pull request #1225 from stan-dev/fix-817-int-container-data

Fix list-to-array conversion for integer arrays

Author: jgabry

NEWS.md

@@ -1,5 +1,18 @@
 # cmdstanr (development version)
 
+* Lists of matrices/vectors and data frames can now be supplied for variables
+declared as `int` in the Stan program. Previously these worked only for `real`
+variables and errored for `int` ones. (#817)
+* Data frame columns that are not numeric, integer, logical, or
+factor are now an error. Previously `data.matrix()` silently coerced them, so a
+character column reached Stan as alphabetically ordered integer codes. Convert
+the column explicitly, e.g. with `as.integer()`, if integer codes are what you
+want. (#1225)
+* Lists of logical vectors/matrices are now converted to integers like logical
+variables are, instead of erroring. (#1225)
+* Supplying a factor for a variable not declared as `int` is now an error. (#1225)
+* Factors are now accepted for length-1 `int` arrays (e.g. `array[1] int x`),
+which previously errored. (#1225)
 * The `CMDSTANR_NO_VER_CHECK` R option and environment variable are deprecated 
 as of CmdStanR 1.0.0; use the lowercase `cmdstanr_no_ver_check` forms instead.
 * `$cpp_options()` no longer includes a `STAN_VERSION` entry read from the model 

R/data.R

@@ -15,24 +15,43 @@
 #' file:
 #'
 #' * `logical` -> `integer` (`TRUE` -> `1`, `FALSE` -> `0`)
-#' * `data.frame` -> `matrix` (via [data.matrix()])
+#' * `factor` -> `integer` (the index of each value's level)
+#' * `data.frame` -> `matrix` (via [data.matrix()]); every column must be
+#' numeric, integer, logical, or factor
 #' * `list` -> `array`
 #' * `table` -> `vector`, `matrix`, or `array` (depending on dimensions of table)
 #'
+#' ### Factor conversion
+#' Factors are written as their level indices: the position of each value in
+#' `levels(x)` rather than the value itself. The default levels are the sorted
+#' unique values, so `factor(c(10, 9, 8))` has levels `8`, `9`, `10` and is
+#' written as `[3, 2, 1]`, and an unused level shifts the indices of the levels
+#' after it. If the original values are what you want, convert them first, e.g.
+#' with `as.numeric(as.character(x))`. The fitting methods of a model compiled
+#' from a Stan file error if a factor is supplied for a variable that is not
+#' declared as `int`, but `write_stan_json()` has no declarations to check
+#' against and so always converts.
+#'
+#'
+#' ### List to array conversion
 #' The `list` to `array` conversion is intended to make it easier to prepare
 #' the data for certain Stan declarations involving arrays:
 #'
 #' * `array[K] vector[J] v ` can be constructed in \R as a list with `K`
 #' elements where each element is a vector of length `J`
 #' * `array[K] matrix[I,J] m ` can be constructed in \R as a list with `K`
 #' elements where each element is an `IxJ` matrix
+#' * `array[K,I,J] int n ` can be constructed in \R as a list with `K`
+#' elements where each element is an `IxJ` matrix of integers
 #'
 #' These can also be passed in from \R as arrays instead of lists but the list
-#' option is provided for convenience. Unfortunately for arrays with more than
-#' one dimension (e.g. `array[K,L] vector[J] v `) it is not possible to use an
-#' \R list and an array must be used instead. For this example the array in \R
-#' should have dimensions `KxLxJ`.
+#' option is provided for convenience. A list always contributes exactly one
+#' leading dimension, so `array[K,L] vector[J] v ` can be supplied either as a
+#' list of `K` matrices each with dimensions `LxJ` or as a single \R array with
+#' dimensions `KxLxJ`. Nested lists are not supported: every element of the list
+#' must be a vector, matrix, or array.
 #'
+#' ### Scalar vs. length-1 vector
 #' Because \R does not distinguish between a scalar and a vector of length 1, a
 #' length-1 vector like `c(42)` is written to JSON as a scalar (`42`) rather
 #' than an array (`[42]`). If a Stan variable is declared as a vector or array
@@ -97,23 +116,12 @@ write_stan_json <- function(data, file, always_decimal = FALSE) {
     if (is.null(var)) {
       stop("Variable '", var_name, "' is NULL.", call. = FALSE)
     }
-    if (!(is.numeric(var) || is.factor(var) || is.logical(var) ||
-          is.data.frame(var) || is.list(var))) {
-      stop("Variable '", var_name, "' is of invalid type.", call. = FALSE)
-    }
+    validate_data_type(var, var_name)
+    var <- convert_to_array(var, var_name)
+    # after the conversion, so that NAs nested inside a list are also found
     if (anyNA(var)) {
       stop("Variable '", var_name, "' has NA values.", call. = FALSE)
     }
-
-    if (is.table(var)) {
-      var <- unclass(var)
-    } else if (is.logical(var)) {
-      mode(var) <- "integer"
-    } else if (is.data.frame(var)) {
-      var <- data.matrix(var)
-    } else if (is.list(var)) {
-      var <- list_to_array(var, var_name)
-    }
     data[[var_name]] <- var
   }
 
@@ -130,6 +138,55 @@ write_stan_json <- function(data, file, always_decimal = FALSE) {
 }
 
 
+# Types accepted for a data variable and for each column of a data frame
+is_valid_data_type <- function(x) {
+  is.numeric(x) || is.factor(x) || is.logical(x)
+}
+
+
+# TRUE for a factor, or a data frame with any factor column
+has_factor <- function(x) {
+  is.factor(x) || (is.data.frame(x) && any(vapply(x, is.factor, logical(1))))
+}
+
+
+# Error if a variable is not one of the types accepted in a data list. Data
+# frames and lists are accepted here and converted by convert_to_array().
+validate_data_type <- function(var, var_name) {
+  if (!is_valid_data_type(var) && !is.data.frame(var) && !is.list(var)) {
+    stop("Variable '", var_name, "' is of invalid type.", call. = FALSE)
+  }
+  invisible(NULL)
+}
+
+
+# Convert the R container types accepted in a data list to the atomic arrays
+# CmdStan's JSON reader expects. Used by both write_stan_json() and
+# process_data() so that the two paths agree.
+convert_to_array <- function(var, var_name = NULL) {
+  if (is.table(var)) {
+    var <- unclass(var)
+  } else if (is.data.frame(var)) {
+    # data.matrix() silently coerces character columns to factor codes and
+    # date/time columns to their numeric representation, so apply the same
+    # type check used for the variables themselves (#817)
+    invalid <- !vapply(var, is_valid_data_type, logical(1))
+    if (any(invalid)) {
+      stop("Variable '", var_name, "' has columns of invalid type: ",
+           paste(names(var)[invalid], collapse = ", "), ".", call. = FALSE)
+    }
+    var <- data.matrix(var)
+  } else if (is.list(var)) {
+    var <- list_to_array(var, var_name)
+  }
+  # after the conversions above so that lists of logicals are also converted
+  if (is.logical(var)) {
+    mode(var) <- "integer"
+  }
+  var
+}
+
+
 list_to_array <- function(x, name = NULL) {
   list_length <- length(x)
   if (list_length == 0) {
@@ -142,9 +199,9 @@ list_to_array <- function(x, name = NULL) {
   if (!all_equal_dim) {
     stop("All matrices/vectors in list '", name, "' must be the same size!", call. = FALSE)
   }
-  all_numeric <- all(sapply(x, function(a) is.numeric(a)))
+  all_numeric <- all(sapply(x, function(a) is.numeric(a) || is.logical(a)))
   if (!all_numeric) {
-    stop("All elements in list '", name, "' must be numeric!", call. = FALSE)
+    stop("All elements in list '", name, "' must be numeric or logical!", call. = FALSE)
   }
   element_num_of_dim <- length(all_dims[[1]])
   x <- unlist(x)
@@ -158,12 +215,6 @@ list_to_array <- function(x, name = NULL) {
 #' @noRd
 #' @param data If not `NULL`, then either a path to a data file compatible with
 #'   CmdStan, or a named list of \R objects to pass to [write_stan_json()].
-#' @param stan_file If not `NULL`, the path to the Stan model for which to
-#'   process the named list suppiled to the `data` argument. The Stan model
-#'   is used for checking whether the supplied named list has all the
-#'   required elements/Stan variables and to help differentiate between a
-#'   vector of length 1 and a scalar when genereting the JSON file. This
-#'   argument is ignored when a path to a data file is supplied for `data`.
 #' @param model_variables A list of all parameters with their types and
 #'   number of dimensions. Typically the output of model$variables().
 #' @return Path to data file.
@@ -192,6 +243,21 @@ process_data <- function(data, model_variables = NULL) {
         if (is.null(data[[var_name]])) {
           stop("Variable '", var_name, "' is NULL.", call. = FALSE)
         }
+        validate_data_type(data[[var_name]], var_name)
+        # Factors are written as level indices, which are only meaningful for
+        # variables declared as int. Handle them before the conversions below,
+        # which replace factors with their codes and drop the factor class.
+        if (data_variables[[var_name]]$type == "int") {
+          if (is.factor(data[[var_name]])) {
+            data[[var_name]] <- as.integer(data[[var_name]])
+          }
+        } else if (has_factor(data[[var_name]])) {
+          stop("A factor was supplied for '", var_name, "', which is declared as '",
+               data_variables[[var_name]]$type, "'.", call. = FALSE)
+        }
+        # Convert lists and data frames to arrays before the checks below,
+        # which require an atomic object (#817)
+        data[[var_name]] <- convert_to_array(data[[var_name]], var_name)
         # distinguish between scalars and arrays/vectors of length 1
         if (length(data[[var_name]]) == 1
             && data_variables[[var_name]]$dimensions == 1) {
@@ -201,17 +267,15 @@ process_data <- function(data, model_variables = NULL) {
         # generating a decimal point in write_stan_json
         if (data_variables[[var_name]]$type == "int"
             && !is.integer(data[[var_name]])) {
-          if (!is.factor(data[[var_name]])) {
-            if (!isTRUE(all(is_wholenumber(data[[var_name]])))) {
-              # Don't warn for NULL/NA, as different warnings are used for those
-              if (!isTRUE(anyNA(data[[var_name]]))) {
-                warning("A non-integer value was supplied for '", var_name, "'!",
-                        " It will be truncated to an integer.", call. = FALSE)
-              }
-            } else {
-              # Round before setting mode to integer to avoid floating point errors
-              data[[var_name]] <- round(data[[var_name]])
+          if (!isTRUE(all(is_wholenumber(data[[var_name]])))) {
+            # Don't warn for NULL/NA, as different warnings are used for those
+            if (!isTRUE(anyNA(data[[var_name]]))) {
+              warning("A non-integer value was supplied for '", var_name, "'!",
+                      " It will be truncated to an integer.", call. = FALSE)
             }
+          } else {
+            # Round before setting mode to integer to avoid floating point errors
+            data[[var_name]] <- round(data[[var_name]])
           }
           mode(data[[var_name]]) <- "integer"
         }