Shiny App: Downloadhandler Does Not Produce a File

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

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)

How to fix 'File not found' when using the downloadHandler?

The download handler does not know that the pseudo_df data frame was created. You probably want to have one reactive that makes the data frame and then separate render and download handlers that call the reactive that creates the data frame. So for example

make_df <- reactive({})  # code that makes the data frame goes here
output$results <- renderTable({make_df()})
output$downloadData <- downloadHandler(
  filename = function() {
    paste("data-", Sys.Date(), ".csv", sep="")
  },
  content = function(file) {
    write.csv(make_df(), file) # notice the call to the reactive again
  }
)

Why the function downloadHandler doesnot download the file in Rshiny?

The problem is that you don't have an input element called var3, so input$var3 returns NULL and thus the filename becomes invalid ("iris.")

You named the input type, so use input$type:

output$down <- downloadHandler(
  filename =  function() {
    paste("iris", input$type, sep=".")
  },
  # content is a function with argument file. content writes the plot to the device
  content = function(file) {
    if(input$type == "png")
      png(file) # open the png device
    else
      pdf(file) # open the pdf device
    hist(colm()) # draw the plot
    dev.off()  # turn the device off

  }
)

(Note that you're saving hist(colm()), that is not the same plot as you rendered)

When I hit the download button, It shows like the following whereas the file name suppose to be iris.png. Why this behaviour?

In RStudio Viewer:

The result from filename=function() is not used by the RStudio Viewer to save the file. This is how it was for a long time. You can download the file if you name it though and it will work.

In browsers:

The result from filename=function() works as you would expect.

R - shiny's downloadHandler() returns an empty HTML file if a condition is not met

To expand on my comment above:

library(shiny)
library(tidyverse)
library(shinyjs)

# UI
ui <- fluidPage(
  useShinyjs(),
  textInput(input = "text",
            label = "Write 'download' to download the correct file"),
  br(),
  downloadButton(outputId = "downloadData", label = "Download")
)

# SERVER
server <- function(input, output) {
  data <- mtcars
  
  observeEvent(input$text, {
    if (input$text == "download") {
      enable("downloadData")
    } else {
      disable("downloadData")
    }
  })
  
  output$downloadData <- downloadHandler(
    filename = function() {
      paste("data-", Sys.Date(), ".csv", sep = "")
    },
    content = function(file) {
        write.csv(x = data, file =  file)
    }
  )
}

shinyApp(ui, server)

Giving

and

[Note the change in font colour on the Download widget.]

Edit

In response to OP's request in the comments below, to use the shinyFeedback package...

1. Load the package and add the necessary call to the UI definition:

...
library(shinyFeedback)

# UI
ui <- fluidPage(
  useShinyjs(),
  useShinyFeedback(), ...

2. Modify the observeEvent that watches the textInput:

  observeEvent(input$text, {
    if (input$text == "download") {
      hideFeedback("text")
      enable("downloadData")
      showFeedbackSuccess("text", "Ready to download")
    } else {
      disable("downloadData")
      showFeedbackDanger("text", "Please enter the password")
    }
  })

This gives

and

---

Related Topics