fix: layout_properties() returns all phs for multiple masters (#600)

`layout_properties()` now returns all placeholders in case of multiple master
(#597). Also, the internal `xfrmize()` now sorts the resulting data by placeholder
position. This yields an intuitive order, with placeholders sorted from top to
bottom and left to right.

close #597

.Rbuildignore

@@ -15,3 +15,4 @@
 ^tests/testthat/_snaps$
 ^inst/visual-testing$
 ^LICENSE\.md$
+dev_local

.gitignore

@@ -4,3 +4,4 @@
 .Ruserdata
 revdep
 todo.*
+dev_local

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: officer
 Title: Manipulation of Microsoft Word and PowerPoint Documents
-Version: 0.6.7.008
+Version: 0.6.7.009
 Authors@R: c(
     person("David", "Gohel", , "david.gohel@ardata.fr", role = c("aut", "cre")),
     person("Stefan", "Moog", , "moogs@gmx.de", role = "aut"),

NEWS.md

@@ -12,6 +12,9 @@ Before, a box was drawn around the plot area. However, the plot area var with de
 - 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`.
+- `layout_properties()` now returns all placeholders in case of multiple master (#597). Also, the internal `xfrmize()` 
+now sorts the resulting data by placeholder position. This yields an intuitive order, with placeholders sorted from 
+top to bottom and left to right.
 
 ## Features
 

R/pptx_informations.R

@@ -117,20 +117,19 @@ plot_layout_properties <- function (x, layout = NULL, master = NULL, labels = TR
   offy <- dat$offy
   cx <- dat$cx
   cy <- dat$cy
-  if (labels)
+  if (labels) {
     labels <- dat$ph_label
-  else {
+  } else {
     labels <- dat$type[order(as.integer(dat$id))]
     rle_ <- rle(labels)
-    labels <- sprintf("type: '%s' - id: %.0f", labels, unlist(lapply(rle_$lengths,
-                                                                     seq_len)))
+    labels <- sprintf("type: '%s' - id: %.0f", labels, unlist(lapply(rle_$lengths, seq_len)))
   }
   plot(x = c(0, w), y = -c(0, h), asp = 1, type = "n", axes = FALSE, xlab = NA, ylab = NA)
   if (title) {
     title(main = paste("Layout:", layout))
   }
   rect(xleft = 0, xright = w, ybottom = 0, ytop = -h, border = "darkgrey")
-  rect(xleft = offx, xright = offx + cx, ybottom = -offy, ytop = -(offy +                                                                   cy))
+  rect(xleft = offx, xright = offx + cx, ybottom = -offy, ytop = -(offy + cy))
   text(x = offx + cx/2, y = -(offy + cy/2), labels = labels, cex = 0.5, col = "red")
   mtext("y [inch]", side = 2, line = 0, cex = 1.2, col="darkgrey")
   mtext("x [inch]", side = 1, line = 0, cex = 1.2, col="darkgrey")

R/utils.R

@@ -51,12 +51,18 @@ read_xfrm <- function(nodeset, file, name){
           name = name )
 }
 
-fortify_master_xfrm <- function(master_xfrm){
 
+fortify_master_xfrm <- function(master_xfrm) {
   master_xfrm <- as.data.frame(master_xfrm)
   has_type <- grepl("type=", master_xfrm$ph)
   master_xfrm <- master_xfrm[has_type, ]
-  master_xfrm <- master_xfrm[!duplicated(master_xfrm$type),]
+  if (nrow(master_xfrm) > 0) {    # see #597
+    list_xfrm <- split(master_xfrm, master_xfrm$file)
+    list_xfrm <- lapply(list_xfrm, function(x) {
+      x[!duplicated(x$type), , drop = FALSE]
+    })
+    master_xfrm <- do.call("rbind", list_xfrm)
+  }
 
   tmp_names <- names(master_xfrm)
 
@@ -72,30 +78,35 @@ fortify_master_xfrm <- function(master_xfrm){
   master_xfrm
 }
 
-xfrmize <- function( slide_xfrm, master_xfrm ){
-  x <- as.data.frame( slide_xfrm )
+xfrmize <- function(slide_xfrm, master_xfrm) {
+  x <- as.data.frame(slide_xfrm)
 
-  master_ref <- unique( data.frame(file = master_xfrm$file,
-                                     master_name = master_xfrm$name,
-                                     stringsAsFactors = FALSE ) )
+  master_ref <- unique(data.frame(
+    file = master_xfrm$file,
+    master_name = master_xfrm$name,
+    stringsAsFactors = FALSE
+  ))
   master_xfrm <- fortify_master_xfrm(master_xfrm)
 
   slide_key_id <- paste0(x$master_file, x$type)
   master_key_id <- paste0(master_xfrm$file, master_xfrm$type)
 
   slide_xfrm_no_match <- x[!slide_key_id %in% master_key_id, ]
   slide_xfrm_no_match <- merge(slide_xfrm_no_match,
-                               master_ref, by.x = "master_file", by.y = "file",
-                               all.x = TRUE, all.y = FALSE)
+    master_ref,
+    by.x = "master_file", by.y = "file",
+    all.x = TRUE, all.y = FALSE
+  )
 
   x <- merge(x, master_xfrm,
-                      by.x = c("master_file", "type"),
-                      by.y = c("file", "type"),
-                      all = FALSE)
-  x$offx <- ifelse( !is.finite(x$offx), x$offx_ref, x$offx )
-  x$offy <- ifelse( !is.finite(x$offy), x$offy_ref, x$offy )
-  x$cx <- ifelse( !is.finite(x$cx), x$cx_ref, x$cx )
-  x$cy <- ifelse( !is.finite(x$cy), x$cy_ref, x$cy )
+    by.x = c("master_file", "type"),
+    by.y = c("file", "type"),
+    all = FALSE
+  )
+  x$offx <- ifelse(!is.finite(x$offx), x$offx_ref, x$offx)
+  x$offy <- ifelse(!is.finite(x$offy), x$offy_ref, x$offy)
+  x$cx <- ifelse(!is.finite(x$cx), x$cx_ref, x$cx)
+  x$cy <- ifelse(!is.finite(x$cy), x$cy_ref, x$cy)
   x$offx_ref <- NULL
   x$offy_ref <- NULL
   x$cx_ref <- NULL
@@ -104,11 +115,17 @@ xfrmize <- function( slide_xfrm, master_xfrm ){
   x$fld_type_ref <- NULL
 
   x <- rbind(x, slide_xfrm_no_match, stringsAsFactors = FALSE)
+  i_master <- get_file_index(x$master_file)
+  i_layout <- get_file_index(x$file)
+  x <- x[order(i_master, i_layout, x$offy, x$offx), , drop = FALSE] # natural sorting: top -> bottom, left -> right
   x[
-    !is.na( x$offx ) &
-      !is.na( x$offy ) &
-      !is.na( x$cx ) &
-      !is.na( x$cy ),]
+    !is.na(x$offx) &
+      !is.na(x$offy) &
+      !is.na(x$cx) &
+      !is.na(x$cy),
+  ]
+  rownames(x) <- NULL # no mixed up numbers
+  x
 }
 
 

tests/testthat/test-pptx-info.R

@@ -52,6 +52,21 @@ test_that("layout properties", {
 })
 
 
+test_that("layout properties - all phs for multiple masters (#597)", {
+  file <- test_path("docs_dir/test-three-identical-masters.pptx")
+  x <- read_pptx(file)
+  lap <- layout_properties(x)
+
+  expect_true(all(table(lap$ph) == 3)) # 3 identical masters => each ph 3 times
+
+  l_df <- split(lap, lap$master_name) # phs sorted by y coords
+  is_y_sorted <- vapply(l_df, function(x) {
+    all(diff(x$offy) >= 0)
+  }, logical(1))
+  expect_true(all(is_y_sorted))
+})
+
+
 save_png <- function(code, width = 700, height = 700) {
   path <- tempfile(fileext = ".png")
   png(path, width = width, height = height, res = 150)
@@ -84,8 +99,8 @@ test_that("plot layout properties", {
     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")
+  expect_snapshot_doc(name = "plot-titleslide-layout", x = png1, engine = "testthat")
+  expect_snapshot_doc(name = "plot-titleslide-layout-nolabel", x = png2, engine = "testthat")
 })