Есть ли способ передать аргументы в реактивную функцию в загрузчике, чтобы можно было скачать графики?

Question

Я создал реактивные функции построения графиков, p1 () и p2 (), и они отлично отображаются.Я переношу их в функцию обработчика загрузки и сохраню png-файл, затем при открытии файла я не вижу изображения?

Цель состоит в том, чтобы обеспечить успешную загрузку обоих графиков, чтобы их можно было распространять.Я попытался скопировать оба вызова функции plot и самой функции plot в обработчик загрузки, но опять же нет изображения.Я подозреваю, что размещение p1 () и p2 () в обработчике загрузки является правильным, но должен быть какой-то способ передачи аргументов этим.Почему они рендерится, но не создают изображение при загрузке?Я предоставил воспроизводимый код и образец кадра данных для этой проблемы.

library(shiny)
library(ggplot2)
library(dplyr)

ui <- shinyUI(navbarPage("Example",


               tabPanel("Data",
                        sidebarLayout(
                          sidebarPanel(
                            "Nothing here at the moment"),
                          mainPanel("Select Dashboard Panel for 
     results.Click on Select/All to make the plots 
                   render"))
               ),

     tabPanel("Dashboard",
     sidebarLayout(
      sidebarPanel(
          checkboxInput('all', 'Select All/None', value = TRUE),
          uiOutput("year_month"),
          tags$head(tags$style("#year_month{color:red; font-size:12px; 
          font-style:italic; 
          overflow-y:scroll; max-height: 100px; background: 
          ghostwhite;}")),     
          checkboxInput('all1', 'Select All/None', value = TRUE),
          uiOutput("year"),
          tags$head(tags$style("#year{color:red; font-size:12px; font- 
          style:italic; 
          overflow-y:scroll; max-height: 100px; background: 
          ghostwhite;}")),
          radioButtons("var3", "Select the file type", choices=c("png", 
          "pdf")),
          downloadButton("down", "Download the plot")
        ),
      mainPanel( 
            uiOutput("tb")))
               )
    ))    

   complaint_id <- c(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,
    21,22,23,24,25,26,27,28,29,30,31,32,33)

    age_group <- c("Over a year", "06 Months", "01 Months", "Over a 
    year", "06 Months", "09 Months","01 Months", "03 Months", "06 
    Months", "03 Months", "12 Months", "09 Months","01 Months", 
    "06 Months", "01 Months", "12 Months", "01 Months", "09 Months",
    "06 Months", "09 Months", "Over a year", "Over a year", "01 Months", 
    "12 Months","06 Months", "01 Months", "09 Months", "12 Months", 
    "03 Months", "01 Months","Over a year", "01 Months", "01 Months")
    closed_fy_ending <- c("2019", "2019", "2019", "2019", "2019", "2019", 
    "2019", "2019", "2019", "2019","2019", "2019", "2019", "2019", 
    "2019", "2019", "2019", "2019", "2019", "2019","2019", "2019", 
    "2019", "2019", "2019", "2019", "2019", "2019","2019", "2019",
    "2019", "2019", "2019")

    closed_date_ym <- c("2019-08", "2019-09", "2019-08", "2019-08", 
    "2019-08", "2019-08", "2019-09","2018-08", "2019-08", "2019-09", 
    "2019-09", "2019-09", "2019-08", "2019-08",
    "2019-09", "2019-09", "2019-08", "2019-09", "2019-09", "2019-09", 
    "2019-09","2019-09", "2019-09", "2019-09", "2019-08", "2019-08", 
    "2019-09", "2019-08","2019-08", "2019-08", "2019-08", "2019-09", 
    "2019-09")      

     officer <- c("E", "D", "B", "A", "A", "D", "C", "C", "C", "D", "C", 
     "B", "C", "D", "A", "A", "D","A", "E", "C", "B", "C", "E", "E", "E", 
     "A", "A", "A", "B", "E", "C", "D", "B")

      Outcome <- c("Excellent", "Poor", "OK", "Excellent", "Poor", 
      "Good", "Poor", "Good", "Poor", "Excellent","Poor", "Good", 
      "Excellent", "Good", "Poor", "Poor", "Excellent", "Poor", "Poor", 
      "Good","OK", "OK", "Excellent", "Poor", "Good", "OK", "Good", "OK", 
      "Good", "Excellent","Excellent", "Excellent", "Excellent")

      sample_data <- data.frame(complaint_id, age_group, 
      closed_fy_ending, closed_date_ym, officer, Outcome)

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

      #Make it reactive 
      data <- reactive({
      sample_data 
      })

     #Have to modify the reactive data object to add a column of 1s(Ones) 
     #inorder that the Pie chart %s are calculated correctly within the 
     #segments. We apply this modification to a new reactive object, 
     #data_mod()
   data_mod <- reactive({
   if(is.null(data()))return()
   req(data())
   data_mod <-
  data() %>% select(complaint_id, age_group, closed_fy_ending, 
  closed_date_ym, officer, Outcome)
  data_mod$Ones <- rep(1, nrow(data()))
  data_mod
  })


  # creates a selectInput widget with unique YYYY-MM variables ordered 
  # from most recent to oldest time period.

output$year_month <- renderUI({
if(is.null(data()))return()
req(data_mod())
data_ordered <-
  order(data_mod()$closed_date_ym, decreasing = TRUE)
data_ordered <- data_mod()[data_ordered,]
checkboxGroupInput("variable_month",
                   "Select Month",
                   choices = unique(data_ordered$closed_date_ym))
  })

  # creates a selectInput widget with unique YYYY variables ordered from 
  # mostrecent to oldest time period.

  output$year <- renderUI({
  if(is.null(data()))return()
  req(data_mod())
  data_ordered <-
    order(data_mod()$closed_fy_ending, decreasing = TRUE)
  data_ordered <- data_mod()[data_ordered,]
  checkboxGroupInput("variable_year",
                     "Select Year",
                     choices = unique(data_ordered$closed_fy_ending))  

 })
 # Observe function for the month tick box widget
   observe({
   if(is.null(data()))return()
   req(data_mod())
   data_ordered <-
   order(data_mod()$closed_date_ym, decreasing = TRUE)
   data_ordered <- data_mod()[data_ordered,]
   updateCheckboxGroupInput(
   session,
   "variable_month",
   choices = unique(data_ordered$closed_date_ym),
   selected = if (input$all)
    unique(data_ordered$closed_date_ym)
   )

   })
   #Observe function for the year tick box widget  
   observe({
   if(is.null(data()))return()
   req(data_mod())
   data_ordered <-
    order(data_mod()$closed_fy_ending, decreasing = TRUE)
    data_ordered <- data_mod()[data_ordered,]
    updateCheckboxGroupInput(
    session,
    "variable_year",
    choices = unique(data_ordered$closed_fy_ending),
    selected = if (input$all1)
      unique(data_ordered$closed_fy_ending)
     )  
    })

   # This subsets the dataset based on what "variable month" or  
   #"variable_year" above is selected (if/esle) and renders it into a 
   #Table

   output$table <- renderTable({
   if(is.null(input$variable_month)) {
   req(data_mod())
   dftable <- data_mod()
   df_subset <- dftable[, 1:5][dftable$closed_fy_ending %in%
                              input$variable_year, ]
   }
   else
   {
   req(data_mod())
   dftable <- data_mod()
   df_subset <- dftable[, 1:5][dftable$closed_date_ym %in%
                                input$variable_month, ]        
   }

   },
   options = list(scrollX = TRUE))

   # This takes the modified reactive data object data_mod(), assigns it 
   # to a dataframe df. The dataset in df is subsetted based on the 
   # selected variable month above and assigned into a new data frame,  
   # dfnew. The Pie chart is built on the variables within dfnew

    plot_func <- function(dfnew, grp_vars, title, scale) {
      plotdf <- group_by(dfnew, dfnew[[grp_vars]]) %>%
      summarize(volume = sum(Ones)) %>%
      mutate(share = volume / sum(volume) * 100.0) %>%
      arrange(desc(volume))
      plotdf %>%
      ggplot(aes("", share, fill = `dfnew[[grp_vars]]`)) +
      geom_bar(
      width = 1,
      size = 1,
      color = "white",
      stat = "identity"
      ) +
      coord_polar("y") +
      geom_text(aes(label = paste0(round(share, digits = 2), "%")),
            position = position_stack(vjust = 0.5)) +
     labs(
     x = NULL,
     y = NULL,
     fill = NULL,
     title = title
     ) +
     guides(fill = guide_legend(reverse = TRUE)) +

    scale_fill_manual(values = scale) +
    theme_classic() +
    theme(
    axis.line = element_blank(),
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    plot.title = element_text(hjust = 0.5, color = "#666666")
    )
    }


    ###1st call to plot function to produce plot1. If/else depends on 
    #widget #ticked, month or year

p1 <- reactive({
if(is.null(input$variable_month)) {
req(data_mod(), input$variable_year)
df <- data_mod()
plot_func(
  dfnew = df[, 1:7][df$closed_fy_ending %in% input$variable_year, ],
  grp_vars = "age_group",
  title = "Age group segmentation",
  scale = c("#ffd700","#bcbcbc","#ffa500","#254290","#f0e68c","#808000")
  )
  }
  else
  {

  req(data_mod(), input$variable_month)

  df <- data_mod()
  plot_func(
  dfnew = df[, 1:7][df$closed_date_ym %in% input$variable_month, ],
  grp_vars = "age_group",
  title = "Age group segmentation",
  scale = c("#ffd700","#bcbcbc","#ffa500","#254290","#f0e68c","#808000")
  ) 
  }
   })


  ###2nd call to plot function to produce plot2. If/else depends on 
   #widget #ticked, month or year

   p2 <- reactive({
   if(is.null(input$variable_month)) {

   req(data_mod(), input$variable_year)
   df <- data_mod()
   plot_func(
   dfnew = df[, 1:7][df$closed_fy_ending %in% input$variable_year, ],
   grp_vars = "Outcome",
   title = "Outcome segmentation",
   scale = c("#ffd700", "#bcbcbc", "#ffa500", "#254290")
   )
   }
   else
   {
   req(data_mod(), input$variable_month)
   df <- data_mod()
   plot_func(
    dfnew = df[, 1:7][df$closed_date_ym %in% input$variable_month, ],
    grp_vars = "Outcome",
    title = "Outcome segmentation",
    scale = c("#ffd700", "#bcbcbc", "#ffa500", "#254290")
    ) 
    }
  })
  output$plot1 <- renderPlot({
  p1()
  })
  output$plot2 <- renderPlot({
  p2()
  })


 # the following renderUI is used to dynamically gnerate the tabsets when 
 # the file is loaded
 output$tb <- renderUI({
 req(data())
 tabsetPanel(tabPanel("Plot",
                     plotOutput("plot1"), plotOutput("plot2")),
            tabPanel("Data", tableOutput("table")))
 })
 #####DOWNLOAD
 output$down <- downloadHandler(
 filename = function(){

  paste("Pie Segmentation", input$var3, sep=".")
},
content = function(file){
  #open the device
  #create the plot
  #close the device
  #png()
  #pdf()
  if(input$var3 == "png")
    png(file)
  else
   pdf(file)
  p1()
   p2() 
  dev.off()

   }

  )
 })

Я не получаю сообщений об ошибках.Когда я нажимаю кнопку загрузки, я вижу имя файла «Pie Segmentation.png», которое затем сохраняю в файл.Когда я открываю этот файл, изображение отсутствует.Буду признателен, если кто-нибудь сможет решить эту проблему для меня, пожалуйста.