Download handler in R shiny does not produce a PDF file (using rmarkdown::render())

Question

Here's a very broken down version of my shiny app...upon pressing the "Go!" button you get two plots. I want to download them to a PDF unsing rmarkdown::render() based on the top answer of this question: How to make pdf download in shiny app response to user inputs?

When pressing the downloadButton the download window opens, but the file is called "report" instead of "Result" and the file type is "All files". When pressing save there is no file generated, or at least none I can find anywhere.

I had the exact same issue using a slightly different solution from the R help website, but I can't figure out what causes it and how to fix it.

This question gave me the idea it might just be a problem running the code in RStudio: Download handler does not save file shiny R However when trying to download from the browser it says "report.html could not be downloaded"- so still wrong name, wrong file type and no successful download.

Can anyone help me fix the issue?

#LIBRARIES
library (shiny)
library(shinydashboard)
library (shinyjs)
library (ggplot2)
library (dplyr)
library(rmarkdown)
library (knitr)



blues <- c( "#013560", "#0065AD", "#007BD3", "#0091F9", "#9FD4F9",  "#EEEEEE")



#sidebar vordefinieren
Codepan <-   div( 
  id = 'sidebar_cr',
  actionButton (inputId = "Button", label = "Go!"),
                  "some intro text and then the download button",
                                   downloadButton("report", "Meine Ergebnisse als PDF speichern")
                                   )
                  



sidebar <- 
  dashboardSidebar(Codepan)


#Body vordefinieren

body <- dashboardBody(
  
          
          
          
          fluidRow(
            
            box(title = "Deine Mediennutzung",
                status= "success", solidHeader = TRUE, height=400,width = 11,
               plotOutput(outputId= "PlotM", height= 300))
          
          
        ),
      
      
      
          fluidRow(
            box(
              width = 11, title = "Deine Ergebnisse",  solidHeader = TRUE, status = "success",
              column(width= 6, plotOutput("plotEAT", height = 250))
            ))
)
             



# hier beginnt die eigentliche App:
ui <- 
  dashboardPage(
    dashboardHeader(title = "title", disable = FALSE),
    sidebar,
    body
  )



server <- function(input, output) {
  

  
  #2 Plot comparison Feedback
 
  
  
  MediaCompare3 <- eventReactive(input$Button, {
    det <-data.frame(group = c("a-du", "a-ges", "b-sport", "c-age"),
                     means = c(16, 22, 31, 15)
                     )
    
    
    
    
    
  })
  
  output$PlotM <- renderPlot({
    ggplot(MediaCompare3(), aes(x = group, y = means)) + 
      geom_bar(stat = "identity", fill = "#013560", color = "#013560") +
     # scale_x_discrete(labels=c("Du", "Gesamtdurchschnitt",paste("Durchschnitt",Daten[toupper(input$Code), "Sportart_zurueckkodiert"]), paste("Durchschnitt", (Daten[toupper(input$Code), "SP01_01"]-1),"-",(Daten[toupper(input$Code), "SP01_01"]+1), "Jahre" )))+ 
      xlab(NULL) + 
      ylab("Mediennutzung in Minuten")+
      #geom_hline(yintercept = as.numeric(as.character(Daten[toupper(input$Code), "Nutzungsdauer_DM_Gesamt"])), lty = 8, col = "Red")+
      geom_text(aes(label = round(means, 0)), vjust =2, colour = "white", size= 8)#+
      #geom_label(label="Du", x = 0.5,y = as.numeric(as.character(Daten[toupper(input$Code), "Nutzungsdauer_DM_Gesamt"])), color ="red")
  })
  
  
  
  
  
  
  
 
  
  forplotEAT <- eventReactive (input$Button, {
    df<- data.frame(Komp = rep(c("Einstellungen zu Essen", "Sozialer Vergleich"), 3), 
                    groupW = c("ADu", "ADu", 
                               "AGesamt", "AGesamt",
                               "ZGeschlecht","ZGeschlecht"),
                    valuesW = c (19, 20, 21, 34, 12, 17
                                 
                                 
                    )) 
    
    
    
  })
  
  
  output$plotEAT <-renderPlot ({
    Geschlecht <- "girls"
    ggplot(forplotEAT(), aes(x = Komp, y = valuesW, fill = groupW)) + 
      geom_bar(position = "dodge", stat = "identity",color = "#404040", show.legend = TRUE)+
      #scale_fill_discrete(name = "Vergleichsgruppen", labels=c("Du", "Gesamtdurchschnitt", Geschlecht))+
      xlab("Gruppe")+
      ylab("Ergebnis")+
      geom_text(aes(label = round(valuesW, 1)), vjust =2, colour = "white", size= 5, position = position_dodge(width= 0.9))+
      scale_fill_manual(values= blues, name = "Vergleichsgruppen", labels=c("Du", "Gesamtdurchschnitt", Geschlecht))#+
    #coord_flip()+
    #geom_hline(yintercept = 10, lty = 8, col = "Red")
  })

The current version relies on the Rmd file down below:

  
  output$report<-
    
    downloadHandler(
      "Result.pdf",
      content = 
        function(file){
          rmarkdwon::render(
            input= "report_file.Rmd",
            output_file = "built_report.pdf",
            params = list (plotM = plotM(),
                           plotEAT= plotEAT())
          )
          readBin (con = "built_report.pdf",
                   what = "raw",
                   n = file.info ("built_report.pdf")[, "size"])%>%
            writeBin (con = file)
        } )
  
  
  
  
  
  
  
  
  
}

shinyApp(ui=ui, server=server)

