如何讓有趣的應用程序響應用戶輸入的pdf下載？

Question

我想讓我的閃亮應用程序生成的表格和barplot可以作爲pdf報告下載。在我第一次在本地計算機上啓動應用程序時，我可以使用所選輸入生成報告，但是當我切換輸入時，它不會生成pdf上新輸入的報告。

這裏是我的UI代碼

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 
) 

這是我的服務器代碼

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) 

這是我放置在app.R是相同的文件夾中的文件.Rmd。

--- 
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")] 
``` 

該數據是學生在學校進行的考試中得分的樣本。

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 

我真的很感謝你的幫助。

Answer 1

我很抱歉，花了我很長時間纔回到這裏。看過我所做的事後，結果發現它比我想起的要多一點。

這裏是我的示例應用程序的代碼

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) 

這裏是我的RMD（題爲report_file.Rmd）

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

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

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

一些亮點，尋找

• 通知params中的存在YAML的RMarkdown腳本的前置事項。這使我們可以在調用rmarkdown::render(..., params = list(...))
• 時傳入要在腳本中使用的值列表我總是將我的PDF構建爲一個虛擬文件。這樣很容易找到。
• 我總是生成一個虛擬文件的原因是爲了讓下載處理程序正常工作，您需要讀取PDF的位內容並使用writeBin將它推送到file參數。看到我的downloadHandler建設。
• 使用參數化報告意味着您不必在rmarkdown腳本中重新創建輸出。該工作是在Shiny應用程序中完成的，參數化報告只是幫助您正確發送對象。 這不像傳遞文件來回傳遞（雖然如果它可以很容易，我很想知道它）。

瞭解更多關於此參數報告：http://rmarkdown.rstudio.com/developer_parameterized_reports.html