是否可以使用一种功能来下载各种 ggplot 图？

Question

我闪亮的应用程序生成了许多有用的图表。我想允许用户下载各种格式的图表。

我之前使用 How to save plots that are made in a shiny app 作为指导对单个图表进行过此操作。但是，我最终会为每个附加图创建更多重复代码。我不是程序员，但似乎我应该能够编写一个函数来执行此操作，因为我只是将参数传递给 downloadHandler 和 ggsave，但我无法弄清楚。

下面的 MRE 代表一个页面，比如说，有十个不同的图表。有没有一种方法可以编写一个函数，从按钮（如标签或其他东西？）和 selectInput 的格式接收绘图 ID，以将这些参数传递给 downloadHandler 和 ggsave 以将这些图形中的每一个保存为选定的格式？底部的功能显示了我的想法，但我不知道从这里去哪里，或者那是否是正确的方向。

谢谢！


library(shiny)
library(ggplot2)

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Old Faithful Geyser Data"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30)
        ),

        # Show plots and download buttons
        mainPanel(
           plotOutput("distPlot"),
           fluidRow(
               column(3,
                      downloadButton("dl_plot1")
               ),
               column(3,
                      selectInput("plot1_format",label = "Format",choices = c("SVG","PDF","JPEG","PNG"),width = "75px")
                      )
           ),
           plotOutput("scat_plot"),
           column(3,
                  downloadButton("dl_plot2")
           ),
           column(3,
                  selectInput("plot2_format",label = "Format",choices = c("SVG","PDF","JPEG","PNG"),width = "75px")
           )
        )
    )
)

# Define server logic required to draw a histogram and scatterplot
server <- function(input, output) {

    output$distPlot <- renderPlot({
        x    <- faithful$waiting
        binwidth<-(max(x)-min(x))/input$bins

        p<-ggplot(faithful,aes(waiting))+
            geom_histogram(binwidth = binwidth)
        p
    })
    output$scat_plot<-renderPlot({
        p<-ggplot(faithful,aes(x=waiting,y=eruptions))+
            geom_point()
        p
    })
    
    downloadPlot <- function(plot_name,file_name,file_format){#concept code
      downloadHandler(
        filename=function() { paste0(file_name,".",file_format)},
        content=function(file){
          ggsave(file,plot=plot_name,device=file_format)
        }
      )
    }
}

# Run the application 
shinyApp(ui = ui, server = server)

Answer 1

要在不重复代码的情况下获得所需的结果，您可以（或必须）使用 Shiny 模块。基本上，一个模块是一对 UI 函数和一个服务器函数。有关模块的更多信息，我建议查看例如Mastering shiny, ch. 19.

在下面的代码中，我使用了一个模块来处理下载部分。 downloadButtonUI 和 downloadSelectUI 的工作是为文件格式添加一个下载按钮和一个 selectInput。 downloadServer 完成艰苦的工作并以所需的格式保存绘图。

注意：除了下载模块外，我将绘图代码移至 reactives，以便可以将绘图传递给 downloadHandler 或下载模块。

编辑：添加了修复。我们必须将 reactive（例如不带括号的 dist_plot）传递给下载服务器，并在 downloadServer 中使用 plot() 来导出更新的图。

library(shiny)
library(ggplot2)

# Download Module
downloaButtondUI <- function(id) {
  downloadButton(NS(id, "dl_plot"))
}
downloadSelectUI <- function(id) {
  selectInput(NS(id, "format"), label = "Format", choices = c("SVG", "PDF", "JPEG", "PNG"), width = "75px")
}
downloadServer <- function(id, plot) {
  moduleServer(id, function(input, output, session) {
    output$dl_plot <- downloadHandler(
      filename = function() {
        file_format <- tolower(input$format)
        paste0(id, ".", file_format)
      },
      content = function(file) {
        ggsave(file, plot = plot())
      }
    )
  })
}

# Define UI for application that draws a histogram
ui <- fluidPage(
  # Application title
  titlePanel("Old Faithful Geyser Data"),
  # Sidebar with a slider input for number of bins
  sidebarLayout(
    sidebarPanel(
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30
      )
    ),
    # Show plots and download buttons
    mainPanel(
      plotOutput("distPlot"),
      fluidRow(
        column(3, downloaButtondUI("distPlot")),
        column(3, downloadSelectUI("distPlot"))
      ),
      plotOutput("scat_plot"),
      fluidRow(
        column(3, downloaButtondUI("scatPlot")),
        column(3, downloadSelectUI("scatPlot"))
      ),
    )
  )
)

server <- function(input, output) {
  dist_plot <- reactive({
    p <- ggplot(faithful, aes(waiting)) +
      geom_histogram(bins = input$bins)
    p
  })
  scat_plot <- reactive({
    p <- ggplot(faithful, aes(x = waiting, y = eruptions)) +
      geom_point()
    p
  })
  output$distPlot <- renderPlot({
    dist_plot()
  })
  output$scat_plot <- renderPlot({
    scat_plot()
  })
  
  downloadServer("distPlot", dist_plot)
  downloadServer("scatPlot", scat_plot)
}

shinyApp(ui = ui, server = server)
#> 
#> Listening on http://127.0.0.1:4092

是否可以使用一种功能来下载各种 ggplot 图？

Is it possible to have one function to download various ggplot plots?

r

ggplot2

shiny