ARROW-13189: [R] Disable row-level metadata application on datasets

r/NAMESPACE

@@ -327,6 +327,7 @@ importFrom(rlang,quos)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
 importFrom(rlang,syms)
+importFrom(rlang,trace_back)
 importFrom(rlang,warn)
 importFrom(stats,median)
 importFrom(stats,na.exclude)

r/R/metadata.R

@@ -50,6 +50,7 @@
  })
 }
 
+#' @importFrom rlang trace_back
 apply_arrow_r_metadata <- function(x, r_metadata) {
  tryCatch({
  columns_metadata <- r_metadata$columns
@@ -60,9 +61,27 @@ apply_arrow_r_metadata <- function(x, r_metadata) {
  }
  }
  } else if (is.list(x) && !inherits(x, "POSIXlt") && !is.null(columns_metadata)) {
- x <- map2(x, columns_metadata, function(.x, .y) {
- apply_arrow_r_metadata(.x, .y)
- })
+ # If we have a list and "columns_metadata" this applies row-level metadata
+ # inside of a column in a dataframe.
+
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dplyr_collect <- any(map_lgl(trace$calls, function(x) {
+ grepl("collect.arrow_dplyr_query", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dplyr_collect) {
+ warning(
+ "Row-level metadata is not compatible with this operation and has ",
+ "been ignored",
+ call. = FALSE
+ )
+ } else {
+ x <- map2(x, columns_metadata, function(.x, .y) {
+ apply_arrow_r_metadata(.x, .y)
+ })
+ }
  x
  }
 
@@ -116,9 +135,23 @@ arrow_attributes <- function(x, only_top_level = FALSE) {
 
  columns <- NULL
  if (is.list(x) && !inherits(x, "POSIXlt")) {
- # for list columns, we also keep attributes of each
- # element in columns
- columns <- map(x, arrow_attributes)
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dataset_write <- any(map_lgl(trace$calls, function(x) {
+ grepl("write_dataset", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dataset_write) {
+ warning(
+ "Row-level metadata is not compatible with datasets and will be discarded",
+ call. = FALSE
+ )
+ } else {
+ # for list columns, we also keep attributes of each
+ # element in columns
+ columns <- map(x, arrow_attributes)
+ }
  if (all(map_lgl(columns, is.null))) {
  columns <- NULL
  }

r/tests/testthat/helper-arrow.R

@@ -67,3 +67,9 @@ test_that <- function(what, code) {
 r_only <- function(code) {
  withr::with_options(list(..skip.tests = FALSE), code)
 }
+
+make_temp_dir <- function() {
+ path <- tempfile()
+ dir.create(path)
+ normalizePath(path, winslash = "/")
+}

r/tests/testthat/test-dataset.R

@@ -21,12 +21,6 @@ context("Dataset")
 
 library(dplyr)
 
-make_temp_dir <- function() {
- path <- tempfile()
- dir.create(path)
- normalizePath(path, winslash = "/")
-}
-
 dataset_dir <- make_temp_dir()
 hive_dir <- make_temp_dir()
 ipc_dir <- make_temp_dir()

r/tests/testthat/test-metadata.R

@@ -205,3 +205,45 @@ test_that("metadata of list elements (ARROW-10386)", {
  expect_identical(attr(as.data.frame(tab)$x[[1]], "foo"), "bar")
  expect_identical(attr(as.data.frame(tab)$x[[2]], "baz"), "qux")
 })
+
+
+test_that("metadata of list elements (ARROW-10386)", {
+ skip_if_not_available("dataset")
+ skip_if_not_available("parquet")
+
+ library(dplyr)
+
+ df <- tibble::tibble(
+ metadata = list(
+ structure(1, my_value_as_attr = 1),
+ structure(2, my_value_as_attr = 2),
+ structure(3, my_value_as_attr = 3),
+ structure(4, my_value_as_attr = 3)),
+ int = 1L:4L,
+ part = c(1, 3, 2, 1)
+ )
+
+ dst_dir <- make_temp_dir()
+ expect_warning(
+ write_dataset(df, dst_dir, partitioning = "part"),
+ "Row-level metadata is not compatible with datasets and will be discarded"
+ )
+
+ # but we need to write a dataset with row-level metadata to make sure when
+ # reading ones that have been written with them we warn appropriately
+ fake_func_name <- write_dataset
+ fake_func_name(df, dst_dir, partitioning = "part")
+
+ ds <- open_dataset(dst_dir)
+ expect_warning(
+ df_from_ds <- collect(ds),
+ "Row-level metadata is not compatible with this operation and has been ignored"
+ )
+ expect_equal(df_from_ds[c(1, 4, 3, 2), ], df, check.attributes = FALSE)
+
+ # however there is *no* warning if we don't select the metadata column
+ expect_warning(
+ df_from_ds <- ds %>% select(int) %>% collect(),
+ NA
+ )
+})

r/NAMESPACE

@@ -327,6 +327,7 @@ importFrom(rlang,quos)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
 importFrom(rlang,syms)
+importFrom(rlang,trace_back)
 importFrom(rlang,warn)
 importFrom(stats,median)
 importFrom(stats,na.exclude)

r/R/metadata.R

@@ -50,6 +50,7 @@
  })
 }
 
+#' @importFrom rlang trace_back
 apply_arrow_r_metadata <- function(x, r_metadata) {
  tryCatch({
  columns_metadata <- r_metadata$columns
@@ -60,9 +61,27 @@ apply_arrow_r_metadata <- function(x, r_metadata) {
  }
  }
  } else if (is.list(x) && !inherits(x, "POSIXlt") && !is.null(columns_metadata)) {
- x <- map2(x, columns_metadata, function(.x, .y) {
- apply_arrow_r_metadata(.x, .y)
- })
+ # If we have a list and "columns_metadata" this applies row-level metadata
+ # inside of a column in a dataframe.
+
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dplyr_collect <- any(map_lgl(trace$calls, function(x) {
+ grepl("collect.arrow_dplyr_query", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dplyr_collect) {
+ warning(
+ "Row-level metadata is not compatible with this operation and has ",
+ "been ignored",
+ call. = FALSE
+ )
+ } else {
+ x <- map2(x, columns_metadata, function(.x, .y) {
+ apply_arrow_r_metadata(.x, .y)
+ })
+ }
  x
  }
 
@@ -116,9 +135,23 @@ arrow_attributes <- function(x, only_top_level = FALSE) {
 
  columns <- NULL
  if (is.list(x) && !inherits(x, "POSIXlt")) {
- # for list columns, we also keep attributes of each
- # element in columns
- columns <- map(x, arrow_attributes)
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dataset_write <- any(map_lgl(trace$calls, function(x) {
+ grepl("write_dataset", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dataset_write) {
+ warning(
+ "Row-level metadata is not compatible with datasets and will be discarded",
+ call. = FALSE
+ )
+ } else {
+ # for list columns, we also keep attributes of each
+ # element in columns
+ columns <- map(x, arrow_attributes)
+ }
  if (all(map_lgl(columns, is.null))) {
  columns <- NULL
  }

r/tests/testthat/helper-arrow.R

@@ -67,3 +67,9 @@ test_that <- function(what, code) {
 r_only <- function(code) {
  withr::with_options(list(..skip.tests = FALSE), code)
 }
+
+make_temp_dir <- function() {
+ path <- tempfile()
+ dir.create(path)
+ normalizePath(path, winslash = "/")
+}

r/tests/testthat/test-dataset.R

@@ -21,12 +21,6 @@ context("Dataset")
 
 library(dplyr)
 
-make_temp_dir <- function() {
- path <- tempfile()
- dir.create(path)
- normalizePath(path, winslash = "/")
-}
-
 dataset_dir <- make_temp_dir()
 hive_dir <- make_temp_dir()
 ipc_dir <- make_temp_dir()

r/tests/testthat/test-metadata.R

@@ -205,3 +205,45 @@ test_that("metadata of list elements (ARROW-10386)", {
  expect_identical(attr(as.data.frame(tab)$x[[1]], "foo"), "bar")
  expect_identical(attr(as.data.frame(tab)$x[[2]], "baz"), "qux")
 })
+
+
+test_that("metadata of list elements (ARROW-10386)", {
+ skip_if_not_available("dataset")
+ skip_if_not_available("parquet")
+
+ library(dplyr)
+
+ df <- tibble::tibble(
+ metadata = list(
+ structure(1, my_value_as_attr = 1),
+ structure(2, my_value_as_attr = 2),
+ structure(3, my_value_as_attr = 3),
+ structure(4, my_value_as_attr = 3)),
+ int = 1L:4L,
+ part = c(1, 3, 2, 1)
+ )
+
+ dst_dir <- make_temp_dir()
+ expect_warning(
+ write_dataset(df, dst_dir, partitioning = "part"),
+ "Row-level metadata is not compatible with datasets and will be discarded"
+ )
+
+ # but we need to write a dataset with row-level metadata to make sure when
+ # reading ones that have been written with them we warn appropriately
+ fake_func_name <- write_dataset
+ fake_func_name(df, dst_dir, partitioning = "part")
+
+ ds <- open_dataset(dst_dir)
+ expect_warning(
+ df_from_ds <- collect(ds),
+ "Row-level metadata is not compatible with this operation and has been ignored"
+ )
+ expect_equal(df_from_ds[c(1, 4, 3, 2), ], df, check.attributes = FALSE)
+
+ # however there is *no* warning if we don't select the metadata column
+ expect_warning(
+ df_from_ds <- ds %>% select(int) %>% collect(),
+ NA
+ )
+})

r/NAMESPACE

@@ -327,6 +327,7 @@ importFrom(rlang,quos)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
 importFrom(rlang,syms)
+importFrom(rlang,trace_back)
 importFrom(rlang,warn)
 importFrom(stats,median)
 importFrom(stats,na.exclude)

r/R/metadata.R

@@ -50,6 +50,7 @@
  })
 }
 
+#' @importFrom rlang trace_back
 apply_arrow_r_metadata <- function(x, r_metadata) {
  tryCatch({
  columns_metadata <- r_metadata$columns
@@ -60,9 +61,27 @@ apply_arrow_r_metadata <- function(x, r_metadata) {
  }
  }
  } else if (is.list(x) && !inherits(x, "POSIXlt") && !is.null(columns_metadata)) {
- x <- map2(x, columns_metadata, function(.x, .y) {
- apply_arrow_r_metadata(.x, .y)
- })
+ # If we have a list and "columns_metadata" this applies row-level metadata
+ # inside of a column in a dataframe.
+
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dplyr_collect <- any(map_lgl(trace$calls, function(x) {
+ grepl("collect.arrow_dplyr_query", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dplyr_collect) {
+ warning(
+ "Row-level metadata is not compatible with this operation and has ",
+ "been ignored",
+ call. = FALSE
+ )
+ } else {
+ x <- map2(x, columns_metadata, function(.x, .y) {
+ apply_arrow_r_metadata(.x, .y)
+ })
+ }
  x
  }
 
@@ -116,9 +135,23 @@ arrow_attributes <- function(x, only_top_level = FALSE) {
 
  columns <- NULL
  if (is.list(x) && !inherits(x, "POSIXlt")) {
- # for list columns, we also keep attributes of each
- # element in columns
- columns <- map(x, arrow_attributes)
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dataset_write <- any(map_lgl(trace$calls, function(x) {
+ grepl("write_dataset", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dataset_write) {
+ warning(
+ "Row-level metadata is not compatible with datasets and will be discarded",
+ call. = FALSE
+ )
+ } else {
+ # for list columns, we also keep attributes of each
+ # element in columns
+ columns <- map(x, arrow_attributes)
+ }
  if (all(map_lgl(columns, is.null))) {
  columns <- NULL
  }

r/tests/testthat/helper-arrow.R

@@ -67,3 +67,9 @@ test_that <- function(what, code) {
 r_only <- function(code) {
  withr::with_options(list(..skip.tests = FALSE), code)
 }
+
+make_temp_dir <- function() {
+ path <- tempfile()
+ dir.create(path)
+ normalizePath(path, winslash = "/")
+}

r/tests/testthat/test-dataset.R

@@ -21,12 +21,6 @@ context("Dataset")
 
 library(dplyr)
 
-make_temp_dir <- function() {
- path <- tempfile()
- dir.create(path)
- normalizePath(path, winslash = "/")
-}
-
 dataset_dir <- make_temp_dir()
 hive_dir <- make_temp_dir()
 ipc_dir <- make_temp_dir()

r/tests/testthat/test-metadata.R

@@ -205,3 +205,45 @@ test_that("metadata of list elements (ARROW-10386)", {
  expect_identical(attr(as.data.frame(tab)$x[[1]], "foo"), "bar")
  expect_identical(attr(as.data.frame(tab)$x[[2]], "baz"), "qux")
 })
+
+
+test_that("metadata of list elements (ARROW-10386)", {
+ skip_if_not_available("dataset")
+ skip_if_not_available("parquet")
+
+ library(dplyr)
+
+ df <- tibble::tibble(
+ metadata = list(
+ structure(1, my_value_as_attr = 1),
+ structure(2, my_value_as_attr = 2),
+ structure(3, my_value_as_attr = 3),
+ structure(4, my_value_as_attr = 3)),
+ int = 1L:4L,
+ part = c(1, 3, 2, 1)
+ )
+
+ dst_dir <- make_temp_dir()
+ expect_warning(
+ write_dataset(df, dst_dir, partitioning = "part"),
+ "Row-level metadata is not compatible with datasets and will be discarded"
+ )
+
+ # but we need to write a dataset with row-level metadata to make sure when
+ # reading ones that have been written with them we warn appropriately
+ fake_func_name <- write_dataset
+ fake_func_name(df, dst_dir, partitioning = "part")
+
+ ds <- open_dataset(dst_dir)
+ expect_warning(
+ df_from_ds <- collect(ds),
+ "Row-level metadata is not compatible with this operation and has been ignored"
+ )
+ expect_equal(df_from_ds[c(1, 4, 3, 2), ], df, check.attributes = FALSE)
+
+ # however there is *no* warning if we don't select the metadata column
+ expect_warning(
+ df_from_ds <- ds %>% select(int) %>% collect(),
+ NA
+ )
+})

r/NAMESPACE

@@ -327,6 +327,7 @@ importFrom(rlang,quos)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
 importFrom(rlang,syms)
+importFrom(rlang,trace_back)
 importFrom(rlang,warn)
 importFrom(stats,median)
 importFrom(stats,na.exclude)

r/R/metadata.R

@@ -50,6 +50,7 @@
  })
 }
 
+#' @importFrom rlang trace_back
 apply_arrow_r_metadata <- function(x, r_metadata) {
  tryCatch({
  columns_metadata <- r_metadata$columns
@@ -60,9 +61,27 @@ apply_arrow_r_metadata <- function(x, r_metadata) {
  }
  }
  } else if (is.list(x) && !inherits(x, "POSIXlt") && !is.null(columns_metadata)) {
- x <- map2(x, columns_metadata, function(.x, .y) {
- apply_arrow_r_metadata(.x, .y)
- })
+ # If we have a list and "columns_metadata" this applies row-level metadata
+ # inside of a column in a dataframe.
+
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dplyr_collect <- any(map_lgl(trace$calls, function(x) {
+ grepl("collect.arrow_dplyr_query", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dplyr_collect) {
+ warning(
+ "Row-level metadata is not compatible with this operation and has ",
+ "been ignored",
+ call. = FALSE
+ )
+ } else {
+ x <- map2(x, columns_metadata, function(.x, .y) {
+ apply_arrow_r_metadata(.x, .y)
+ })
+ }
  x
  }
 
@@ -116,9 +135,23 @@ arrow_attributes <- function(x, only_top_level = FALSE) {
 
  columns <- NULL
  if (is.list(x) && !inherits(x, "POSIXlt")) {
- # for list columns, we also keep attributes of each
- # element in columns
- columns <- map(x, arrow_attributes)
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dataset_write <- any(map_lgl(trace$calls, function(x) {
+ grepl("write_dataset", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dataset_write) {
+ warning(
+ "Row-level metadata is not compatible with datasets and will be discarded",
+ call. = FALSE
+ )
+ } else {
+ # for list columns, we also keep attributes of each
+ # element in columns
+ columns <- map(x, arrow_attributes)
+ }
  if (all(map_lgl(columns, is.null))) {
  columns <- NULL
  }

r/tests/testthat/helper-arrow.R

@@ -67,3 +67,9 @@ test_that <- function(what, code) {
 r_only <- function(code) {
  withr::with_options(list(..skip.tests = FALSE), code)
 }
+
+make_temp_dir <- function() {
+ path <- tempfile()
+ dir.create(path)
+ normalizePath(path, winslash = "/")
+}

r/tests/testthat/test-dataset.R

@@ -21,12 +21,6 @@ context("Dataset")
 
 library(dplyr)
 
-make_temp_dir <- function() {
- path <- tempfile()
- dir.create(path)
- normalizePath(path, winslash = "/")
-}
-
 dataset_dir <- make_temp_dir()
 hive_dir <- make_temp_dir()
 ipc_dir <- make_temp_dir()

r/tests/testthat/test-metadata.R

@@ -205,3 +205,45 @@ test_that("metadata of list elements (ARROW-10386)", {
  expect_identical(attr(as.data.frame(tab)$x[[1]], "foo"), "bar")
  expect_identical(attr(as.data.frame(tab)$x[[2]], "baz"), "qux")
 })
+
+
+test_that("metadata of list elements (ARROW-10386)", {
+ skip_if_not_available("dataset")
+ skip_if_not_available("parquet")
+
+ library(dplyr)
+
+ df <- tibble::tibble(
+ metadata = list(
+ structure(1, my_value_as_attr = 1),
+ structure(2, my_value_as_attr = 2),
+ structure(3, my_value_as_attr = 3),
+ structure(4, my_value_as_attr = 3)),
+ int = 1L:4L,
+ part = c(1, 3, 2, 1)
+ )
+
+ dst_dir <- make_temp_dir()
+ expect_warning(
+ write_dataset(df, dst_dir, partitioning = "part"),
+ "Row-level metadata is not compatible with datasets and will be discarded"
+ )
+
+ # but we need to write a dataset with row-level metadata to make sure when
+ # reading ones that have been written with them we warn appropriately
+ fake_func_name <- write_dataset
+ fake_func_name(df, dst_dir, partitioning = "part")
+
+ ds <- open_dataset(dst_dir)
+ expect_warning(
+ df_from_ds <- collect(ds),
+ "Row-level metadata is not compatible with this operation and has been ignored"
+ )
+ expect_equal(df_from_ds[c(1, 4, 3, 2), ], df, check.attributes = FALSE)
+
+ # however there is *no* warning if we don't select the metadata column
+ expect_warning(
+ df_from_ds <- ds %>% select(int) %>% collect(),
+ NA
+ )
+})

r/NAMESPACE

@@ -327,6 +327,7 @@ importFrom(rlang,quos)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
 importFrom(rlang,syms)
+importFrom(rlang,trace_back)
 importFrom(rlang,warn)
 importFrom(stats,median)
 importFrom(stats,na.exclude)

r/R/metadata.R

@@ -50,6 +50,7 @@
  })
 }
 
+#' @importFrom rlang trace_back
 apply_arrow_r_metadata <- function(x, r_metadata) {
  tryCatch({
  columns_metadata <- r_metadata$columns
@@ -60,9 +61,27 @@ apply_arrow_r_metadata <- function(x, r_metadata) {
  }
  }
  } else if (is.list(x) && !inherits(x, "POSIXlt") && !is.null(columns_metadata)) {
- x <- map2(x, columns_metadata, function(.x, .y) {
- apply_arrow_r_metadata(.x, .y)
- })
+ # If we have a list and "columns_metadata" this applies row-level metadata
+ # inside of a column in a dataframe.
+
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dplyr_collect <- any(map_lgl(trace$calls, function(x) {
+ grepl("collect.arrow_dplyr_query", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dplyr_collect) {
+ warning(
+ "Row-level metadata is not compatible with this operation and has ",
+ "been ignored",
+ call. = FALSE
+ )
+ } else {
+ x <- map2(x, columns_metadata, function(.x, .y) {
+ apply_arrow_r_metadata(.x, .y)
+ })
+ }
  x
  }
 
@@ -116,9 +135,23 @@ arrow_attributes <- function(x, only_top_level = FALSE) {
 
  columns <- NULL
  if (is.list(x) && !inherits(x, "POSIXlt")) {
- # for list columns, we also keep attributes of each
- # element in columns
- columns <- map(x, arrow_attributes)
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dataset_write <- any(map_lgl(trace$calls, function(x) {
+ grepl("write_dataset", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dataset_write) {
+ warning(
+ "Row-level metadata is not compatible with datasets and will be discarded",
+ call. = FALSE
+ )
+ } else {
+ # for list columns, we also keep attributes of each
+ # element in columns
+ columns <- map(x, arrow_attributes)
+ }
  if (all(map_lgl(columns, is.null))) {
  columns <- NULL
  }

r/tests/testthat/helper-arrow.R

@@ -67,3 +67,9 @@ test_that <- function(what, code) {
 r_only <- function(code) {
  withr::with_options(list(..skip.tests = FALSE), code)
 }
+
+make_temp_dir <- function() {
+ path <- tempfile()
+ dir.create(path)
+ normalizePath(path, winslash = "/")
+}

r/tests/testthat/test-dataset.R

@@ -21,12 +21,6 @@ context("Dataset")
 
 library(dplyr)
 
-make_temp_dir <- function() {
- path <- tempfile()
- dir.create(path)
- normalizePath(path, winslash = "/")
-}
-
 dataset_dir <- make_temp_dir()
 hive_dir <- make_temp_dir()
 ipc_dir <- make_temp_dir()

r/tests/testthat/test-metadata.R

@@ -205,3 +205,45 @@ test_that("metadata of list elements (ARROW-10386)", {
  expect_identical(attr(as.data.frame(tab)$x[[1]], "foo"), "bar")
  expect_identical(attr(as.data.frame(tab)$x[[2]], "baz"), "qux")
 })
+
+
+test_that("metadata of list elements (ARROW-10386)", {
+ skip_if_not_available("dataset")
+ skip_if_not_available("parquet")
+
+ library(dplyr)
+
+ df <- tibble::tibble(
+ metadata = list(
+ structure(1, my_value_as_attr = 1),
+ structure(2, my_value_as_attr = 2),
+ structure(3, my_value_as_attr = 3),
+ structure(4, my_value_as_attr = 3)),
+ int = 1L:4L,
+ part = c(1, 3, 2, 1)
+ )
+
+ dst_dir <- make_temp_dir()
+ expect_warning(
+ write_dataset(df, dst_dir, partitioning = "part"),
+ "Row-level metadata is not compatible with datasets and will be discarded"
+ )
+
+ # but we need to write a dataset with row-level metadata to make sure when
+ # reading ones that have been written with them we warn appropriately
+ fake_func_name <- write_dataset
+ fake_func_name(df, dst_dir, partitioning = "part")
+
+ ds <- open_dataset(dst_dir)
+ expect_warning(
+ df_from_ds <- collect(ds),
+ "Row-level metadata is not compatible with this operation and has been ignored"
+ )
+ expect_equal(df_from_ds[c(1, 4, 3, 2), ], df, check.attributes = FALSE)
+
+ # however there is *no* warning if we don't select the metadata column
+ expect_warning(
+ df_from_ds <- ds %>% select(int) %>% collect(),
+ NA
+ )
+})

r/NAMESPACE

@@ -327,6 +327,7 @@ importFrom(rlang,quos)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
 importFrom(rlang,syms)
+importFrom(rlang,trace_back)
 importFrom(rlang,warn)
 importFrom(stats,median)
 importFrom(stats,na.exclude)

r/R/metadata.R

@@ -50,6 +50,7 @@
  })
 }
 
+#' @importFrom rlang trace_back
 apply_arrow_r_metadata <- function(x, r_metadata) {
  tryCatch({
  columns_metadata <- r_metadata$columns
@@ -60,9 +61,27 @@ apply_arrow_r_metadata <- function(x, r_metadata) {
  }
  }
  } else if (is.list(x) && !inherits(x, "POSIXlt") && !is.null(columns_metadata)) {
- x <- map2(x, columns_metadata, function(.x, .y) {
- apply_arrow_r_metadata(.x, .y)
- })
+ # If we have a list and "columns_metadata" this applies row-level metadata
+ # inside of a column in a dataframe.
+
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dplyr_collect <- any(map_lgl(trace$calls, function(x) {
+ grepl("collect.arrow_dplyr_query", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dplyr_collect) {
+ warning(
+ "Row-level metadata is not compatible with this operation and has ",
+ "been ignored",
+ call. = FALSE
+ )
+ } else {
+ x <- map2(x, columns_metadata, function(.x, .y) {
+ apply_arrow_r_metadata(.x, .y)
+ })
+ }
  x
  }
 
@@ -116,9 +135,23 @@ arrow_attributes <- function(x, only_top_level = FALSE) {
 
  columns <- NULL
  if (is.list(x) && !inherits(x, "POSIXlt")) {
- # for list columns, we also keep attributes of each
- # element in columns
- columns <- map(x, arrow_attributes)
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dataset_write <- any(map_lgl(trace$calls, function(x) {
+ grepl("write_dataset", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dataset_write) {
+ warning(
+ "Row-level metadata is not compatible with datasets and will be discarded",
+ call. = FALSE
+ )
+ } else {
+ # for list columns, we also keep attributes of each
+ # element in columns
+ columns <- map(x, arrow_attributes)
+ }
  if (all(map_lgl(columns, is.null))) {
  columns <- NULL
  }

r/tests/testthat/helper-arrow.R

@@ -67,3 +67,9 @@ test_that <- function(what, code) {
 r_only <- function(code) {
  withr::with_options(list(..skip.tests = FALSE), code)
 }
+
+make_temp_dir <- function() {
+ path <- tempfile()
+ dir.create(path)
+ normalizePath(path, winslash = "/")
+}

r/tests/testthat/test-dataset.R

@@ -21,12 +21,6 @@ context("Dataset")
 
 library(dplyr)
 
-make_temp_dir <- function() {
- path <- tempfile()
- dir.create(path)
- normalizePath(path, winslash = "/")
-}
-
 dataset_dir <- make_temp_dir()
 hive_dir <- make_temp_dir()
 ipc_dir <- make_temp_dir()

r/tests/testthat/test-metadata.R

@@ -205,3 +205,45 @@ test_that("metadata of list elements (ARROW-10386)", {
  expect_identical(attr(as.data.frame(tab)$x[[1]], "foo"), "bar")
  expect_identical(attr(as.data.frame(tab)$x[[2]], "baz"), "qux")
 })
+
+
+test_that("metadata of list elements (ARROW-10386)", {
+ skip_if_not_available("dataset")
+ skip_if_not_available("parquet")
+
+ library(dplyr)
+
+ df <- tibble::tibble(
+ metadata = list(
+ structure(1, my_value_as_attr = 1),
+ structure(2, my_value_as_attr = 2),
+ structure(3, my_value_as_attr = 3),
+ structure(4, my_value_as_attr = 3)),
+ int = 1L:4L,
+ part = c(1, 3, 2, 1)
+ )
+
+ dst_dir <- make_temp_dir()
+ expect_warning(
+ write_dataset(df, dst_dir, partitioning = "part"),
+ "Row-level metadata is not compatible with datasets and will be discarded"
+ )
+
+ # but we need to write a dataset with row-level metadata to make sure when
+ # reading ones that have been written with them we warn appropriately
+ fake_func_name <- write_dataset
+ fake_func_name(df, dst_dir, partitioning = "part")
+
+ ds <- open_dataset(dst_dir)
+ expect_warning(
+ df_from_ds <- collect(ds),
+ "Row-level metadata is not compatible with this operation and has been ignored"
+ )
+ expect_equal(df_from_ds[c(1, 4, 3, 2), ], df, check.attributes = FALSE)
+
+ # however there is *no* warning if we don't select the metadata column
+ expect_warning(
+ df_from_ds <- ds %>% select(int) %>% collect(),
+ NA
+ )
+})

r/NAMESPACE

@@ -327,6 +327,7 @@ importFrom(rlang,quos)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
 importFrom(rlang,syms)
+importFrom(rlang,trace_back)
 importFrom(rlang,warn)
 importFrom(stats,median)
 importFrom(stats,na.exclude)

r/R/metadata.R

@@ -50,6 +50,7 @@
  })
 }
 
+#' @importFrom rlang trace_back
 apply_arrow_r_metadata <- function(x, r_metadata) {
  tryCatch({
  columns_metadata <- r_metadata$columns
@@ -60,9 +61,27 @@ apply_arrow_r_metadata <- function(x, r_metadata) {
  }
  }
  } else if (is.list(x) && !inherits(x, "POSIXlt") && !is.null(columns_metadata)) {
- x <- map2(x, columns_metadata, function(.x, .y) {
- apply_arrow_r_metadata(.x, .y)
- })
+ # If we have a list and "columns_metadata" this applies row-level metadata
+ # inside of a column in a dataframe.
+
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dplyr_collect <- any(map_lgl(trace$calls, function(x) {
+ grepl("collect.arrow_dplyr_query", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dplyr_collect) {
+ warning(
+ "Row-level metadata is not compatible with this operation and has ",
+ "been ignored",
+ call. = FALSE
+ )
+ } else {
+ x <- map2(x, columns_metadata, function(.x, .y) {
+ apply_arrow_r_metadata(.x, .y)
+ })
+ }
  x
  }
 
@@ -116,9 +135,23 @@ arrow_attributes <- function(x, only_top_level = FALSE) {
 
  columns <- NULL
  if (is.list(x) && !inherits(x, "POSIXlt")) {
- # for list columns, we also keep attributes of each
- # element in columns
- columns <- map(x, arrow_attributes)
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dataset_write <- any(map_lgl(trace$calls, function(x) {
+ grepl("write_dataset", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dataset_write) {
+ warning(
+ "Row-level metadata is not compatible with datasets and will be discarded",
+ call. = FALSE
+ )
+ } else {
+ # for list columns, we also keep attributes of each
+ # element in columns
+ columns <- map(x, arrow_attributes)
+ }
  if (all(map_lgl(columns, is.null))) {
  columns <- NULL
  }

r/tests/testthat/helper-arrow.R

@@ -67,3 +67,9 @@ test_that <- function(what, code) {
 r_only <- function(code) {
  withr::with_options(list(..skip.tests = FALSE), code)
 }
+
+make_temp_dir <- function() {
+ path <- tempfile()
+ dir.create(path)
+ normalizePath(path, winslash = "/")
+}

r/tests/testthat/test-dataset.R

@@ -21,12 +21,6 @@ context("Dataset")
 
 library(dplyr)
 
-make_temp_dir <- function() {
- path <- tempfile()
- dir.create(path)
- normalizePath(path, winslash = "/")
-}
-
 dataset_dir <- make_temp_dir()
 hive_dir <- make_temp_dir()
 ipc_dir <- make_temp_dir()

r/tests/testthat/test-metadata.R

@@ -205,3 +205,45 @@ test_that("metadata of list elements (ARROW-10386)", {
  expect_identical(attr(as.data.frame(tab)$x[[1]], "foo"), "bar")
  expect_identical(attr(as.data.frame(tab)$x[[2]], "baz"), "qux")
 })
+
+
+test_that("metadata of list elements (ARROW-10386)", {
+ skip_if_not_available("dataset")
+ skip_if_not_available("parquet")
+
+ library(dplyr)
+
+ df <- tibble::tibble(
+ metadata = list(
+ structure(1, my_value_as_attr = 1),
+ structure(2, my_value_as_attr = 2),
+ structure(3, my_value_as_attr = 3),
+ structure(4, my_value_as_attr = 3)),
+ int = 1L:4L,
+ part = c(1, 3, 2, 1)
+ )
+
+ dst_dir <- make_temp_dir()
+ expect_warning(
+ write_dataset(df, dst_dir, partitioning = "part"),
+ "Row-level metadata is not compatible with datasets and will be discarded"
+ )
+
+ # but we need to write a dataset with row-level metadata to make sure when
+ # reading ones that have been written with them we warn appropriately
+ fake_func_name <- write_dataset
+ fake_func_name(df, dst_dir, partitioning = "part")
+
+ ds <- open_dataset(dst_dir)
+ expect_warning(
+ df_from_ds <- collect(ds),
+ "Row-level metadata is not compatible with this operation and has been ignored"
+ )
+ expect_equal(df_from_ds[c(1, 4, 3, 2), ], df, check.attributes = FALSE)
+
+ # however there is *no* warning if we don't select the metadata column
+ expect_warning(
+ df_from_ds <- ds %>% select(int) %>% collect(),
+ NA
+ )
+})

r/NAMESPACE

@@ -327,6 +327,7 @@ importFrom(rlang,quos)
 importFrom(rlang,seq2)
 importFrom(rlang,set_names)
 importFrom(rlang,syms)
+importFrom(rlang,trace_back)
 importFrom(rlang,warn)
 importFrom(stats,median)
 importFrom(stats,na.exclude)

r/R/metadata.R

@@ -50,6 +50,7 @@
  })
 }
 
+#' @importFrom rlang trace_back
 apply_arrow_r_metadata <- function(x, r_metadata) {
  tryCatch({
  columns_metadata <- r_metadata$columns
@@ -60,9 +61,27 @@ apply_arrow_r_metadata <- function(x, r_metadata) {
  }
  }
  } else if (is.list(x) && !inherits(x, "POSIXlt") && !is.null(columns_metadata)) {
- x <- map2(x, columns_metadata, function(.x, .y) {
- apply_arrow_r_metadata(.x, .y)
- })
+ # If we have a list and "columns_metadata" this applies row-level metadata
+ # inside of a column in a dataframe.
+
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dplyr_collect <- any(map_lgl(trace$calls, function(x) {
+ grepl("collect.arrow_dplyr_query", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dplyr_collect) {
+ warning(
+ "Row-level metadata is not compatible with this operation and has ",
+ "been ignored",
+ call. = FALSE
+ )
+ } else {
+ x <- map2(x, columns_metadata, function(.x, .y) {
+ apply_arrow_r_metadata(.x, .y)
+ })
+ }
  x
  }
 
@@ -116,9 +135,23 @@ arrow_attributes <- function(x, only_top_level = FALSE) {
 
  columns <- NULL
  if (is.list(x) && !inherits(x, "POSIXlt")) {
- # for list columns, we also keep attributes of each
- # element in columns
- columns <- map(x, arrow_attributes)
+ # However, if we are inside of a dplyr collection (including all datasets),
+ # we cannot apply this row-level metadata, since the order of the rows is
+ # not guaranteed to be the same, so don't even try, but warn what's going on
+ trace <- trace_back()
+ in_dataset_write <- any(map_lgl(trace$calls, function(x) {
+ grepl("write_dataset", x, fixed = TRUE)[[1]]
+ }))
+ if (in_dataset_write) {
+ warning(
+ "Row-level metadata is not compatible with datasets and will be discarded",
+ call. = FALSE
+ )
+ } else {
+ # for list columns, we also keep attributes of each
+ # element in columns
+ columns <- map(x, arrow_attributes)
+ }
  if (all(map_lgl(columns, is.null))) {
  columns <- NULL
  }

r/tests/testthat/helper-arrow.R

@@ -67,3 +67,9 @@ test_that <- function(what, code) {
 r_only <- function(code) {
  withr::with_options(list(..skip.tests = FALSE), code)
 }
+
+make_temp_dir <- function() {
+ path <- tempfile()
+ dir.create(path)
+ normalizePath(path, winslash = "/")
+}

r/tests/testthat/test-dataset.R

@@ -21,12 +21,6 @@ context("Dataset")
 
 library(dplyr)
 
-make_temp_dir <- function() {
- path <- tempfile()
- dir.create(path)
- normalizePath(path, winslash = "/")
-}
-
 dataset_dir <- make_temp_dir()
 hive_dir <- make_temp_dir()
 ipc_dir <- make_temp_dir()

r/tests/testthat/test-metadata.R

@@ -205,3 +205,45 @@ test_that("metadata of list elements (ARROW-10386)", {
  expect_identical(attr(as.data.frame(tab)$x[[1]], "foo"), "bar")
  expect_identical(attr(as.data.frame(tab)$x[[2]], "baz"), "qux")
 })
+
+
+test_that("metadata of list elements (ARROW-10386)", {
+ skip_if_not_available("dataset")
+ skip_if_not_available("parquet")
+
+ library(dplyr)
+
+ df <- tibble::tibble(
+ metadata = list(
+ structure(1, my_value_as_attr = 1),
+ structure(2, my_value_as_attr = 2),
+ structure(3, my_value_as_attr = 3),
+ structure(4, my_value_as_attr = 3)),
+ int = 1L:4L,
+ part = c(1, 3, 2, 1)
+ )
+
+ dst_dir <- make_temp_dir()
+ expect_warning(
+ write_dataset(df, dst_dir, partitioning = "part"),
+ "Row-level metadata is not compatible with datasets and will be discarded"
+ )
+
+ # but we need to write a dataset with row-level metadata to make sure when
+ # reading ones that have been written with them we warn appropriately
+ fake_func_name <- write_dataset
+ fake_func_name(df, dst_dir, partitioning = "part")
+
+ ds <- open_dataset(dst_dir)
+ expect_warning(
+ df_from_ds <- collect(ds),
+ "Row-level metadata is not compatible with this operation and has been ignored"
+ )
+ expect_equal(df_from_ds[c(1, 4, 3, 2), ], df, check.attributes = FALSE)
+
+ # however there is *no* warning if we don't select the metadata column
+ expect_warning(
+ df_from_ds <- ds %>% select(int) %>% collect(),
+ NA
+ )
+})