Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

How to make pdf download in shiny app response to user inputs?

I want to make the table and the barplot generated by my shiny app to be downloadable as a pdf report. I can generate the report with the selected inputs the first time I start the app on my local computer, but when I switch the inputs, it doesn't generate the reports of the new inputs on pdf.

Here's my ui code

require(shiny)
require(shinydashboard)
require(ggplot2)
require(ggthemes)

sample <- read.csv("new_sample2.csv", stringsAsFactors = FALSE)

header <- dashboardHeader(title = "XYZ School Student Dashboard", titleWidth = 370)

body <- dashboardBody(
tags$head(tags$style(HTML('
  .main-header .logo {
                        font-family: "Georgia", Times, "Times New Roman", serif;
                        font-weight: bold;
                        font-size: 20px;
                        }
                        '))),
fluidRow(
column(width = 9,
box(title = "Selected Student", width = NULL, solidHeader = TRUE, status = "info",
           textOutput("summary1"),
           textOutput("summary2"),
           textOutput("summary3")
),

       box(title = "Marks card", status = "info", width = NULL, solidHeader = TRUE, collapsible = TRUE,
           tableOutput("table")),
       box(title = "Marks card bar plot", status = "info", width = NULL, solidHeader = TRUE, collapsible = TRUE,
           plotOutput("plot"))
),

column(width = 3,
       box(title = "Select", background = "blue" ,width = NULL,
           selectInput("class", "Class", unique(sample$class)),
           selectInput("name", "Name", unique(sample$name)),
           selectInput("exams", "Exams", choices = c("1st Periodic Test", "1st Term", "2nd Periodic Test",
                                                     "2nd Term", "3rd Periodic Test", "4th Periodic Test",
                                                     "Final")),

           "Note: In the Bar Plot", 
           br(),
           "1. The black line is the average class mark for that particular subject.",
           br(),
           "2. The red line is the pass mark for that particular subject.",
           hr(),
           downloadButton("downloadReport", "Download report")
           )
       )
  )
)


ui <- dashboardPage(skin = "blue",
    header,
      dashboardSidebar(disable = TRUE),
        body
)  

And here's my server code

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

output$summary1 <- renderText({
paste("Student Name: ", input$name)
})

output$summary2 <- renderText({
paste("Class: ", input$class)
})
output$summary3 <- renderText({
paste("Examination: ", input$exams)
})


getdataset <- reactive({
dataset <- sample[sample$class == input$class & sample$name == input$name & sample$examination == input$exams, ]
})

observe({
classInput <- input$class
updateSelectInput(session, "name", choices = sample$name[sample$class == classInput])
})

output$table <- renderTable({
dataset <- getdataset()
dataset[, c("date", "subject", "maximum_mark", "pass_mark", "obtain_mark", "class_ave", "pc", "exam_pc")]
})

plotInput <- reactive({
df <- getdataset()
ggplot(df, aes(x = subject, y = obtain_mark)) +
  theme_fivethirtyeight() +
  geom_bar(stat = "identity", fill = "#006699") +
  geom_text(aes(label = obtain_mark),vjust = -0.4) +
  geom_errorbar(data = getdataset(),
                aes(y = class_ave, ymax = class_ave,
                    ymin = class_ave), colour = "#000000") +
  geom_errorbar(data = getdataset(),
                aes(y = pass_mark, ymax = pass_mark,
                    ymin = pass_mark), colour = "red") +
  labs(title = paste(input$name,"'s", input$exams, "marks"), x = "", y = "Marks") +
  theme(axis.text=element_text(size=10, face = "bold")
  )
})

output$plot <- renderPlot({
print(plotInput())
 })

output$downloadReport <- downloadHandler(
filename = "Student-report.pdf",
content = function(file){
  inputEnv <- new.env()
  inputEnv$class <- input$class
  inputEnv$name <- input$name
  inputEnv$exams <- input$exams
  inputEnv$data <- getdataset()
  out = rmarkdown::render("student_report.Rmd", envir = inputEnv)
  file.rename(out, file)
     }
    )
   }

 shinyApp(ui, server)  

This is the .Rmd file that I have placed in the same folder where app.R is.

---
title: "school_report"
author: "Management"
date: "May 4, 2016"
output: pdf_document
---

```{r echo=FALSE}
plotInput()
```  

```{r echo=FALSE}
dataset <- getdataset()
dataset[, c("date", "subject", "maximum_mark", "pass_mark", "obtain_mark", "class_ave", "pc", "exam_pc")]
```  

The data is a sample of marks scored by students in exams conducted by the school.

head(sample)
 class   name       examination       date        subject maximum_mark pass_mark obtain_mark  pc class_ave
1   1 Adison 1st Periodic Test 2015-03-23      English-I        20         8          14     70      15
2   1 Adison 1st Periodic Test 2015-03-24    Mathematics        20         8          19     95      16
3   1 Adison 1st Periodic Test 2015-03-25        Science        20         8          18     90      12
4   1 Adison 1st Periodic Test 2015-03-26          Hindi        20         8          20    100      15
5   1 Adison 1st Periodic Test 2015-03-27 Social Studies        20         8          19     95      11
6   1 Adison 1st Periodic Test 2015-03-28            M.M        20         8          20    100      14
 exam_pc
1 92.86
2 92.86
3 92.86
4 92.86
5 92.86
6 92.86  

tail(sample)
     class   name examination       date       subject maximum_mark pass_mark obtain_mark  pc class_ave
1851   2   Denver       Final 2015-12-10    English-II          100        40          93  93        59
1852   2   Denver       Final 2015-12-02       Drawing           50        20          25  50        34
1853   2   Denver       Final 2015-11-30            GK           50        20          50 100        42
1854   2   Denver       Final 2015-12-01 Moral Science           50        20          50 100        41
1855   2   Denver       Final 2015-12-02     Dictation           25        10          25 100        20
1856   2   Denver       Final 2015-11-30  Hand Writing           25        10          25 100        20
       exam_pc
 1851   87.89
 1852   87.89
 1853   87.89
 1854   87.89
 1855   87.89
 1856   87.89  

I would really appreciate your help.

like image 875
Loy Avatar asked May 04 '16 05:05

Loy


People also ask

How do you read data to the Shiny app?

Your title asks about importing a data frame into shiny. That can be done by storing the data frame either as a binary file using the save() function or a csv file using write. csv() and having the shiny app read it in using load() for a binary file or read. csv() for a csv file.

How do you show a message in Shiny?

Simply call shinyalert() with the desired arguments, such as a title and text, and a modal will show up. In order to be able to call shinyalert() in a Shiny app, you must first call useShinyalert() anywhere in the app's UI.


1 Answers

I apologize that it took me this long to get back to this. After looking at what I've done, it turns out it was a little more involved than I remembered.

Here's my example app code

library(shiny)
library(ggplot2)
library(magrittr)

ui <- shinyUI(
  fluidPage(
    column(
      width = 2,
      selectInput(
        inputId = "x_var",
        label = "Select the X-variable",
        choices = names(mtcars)
      ),
      selectInput(
        inputId = "y_var",
        label = "Select the Y-variable",
        choices = names(mtcars)
      ),
      selectInput(
        inputId = "plot_type",
        label = "Select the plot type",
        choices = c("scatter plot", "boxplot")
      ),
      downloadButton(
        outputId = "downloader",
        label = "Download PDF"
      )
    ),
    column(
      width = 3,
      tableOutput("table")
    ),
    column(
      width = 7,
      plotOutput("plot")
    )
  )
)

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

  #****************************************
  #* Reactive Values

  table <- reactive({
    mtcars[, c(input[["x_var"]], input[["y_var"]])]
  })

  plot <- reactive({
    p <- ggplot(data = mtcars,
                mapping = aes_string(x = input[["x_var"]],
                                     y = input[["y_var"]]))
    if (input[["plot_type"]] == "scatter plot")
    {
      p + geom_point()
    }
    else
    {
      p + geom_boxplot()
    }
  })

  #****************************************
  #* Output Components

  output$table <- 
    renderTable({
      table()
    })

  output$plot <- 
    renderPlot({
      plot()
    })

  #****************************************
  #* Download Handlers

  output$downloader <- 
    downloadHandler(
      "results_from_shiny.pdf",
      content = 
        function(file)
        {
          rmarkdown::render(
            input = "report_file.Rmd",
            output_file = "built_report.pdf",
            params = list(table = table(),
                          plot = plot())
          ) 
          readBin(con = "built_report.pdf", 
                  what = "raw",
                  n = file.info("built_report.pdf")[, "size"]) %>%
            writeBin(con = file)
        }
    )
})

shinyApp(ui, server)

And here is my RMD (entitled report_file.Rmd)

---
title: "Parameterized Report for Shiny"
output: pdf_document
params:
  table: 'NULL'
  plot: 'NULL'
---

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

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

Some highlights to look for

  • Notice the exists of params in the YAML front matter of the RMarkdown script. This allows us to pass in a list of values to be used in the script when we invoke rmarkdown::render(..., params = list(...))
  • I always build my PDF to a dummy file. That way it's easy to find.
  • The reason I always build to a dummy file is that to get the download handler to work, you need to read the bit-content of the PDF and push it to the file argument using writeBin. See my downloadHandler construction.
  • Using the parameterized report means you don't have to recreate your outputs in the rmarkdown script. The work was done in the Shiny app, the parameterized report just helps you send the objects correctly. It isn't quite the same as passing files back and forth (although if it could be that easy, I'd love to know it).

Read more about parameterized reports here: http://rmarkdown.rstudio.com/developer_parameterized_reports.html

like image 120
Benjamin Avatar answered Oct 21 '22 10:10

Benjamin