add remove_slicer(). part of #1010 (#1020)

* add `remove_slicer()`. part of #1010

* add wrapper

NAMESPACE

@@ -122,6 +122,7 @@ export(wb_remove_creators)
 export(wb_remove_filter)
 export(wb_remove_named_region)
 export(wb_remove_row_heights)
+export(wb_remove_slicer)
 export(wb_remove_tables)
 export(wb_remove_worksheet)
 export(wb_save)

R/class-workbook-wrappers.R

@@ -508,6 +508,8 @@ wb_add_pivot_table <- function(
 #' * level: the granularity of the slicer (for timeline 0 = year, 1 = quarter, 2 = month)
 #' * show_caption: logical if caption should be shown or not
 #'
+#' Removing slicers works on the spreadsheet level. Therefore all slicers are removed from a worksheet.
+#'
 #' @param wb A Workbook object containing a worksheet.
 #' @param x A `data.frame` that inherits the [`wb_data`][wb_data()] class.
 #' @param sheet A worksheet
@@ -597,6 +599,18 @@ wb_add_slicer <- function(
 
 }
 
+#' @rdname wb_add_slicer
+#' @export
+wb_remove_slicer <- function(
+    wb,
+    sheet       = current_sheet()
+) {
+  assert_workbook(wb)
+  wb$clone()$remove_slicer(
+    sheet       = sheet
+  )
+}
+
 #' @rdname wb_add_slicer
 #' @export
 wb_add_timeline <- function(

R/class-workbook.R

@@ -1960,6 +1960,48 @@ wbWorkbook <- R6::R6Class(
       invisible(self)
     },
 
+    #' @description add pivot table
+    #' @return The `wbWorkbook` object
+    remove_slicer = function(sheet = current_sheet()) {
+      sheet <- private$get_sheet_index(sheet)
+
+      # get indices
+      slicer_id       <- self$worksheets[[sheet]]$relships$slicer
+
+      # skip if nothing to do
+      if (identical(slicer_id, integer())) return(invisible(self))
+
+      cache_names     <- unname(sapply(xml_attr(self$slicers[slicer_id], "slicers", "slicer"), "[", "cache"))
+      slicer_names    <- unname(sapply(xml_attr(self$slicerCaches, "slicerCacheDefinition"), "[", "name"))
+      slicer_cache_id <- which(cache_names %in% slicer_names)
+
+      # strings to grep
+      slicer_xml <- sprintf("slicers/slicer%s.xml", slicer_id)
+      caches_xml <- sprintf("slicerCaches/slicerCache%s.xml", slicer_cache_id)
+
+      # empty slicer
+      self$slicers[slicer_id]                  <- ""
+      # empty slicerCache
+      self$slicerCaches[slicer_cache_id]       <- ""
+
+      # remove slicer cache relship
+      self$worksheets[[sheet]]$relships$slicer <- integer()
+      # remove worksheet relationship
+      self$worksheets_rels[[sheet]]            <- self$worksheets_rels[[sheet]][!grepl(slicer_xml, self$worksheets_rels[[sheet]])]
+      # remove "x14:slicerList"
+      is_ext_x14 <- grepl("xmlns:x14", self$worksheets[[sheet]]$extLst)
+      extLst     <- xml_rm_child(self$worksheets[[sheet]]$extLst[is_ext_x14], xml_child = "x14:slicerList")
+      self$worksheets[[sheet]]$extLst[is_ext_x14] <- extLst
+
+      # clear workbook.xml.rels
+      self$workbook.xml.rels                   <- self$workbook.xml.rels[!grepl(paste0(caches_xml, collapse = "|"), self$workbook.xml.rels)]
+
+      # clear Content_Types
+      self$Content_Types                       <- self$Content_Types[!grepl(paste0(c(slicer_xml, caches_xml), collapse = "|"), self$Content_Types)]
+
+      invisible(self)
+    },
+
     #' @description add pivot table
     #' @param x a wb_data object
     #' @param dims the worksheet cell where the pivot table is placed
@@ -2662,15 +2704,16 @@ wbWorkbook <- R6::R6Class(
         slicersDir      <- dir_create(tmpDir, "xl", "slicers")
         slicerCachesDir <- dir_create(tmpDir, "xl", "slicerCaches")
 
-        slicer <- self$slicers[self$slicers != ""]
-        for (i in seq_along(slicer)) {
+        slicer_id <- which(self$slicers != "")
+        for (i in slicer_id) {
           write_file(
-            body = slicer[i],
+            body = self$slicers[i],
             fl = file.path(slicersDir, sprintf("slicer%s.xml", i))
           )
         }
 
-        for (i in seq_along(self$slicerCaches)) {
+        caches_id <- which(self$slicerCaches != "")
+        for (i in caches_id) {
           write_file(
             body = self$slicerCaches[[i]],
             fl = file.path(slicerCachesDir, sprintf("slicerCache%s.xml", i))

tests/testthat/test-class-workbook-wrappers.R

@@ -403,6 +403,11 @@ test_that("wb_add_slicer() is a wrapper", {
   expect_wrapper("add_slicer", wb = wb, params = list(x = df, slicer = "vs", pivot_table = "pivot1"))
 })
 
+test_that("wb_remove_slicer() is a wrapper", {
+  wb <- wb_workbook()$add_worksheet()
+  expect_wrapper("remove_slicer", wb = wb)
+})
+
 test_that("wb_add_timeline() is a wrapper", {
   df <- data.frame(
     date = seq(from = as.Date("2024-01-01"), length.out = 26, by = "month"),

tests/testthat/test-write.R

@@ -600,6 +600,98 @@ test_that("writing slicers works", {
 
 })
 
+
+test_that("removing slicers works", {
+
+  ### prepare data
+  df <- data.frame(
+    AirPassengers = c(AirPassengers),
+    time = seq(from = as.Date("1949-01-01"), to = as.Date("1960-12-01"), by = "month"),
+    letters = letters[1:4]
+  )
+
+  ### create workbook
+  wb <- wb_workbook()$
+    add_worksheet("pivot")$
+    add_worksheet("pivot2")$
+    add_worksheet("data")$
+    add_data(x = df)
+
+  ### get pivot table data source
+  df <- wb_data(wb, sheet = "data")
+
+  ### first sheet
+  # create pivot table
+  wb$add_pivot_table(
+    df,
+    sheet = "pivot",
+    rows = "time",
+    cols = "letters",
+    data = "AirPassengers",
+    pivot_table = "airpassengers",
+    params = list(
+      compact = FALSE, outline = FALSE, compact_data = FALSE,
+      row_grand_totals = FALSE, col_grand_totals = FALSE)
+  )
+
+  # add slicer
+  wb$add_slicer(
+    df,
+    dims = "E1:I7",
+    sheet = "pivot",
+    slicer = "letters",
+    pivot_table = "airpassengers",
+    params = list(choose = c(letters = 'x %in% c("a", "b")'))
+  )
+
+  wb$add_slicer(
+    df,
+    dims = "E8:I15",
+    sheet = "pivot",
+    slicer = "time",
+    pivot_table = "airpassengers"
+  )
+
+  ### second sheet
+  # create pivot table
+  wb$add_pivot_table(
+    df,
+    sheet = "pivot2",
+    rows = "time",
+    cols = "letters",
+    data = "AirPassengers",
+    pivot_table = "airpassengers2",
+    params = list(
+      compact = FALSE, outline = FALSE, compact_data = FALSE,
+      row_grand_totals = FALSE, col_grand_totals = FALSE)
+  )
+
+  # add slicer
+  wb$add_slicer(
+    df,
+    dims = "E1:I7",
+    sheet = "pivot2",
+    slicer = "letters",
+    pivot_table = "airpassengers2",
+    params = list(choose = c(letters = 'x %in% c("a", "b")'))
+  )
+
+  wb$add_slicer(
+    df,
+    dims = "E8:I15",
+    sheet = "pivot2",
+    slicer = "time",
+    pivot_table = "airpassengers2"
+  )
+
+  ### remove slicer
+  wb$remove_slicer(sheet = "pivot")
+
+  temp <- temp_xlsx()
+  expect_silent(wb$save(temp)) # no warning, all files written as expected
+
+})
+
 test_that("writing na.strings = NULL works", {
 
   # write na.strings = na_strings()