如何在闪亮的应用程序中响应用户输入进行pdf下载? [英] How to make pdf download in shiny app response to user inputs?
问题描述
我想将我闪亮的应用程序生成的表格和条形图下载为pdf报告.第一次在本地计算机上启动应用程序时,可以使用选定的输入生成报告,但是当我切换输入时,它不会生成pdf上新输入的报告.
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.
这是我的用户界面代码
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文件.
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 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.
这是我的示例应用代码
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
)
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"]]
```
要寻找的一些亮点
- 请注意,RMarkdown脚本的YAML前端存在
params
.这使我们可以在调用rmarkdown::render(..., params = list(...))
时传递要在脚本中使用的值的列表.
- 我总是将我的PDF生成为虚拟文件.这样就很容易找到.
- 我始终构建为虚拟文件的原因是要使下载处理程序正常工作,您需要读取PDF的位内容,然后使用
writeBin
将其推入file
参数.参见我的downloadHandler
构造. - 使用参数化报告意味着您不必在rmarkdown脚本中重新创建输出.这项工作是在Shiny应用程序中完成的,参数化报告仅可帮助您正确发送对象. 它与来回传递文件并不完全相同(尽管可能很简单,但我很想知道).
- 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 invokermarkdown::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 usingwriteBin
. See mydownloadHandler
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).
在此处了解有关参数化报告的更多信息: http://rmarkdown.rstudio.com/developer_parameterized_reports.html
Read more about parameterized reports here: http://rmarkdown.rstudio.com/developer_parameterized_reports.html
这篇关于如何在闪亮的应用程序中响应用户输入进行pdf下载?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!