将数据框作为参数从 Shiny 应用程序传递到 RMarkdown
Passing a dataframe as a parameter from Shiny app to RMarkdown
我仍在努力解决我正在开发的 Shiny 应用程序的某些方面。目的是用户上传数据的 csv 文件，然后处理生成报告（从 .Rmd 模板），然后用户可以将其下载为可编辑的 Word .doc。
如果我在普通 R session 中渲染 .Rmd，它工作正常。但是，如果从我的 Shiny 应用程序完成，我会收到以下错误：
Warning: Error in unique: object 'report.data' not found
[No stack trace available]
report.data 应该是通过读取输入 .csv 文件生成的数据帧。令人困惑的是，该应用程序有时确实有效（我认为如果 report.data 在全局环境中已经可用，就会发生这种情况。）。
我尝试在 .Rmd 文件的 header 中定义参数（请参阅下面注释掉的行。）- 如果我这样做，则代码运行时没有错误，但结果是文档是空白的，除了标题。
谁能看出我错在哪里？一如既往地感谢您花时间阅读并回复。
抱歉，我觉得我正在发很多帖子寻求帮助，这些问题在 Shiny 中似乎是非常基本的事情，但我确实搜索过类似的问题，但从来没有找到完全正确的事情！但是一旦我有了这些基本的东西，我应该能够自己取得进步。
为 report.data 生成 .csv 示例输入文件的代码：
library(dplyr)
set.seed(1234)
product1.parameter1.location1 <- data.frame(
result = rnorm(25, mean = 2.5, sd = 0.2),
product = c("Red Aeroplanes"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 1")
)
product1.parameter1.location2 <- data.frame(
result = rnorm(25, mean = 2.6, sd = 0.1),
product = c("Red Aeroplanes"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 2")
)
product1 <- rbind(product1.parameter1.location1, product1.parameter1.location2)
product2.parameter1.location1 <- data.frame(
result = rnorm(25, mean = 10, sd = 2),
product = c("Blue Trollies"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 1")
)
product2.parameter1.location2 <- data.frame(
result = rnorm(25, mean = 9.5, sd = 0.75),
product = c("Blue Trollies"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 2"))
product2.parameter1 <- rbind(product2.parameter1.location1, product2.parameter1.location2)
product2.parameter2.location1 <- data.frame(
result = rnorm(25, mean = 30, sd = 1.8),
product = c("Blue Trollies"),
parameter = c("Parameter 2"),
sample.no = c(1:25),
location = c("Factory 1")
)
product2.parameter2.location2 <- data.frame(
result = rnorm(25, mean = 25, sd = 0.75),
product = c("Blue Trollies"),
parameter = c("Parameter 2"),
sample.no = c(1:25),
location = c("Factory 2"))
product2.parameter2 <- rbind(product2.parameter2.location1, product2.parameter2.location2)
product2 <- rbind(product2.parameter1, product2.parameter2)
product3.parameter1.location1 <- data.frame(
result = rnorm(35, mean = 2, sd = 0.2),
product = c("Brown Carriages"),
parameter = c("Parameter 1"),
sample.no = c(1:35),
location = c("Factory 1")
)
product3.parameter1.location2 <- data.frame(
result = rnorm(35, mean = 1.9, sd = 0.15),
product = c("Brown Carriages"),
parameter = c("Parameter 1"),
sample.no = c(1:35),
location = c("Factory 2"))
product3.parameter1 <- rbind(product3.parameter1.location1, product3.parameter1.location2)
product3.parameter2.location1 <- data.frame(
result = rnorm(35, mean = 4, sd = 0.4),
product = c("Brown Carriages"),
parameter = c("Parameter 2"),
sample.no = c(1:35),
location = c("Factory 1")
)
product3.parameter2.location2 <- data.frame(
result = rnorm(35, mean = 3.8, sd = 0.5),
product = c("Brown Carriages"),
parameter = c("Parameter 2"),
sample.no = c(1:35),
location = c("Factory 2"))
product3.parameter2 <- rbind(product3.parameter2.location1, product3.parameter2.location2)
product3.parameter3.location1 <- data.frame(
result = rnorm(35, mean = 10, sd = 1.8),
product = c("Brown Carriages"),
parameter = c("Parameter 3"),
sample.no = c(1:35),
location = c("Factory 1")
)
product3.parameter3.location2 <- data.frame(
result = rnorm(35, mean = 10, sd = 2),
product = c("Brown Carriages"),
parameter = c("Parameter 3"),
sample.no = c(1:35),
location = c("Factory 2"))
product3.parameter3 <- rbind(product3.parameter3.location1, product3.parameter3.location2)
product3 <- rbind(product3.parameter1, product3.parameter2, product3.parameter3)
write.csv(product1, "product1.csv", row.names = FALSE)
write.csv(product2, "product2.csv", row.names = FALSE)
write.csv(product3, "product3.csv", row.names = FALSE)
report.data <- rbind(product1, product2, product3) %>% mutate(identifier = paste(product, parameter, sep = " "))
write.csv(report.data, "all.data.csv", row.names = FALSE)
app.R代码：
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("R Shiny app"),
# Sidebar with file input
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "file1",
label = "Select file(s)",
multiple = TRUE,
accept = NULL,
width = NULL,
buttonLabel = "Browse...",
placeholder = "No file(s) selected"
),
downloadButton("report", "Generate report")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$report <- downloadHandler(
reactive(file <- input$file1),
# For PDF output, change this to "report.pdf"
filename = "report.doc",
content = function(file) {
# Copy the report file to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).
tempReport <- file.path(tempdir(), "wordreport.Rmd")
file.copy("wordreport.Rmd", tempReport, overwrite = TRUE)
# Knit the document, passing in the `params` list, and eval it in a
# child of the global environment (this isolates the code in the document
# from the code in this app).
params <- list(report.data = input$file1)
rmarkdown::render(tempReport, output_file = "wordreport.doc",
params = params,
envir = new.env(parent = globalenv()))
file.copy("wordreport.doc", file)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
.Rmd 文件（与参数声明相关的行被注释掉）：
---
title: "Comparison Report for [CATEGORY] in [MONTH/YEAR]"
output: word_document
toc: yes
#params:
#report.data: report.data
---
```{r setup, include=FALSE, comment = "", results = 'asis', echo = FALSE}
library(dplyr)
library(ggplot2)
library(purrr)
knitr::opts_chunk$set(echo = FALSE)
```
#report.data <- params$report.data
```
my_plot <- function(df) {
ggplot(df, aes(x = sample.no, y = result)) +
geom_point(aes(colour = location)) +
geom_hline(aes(yintercept = mean(result)), colour = "black", linetype = "dotted") +
geom_hline(aes(yintercept = mean(result) + 1.96 * sd(result)), colour = "red", linetype = "dashed") +
geom_hline(aes(yintercept = mean(result) - 1.96 * sd(result)), colour = "red", linetype = "dashed") +
theme_classic() +
theme(legend.title = element_blank()) +
labs(
title = paste0("Comparison for ", unique(df$identifier)),
x = "Sample number",
y = "Result") +
#caption = paste0("Caption here.")) +
expand_limits(y = 0) +
coord_cartesian(xlim = c(0, max(df$sample.no) + 2)) +
theme(
plot.caption=element_text(size=12, hjust = 0, margin = margin(t=20)),
plot.margin = margin(b=50)
)
}
```
```{r, comment = "", results = 'asis', echo = FALSE}
purrr::map(unique(report.data$identifier),
function(x) {
#section heading
cat("#", (x), "\n")
cat("\n\n")
# filter data before passing it to the plot function
report.data %>%
dplyr::filter(identifier == x) %>%
my_plot() %>% print()
cat("\n\n")
no.outofbounds <- report.data %>%
dplyr::filter(identifier == x) %>%
mutate(outofbounds = ifelse(result > mean(result)+1.96*sd(result)|result < mean(result)-1.96*sd(result), TRUE, FALSE)) %>%
dplyr::filter(outofbounds == TRUE) %>%
nrow()
ifelse(no.outofbounds > 0, paste(cat(no.outofbounds), " results greater than 1.96 standard deviations away from the mean."), "All results within 1.96 standard deviations of the mean.") %>%
cat()
cat("\n\n")
CV <- report.data %>%
dplyr::filter(identifier == x) %>%
summarise(CV = sd(result)/mean(result) * 100) %>%
round(2)
cat("\n\n")
paste("The all-site/factor CV for this parameter is ", CV, "%.") %>%
cat()
cat("\n\n")
cat("APPROVED/REJECTED.")
cat("\n\n")
}
) -> results
```
您的代码存在几个问题。我会一一过一遍
downloadHandler() 中的参数无效
您正在将 class reactive 的对象传递给 downloadHandler() 的 contentType 参数。
downloadHandler(
reactive(file <- input$file1), ## <--- here
filename = "report.doc",
content = function(file) {
# ...
}
)
这似乎打乱了 downloadHandler() 的整个逻辑，并导致客户端出现“服务器错误”消息，而 shiny 没有任何错误或警告。
需要删除此行才能成功下载文件
正确引用 Rmd-parameter
当您想从 Rmd 报告中访问参数时，您需要使用 params$report.data。仅使用 report.data 将导致以下错误：object 'report.data' not found.
---
output: word_document
params:
report.data: NULL
---
```{r}
report.data <- params$report.data
# ...
```
修复生成文件的路径
您正在临时目录中编织 Rmd，这通常是个好主意。然而，获得正确的路径并不总是那么容易。在你的情况下，我使用了以下内容
rendered_report <- rmarkdown::render(
tempReport, output_file = "wordreport.doc",
params = params,
envir = new.env(parent = globalenv())
)
file.copy(rendered_report, file)
您的版本不起作用的原因是生成的报告是在临时目录 alogside tmpReport 中创建的。有关详细信息，请参阅 ?rmarkdown::render 的参考文档。
我使用了 rmarkdown::render() 的 return 值，它保存了生成文件的绝对路径。如果您事先不知道生成文件的文件扩展名，这不太容易出错并且特别有用
使用read.csv将上传的文件转换成data.frame
Shiny 不会自动将上传的 csv 文件转换为数据帧。你需要定义一个解析逻辑来做到这一点。
params <- list(report.data = read.csv(input$file1$datapath))
最后一句话
尝试让您的编码项目更有条理，并将未来的 SO 问题的范围一次限制为一个问题。创建“最小可重现示例”乍一看似乎很乏味，但这样做有几个好处
- 其他人可以阅读问题和答案并轻松地在自己的项目中重用它们，而无需剖析代码墙
- 回答这些问题要容易得多。像这样的问题，SO社区通常只提供评论，因为正确回答它们需要很多努力
- 最大限度地减少和隔离问题是一种技能，可以帮助您更轻松地找出未来编码项目中的问题
我仍在努力解决我正在开发的 Shiny 应用程序的某些方面。目的是用户上传数据的 csv 文件，然后处理生成报告（从 .Rmd 模板），然后用户可以将其下载为可编辑的 Word .doc。
如果我在普通 R session 中渲染 .Rmd，它工作正常。但是，如果从我的 Shiny 应用程序完成，我会收到以下错误：
Warning: Error in unique: object 'report.data' not found
[No stack trace available]
report.data 应该是通过读取输入 .csv 文件生成的数据帧。令人困惑的是，该应用程序有时确实有效（我认为如果 report.data 在全局环境中已经可用，就会发生这种情况。）。
我尝试在 .Rmd 文件的 header 中定义参数（请参阅下面注释掉的行。）- 如果我这样做，则代码运行时没有错误，但结果是文档是空白的，除了标题。
谁能看出我错在哪里？一如既往地感谢您花时间阅读并回复。
抱歉，我觉得我正在发很多帖子寻求帮助，这些问题在 Shiny 中似乎是非常基本的事情，但我确实搜索过类似的问题，但从来没有找到完全正确的事情！但是一旦我有了这些基本的东西，我应该能够自己取得进步。
为 report.data 生成 .csv 示例输入文件的代码：
library(dplyr)
set.seed(1234)
product1.parameter1.location1 <- data.frame(
result = rnorm(25, mean = 2.5, sd = 0.2),
product = c("Red Aeroplanes"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 1")
)
product1.parameter1.location2 <- data.frame(
result = rnorm(25, mean = 2.6, sd = 0.1),
product = c("Red Aeroplanes"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 2")
)
product1 <- rbind(product1.parameter1.location1, product1.parameter1.location2)
product2.parameter1.location1 <- data.frame(
result = rnorm(25, mean = 10, sd = 2),
product = c("Blue Trollies"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 1")
)
product2.parameter1.location2 <- data.frame(
result = rnorm(25, mean = 9.5, sd = 0.75),
product = c("Blue Trollies"),
parameter = c("Parameter 1"),
sample.no = c(1:25),
location = c("Factory 2"))
product2.parameter1 <- rbind(product2.parameter1.location1, product2.parameter1.location2)
product2.parameter2.location1 <- data.frame(
result = rnorm(25, mean = 30, sd = 1.8),
product = c("Blue Trollies"),
parameter = c("Parameter 2"),
sample.no = c(1:25),
location = c("Factory 1")
)
product2.parameter2.location2 <- data.frame(
result = rnorm(25, mean = 25, sd = 0.75),
product = c("Blue Trollies"),
parameter = c("Parameter 2"),
sample.no = c(1:25),
location = c("Factory 2"))
product2.parameter2 <- rbind(product2.parameter2.location1, product2.parameter2.location2)
product2 <- rbind(product2.parameter1, product2.parameter2)
product3.parameter1.location1 <- data.frame(
result = rnorm(35, mean = 2, sd = 0.2),
product = c("Brown Carriages"),
parameter = c("Parameter 1"),
sample.no = c(1:35),
location = c("Factory 1")
)
product3.parameter1.location2 <- data.frame(
result = rnorm(35, mean = 1.9, sd = 0.15),
product = c("Brown Carriages"),
parameter = c("Parameter 1"),
sample.no = c(1:35),
location = c("Factory 2"))
product3.parameter1 <- rbind(product3.parameter1.location1, product3.parameter1.location2)
product3.parameter2.location1 <- data.frame(
result = rnorm(35, mean = 4, sd = 0.4),
product = c("Brown Carriages"),
parameter = c("Parameter 2"),
sample.no = c(1:35),
location = c("Factory 1")
)
product3.parameter2.location2 <- data.frame(
result = rnorm(35, mean = 3.8, sd = 0.5),
product = c("Brown Carriages"),
parameter = c("Parameter 2"),
sample.no = c(1:35),
location = c("Factory 2"))
product3.parameter2 <- rbind(product3.parameter2.location1, product3.parameter2.location2)
product3.parameter3.location1 <- data.frame(
result = rnorm(35, mean = 10, sd = 1.8),
product = c("Brown Carriages"),
parameter = c("Parameter 3"),
sample.no = c(1:35),
location = c("Factory 1")
)
product3.parameter3.location2 <- data.frame(
result = rnorm(35, mean = 10, sd = 2),
product = c("Brown Carriages"),
parameter = c("Parameter 3"),
sample.no = c(1:35),
location = c("Factory 2"))
product3.parameter3 <- rbind(product3.parameter3.location1, product3.parameter3.location2)
product3 <- rbind(product3.parameter1, product3.parameter2, product3.parameter3)
write.csv(product1, "product1.csv", row.names = FALSE)
write.csv(product2, "product2.csv", row.names = FALSE)
write.csv(product3, "product3.csv", row.names = FALSE)
report.data <- rbind(product1, product2, product3) %>% mutate(identifier = paste(product, parameter, sep = " "))
write.csv(report.data, "all.data.csv", row.names = FALSE)
app.R代码：
#
# This is a Shiny web application. You can run the application by clicking
# the 'Run App' button above.
#
# Find out more about building applications with Shiny here:
#
# http://shiny.rstudio.com/
#
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("R Shiny app"),
# Sidebar with file input
sidebarLayout(
sidebarPanel(
fileInput(
inputId = "file1",
label = "Select file(s)",
multiple = TRUE,
accept = NULL,
width = NULL,
buttonLabel = "Browse...",
placeholder = "No file(s) selected"
),
downloadButton("report", "Generate report")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$report <- downloadHandler(
reactive(file <- input$file1),
# For PDF output, change this to "report.pdf"
filename = "report.doc",
content = function(file) {
# Copy the report file to a temporary directory before processing it, in
# case we don't have write permissions to the current working dir (which
# can happen when deployed).
tempReport <- file.path(tempdir(), "wordreport.Rmd")
file.copy("wordreport.Rmd", tempReport, overwrite = TRUE)
# Knit the document, passing in the `params` list, and eval it in a
# child of the global environment (this isolates the code in the document
# from the code in this app).
params <- list(report.data = input$file1)
rmarkdown::render(tempReport, output_file = "wordreport.doc",
params = params,
envir = new.env(parent = globalenv()))
file.copy("wordreport.doc", file)
}
)
}
# Run the application
shinyApp(ui = ui, server = server)
.Rmd 文件（与参数声明相关的行被注释掉）：
---
title: "Comparison Report for [CATEGORY] in [MONTH/YEAR]"
output: word_document
toc: yes
#params:
#report.data: report.data
---
```{r setup, include=FALSE, comment = "", results = 'asis', echo = FALSE}
library(dplyr)
library(ggplot2)
library(purrr)
knitr::opts_chunk$set(echo = FALSE)
```
#report.data <- params$report.data
```
my_plot <- function(df) {
ggplot(df, aes(x = sample.no, y = result)) +
geom_point(aes(colour = location)) +
geom_hline(aes(yintercept = mean(result)), colour = "black", linetype = "dotted") +
geom_hline(aes(yintercept = mean(result) + 1.96 * sd(result)), colour = "red", linetype = "dashed") +
geom_hline(aes(yintercept = mean(result) - 1.96 * sd(result)), colour = "red", linetype = "dashed") +
theme_classic() +
theme(legend.title = element_blank()) +
labs(
title = paste0("Comparison for ", unique(df$identifier)),
x = "Sample number",
y = "Result") +
#caption = paste0("Caption here.")) +
expand_limits(y = 0) +
coord_cartesian(xlim = c(0, max(df$sample.no) + 2)) +
theme(
plot.caption=element_text(size=12, hjust = 0, margin = margin(t=20)),
plot.margin = margin(b=50)
)
}
```
```{r, comment = "", results = 'asis', echo = FALSE}
purrr::map(unique(report.data$identifier),
function(x) {
#section heading
cat("#", (x), "\n")
cat("\n\n")
# filter data before passing it to the plot function
report.data %>%
dplyr::filter(identifier == x) %>%
my_plot() %>% print()
cat("\n\n")
no.outofbounds <- report.data %>%
dplyr::filter(identifier == x) %>%
mutate(outofbounds = ifelse(result > mean(result)+1.96*sd(result)|result < mean(result)-1.96*sd(result), TRUE, FALSE)) %>%
dplyr::filter(outofbounds == TRUE) %>%
nrow()
ifelse(no.outofbounds > 0, paste(cat(no.outofbounds), " results greater than 1.96 standard deviations away from the mean."), "All results within 1.96 standard deviations of the mean.") %>%
cat()
cat("\n\n")
CV <- report.data %>%
dplyr::filter(identifier == x) %>%
summarise(CV = sd(result)/mean(result) * 100) %>%
round(2)
cat("\n\n")
paste("The all-site/factor CV for this parameter is ", CV, "%.") %>%
cat()
cat("\n\n")
cat("APPROVED/REJECTED.")
cat("\n\n")
}
) -> results
```
您的代码存在几个问题。我会一一过一遍
downloadHandler() 中的参数无效
您正在将 class reactive 的对象传递给 downloadHandler() 的 contentType 参数。
downloadHandler(
reactive(file <- input$file1), ## <--- here
filename = "report.doc",
content = function(file) {
# ...
}
)
这似乎打乱了 downloadHandler() 的整个逻辑，并导致客户端出现“服务器错误”消息，而 shiny 没有任何错误或警告。
需要删除此行才能成功下载文件
正确引用 Rmd-parameter
当您想从 Rmd 报告中访问参数时，您需要使用 params$report.data。仅使用 report.data 将导致以下错误：object 'report.data' not found.
---
output: word_document
params:
report.data: NULL
---
```{r}
report.data <- params$report.data
# ...
```
修复生成文件的路径
您正在临时目录中编织 Rmd，这通常是个好主意。然而，获得正确的路径并不总是那么容易。在你的情况下，我使用了以下内容
rendered_report <- rmarkdown::render(
tempReport, output_file = "wordreport.doc",
params = params,
envir = new.env(parent = globalenv())
)
file.copy(rendered_report, file)
您的版本不起作用的原因是生成的报告是在临时目录 alogside tmpReport 中创建的。有关详细信息，请参阅 ?rmarkdown::render 的参考文档。
我使用了 rmarkdown::render() 的 return 值，它保存了生成文件的绝对路径。如果您事先不知道生成文件的文件扩展名，这不太容易出错并且特别有用
使用read.csv将上传的文件转换成data.frame
Shiny 不会自动将上传的 csv 文件转换为数据帧。你需要定义一个解析逻辑来做到这一点。
params <- list(report.data = read.csv(input$file1$datapath))
最后一句话
尝试让您的编码项目更有条理，并将未来的 SO 问题的范围一次限制为一个问题。创建“最小可重现示例”乍一看似乎很乏味，但这样做有几个好处
- 其他人可以阅读问题和答案并轻松地在自己的项目中重用它们，而无需剖析代码墙
- 回答这些问题要容易得多。像这样的问题，SO社区通常只提供评论，因为正确回答它们需要很多努力
- 最大限度地减少和隔离问题是一种技能，可以帮助您更轻松地找出未来编码项目中的问题