GH-45601: [R] R arrow cannot handle labelled data in arrow tables

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

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)
 }
 

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")

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))