diff --git a/R/subsetting.R b/R/subsetting.R index 565dfc667..6ed09f701 100644 --- a/R/subsetting.R +++ b/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) { diff --git a/tests/testthat/msg.txt b/tests/testthat/msg.txt index 93ec7e33f..3e786e444 100644 --- a/tests/testthat/msg.txt +++ b/tests/testthat/msg.txt @@ -199,11 +199,11 @@ subsetting > error_need_rhs_vector(quote(RHS)) -`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)) -`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) diff --git a/tests/testthat/subsetting.txt b/tests/testthat/subsetting.txt index eb4d9dff6..0a39cc4b3 100644 --- a/tests/testthat/subsetting.txt +++ b/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` and `x` . > 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 diff --git a/tests/testthat/test-subsetting.R b/tests/testthat/test-subsetting.R index 8cbda5f16..5ec57d7d3 100644 --- a/tests/testthat/test-subsetting.R +++ b/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) diff --git a/vignettes/invariants.Rmd b/vignettes/invariants.Rmd index 212eccc90..dc5c82b16 100644 --- a/vignettes/invariants.Rmd +++ b/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` diff --git a/vignettes/invariants.md b/vignettes/invariants.md index 25a0a2e3b..2478fb44a 100644 --- a/vignettes/invariants.md +++ b/vignettes/invariants.md @@ -2522,6 +2522,132 @@ and if all columns updated are compatible with the value assigned. +### `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. + + + + + + + + + + + + + + + + + + + + + + + + + + + + +
+ + + with_tbl(tbl[1:2] <- matrix(8:1, ncol = 2)) + #> # A tibble: 4 x 3 + #> n c li + #> + #> 1 8 4 + #> 2 7 3 + #> 3 6 2 + #> 4 5 1 + +
+ + with_df(df[1:3, 1:2] <- matrix(6:1, ncol = 2)) + #> n c li + #> 1 6 3 9 + #> 2 5 2 10, 11 + #> 3 4 1 12, 13, 14 + #> 4 NA h text + + + + with_tbl(tbl[1:3, 1:2] <- matrix(6:1, ncol = 2)) + + #> Error: Assigned data `matrix(6:1, ncol = + #> 2)` must be compatible with existing + #> data. + #> ℹ Error occurred for column `c`. + #> x No common type for `value` + #> and `x` . + +
+ + + with_tbl(tbl[1:2] <- array(4:1, dim = c(4, 1, 1))) + #> # A tibble: 4 x 3 + #> n c li + #> + #> 1 4 4 + #> 2 3 3 + #> 3 2 2 + #> 4 1 1 + +
+ + + with_tbl(tbl[1:2] <- array(8:1, dim = c(4, 2, 1))) + #> # A tibble: 4 x 3 + #> n c li + #> + #> 1 8 4 + #> 2 7 3 + #> 3 6 2 + #> 4 5 1 + +
+ + with_df(df[1:2] <- array(8:1, dim = c(2, 1, 4))) + #> n c li + #> 1 8 4 9 + #> 2 7 3 10, 11 + #> 3 6 2 12, 13, 14 + #> 4 5 1 text + + + + with_tbl(tbl[1:2] <- array(8:1, dim = c(2, 1, 4))) + + #> Error: `array(8:1, dim = c(2, 1, 4))` + #> must be a vector, a bare list, a data + #> frame, a matrix, or NULL. + +
+ + with_df(df[1:2] <- array(8:1, dim = c(4, 1, 2))) + #> n c li + #> 1 8 4 9 + #> 2 7 3 10, 11 + #> 3 6 2 12, 13, 14 + #> 4 5 1 text + + + + with_tbl(tbl[1:2] <- array(8:1, dim = c(4, 1, 2))) + + #> Error: `array(8:1, dim = c(4, 1, 2))` + #> must be a vector, a bare list, a data + #> frame, a matrix, or NULL. + +
+ ### `a` is another type of vector If `vec_is(a)`, then `x[j] <- a` is equivalent to `x[j] <- list(a)`. @@ -2564,11 +2690,8 @@ This is primarily provided for backward compatbility. -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. @@ -2577,7 +2700,7 @@ column. @@ -2703,7 +2818,7 @@ scalar. See `?vec_is` and `?vec_proxy` for details. with_tbl(tbl[1] <- mean) #> Error: `mean` must be a vector, a bare - #> list, a data frame or NULL. + #> list, a data frame, a matrix, or NULL. @@ -2749,7 +2864,7 @@ scalar. See `?vec_is` and `?vec_proxy` for details. #> Error: `lm(mpg ~ wt, data = mtcars)` #> must be a vector, a bare list, a data - #> frame or NULL. + #> frame, a matrix, or NULL. @@ -3601,7 +3716,7 @@ For new columns, `x[i, j] <- a` fills the unassigned rows with `NA`. with_tbl(tbl[2:3, "n"] <- NULL) #> Error: `NULL` must be a vector, a bare - #> list or a data frame. + #> list, a data frame or a matrix.
- with_tbl(tbl[1] <- matrix(1:8, ncol = 2)) + with_tbl(tbl[1] <- list(matrix(1:8, ncol = 2))) #> # A tibble: 4 x 3 #> n[,1] [,2] c li #> @@ -2596,18 +2719,10 @@ column.
- - with_df(df[1:2] <- matrix(1:8, ncol = 2)) - #> n c li - #> 1 1 5 9 - #> 2 2 6 10, 11 - #> 3 3 7 12, 13, 14 - #> 4 4 8 text - - with_tbl(tbl[1:2] <- matrix(1:8, ncol = 2)) + with_tbl(tbl[1:2] <- list(matrix(1:8, ncol = 2))) #> # A tibble: 4 x 3 #> n[,1] [,2] c[,1] [,2] li #> @@ -2673,7 +2788,7 @@ Entire columns can be removed. Specifying `i` is an error. with_tbl(tbl[1, 2:3] <- NULL) #> Error: `NULL` must be a vector, a bare - #> list or a data frame. + #> list, a data frame or a matrix.