RMD File:

---
title: "Individuelles Ergebnis"
output: pdf_document
params:
  plotM: "NULL"
  plotEAT: "NULL"


---




```{r}
params[["plotM"]]```

```{r}
params[["plotEAT"]]```

This is the other version I tried, directly attempting to pass the body to the download handler:

  
  output$report<-
    
    downloadHandler(
      "Ergebnisse.pdf",
      content = 
        function(file){
          rmarkdwon::render(
            input= "report_file.Rmd",
            output_file = "built_report.pdf",
            params = list (plotM = plotM(),
                           plotEAT= plotEAT())
          )
          readBin (con = "built_report.pdf",
                   what = "raw",
                   n = file.info ("built_report.pdf")[, "size"])%>%
            writeBin (con = file)
         } )
        

Answer 1

Here is a working solution if you have latex installed:

#LIBRARIES
library (shiny)
library(shinydashboard)
library (ggplot2)
library (dplyr)



blues <- c( "#013560", "#0065AD", "#007BD3", "#0091F9", "#9FD4F9",  "#EEEEEE")



#sidebar vordefinieren
Codepan <-   div( 
  id = 'sidebar_cr',
  actionButton (inputId = "Button", label = "Go!"),
  "some intro text and then the download button",
  downloadButton("report", "Meine Ergebnisse als PDF speichern")
)




sidebar <- 
  dashboardSidebar(Codepan)


#Body vordefinieren

body <- dashboardBody(
  
  
  
  
  fluidRow(
    
    box(title = "Deine Mediennutzung",
        status= "success", solidHeader = TRUE, height=400,width = 11,
        plotOutput(outputId= "PlotM", height= 300))
    
    
  ),
  
  
  
  fluidRow(
    box(
      width = 11, title = "Deine Ergebnisse",  solidHeader = TRUE, status = "success",
      column(width= 6, plotOutput("plotEAT", height = 250))
    ))
)




# hier beginnt die eigentliche App:
ui <- 
  dashboardPage(
    dashboardHeader(title = "title", disable = FALSE),
    sidebar,
    body
  )



server <- function(input, output) {
  
  
  
  #2 Plot comparison Feedback
  
  
  
  MediaCompare3 <- eventReactive(input$Button, {
    det <-data.frame(group = c("a-du", "a-ges", "b-sport", "c-age"),
                     means = c(16, 22, 31, 15)
    )
    
    
    
    
    
  })
  
  plotM <- reactive({
    ggplot(MediaCompare3(), aes(x = group, y = means)) + 
      geom_bar(stat = "identity", fill = "#013560", color = "#013560") +
      # scale_x_discrete(labels=c("Du", "Gesamtdurchschnitt",paste("Durchschnitt",Daten[toupper(input$Code), "Sportart_zurueckkodiert"]), paste("Durchschnitt", (Daten[toupper(input$Code), "SP01_01"]-1),"-",(Daten[toupper(input$Code), "SP01_01"]+1), "Jahre" )))+ 
      xlab(NULL) + 
      ylab("Mediennutzung in Minuten")+
      #geom_hline(yintercept = as.numeric(as.character(Daten[toupper(input$Code), "Nutzungsdauer_DM_Gesamt"])), lty = 8, col = "Red")+
      geom_text(aes(label = round(means, 0)), vjust =2, colour = "white", size= 8)#+
    #geom_label(label="Du", x = 0.5,y = as.numeric(as.character(Daten[toupper(input$Code), "Nutzungsdauer_DM_Gesamt"])), color ="red")
  })
  
  output$PlotM <- renderPlot({
    plotM()
  })
  
  
  
  
  
  
  
  
  forplotEAT <- eventReactive (input$Button, {
    df<- data.frame(Komp = rep(c("Einstellungen zu Essen", "Sozialer Vergleich"), 3), 
                    groupW = c("ADu", "ADu", 
                               "AGesamt", "AGesamt",
                               "ZGeschlecht","ZGeschlecht"),
                    valuesW = c (19, 20, 21, 34, 12, 17
                                 
                                 
                    )) 
    
    
    
  })
  
  plotEAT <- reactive({
    Geschlecht <- "girls"
    ggplot(forplotEAT(), aes(x = Komp, y = valuesW, fill = groupW)) + 
      geom_bar(position = "dodge", stat = "identity",color = "#404040", show.legend = TRUE)+
      #scale_fill_discrete(name = "Vergleichsgruppen", labels=c("Du", "Gesamtdurchschnitt", Geschlecht))+
      xlab("Gruppe")+
      ylab("Ergebnis")+
      geom_text(aes(label = round(valuesW, 1)), vjust =2, colour = "white", size= 5, position = position_dodge(width= 0.9))+
      scale_fill_manual(values= blues, name = "Vergleichsgruppen", labels=c("Du", "Gesamtdurchschnitt", Geschlecht))#+
    #coord_flip()+
    #geom_hline(yintercept = 10, lty = 8, col = "Red")
  })
  
  output$plotEAT <-renderPlot ({
    plotEAT()
  })
  
  output$report<-
    
    downloadHandler(
      "Result.pdf",
      content = 
        function(file){
          rmarkdown::render(
            input= "report_file.Rmd",
            output_file = "built_report.pdf",
            params = list (plotM = plotM(),
                           plotEAT= plotEAT())
          )
          readBin (con = "built_report.pdf",
                   what = "raw",
                   n = file.info ("built_report.pdf")[, "size"])%>%
            writeBin (con = file)
        } )
  
  
  
  
  
  
  
  
  
}

shinyApp(ui=ui, server=server)