diff --git a/DESCRIPTION b/DESCRIPTION index 6cbb02ce..863b4435 100644 --- a/DESCRIPTION +++ b/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 diff --git a/R/save.R b/R/save.R index 60e9ecc6..7bb07399 100644 --- a/R/save.R +++ b/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) diff --git a/tests/testthat/test-save-load.R b/tests/testthat/test-save-load.R index 650d5cf1..bfcdfa44 100644 --- a/tests/testthat/test-save-load.R +++ b/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)) +})