如何在闪亮的应用程序中下载 pdf 以响应用户输入？
How to make pdf download in shiny app response to user inputs?
我想让 table 和由我闪亮的应用程序生成的条形图可以下载为 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
非常感谢您的帮助。
很抱歉我花了这么长时间才回到这个问题上。在查看我所做的之后，事实证明它比我记得的要复杂一些。
这是我的示例应用程序代码
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 在 RMarkdown 脚本的 YAML front matter 中的存在。这允许我们在调用 rmarkdown::render(..., params = list(...)) 时传入要在脚本中使用的值列表
- 我总是将 PDF 构建为虚拟文件。这样就很容易找到了。
- 我总是生成一个虚拟文件的原因是为了让下载处理程序工作，您需要读取 PDF 的 bit-content 并使用
file 将其推送到参数 writeBin。请参阅我的 downloadHandler 构造。
- 使用参数化报告意味着您不必在 rmarkdown 脚本中重新创建输出。这项工作是在 Shiny 应用程序中完成的，参数化报告只是帮助您正确发送 objects。
它与来回传递文件不太一样（尽管如果它能那么简单，我很想知道）。
在此处阅读有关参数化报告的更多信息：http://rmarkdown.rstudio.com/developer_parameterized_reports.html
我想让 table 和由我闪亮的应用程序生成的条形图可以下载为 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
非常感谢您的帮助。
很抱歉我花了这么长时间才回到这个问题上。在查看我所做的之后，事实证明它比我记得的要复杂一些。
这是我的示例应用程序代码
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在 RMarkdown 脚本的 YAML front matter 中的存在。这允许我们在调用rmarkdown::render(..., params = list(...)) 时传入要在脚本中使用的值列表
- 我总是将 PDF 构建为虚拟文件。这样就很容易找到了。
- 我总是生成一个虚拟文件的原因是为了让下载处理程序工作，您需要读取 PDF 的 bit-content 并使用
file将其推送到参数writeBin。请参阅我的downloadHandler构造。 - 使用参数化报告意味着您不必在 rmarkdown 脚本中重新创建输出。这项工作是在 Shiny 应用程序中完成的，参数化报告只是帮助您正确发送 objects。 它与来回传递文件不太一样（尽管如果它能那么简单，我很想知道）。
在此处阅读有关参数化报告的更多信息：http://rmarkdown.rstudio.com/developer_parameterized_reports.html