nealrichardson commented on a change in pull request #8579:
URL: https://github.com/apache/arrow/pull/8579#discussion_r516787998
##########
File path: r/R/table.R
##########
@@ -254,6 +257,49 @@ names.Table <- function(x) x$ColumnNames()
#' @export
`[[.Table` <- `[[.RecordBatch`
+#' @export
+`[[<-.Table` <- function(x, i, value) {
+ if (is.null(value)) {
+ if (is.character(i)) {
+ i <- match(i, names(x)) - 1L
+ }
Review comment:
I think we need to do the `- 1L` even if i is not character, otherwise
we'll be off by one with an integer `i`.
##########
File path: r/R/table.R
##########
@@ -254,6 +257,49 @@ names.Table <- function(x) x$ColumnNames()
#' @export
`[[.Table` <- `[[.RecordBatch`
+#' @export
+`[[<-.Table` <- function(x, i, value) {
+ if (is.null(value)) {
+ if (is.character(i)) {
+ i <- match(i, names(x)) - 1L
+ }
+ x <- x$RemoveColumn(i)
+ } else {
+ if (!is.character(i)) {
+ # get or create a/the column name
+ if (i <= ncol(x)) {
Review comment:
This is a trivial difference but it does save some work because `ncol ==
function (x) dim(x)[2L]`
```suggestion
if (i <= x$num_columns) {
```
##########
File path: r/tests/testthat/test-Table.R
##########
@@ -145,7 +145,55 @@ test_that("[, [[, $ for Table", {
expect_data_frame(tab[0], tbl[0])
})
+test_that("[[<- assignment", {
+ tbl <- tibble::tibble(
+ int = 1:10,
+ dbl = as.numeric(1:10),
+ lgl = sample(c(TRUE, FALSE, NA), 10, replace = TRUE),
+ chr = letters[1:10],
+ fct = factor(letters[1:10])
+ )
+ tab <- Table$create(tbl)
+
+ # can remove a column
+ tab[["chr"]] <- NULL
+ expect_data_frame(tab, tbl[-4])
+
+ # can add a named column
+ tab[["new"]] <- letters[10:1]
+ expect_vector(tab[["new"]], letters[10:1])
Review comment:
Part of the behavior we want to test is the position of the new column,
so let's assert the whole data.frame
```suggestion
expect_data_frame(tab, cbind(tbl, new = letters[10:1]))
```
##########
File path: r/tests/testthat/test-Table.R
##########
@@ -145,7 +145,55 @@ test_that("[, [[, $ for Table", {
expect_data_frame(tab[0], tbl[0])
})
+test_that("[[<- assignment", {
+ tbl <- tibble::tibble(
+ int = 1:10,
+ dbl = as.numeric(1:10),
+ lgl = sample(c(TRUE, FALSE, NA), 10, replace = TRUE),
+ chr = letters[1:10],
+ fct = factor(letters[1:10])
+ )
+ tab <- Table$create(tbl)
+
+ # can remove a column
+ tab[["chr"]] <- NULL
+ expect_data_frame(tab, tbl[-4])
+
+ # can add a named column
+ tab[["new"]] <- letters[10:1]
+ expect_vector(tab[["new"]], letters[10:1])
+
+ # can add a column
+ tab[[2]] <- as.numeric(10:1)
+ expect_vector(tab[[2]], as.numeric(10:1))
+
+ # can add a column by index
+ tab[[6]] <- as.numeric(10:1)
+ expect_vector(tab[[6]], as.numeric(10:1))
+ expect_vector(tab[["6"]], as.numeric(10:1))
+
+ # can replace a column
+ tab[["int"]] <- 10:1
+ expect_vector(tab[["int"]], 10:1)
+
+ # can use $
+ tab$new <- NULL
+ expect_null(as.vector(tab$new))
+ expect_identical(dim(tab), c(10L, 5L))
+
+ tab$int <- 1:10
+ expect_vector(tab$int, 1:10)
+})
Review comment:
Other tests we might want to add (and implement as necessary):
* `tab[[NA]] <- something`
* `tab[[NULL]] <- something`
* R input recycling (making sure we're consistent with how [[<-.data.frame
works)
* assigning in an Arrow Array or ChunkedArray. `chunked_array()` should
handle that but we should confirm
* any others?
##########
File path: r/R/table.R
##########
@@ -254,6 +257,49 @@ names.Table <- function(x) x$ColumnNames()
#' @export
`[[.Table` <- `[[.RecordBatch`
+#' @export
+`[[<-.Table` <- function(x, i, value) {
+ if (is.null(value)) {
+ if (is.character(i)) {
+ i <- match(i, names(x)) - 1L
+ }
+ x <- x$RemoveColumn(i)
+ } else {
+ if (!is.character(i)) {
+ # get or create a/the column name
+ if (i <= ncol(x)) {
+ i <- names(x)[[i]]
Review comment:
```suggestion
i <- names(x)[i]
```
##########
File path: r/R/table.R
##########
@@ -254,6 +257,49 @@ names.Table <- function(x) x$ColumnNames()
#' @export
`[[.Table` <- `[[.RecordBatch`
+#' @export
+`[[<-.Table` <- function(x, i, value) {
+ if (is.null(value)) {
+ if (is.character(i)) {
+ i <- match(i, names(x)) - 1L
+ }
+ x <- x$RemoveColumn(i)
+ } else {
+ if (!is.character(i)) {
+ # get or create a/the column name
+ if (i <= ncol(x)) {
+ i <- names(x)[[i]]
+ } else {
+ i <- as.character(i)
+ }
+ }
+
+ # construct the field
+ value <- chunked_array(value)
+ new_field <- field(i, value$type)
+
+ if (i %in% names(x)) {
+ i <- match(i, names(x)) - 1L
+ x <- x$SetColumn(i, new_field, value)
+ } else {
+ i <- ncol(x)
+ x <- x$AddColumn(i, new_field, value)
+ }
+ }
+ x
+}
+
+#' @export
+`$<-.Table` <- function(x, i, value) {
+ assert_that(is.string(i))
+ if (i %in% ls(x)) {
+ assign(i, value, x)
Review comment:
Can you add a comment explaining why this `if` is here?
----------------------------------------------------------------
This is an automated message from the Apache Git Service.
To respond to the message, please log on to GitHub and use the
URL above to go to the specific comment.
For queries about this service, please contact Infrastructure at:
[email protected]
