- [<- coerces matrices to data frames (#762).

R/subsetting.R

@@ -417,7 +417,7 @@ tbl_subassign <- function(x, i, j, value, i_arg, j_arg, value_arg) {
   } else {
     # Fill up rows first if necessary
     x <- tbl_expand_to_nrow(x, i)
-    value <- vectbl_wrap_rhs_row(value, value_arg, i = i)
+    value <- vectbl_wrap_rhs_row(value, value_arg)
 
     if (is.null(j)) {
       value <- vectbl_recycle_rhs(value, length(i), length(x), i_arg, value_arg)
@@ -651,23 +651,35 @@ vectbl_strip_names <- function(x) {
 
 vectbl_wrap_rhs_col <- function(value, value_arg) {
   if (is_null(value)) {
-    list(value)
-  } else if (!vec_is(value)) {
+    return(list(value))
+  }
+
+  value <- result_vectbl_wrap_rhs(value)
+  if (is_null(value)) {
     cnd_signal(error_need_rhs_vector_or_null(value_arg))
-  } else if (is_atomic(value)) {
-    list(value)
-  } else {
-    value <- unclass(value)
-    if (!is_bare_list(value)) {
-      cnd_signal(error_need_rhs_vector_or_null(value_arg))
-    }
-    value
   }
+
+  value
+}
+
+vectbl_wrap_rhs_row <- function(value, value_arg) {
+  value <- result_vectbl_wrap_rhs(value)
+  if (is_null(value)) {
+    cnd_signal(error_need_rhs_vector(value_arg))
+  }
+
+  value
 }
 
-vectbl_wrap_rhs_row <- function(value, value_arg, i) {
+result_vectbl_wrap_rhs <- function(value) {
   if (!vec_is(value)) {
-    cnd_signal(error_need_rhs_vector(value_arg))
+    NULL
+  } else if (is.array(value)) {
+    if (any(dim(value)[-1:-2] != 1)) {
+      return(NULL)
+    }
+    dim(value) <- head(dim(value), 2)
+    as.list(as.data.frame(value, stringsAsFactors = FALSE))
   } else if (is_atomic(value)) {
     list(value)
   } else {
@@ -716,11 +728,11 @@ string_to_indices <- function(x) {
 # Errors ------------------------------------------------------------------
 
 error_need_rhs_vector <- function(value_arg) {
-  tibble_error(paste0(tick(as_label(value_arg)), " must be a vector, a bare list or a data frame."))
+  tibble_error(paste0(tick(as_label(value_arg)), " must be a vector, a bare list, a data frame or a matrix."))
 }
 
 error_need_rhs_vector_or_null <- function(value_arg) {
-  tibble_error(paste0(tick(as_label(value_arg)), " must be a vector, a bare list, a data frame or NULL."))
+  tibble_error(paste0(tick(as_label(value_arg)), " must be a vector, a bare list, a data frame, a matrix, or NULL."))
 }
 
 error_na_column_index <- function(j) {

tests/testthat/msg.txt

@@ -199,11 +199,11 @@ subsetting
 
 > error_need_rhs_vector(quote(RHS))
 <error/tibble_error_need_rhs_vector>
-`RHS` must be a vector, a bare list or a data frame.
+`RHS` must be a vector, a bare list, a data frame or a matrix.
 
 > error_need_rhs_vector_or_null(quote(RHS))
 <error/tibble_error_need_rhs_vector_or_null>
-`RHS` must be a vector, a bare list, a data frame or NULL.
+`RHS` must be a vector, a bare list, a data frame, a matrix, or NULL.
 
 > error_na_column_index(1:3)
 <error/tibble_error_na_column_index>

tests/testthat/subsetting.txt

@@ -405,10 +405,10 @@ Error: Can't use NA as row index in a tibble for assignment.
 
 > df <- tibble(x = 1:2, y = x)
 > df[] <- mean
-Error: `mean` must be a vector, a bare list, a data frame or NULL.
+Error: `mean` must be a vector, a bare list, a data frame, a matrix, or NULL.
 
 > df[] <- lm(y ~ x, df)
-Error: `lm(y ~ x, df)` must be a vector, a bare list, a data frame or NULL.
+Error: `lm(y ~ x, df)` must be a vector, a bare list, a data frame, a matrix, or NULL.
 
 
 [<-.tbl_df throws an error with OOB assignment
@@ -488,7 +488,7 @@ i Error occurred for column `x`.
 x No common type for `value` <list> and `x` <integer>.
 
 > df[1:3, 1:3] <- NULL
-Error: `NULL` must be a vector, a bare list or a data frame.
+Error: `NULL` must be a vector, a bare list, a data frame or a matrix.
 
 
 [<-.tbl_df and overwriting NA
@@ -633,10 +633,10 @@ i Only vectors of size 1 are recycled.
 
 > df <- tibble(x = 1:2, y = x)
 > df[1] <- lm(y ~ x, df)
-Error: `lm(y ~ x, df)` must be a vector, a bare list, a data frame or NULL.
+Error: `lm(y ~ x, df)` must be a vector, a bare list, a data frame, a matrix, or NULL.
 
 > df[1:2, 1] <- NULL
-Error: `NULL` must be a vector, a bare list or a data frame.
+Error: `NULL` must be a vector, a bare list, a data frame or a matrix.
 
 
 $<- recycles only values of length one

tests/testthat/test-subsetting.R

@@ -518,6 +518,38 @@ test_that("[<-.tbl_df supports adding duplicate columns", {
   expect_identical(df, tibble(x = 1:2, x = 3:4, .name_repair = "minimal"))
 })
 
+
+test_that("[<-.tbl_df supports matrix on the RHS (#762)", {
+  df <- tibble(x = 1:4, y = letters[1:4])
+  df[1:2] <- matrix(8:1, ncol = 2)
+  expect_identical(df, tibble(x = 8:5, y = 4:1))
+
+  df <- tibble(x = 1:4, y = letters[1:4])
+  df[1:2] <- array(4:1, dim = c(4, 1, 1))
+  expect_identical(df, tibble(x = 4:1, y = 4:1))
+
+  df <- tibble(x = 1:4, y = letters[1:4])
+  df[1:2] <- array(8:1, dim = c(4, 2, 1))
+  expect_identical(df, tibble(x = 8:5, y = 4:1))
+
+  df <- tibble(x = 1:4, y = letters[1:4])
+  expect_tibble_error(
+    df[1:3, 1:2] <- matrix(6:1, ncol = 2),
+    error_assign_incompatible_type(
+      df, matrix(6:1, ncol = 2), 2, quote(matrix(6:1, ncol = 2)),
+      cnd_message(tryCatch(vec_assign(letters, 1:3, 3:1), error = identity))
+    )
+  )
+  expect_tibble_error(
+    df[1:2] <- array(8:1, dim = c(2, 1, 4)),
+    error_need_rhs_vector_or_null(quote(array(8:1, dim = c(2, 1, 4))))
+  )
+  expect_tibble_error(
+    df[1:2] <- array(8:1, dim = c(4, 1, 2)),
+    error_need_rhs_vector_or_null(quote(array(8:1, dim = c(4, 1, 2))))
+  )
+})
+
 test_that("[<- with explicit NULL doesn't change anything (#696)", {
   iris_tbl_orig <- as_tibble(iris)
 

vignettes/invariants.Rmd

@@ -577,6 +577,21 @@ with_df(df[is.na(df)] <- 1:2)
 with_df(df[matrix(c(rep(TRUE, 5), rep(FALSE, 7)), ncol = 3)] <- 4)
 ```
 
+### `a` is a matrix or array
+
+If `is.matrix(a)`, then `a` is coerced to a data frame with `as.data.frame()` before assigning.
+If rows are assigned, the matrix type must be compatible with all columns.
+If `is.array(a)` and `any(dim(a)[-1:-2] != 1)`, an error is thrown.
+
+```{r bracket-assign-array, dftbl = TRUE}
+with_df(df[1:2] <- matrix(8:1, ncol = 2))
+with_df(df[1:3, 1:2] <- matrix(6:1, ncol = 2))
+with_df(df[1:2] <- array(4:1, dim = c(4, 1, 1)))
+with_df(df[1:2] <- array(8:1, dim = c(4, 2, 1)))
+with_df(df[1:2] <- array(8:1, dim = c(2, 1, 4)))
+with_df(df[1:2] <- array(8:1, dim = c(4, 1, 2)))
+```
+
 ### `a` is another type of vector
 
 If `vec_is(a)`, then `x[j] <- a` is equivalent to `x[j] <- list(a)`.
@@ -587,13 +602,12 @@ with_df(df[1] <- 0)
 with_df(df[1] <- list(0))
 ```
 
-Matrices are vectors, so they are also wrapped in `list()` before assignment.
-This consistently creates matrix columns, unlike data frames, which creates matrix columns when assigning to one column, but treats the matrix like a data frame when assigning to more than one column.
+Matrices must be wrapped in `list()` before assignment to create a matrix column.
 
 ```{r bracket-assign-matrix, dftbl = TRUE}
-with_df(df[1] <- matrix(1:8, ncol = 2))
+with_df(df[1] <- list(matrix(1:8, ncol = 2)))
 
-with_df(df[1:2] <- matrix(1:8, ncol = 2))
+with_df(df[1:2] <- list(matrix(1:8, ncol = 2)))
 ```
 
 ### `a` is `NULL`