Save spatial plots after dropping spatial cols and attributes

DESCRIPTION

@@ -80,4 +80,4 @@ Config/Needs/website: poissonconsulting/poissontemplate
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-Config/roxygen2/version: 8.0.0.9000
+Config/roxygen2/version: 8.1.0.9000

R/save.R

@@ -19,6 +19,7 @@ save_rds <- function(x, class, main, sub, x_name) {
 
 save_csv <- function(x, class, sub, main, x_name) {
   x[vapply(x, is.list, TRUE)] <- NULL
+  x <- remove_geometry(x)
   file <- file_name(main, class, sub, x_name, "csv")
   readr::write_csv(x, file)
   invisible(file)
@@ -53,11 +54,25 @@ read_metas <- function(x) {
 }
 
 save_xlsx <- function(x, class, main, sub, x_name) {
+  x <- purrr::map(x, remove_geometry)
   file <- file_name(main, class, sub, x_name, "xlsx")
   writexl::write_xlsx(x, file)
   invisible(file)
 }
 
+# to drop geometry columns before saving data as csv or xlsx
+remove_geometry <- function(x) {
+  x <- sf::st_drop_geometry(x)
+  # st_drop_geometry() isn't enough when elements coerced with as.data.frame()
+  if (ncol(x)) { # to avoid failures with zero-column data.frames
+    spatial <- grepl("sfc", purrr::map_chr(seq(ncol(x)), function(.col_id) {
+      paste(class(x[[.col_id]]), collapse = " ")
+    }))
+    x <- x[, !spatial, drop = FALSE] # drop = FALSE to keep data.frame structure
+  }
+  x
+}
+
 save_gpkg <- function(x, class, main, sub, x_name) {
   file <- file_name(main, class, sub, x_name, "gpkg")
   x <- hms_to_text(x)

tests/testthat/test-save-load.R

@@ -3062,3 +3062,57 @@ test_that("plot with no data and no layers saves no csv or xlsx", {
     c("x.png", "x.rds", "x.yaml")
   )
 })
+
+test_that("plot with geometry layers is saved properly.", {
+  sbf_reset()
+  sbf_set_main(file.path(withr::local_tempdir(), "output"))
+  sbf_close_windows()
+
+  csv_file <- file.path(sbf_get_main(), "plots/plot.csv")
+  xlsx_file <- file.path(sbf_get_main(), "plots/plot.xlsx")
+
+  # no data worth keeping
+  shp <- sf::st_as_sf(data.frame(x = c(1, 2), y = c(10, 15)),
+                      coords = c("x", "y"))
+
+  p <- ggplot2::ggplot(shp) + ggplot2::geom_sf()
+
+  expect_no_error(sbf_save_plot(x_name = "plot", caption = "Caption."))
+  expect_true(file.exists(csv_file))
+  expect_equal(ncol(readr::read_csv(csv_file, show_col_types = FALSE)), 0)
+
+  expect_equal(readxl::excel_sheets(xlsx_file), c("1_0_data", "1_1_sf"))
+  expect_equal(ncol(readxl::read_xlsx(xlsx_file, sheet = "1_0_data")), 0)
+  expect_equal(nrow(readxl::read_xlsx(xlsx_file, sheet = "1_0_data")), 0)
+  expect_equal(readxl::read_xlsx(xlsx_file, sheet = "1_1_sf"),
+               tibble())
+
+  # one informative column in the data but not the layers
+  shp <- sf::st_as_sf(data.frame(x = c(1, 2), y = c(10, 15), let = c("a", "b")),
+                      coords = c("x", "y"))
+
+  p <- ggplot2::ggplot(shp) + ggplot2::geom_sf()
+
+  expect_no_error(sbf_save_plot(x_name = "plot", caption = "Caption."))
+  expect_equal(readr::read_csv(csv_file, show_col_types = FALSE),
+               tibble(let = c("a", "b")))
+
+  expect_equal(readxl::excel_sheets(xlsx_file), c("1_0_data", "1_1_sf"))
+  expect_equal(readxl::read_xlsx(xlsx_file, sheet = "1_0_data"),
+               tibble::tibble(let = c("a", "b")))
+  expect_equal(readxl::read_xlsx(xlsx_file, sheet = "1_1_sf"),
+               tibble())
+
+  # one informative column in the data and the layers
+  p <- ggplot2::ggplot(shp) + ggplot2::geom_sf(ggplot2::aes(color = let))
+
+  expect_no_error(sbf_save_plot(x_name = "plot", caption = "Caption."))
+  expect_equal(readr::read_csv(csv_file, show_col_types = FALSE),
+               tibble(let = c("a", "b")))
+
+  expect_equal(readxl::excel_sheets(xlsx_file), c("1_0_data", "1_1_sf"))
+  expect_equal(readxl::read_xlsx(xlsx_file, sheet = "1_0_data"),
+               tibble::tibble(let = c("a", "b")))
+  expect_equal(readxl::read_xlsx(xlsx_file, sheet = "1_1_sf"),
+               tibble(colour = c("#F8766D", "#00BFC4"), group = 1:2))
+})