Issue with downloading two rendered shiny pie plots

Hi, I can successfully render two shiny pie plots after creating reactive plot objects, p1() and p2(). I bring these into the download handler function and set up a png file extension in the output. When I open my saved png file, only the plot title is saved and no plot image appears? Why is it that p1() and p2() render but their images aren't saved when I open the png file? I would be very grateful if someone could assist me with that. My reproduceable code is below....

library(shiny)

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;}")),
              #uiOutput("year")
              #tags$head(tags$style("#year{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")))
                   )
))    
library(shiny)
library(ggplot2)
library(dplyr)

#use the below if you want to increase the file size being inputed to 9MB
#options(shiny.maxRequestSize = 9.1024^2)

                 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){
  
  #This reactive function takes the inputs from ui.r and use them for read.table()
  #file$datapath -> gives the path of the file
  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 most
  # recent 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()
      
    }
    
  )
})

Hi @johna. You cannot export the plot because p1() and p2() are expression. It will not evaluate automatically, so no plot appear. You can use print to trigger the evaluation.

      if(input$var3 == "png")
        png(file)
      else
       pdf(file)
       print(p1())
       print(p2()) 
      dev.off()

But if you do it like this, for exporting pdf is fine. However, for png, the last plot will overwrite the first plot. So, you just get the second plot only. The solution is to arrange your plots into a single plot by grid.arrange function from gridExtra package.

      if(input$var3 == "png") { 
         png(file) }
      else {
         pdf(file) }
      
      gridExtra::grid.arrange(
        grobs = list(
          p1(),p2()
        )
      )
      dev.off()
1 Like

Hi, thank you so much for solution. I tried your first print solution and yes, the second plot image was produced overwriting the first as you said. However, when I tried your fuller solution after installing the gridExtra package and including it in the library, I got an error message,
Error opening file C:\Users\johna\AppData\Local\Temp\Rtmpsdjj9n\file3b98386717a.png: 32
and nothing downloaded. Any thoughts on this will be much appreciated.

Hi, scratch my reply above. I accidentally deleted the dev.off() function in the code which is why I got the error message. When I put that line back in both plot images were successfully downloaded and all is good. Thanks you so much for your helpful solution.