From 9632ae16c89622a60bd74cf70b8dae73d001c34c Mon Sep 17 00:00:00 2001 From: Stefan Moog Date: Thu, 25 Jul 2024 17:39:15 +0200 Subject: [PATCH] Replace text at bkm with plots. * Add body_replace_gg_at_bkm. * Add body_replace_plot_at_bkm. --- NAMESPACE | 2 + NEWS.md | 5 + R/docx_replace.R | 71 +++++++++++++- man/body_replace_gg_at_bkm.Rd | 85 +++++++++++++++++ tests/testthat/test-docx-replace.R | 144 +++++++++++++++++++++++------ 5 files changed, 277 insertions(+), 30 deletions(-) create mode 100644 man/body_replace_gg_at_bkm.Rd diff --git a/NAMESPACE b/NAMESPACE index a396657b..e6e667e2 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -181,7 +181,9 @@ export(body_end_section_landscape) export(body_end_section_portrait) export(body_remove) export(body_replace_all_text) +export(body_replace_gg_at_bkm) export(body_replace_img_at_bkm) +export(body_replace_plot_at_bkm) export(body_replace_text_at_bkm) export(body_set_default_section) export(change_styles) diff --git a/NEWS.md b/NEWS.md index 1968dcaa..e5e3cc58 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,11 @@ replaced with a hyphen-minus (Unicode character 002D). Closes #573. ## Features +- new convenience functions `body_replace_gg_at_bkm()` and `body_replace_plot_at_bkm()` +to replace text content enclosed in a bookmark with a ggplot or a base plot. + +#' with different text. + - `docx_summary()` gains parameter 'detailed' which allows to get a detailed summary including formatting properties of runs in a paragraph. Formatting properties are stored in a list column `run`, where each element diff --git a/R/docx_replace.R b/R/docx_replace.R index 6778002b..0632808c 100644 --- a/R/docx_replace.R +++ b/R/docx_replace.R @@ -114,8 +114,6 @@ docxpart_replace_img_at_bkm <- function(node, bookmark, value) { xml_replace(run_nodes[[1]], as_xml_document(out)) } - - #' @export #' @rdname body_replace_text_at_bkm headers_replace_text_at_bkm <- function( x, bookmark, value ){ @@ -156,6 +154,75 @@ footers_replace_img_at_bkm <- function( x, bookmark, value ){ x } +#' @export +#' @title Add plots at bookmark location in a 'Word' document +#' @description +#' Use these functions if you want to replace a paragraph containing +#' a bookmark with a 'ggplot' or a base plot. +#' @param value a ggplot object for body_replace_gg_at_bkm() or a set plot instructions +#' body_replace_plot_at_bkm(), see plot_instr(). +#' @param bookmark bookmark id +#' @param keep Should the bookmark be preserved? Defaults to `FALSE`, +#' i.e.the bookmark will be lost as a side effect. +#' @inheritParams body_add_gg +#' +#' @examples +#' if (require("ggplot2")) { +#' gg_plot <- ggplot(data = iris) + +#' geom_point(mapping = aes(Sepal.Length, Petal.Length)) +#' +#' doc <- read_docx() +#' doc <- body_add_par(doc, "insert_plot_here") +#' doc <- body_bookmark(doc, "plot") +#' doc <- body_replace_gg_at_bkm(doc, bookmark = "plot", value = gg_plot) +#' print(doc, target = tempfile(fileext = ".docx")) +#' } +body_replace_gg_at_bkm <- function(x, bookmark, value, width = 6, height = 5, + res = 300, style = "Normal", scale = 1, + keep = FALSE, ...) { + x <- cursor_bookmark(x, bookmark) + x <- body_add_gg( + x = x, value = value, width = width, height = height, + res = res, style = style, scale = scale, pos = "on", ... + ) + if (keep) { + x <- body_bookmark(x, bookmark) + } + + x +} + +#' @export +#' @rdname body_replace_gg_at_bkm +#' @examples +#' doc <- read_docx() +#' doc <- body_add_par(doc, "insert_plot_here") +#' doc <- body_bookmark(doc, "plot") +#' if (capabilities(what = "png")) { +#' doc <- body_replace_plot_at_bkm( +#' doc, bookmark = "plot", +#' value = plot_instr( +#' code = { +#' barplot(1:5, col = 2:6) +#' } +#' ) +#' ) +#' } +#' print(doc, target = tempfile(fileext = ".docx")) +body_replace_plot_at_bkm <- function(x, bookmark, value, width = 6, height = 5, + res = 300, style = "Normal", + keep = FALSE, ...) { + x <- cursor_bookmark(x, bookmark) + x <- body_add_plot( + x = x, value = value, width = width, height = height, + res = res, style = style, pos = "on", ... + ) + if (keep) { + x <- body_bookmark(x, bookmark) + } + + x +} #' @export #' @title Replace text anywhere in the document diff --git a/man/body_replace_gg_at_bkm.Rd b/man/body_replace_gg_at_bkm.Rd new file mode 100644 index 00000000..72f14b11 --- /dev/null +++ b/man/body_replace_gg_at_bkm.Rd @@ -0,0 +1,85 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/docx_replace.R +\name{body_replace_gg_at_bkm} +\alias{body_replace_gg_at_bkm} +\alias{body_replace_plot_at_bkm} +\title{Add plots at bookmark location in a 'Word' document} +\usage{ +body_replace_gg_at_bkm( + x, + bookmark, + value, + width = 6, + height = 5, + res = 300, + style = "Normal", + scale = 1, + keep = FALSE, + ... +) + +body_replace_plot_at_bkm( + x, + bookmark, + value, + width = 6, + height = 5, + res = 300, + style = "Normal", + keep = FALSE, + ... +) +} +\arguments{ +\item{x}{an rdocx object} + +\item{bookmark}{bookmark id} + +\item{value}{a ggplot object for body_replace_gg_at_bkm() or a set plot instructions +body_replace_plot_at_bkm(), see plot_instr().} + +\item{width}{height in inches} + +\item{height}{height in inches} + +\item{res}{resolution of the png image in ppi} + +\item{style}{paragraph style} + +\item{scale}{Multiplicative scaling factor, same as in ggsave} + +\item{keep}{Should the bookmark be preserved? Defaults to \code{FALSE}, +i.e.the bookmark will be lost as a side effect.} + +\item{...}{Arguments to be passed to png function.} +} +\description{ +Use these functions if you want to replace a paragraph containing +a bookmark with a 'ggplot' or a base plot. +} +\examples{ +if (require("ggplot2")) { + gg_plot <- ggplot(data = iris) + + geom_point(mapping = aes(Sepal.Length, Petal.Length)) + + doc <- read_docx() + doc <- body_add_par(doc, "insert_plot_here") + doc <- body_bookmark(doc, "plot") + doc <- body_replace_gg_at_bkm(doc, bookmark = "plot", value = gg_plot) + print(doc, target = tempfile(fileext = ".docx")) +} +doc <- read_docx() +doc <- body_add_par(doc, "insert_plot_here") +doc <- body_bookmark(doc, "plot") +if (capabilities(what = "png")) { + doc <- body_replace_plot_at_bkm( + doc, bookmark = "plot", + value = plot_instr( + code = { + barplot(1:5, col = 2:6) + } + ) + ) +} +print(doc, target = tempfile(fileext = ".docx")) +} diff --git a/tests/testthat/test-docx-replace.R b/tests/testthat/test-docx-replace.R index 6ba05694..9535e63f 100644 --- a/tests/testthat/test-docx-replace.R +++ b/tests/testthat/test-docx-replace.R @@ -3,7 +3,8 @@ test_that("replace bkm with text in body", { fp <- fpar( run_bookmark( ftext( - "centered text"), + "centered text" + ), bkm = "text_to_replace" ), ftext( @@ -12,15 +13,16 @@ test_that("replace bkm with text in body", { color = NA, font.size = NA, bold = TRUE, italic = NA, underlined = NA, font.family = NA_character_, cs.family = NA_character_, eastasia.family = NA_character_, - hansi.family = NA_character_, shading.color = NA_character_) + hansi.family = NA_character_, shading.color = NA_character_ ) + ) ) doc <- body_add_fpar(doc, value = fp, style = "centered") xmldoc <- doc$doc_obj$get() xpath_ <- sprintf("//w:bookmarkStart[@w:name='%s']", "text_to_replace") bm_start <- xml_find_first(xmldoc, xpath_) - expect_false( inherits(bm_start, "xml_missing")) + expect_false(inherits(bm_start, "xml_missing")) doc <- body_replace_text_at_bkm(doc, "text_to_replace", "not left aligned") xmldoc <- doc$doc_obj$get() @@ -32,15 +34,18 @@ test_that("replace bkm with text in body", { }) test_that("replace bkm with images in header/footer", { - template <- system.file(package = "officer", "doc_examples/example.docx") - img.file <- file.path( R.home("doc"), "html", "logo.jpg" ) + img.file <- file.path(R.home("doc"), "html", "logo.jpg") doc <- read_docx(path = template) - doc <- headers_replace_img_at_bkm(x = doc, bookmark = "bmk_header", - value = external_img(src = img.file, width = .53, height = .7)) - doc <- footers_replace_img_at_bkm(x = doc, bookmark = "bmk_footer", - value = external_img(src = img.file, width = .53, height = .7)) + doc <- headers_replace_img_at_bkm( + x = doc, bookmark = "bmk_header", + value = external_img(src = img.file, width = .53, height = .7) + ) + doc <- footers_replace_img_at_bkm( + x = doc, bookmark = "bmk_footer", + value = external_img(src = img.file, width = .53, height = .7) + ) print(doc, target = "test_replace_img.docx") doc <- read_docx(path = "test_replace_img.docx") @@ -48,66 +53,149 @@ test_that("replace bkm with images in header/footer", { xmldoc <- doc$headers[[1]]$get() xpath_ <- sprintf("//w:bookmarkStart[@w:name='%s']", "bmk_header") bm_start <- xml_find_first(xmldoc, xpath_) - expect_false( inherits(bm_start, "xml_missing")) + expect_false(inherits(bm_start, "xml_missing")) blip <- xml_find_first(xmldoc, "//w:p/w:r/w:drawing/wp:inline/a:graphic/a:graphicData/pic:pic/pic:blipFill/a:blip") - expect_equal( xml_attr(blip, "embed"), "rId1") + expect_equal(xml_attr(blip, "embed"), "rId1") xmldoc <- doc$footers[[1]]$get() xpath_ <- sprintf("//w:bookmarkStart[@w:name='%s']", "bmk_footer") bm_start <- xml_find_first(xmldoc, xpath_) - expect_false( inherits(bm_start, "xml_missing")) + expect_false(inherits(bm_start, "xml_missing")) blip <- xml_find_first(xmldoc, "//w:p/w:r/w:drawing/wp:inline/a:graphic/a:graphicData/pic:pic/pic:blipFill/a:blip") - expect_equal( xml_attr(blip, "embed"), "rId1") - + expect_equal(xml_attr(blip, "embed"), "rId1") }) test_that("replace bkm in headers and footers", { - - doc <- read_docx(path = "docs_dir/table-complex.docx" ) + doc <- read_docx(path = "docs_dir/table-complex.docx") doc <- headers_replace_text_at_bkm(doc, "hello1", "salut") doc <- footers_replace_text_at_bkm(doc, "hello2", "salut") xmldoc <- doc$headers[[1]]$get() xpath_ <- sprintf("//w:bookmarkStart[@w:name='%s']", "hello1") bm_start <- xml_find_first(xmldoc, xpath_) - expect_false( inherits(bm_start, "xml_missing")) + expect_false(inherits(bm_start, "xml_missing")) newtext <- xml_find_first(xmldoc, "/w:hdr/w:p[1]/w:r") expect_equal(xml_text(newtext), "salut") xmldoc <- doc$footers[[1]]$get() xpath_ <- sprintf("//w:bookmarkStart[@w:name='%s']", "hello2") bm_start <- xml_find_first(xmldoc, xpath_) - expect_false( inherits(bm_start, "xml_missing")) + expect_false(inherits(bm_start, "xml_missing")) newtext <- xml_find_first(xmldoc, "/w:ftr/w:p[1]/w:r[3]") expect_equal(xml_text(newtext), "salut") +}) + +test_that("replace text at bkm with a ggplot", { + testthat::skip_if_not(requireNamespace("ggplot2", quietly = TRUE)) + library("ggplot2") + + gg_plot <- ggplot(data = iris) + + geom_point(mapping = aes(Sepal.Length, Petal.Length)) + + doc <- read_docx() + doc <- body_add_par(doc, "text_to_replace") + doc <- body_bookmark(doc, "plot") + doc <- body_add_par(doc, "text_to_replace") + doc <- body_bookmark(doc, "plot_with_bkm") + + xmldoc <- doc$doc_obj$get() + xpath_ <- sprintf("//w:bookmarkStart[@w:name='%s']", "plot") + bm_start <- xml_find_first(xmldoc, xpath_) + expect_false(inherits(bm_start, "xml_missing")) + + doc <- body_replace_gg_at_bkm(x = doc, bookmark = "plot", value = gg_plot) + + node <- docx_current_block_xml(doc) + child_ <- xml_child(node, "w:r/w:drawing") + expect_false( inherits(child_, "xml_missing") ) + + bm_start <- xml_find_first(xmldoc, xpath_) + expect_true(inherits(bm_start, "xml_missing")) + + # Keep bookmark + doc <- body_replace_gg_at_bkm(x = doc, bookmark = "plot_with_bkm", + value = gg_plot, keep = TRUE) + xpath_ <- sprintf("//w:bookmarkStart[@w:name='%s']", "plot_with_bkm") + bm_start <- xml_find_first(doc$doc_obj$get(), xpath_) + expect_false(inherits(bm_start, "xml_missing")) + + node <- docx_current_block_xml(doc) + child_ <- xml_child(node, "w:r/w:drawing") + expect_false( inherits(child_, "xml_missing") ) +}) + +test_that("replace text at bkm with a plot", { + doc <- read_docx() + doc <- body_add_par(doc, "text_to_replace") + doc <- body_bookmark(doc, "plot") + doc <- body_add_par(doc, "text_to_replace") + doc <- body_bookmark(doc, "plot_with_bkm") + + xmldoc <- doc$doc_obj$get() + xpath_ <- sprintf("//w:bookmarkStart[@w:name='%s']", "plot") + bm_start <- xml_find_first(xmldoc, xpath_) + expect_false(inherits(bm_start, "xml_missing")) + + doc <- body_replace_plot_at_bkm( + doc, + bookmark = "plot", + value = plot_instr(code = { barplot(1:5, col = 2:6) }) + ) + + node <- docx_current_block_xml(doc) + child_ <- xml_child(node, "w:r/w:drawing") + expect_false( inherits(child_, "xml_missing") ) + + bm_start <- xml_find_first(xmldoc, xpath_) + expect_true(inherits(bm_start, "xml_missing")) + + # Keep bookmark + doc <- body_replace_plot_at_bkm( + doc, + bookmark = "plot_with_bkm", + value = plot_instr(code = { barplot(1:5, col = 2:6) }), + keep = TRUE + ) + xpath_ <- sprintf("//w:bookmarkStart[@w:name='%s']", "plot_with_bkm") + bm_start <- xml_find_first(doc$doc_obj$get(), xpath_) + expect_false(inherits(bm_start, "xml_missing")) + node <- docx_current_block_xml(doc) + child_ <- xml_child(node, "w:r/w:drawing") + expect_false( inherits(child_, "xml_missing") ) }) test_that("docx replace text", { doc <- read_docx() doc <- body_add_par(doc, "Placeholder one") doc <- body_add_par(doc, "Placeholder two") - doc <- body_replace_all_text(doc, old_value = "placeholder", new_value = "new", - only_at_cursor = FALSE, ignore.case = TRUE) + doc <- body_replace_all_text(doc, + old_value = "placeholder", new_value = "new", + only_at_cursor = FALSE, ignore.case = TRUE + ) xmldoc <- doc$doc_obj$get() - expect_equal(xml_text( xml_find_all(xmldoc, "//w:p") ), c("new one", "new two") ) + expect_equal(xml_text(xml_find_all(xmldoc, "//w:p")), c("new one", "new two")) }) test_that("docx replace all text", { - doc <- read_docx(path = "docs_dir/table-complex.docx" ) + doc <- read_docx(path = "docs_dir/table-complex.docx") - doc <- headers_replace_all_text(doc, old_value = "hello", new_value = "salut", - only_at_cursor = FALSE, ignore.case = TRUE) - doc <- footers_replace_all_text(doc, old_value = "hello", new_value = "salut", - only_at_cursor = FALSE, ignore.case = TRUE) + doc <- headers_replace_all_text(doc, + old_value = "hello", new_value = "salut", + only_at_cursor = FALSE, ignore.case = TRUE + ) + doc <- footers_replace_all_text(doc, + old_value = "hello", new_value = "salut", + only_at_cursor = FALSE, ignore.case = TRUE + ) xmldoc <- doc$headers[[1]]$get() - expect_equal(xml_text( xml_find_all(xmldoc, "//w:p") ), "salut world" ) + expect_equal(xml_text(xml_find_all(xmldoc, "//w:p")), "salut world") xmldoc <- doc$footers[[1]]$get() - expect_equal(xml_text( xml_find_all(xmldoc, "//w:p") ), "world salut" ) + expect_equal(xml_text(xml_find_all(xmldoc, "//w:p")), "world salut") }) unlink("*.docx", force = TRUE)