fix #596: make layout_summary() layout order correspond to order in PPTX file

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: officer
 Title: Manipulation of Microsoft Word and PowerPoint Documents
-Version: 0.6.7.007
+Version: 0.6.7.008
 Authors@R: c(
     person("David", "Gohel", , "[email protected]", role = c("aut", "cre")),
     person("Stefan", "Moog", , "[email protected]", role = "aut"),

NEWS.md

@@ -6,7 +6,12 @@
 - remove_fields in `docx_summary()` now also removes "w:fldData" nodes.
 - complete the manual of `body_add_docx()` with a note about the file basename
 that can not contain ' ' and trigger an error if it contains a ' '. 
-- `plot_layout_properties()` gains a 'title' parameter, which will add the layout name as the plot title. Defaults to `FALSE`, to not alter the old behavior. Also, the slide width and height are now correctly displayed in the plot. Before, a box was drawn around the plot area. However, the plot area var with device size, not slide size.
+- `plot_layout_properties()` gains a 'title' parameter, which will add the layout name as the plot title. Defaults to 
+`FALSE`, to not alter the old behavior. Also, the slide width and height are now correctly displayed in the plot. 
+Before, a box was drawn around the plot area. However, the plot area var with device size, not slide size.
+- class `dir_collection`: Files are now added to a container in the order of their trailing numeric index (#596).
+For example, `slideLayout2.xml` will now preceed `slideLayout10.xml`. Before, alphabetical sorting was used, where 
+`slideLayout10.xml` comes before `slideLayout2.xml`.
 
 ## Features
 

R/ppt_class_dir_collection.R

@@ -6,8 +6,8 @@ dir_collection <- R6Class(
     initialize = function( package_dir, container ) {
       dir_ <- file.path(package_dir, container$dir_name())
       private$package_dir <- package_dir
-
       filenames <- list.files(path = dir_, pattern = "\\.xml$", full.names = TRUE)
+      filenames <- sort_vec_by_index(filenames)  # see issue 596
       private$collection <- lapply( filenames, function(x, container){
         container$clone()$feed(x)
       }, container = container)

R/utils.R

@@ -210,9 +210,6 @@ correct_id <- function(doc, int_id){
 }
 
 
-
-
-
 check_bookmark_id <- function(bkm){
   if(!is.null(bkm)){
     invalid_bkm <- is.character(bkm) &&
@@ -237,7 +234,70 @@ is_doc_open <- function(file) {
 }
 
 
+# Extract trailing numeric index in .xml filename
+#
+# Useful to for slideMaster and slideLayout .xml files.
+#
+# Examples:
+#   files <- c("slideLayout1.xml", "slideLayout2.xml", "slideLayout10.xml")
+#   get_file_index(files)
+#
+get_file_index <- function(file) {
+  sub(pattern = ".+?(\\d+).xml$", replacement = "\\1", x = basename(file), ignore.case = TRUE) |> as.numeric()
+}
+
+
+# Sort xml filenames by trailing numeric index
+#
+# Useful to for slideMaster and slideLayout xml files.
+#
+# Examples:
+#   files <- c("slideLayout1.xml", "slideLayout2.xml", "slideLayout12.xml")
+#   sort_vec_by_index(files)  # => order corresponding to trailing index
+#   sort(files)           # => incorrect lexicographical ordering
+#
+sort_vec_by_index <- function(x) {
+  indexes <- get_file_index(x)
+  x[order(indexes)]
+}
+
+
+# Sort dataframe column by trailing index
+#
+# df: A dataframe
+# ...: columsn to sort by, comma separated
+#
+# Examples:
+# df <- data.frame(
+#   a = paste0("file_", rep(3:1, each = 2), ".xml"),
+#   b = paste0("file_", rep(3:1, 2), ".xml")
+# )
+# sort_dataframe_by_index(df, "a", "b")
+# sort_dataframe_by_index(df, "b", "a")
+#
+sort_dataframe_by_index <- function(df, ...) {
+  sort_columns <- c(...)
+  l <- lapply(sort_columns, function(.col) {
+    get_file_index(df[[.col]])
+  })
+  df[do.call(order, l), , drop =FALSE]
+}
+
+
+# rename dataframe columns
+#
+# Examples:
+#   df_rename(mtcars, c("mpg", "cyl"), c("A", "B"))
+#
+df_rename <- function(df, old, new) {
+  .nms <- names(df)
+  .nms[match(old, .nms)] <- new
+  stats::setNames(df, .nms)
+}
+
+
 # htmlEscapeCopy ----
+
 htmlEscapeCopy <- local({
 
   .htmlSpecials <- list(

tests/testthat/test-pptx-info.R

@@ -1,12 +1,36 @@
 test_that("layout summary", {
   x <- read_pptx()
   laysum <- layout_summary(x)
-  expect_is( laysum, "data.frame" )
-  expect_true( all( c("layout", "master") %in% names(laysum)) )
-  expect_is( laysum$layout, "character" )
-  expect_is( laysum$master, "character" )
+  expect_is(laysum, "data.frame")
+  expect_true(all(c("layout", "master") %in% names(laysum)))
+  expect_is(laysum$layout, "character")
+  expect_is(laysum$master, "character")
 })
 
+
+test_that("layout summary - layout order (#596)", {
+  file <- test_path("docs_dir", "test-layouts-ordering.pptx")
+  x <- read_pptx(file)
+  df <- layout_summary(x)
+  order_exp <- c(
+    "Title Slide", "Title and Content", "Section Header", "Two Content", "Comparison",
+    "Title Only", "Blank", "layout_8", "layout_9", "layout_10", "layout_11"
+  )
+  expect_equal(df$layout, order_exp)
+  df <- x$slideLayouts$get_metadata() # used inside layout_summary
+  expect_true(all(get_file_index(df$filename) == 1:11))
+
+  file <- test_path("docs_dir", "test-layouts-ordering-3-masters.pptx")
+  x <- read_pptx(file)
+  df <- layout_summary(x)
+  la <- c("Title Slide", "Title and Content", "Section Header", "Two Content", "Comparison", "Title Only", "Blank")
+  order_exp <- rep(la, 3)
+  expect_equal(df$layout, order_exp)
+  order_exp <- rep(paste0("Master_", 1:3), each = length(la))
+  expect_equal(df$master, order_exp)
+})
+
+
 test_that("layout properties", {
   x <- read_pptx()
   x <- add_slide(x, "Title and Content", "Office Theme")
@@ -15,18 +39,19 @@ test_that("layout properties", {
 
   laypr <- layout_properties(x, layout = "Title and Content", master = "Office Theme")
 
-  expect_is( laypr, "data.frame" )
-  expect_true( all( c("master_name", "name", "type", "offx", "offy", "cx", "cy", "rotation") %in% names(laypr)) )
-  expect_is( laypr$master_name, "character" )
-  expect_is( laypr$name, "character" )
-  expect_is( laypr$type, "character" )
-  expect_is( laypr$offx, "numeric" )
-  expect_is( laypr$offy, "numeric" )
-  expect_is( laypr$cx, "numeric" )
-  expect_is( laypr$cy, "numeric" )
-  expect_is( laypr$rotation, "numeric" )
+  expect_is(laypr, "data.frame")
+  expect_true(all(c("master_name", "name", "type", "offx", "offy", "cx", "cy", "rotation") %in% names(laypr)))
+  expect_is(laypr$master_name, "character")
+  expect_is(laypr$name, "character")
+  expect_is(laypr$type, "character")
+  expect_is(laypr$offx, "numeric")
+  expect_is(laypr$offy, "numeric")
+  expect_is(laypr$cx, "numeric")
+  expect_is(laypr$cy, "numeric")
+  expect_is(laypr$rotation, "numeric")
 })
 
+
 save_png <- function(code, width = 700, height = 700) {
   path <- tempfile(fileext = ".png")
   png(path, width = width, height = height, res = 150)
@@ -36,6 +61,7 @@ save_png <- function(code, width = 700, height = 700) {
   path
 }
 
+
 test_that("plot layout properties", {
   skip_if_not_installed("doconv")
   skip_if_not(doconv::msoffice_available())
@@ -45,20 +71,24 @@ test_that("plot layout properties", {
 
   png1 <- tempfile(fileext = ".png")
   png(png1, width = 7, height = 6, res = 150, units = "in")
-  plot_layout_properties( x = x, layout = "Title Slide",
-                          master = "Office Theme" )
+  plot_layout_properties(
+    x = x, layout = "Title Slide",
+    master = "Office Theme"
+  )
   dev.off()
   png2 <- tempfile(fileext = ".png")
   png(png2, width = 7, height = 6, res = 150, units = "in")
-  plot_layout_properties( x = x, layout = "Title Slide",
-                          master = "Office Theme",
-                          labels = FALSE)
+  plot_layout_properties(
+    x = x, layout = "Title Slide",
+    master = "Office Theme",
+    labels = FALSE
+  )
   dev.off()
   expect_snapshot_doc(name = "plot-twocontent-layout", x = png1, engine = "testthat")
   expect_snapshot_doc(name = "plot-twocontent-layout-nolabel", x = png2, engine = "testthat")
-
 })
 
+
 test_that("slide summary", {
   x <- read_pptx()
   x <- add_slide(x, "Title and Content", "Office Theme")
@@ -67,28 +97,27 @@ test_that("slide summary", {
 
   sm <- slide_summary(x)
 
-  expect_is( sm, "data.frame" )
-  expect_equal( nrow(sm), 2 )
-  expect_true( all( c("id", "type", "offx", "offy", "cx", "cy") %in% names(sm)) )
-  expect_is( sm$id, "character" )
-  expect_is( sm$type, "character" )
-  expect_true( is.double(sm$offx) )
-  expect_true( is.double(sm$offy) )
-  expect_true( is.double(sm$cx) )
-  expect_true( is.double(sm$cy) )
+  expect_is(sm, "data.frame")
+  expect_equal(nrow(sm), 2)
+  expect_true(all(c("id", "type", "offx", "offy", "cx", "cy") %in% names(sm)))
+  expect_is(sm$id, "character")
+  expect_is(sm$type, "character")
+  expect_true(is.double(sm$offx))
+  expect_true(is.double(sm$offy))
+  expect_true(is.double(sm$cx))
+  expect_true(is.double(sm$cy))
 })
 
+
 test_that("color scheme", {
   x <- read_pptx()
   cs <- color_scheme(x)
 
-  expect_is( cs, "data.frame" )
-  expect_equal( ncol(cs), 4 )
-  expect_true( all( c("name", "type", "value", "theme") %in% names(cs)) )
-  expect_is( cs$name, "character" )
-  expect_is( cs$type, "character" )
-  expect_is( cs$value, "character" )
-  expect_is( cs$theme, "character" )
+  expect_is(cs, "data.frame")
+  expect_equal(ncol(cs), 4)
+  expect_true(all(c("name", "type", "value", "theme") %in% names(cs)))
+  expect_is(cs$name, "character")
+  expect_is(cs$type, "character")
+  expect_is(cs$value, "character")
+  expect_is(cs$theme, "character")
 })
-
-

tests/testthat/test-utils.R

@@ -0,0 +1,19 @@
+test_that("trailing file index extraction / sorting", {
+  files <- c("slideLayout1.xml", "slideLayout11.xml", "slideLayout2.xml", "slideLayout10.xml")
+
+  expect_equal(get_file_index(files), c(1, 11, 2, 10))
+
+  expect_equal(sort_vec_by_index(files), c("slideLayout1.xml", "slideLayout2.xml", "slideLayout10.xml", "slideLayout11.xml"))
+
+  df <- data.frame(file1 = files, file2 = rev(files))
+  a <- sort_dataframe_by_index(df, "file1")
+  b <- sort_dataframe_by_index(df, "file2")
+  expect_true(all(a == rev(b)))
+})
+
+
+test_that("misc", {
+  df <- df_rename(mtcars, c("mpg", "cyl"), c("A", "B"))
+  expect_true(all(names(df)[1:2] == c("A", "B")))
+})
+