r-如何使用软件包管理员更新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"))