diff --git a/r/R/arrow-package.R b/r/R/arrow-package.R index 4b54697d4bd90..9206daadb92a6 100644 --- a/r/R/arrow-package.R +++ b/r/R/arrow-package.R @@ -18,7 +18,7 @@ #' @importFrom stats quantile median na.omit na.exclude na.pass na.fail #' @importFrom R6 R6Class #' @importFrom purrr as_mapper map map2 map_chr map2_chr map_dbl map_dfr map_int map_lgl keep imap imap_chr -#' @importFrom purrr flatten reduce walk +#' @importFrom purrr flatten reduce walk modify_if #' @importFrom assertthat assert_that is.string #' @importFrom rlang list2 %||% is_false abort dots_n warn enquo quo_is_null enquos is_integerish quos quo #' @importFrom rlang eval_tidy new_data_mask syms env new_environment env_bind set_names exec diff --git a/r/R/table.R b/r/R/table.R index ac2cbc1440f5b..e344db35019cd 100644 --- a/r/R/table.R +++ b/r/R/table.R @@ -324,6 +324,7 @@ as_arrow_table.RecordBatch <- function(x, ..., schema = NULL) { #' @export as_arrow_table.data.frame <- function(x, ..., schema = NULL) { check_named_cols(x) + x <- unlabel_cols(x) Table$create(x, schema = schema) } diff --git a/r/R/util.R b/r/R/util.R index ca9a9efd9da09..ae5c92a298ead 100644 --- a/r/R/util.R +++ b/r/R/util.R @@ -249,6 +249,17 @@ check_named_cols <- function(df) { } } +unlabel_cols <- function(df) { + remove_label <- function(x) { + attr(x, "label") <- NULL + class(x) <- class(x)[!class(x) %in% c("haven_labelled", "vctrs_vctr")] + rlang::warn("haven labels have been discarded") + x + } + + purrr::modify_if(df, ~ inherits(.x, "haven_labelled"), remove_label) +} + parse_compact_col_spec <- function(col_types, col_names) { if (length(col_types) != 1L) { abort("`col_types` must be a character vector of size 1") diff --git a/r/tests/testthat/test-Table.R b/r/tests/testthat/test-Table.R index 3c0cbb1e3297a..fef8f32e491d3 100644 --- a/r/tests/testthat/test-Table.R +++ b/r/tests/testthat/test-Table.R @@ -707,8 +707,19 @@ test_that("as_arrow_table() errors on data.frame with NULL names", { expect_error(as_arrow_table(df), "Input data frame columns must be named") }) -test_that("# GH-35038 - passing in multiple arguments doesn't affect return type", { +test_that("as_arrow_table() removes haven labels and warns users", { + haven_df <- tibble::tibble( + a = structure(1, label = "example variable a", class = c("haven_labelled", "vctrs_vctr", "integer")), + b = structure(2, label = "example variable b", class = c("haven_labelled", "vctrs_vctr", "integer")) + ) + + expect_warning( + as_arrow_table(haven_df), + regexp = "haven labels have been discarded" + ) +}) +test_that("# GH-35038 - passing in multiple arguments doesn't affect return type", { df <- data.frame(x = 1) out1 <- as.data.frame(arrow_table(df, name = "1")) out2 <- as.data.frame(arrow_table(name = "1", df))