feat: remove_slide() now supports deletion of multiple slides

thanks to Wahiduzzaman Khan (#691)

Author: davidgohel

DESCRIPTION

@@ -27,6 +27,8 @@ Authors@R: c(
     person("Greg", "Leleu", , "gregoire.leleu@gmail.com", role = "ctb",
            comment = "fields functionality in ppt"),
     person("Majid", "Eismann", role = "ctb"),
+    person("Wahiduzzaman", "Khan", role = "ctb",
+           comment = "vectorization of remove_slide"),
     person("Hongyuan", "Jia", , "hongyuanjia@cqust.edu.cn", role = "ctb",
            comment = c(ORCID = "0000-0002-0075-8183")),
     person("Michael", "Stackhouse", , "mike.stackhouse@atorusresearch.com", role = "ctb")

NEWS.md

@@ -1,5 +1,10 @@
 # officer 0.7.3
 
+## Features
+
+- function `remove_slide()` now supports deletion of multiple slides
+thanks to Wahiduzzaman Khan (#691).
+
 ## Issues
 
 - fix feed_from_xml for 'officedown'.

R/ppt_classes.R

@@ -41,13 +41,18 @@ presentation <- R6Class(
     },
     slide_data = function(){
       rel_df <- self$rel_df()
-      rel_df <- rel_df[, c("id", "target")]
-      names(rel_df) <- c("slide_rid", "target")
-      ref <- data.frame(slide_id = private$slide_id,
-                 slide_rid = private$slide_rid,
-                 stringsAsFactors = FALSE)
-      base::merge(x = ref, y = rel_df, sort = FALSE,
-                  by = "slide_rid", all.x = TRUE, all.y = FALSE)
+      rel_df <- select(
+        .data = rel_df,
+        all_of(setNames(c("id", "target"), c("slide_rid", "target")))
+      )
+
+      ref <- data.frame(
+        slide_id = private$slide_id,
+        slide_rid = private$slide_rid,
+        stringsAsFactors = FALSE
+      )
+
+      left_join(ref, rel_df, by = "slide_rid")
     },
 
     move_slide = function(from, to){

R/pptx_slide_manip.R

@@ -117,19 +117,19 @@ on_slide <- function(x, index) {
 
 
 #' @export
-#' @title Remove a slide
-#' @description Remove a slide from a pptx presentation.
+#' @title Remove slide(s)
+#' @description Remove one or more slides from a pptx presentation.
 #' @param x an rpptx object
-#' @param index slide index, default to current slide position.
+#' @param index slide index or a vector of slide indices to remove,
+#' default to current slide position.
 #' @param rm_images unused anymore.
 #' @note cursor is set on the last slide.
-#' @examples
-#' my_pres <- read_pptx()
-#' my_pres <- add_slide(my_pres, "Title and Content")
-#' my_pres <- remove_slide(my_pres)
+#' @example inst/examples/example_remove_slide.R
 #' @family slide_manipulation
 #' @seealso [read_pptx()], [ph_with()], [ph_remove()]
 remove_slide <- function(x, index = NULL, rm_images = FALSE) {
+  stop_if_not_rpptx(x)
+
   l_ <- length(x)
   if (l_ < 1) {
     stop("presentation contains no slide to delete", call. = FALSE)
@@ -139,17 +139,57 @@ remove_slide <- function(x, index = NULL, rm_images = FALSE) {
     index <- x$cursor
   }
 
-  if (!between(index, 1, l_)) {
-    stop("unvalid index ", index, " (", l_, " slide(s))", call. = FALSE)
+  if (length(index) == 0) {
+    return(x)
+  }
+
+  # Validate all indices
+  indices <- unique(as.integer(index))
+  invalid_indices <- indices[!between(indices, 1, l_)]
+  if (length(invalid_indices) > 0) {
+    stop(
+      "invalid index(es) ",
+      paste(invalid_indices, collapse = ", "),
+      call. = FALSE
+    )
   }
-  filename <- basename(x$presentation$slide_data()$target[index])
-  location <- which(x$slide$get_metadata()$name %in% filename)
 
-  del_file <- x$slide$remove_slide(location)
+  # Get slide mapping information using existing slide_data method
+  slide_map <- x$presentation$slide_data()
+  slide_map$filename <- basename(slide_map$target)
+
+  indices_to_remove <- sort(unique(indices), decreasing = TRUE)
+  slides_to_remove_df <- slide_map[indices_to_remove, , drop = FALSE]
+
+  # Build file paths for deletion
+  files_to_delete <- file.path(
+    x$package_dir,
+    "ppt",
+    "slides",
+    slides_to_remove_df$filename
+  )
+  rels_to_delete <- file.path(
+    x$package_dir,
+    "ppt",
+    "slides",
+    "_rels",
+    paste0(slides_to_remove_df$filename, ".rels")
+  )
+
+  # Delete slide XML files if they exist
+  unlink(files_to_delete[file.exists(files_to_delete)], force = TRUE)
+  # Delete slide relationship files if they exist
+  unlink(rels_to_delete[file.exists(rels_to_delete)], force = TRUE)
+
+  # Remove slides from internal collections
+  for (filename in slides_to_remove_df$filename) {
+    slide_idx <- x$slide$slide_index(filename)
+    x$slide$remove_slide(slide_idx)
+    x$presentation$remove_slide(filename)
+    x$content_type$remove_slide(partname = filename)
+  }
 
-  # update presentation elements
-  x$presentation$remove_slide(del_file)
-  x$content_type$remove_slide(partname = del_file)
+  # Set cursor to last slide
   x$cursor <- x$slide$length()
   x
 }

inst/examples/example_remove_slide.R

@@ -0,0 +1,31 @@
+library(officer)
+
+x <- read_pptx()
+x <- add_slide(x, "Title and Content")
+x <- remove_slide(x)
+
+# Remove multiple slides at once
+x <- read_pptx()
+x <- add_slide(x, "Title and Content")
+x <- add_slide(
+  x,
+  layout = "Two Content",
+  `Title 1` = "A title",
+  dt = "Jan. 26, 2025",
+  `body[2]` = "Body 2",
+  left = "Left side",
+  `6` = "Footer"
+)
+x <- add_slide(
+  x,
+  layout = "Two Content",
+  `Title 1` = "A title",
+  dt = "Jan. 26, 2025",
+  `body[2]` = "Body 2",
+  left = "Left side",
+  `6` = "Footer"
+)
+x <- add_slide(x, "Title and Content")
+x <- remove_slide(x, index = c(2, 4))
+pptx_file <- print(x, target = tempfile(fileext = ".pptx"))
+pptx_file

man/move_slide.Rd

@@ -107,6 +107,86 @@ test_that("slide remove", {
   expect_equal(sm[1, ]$text, "Hello world 2")
 })
 
+test_that("remove multiple slides at once", {
+  x <- read_pptx()
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 1", location = ph_location_type(type = "body"))
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 2", location = ph_location_type(type = "body"))
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 3", location = ph_location_type(type = "body"))
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 4", location = ph_location_type(type = "body"))
+
+  # Remove slides 2 and 4
+  x <- remove_slide(x, index = c(2, 4))
+  expect_equal(length(x), 2)
+
+  # Check remaining slides are 1 and 3
+  sm1 <- slide_summary(x, index = 1)
+  sm2 <- slide_summary(x, index = 2)
+  expect_equal(sm1[1, ]$text, "Slide 1")
+  expect_equal(sm2[1, ]$text, "Slide 3")
+})
+
+test_that("remove multiple slides - edge cases", {
+  # Test removing all slides
+  x <- read_pptx()
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- remove_slide(x, index = c(1, 2))
+  expect_equal(length(x), 0)
+
+  # Test with duplicate indices (should only remove once)
+  x <- read_pptx()
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 1", location = ph_location_type(type = "body"))
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 2", location = ph_location_type(type = "body"))
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 3", location = ph_location_type(type = "body"))
+  x <- remove_slide(x, index = c(2, 2, 2))
+  expect_equal(length(x), 2)
+  sm <- slide_summary(x, index = 2)
+  expect_equal(sm[1, ]$text, "Slide 3")
+
+  # Test with empty index vector (should return unchanged)
+  x <- read_pptx()
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- remove_slide(x, index = integer(0))
+  expect_equal(length(x), 2)
+
+  # Test removing slides in non-sequential order
+  x <- read_pptx()
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 1", location = ph_location_type(type = "body"))
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 2", location = ph_location_type(type = "body"))
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 3", location = ph_location_type(type = "body"))
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- ph_with(x, "Slide 4", location = ph_location_type(type = "body"))
+  x <- remove_slide(x, index = c(4, 1, 3))
+  expect_equal(length(x), 1)
+  sm <- slide_summary(x, index = 1)
+  expect_equal(sm[1, ]$text, "Slide 2")
+})
+
+test_that("remove multiple slides - invalid indices", {
+  x <- read_pptx()
+  x <- add_slide(x, "Title and Content", "Office Theme")
+  x <- add_slide(x, "Title and Content", "Office Theme")
+
+  # Test with out of range indices
+  expect_error(remove_slide(x, index = c(1, 5)), "invalid index")
+  expect_error(remove_slide(x, index = c(0, 1)), "invalid index")
+  expect_error(remove_slide(x, index = c(-1, 2)), "invalid index")
+
+  # Test with all invalid indices
+  expect_error(remove_slide(x, index = c(5, 6)), "invalid index")
+})
+
 test_that("ph remove", {
   x <- read_pptx()
   x <- add_slide(x, "Title and Content", "Office Theme")

man/officer.Rd

@@ -35,7 +35,7 @@ test_that("check errors", {
   x <- ph_with(x, "my title 2", location = ph_location_type(type = "title"))
 
   expect_error(on_slide(x, index = 3), "unvalid index 3")
-  expect_error(remove_slide(x, index = 3), "unvalid index 3")
+  expect_error(remove_slide(x, index = 3), "invalid index\\(es\\) 3")
   expect_error(slide_summary(x, index = 3), "unvalid index 3")
 })