如何使用包官从 Shiny 更新 PowerPoint 幻灯片？

Question

我想和包官一起从 Shiny 下载 PowerPoint 幻灯片。 我制作了一个包含情节的 PowerPoint 示例。 如果更改绘图的输入，如何更新幻灯片？ 因为当我更改输入时，它并没有更新绘图，而是添加了一张带有修改过的绘图的新幻灯片。 那不是我想要的。 我想根据输入更新绘图。 如何做到这一点？ 这是一个可重现的示例：

• 导入库并定义有用的函数

# Import packages ---------------------------------------------------------

library(shiny)
library(tidyr)
library(dplyr)
library(ggplot2)
library(officer)

# Useful functions --------------------------------------------------------

IsNumeric <- function(x){return(is.numeric(x) == TRUE)}
IsNotNumeric <- function(x){return(is.numeric(x) == FALSE)}

• 定义用户界面

# Define user interface ---------------------------------------------------

ui <- fluidPage(
    titlePanel("Dataset analysis"),

    sidebarLayout(
        sidebarPanel(

            # Select categorical variables:
            selectInput(inputId = "CatVar"
                        , label = "Select categorical variables:"
                        , choices = diamonds %>% select_if(IsNotNumeric) %>% colnames()
                        , multiple = TRUE
                        ),

            selectInput(inputId = "NumVar"
                        , label = "Select categorical variables:"
                        , choices = diamonds %>% select_if(IsNumeric) %>% colnames()
                        , multiple = FALSE
                        )
                    ),

       mainPanel(

           plotOutput(outputId = "plot_id"),

           downloadButton(outputId = "pptx_id"
                          , label = "Download analysis to PowerPoint"
           )

       )
    )

)

• 定义服务器功能

mypptx <- read_pptx()

server <- function(session, input, output){

    selectCatVar <- reactive({

        validate(

            need(is.null(input$CatVar) == FALSE, "Please select at least one categorical variable.")
        )

        input$CatVar

    })

    # selectNumVar <- reactive({input$NumVar})

    myplot <- reactive({

        dat <- diamonds %>% select(selectCatVar(), input$NumVar) %>% 
            gather(MyVar, MyValue, -input$NumVar)

        ggplot(data = dat, mapping = aes(x = MyValue, y = !!sym(input$NumVar), fill = MyValue)) +
            geom_boxplot() +
            facet_wrap(MyVar ~ ., scales = "free_x") +
            labs(y = input$NumVar) +
            theme(legend.position = "none"
            )


    })


    output$plot_id <- renderPlot({

        myplot()

    })

    output$pptx_id <- downloadHandler(
        filename = function(){"test_pptx.pptx"},
        content = function(file){

            mypptx  %>% add_slide(layout = "Title and Content", master = "Office Theme") %>%
                            ph_with(value = myplot(), location = ph_location_type(type = "body")) %>%
                            print(target = file)
        }
    )

}

• 运行应用程序

shinyApp(ui = ui, server = server)

Answer 1

我找到了解决方案。 不要将read_pptx()存储在变量中。 因此，更改将如下：

read_pptx() %>% add_slide(layout = "Title and Content", master = "Office Theme") %>%
                            ph_with(value = myplot(), location = ph_location_type(type = "body")) %>%
                            print(target = file)

Answer 2

####  Library  ####
install.packages("flextable")
install.packages("rvg")
library(flextable)
library(rvg)
library(officer)
library(ggplot2)
library(magrittr)

# Creat a path
path_out <- "."

#### prep ggplot ####
p1 <- iris %>% 
  ggplot() +
  geom_point(aes(Sepal.Length,Petal.Length,color = Species), size = 3) +
  theme_minimal()

#### prep editable graph (rvg) ####
p2 <- dml(ggobj = P1)

#### Producing ppt file ####
my_pres <- read_pptx() %>%
  #slide 1 # for dummy graph
  add_slide(layout = "Title and Content", master = "Office Theme") %>%
  ph_with(value = p1, location = ph_location("body", left = 1, top = 1, width = 5, height = 5)) %>%
  #slide 2 # for Editable graph / vector graph
  add_slide() %>%
  ph_with(value = p2, location = ph_location("body", left = 1, top = 1, width = 5, height = 5)) %>%
  print(target = file.path(path_out,"example_v1.pptx"))