Is there a way to have the output of a function in R be an R markdown chunk?

Question

我正在开展一个项目，以便更轻松地从 qualtrics 调查中创建灵活/闪亮的仪表板。 我真的很希望能够编写几个函数，让对 R 经验较少的同事能够制作类似的文档，而无需了解 Rmarkdown 语法。

例如，如果有人想制作一个带有散点图的单页仪表板，我希望能够让他们使用几个函数，如 (make_dashboard, make_page) 等：

make_dashboard(
  title = "Qualtrics Report Dashboard", 
  page 1 = make_page(header = "Page 1", format = "column", render = "plot", 
                     data = survey_data, variables = c("var1", "var2"))
)

然后将使用以下内容创建一个 rmd 文件：

---
title: "Qualtrics Report Dashboard"
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: scroll
    runtime: shiny
---

Page 1
=====================================  

renderPlot( {
ggplot(data = survey_data, mapping = aes_string(x = var1,
                                                      y = var2)) +
          geom_point() + 
          labs(x = get_label(get(var1, survey_data)),
               y = get_label(get(var2, survey_data)))
}
)

我在尝试编写这些函数/实现这个逻辑方面还没有走得太远，因为我什至不确定我是否以正确的方式考虑它——是否可以使用这样的函数创建 rmarkdown 块？

我已经查看了关于 knitr 中子文档的其他帖子1和2 ，但我真的不希望每个块都相同，而是让人们能够更改某些方面（例如 plot 的类型、数据等）。 ）。

Answer 1

不确定这对其他人是否有用，但我最终使用了胡须（ https://github.com/edwindj/whisker ），它可以将字符串渲染到文档中以构建 flexdashboard 风格的 Rmd。

TLDR ：本质上，我创建了创建与 flexdashboard 构建块匹配的文本字符串的函数。 使用胡须，您可以通过用两个括号括住字符串中的单词来传递变量，然后使用字符串中每个变量的 var_name = value 列表分配它们的值，例如

template <- "My name is {{name}}."
d <- list(name = "Emily")
cat(whisker.render(template, data = d))
print(d)

我的名字是艾米莉

我结合使用这个和来自 stringr 的 str_c 来为 flexdashboard 的不同元素构造字符串，允许用户输入变量，如标题、绘图变量等，然后可以使用胡须渲染到字符串中。 然后，我将所有这些字符串连接在一起并将其渲染为 Rmd 文件。 老实说，我不确定这对于不知道 R 的人来说是否更容易使用，我可能最终会做一些不同的事情，但我想分享一下，以防有人考虑这个问题。

示例：运行下面的块会创建一个名为“test_dashboard.Rmd”的文件，其文本格式为带有 1 个输入侧边栏和一个带有 plot 的单个页面的 flexdashboard。

```
make_dashboard(title = "Test Dashboard",
               sidebar = make_sidebar(sidebar_title = "here is the input",
                                      input_type = "multi-select",
                                      input_name = "Interesting Var #1"),
               page1 = make_page(page_title = "Cool Plots!",
                                 element_one = make_plot(plot_title = "this is my plot",
                                                         type = "bivariate",
                                                         vars = c("cool_var1",
                                                                  "cool_var2"))),
               fn = "test_dashboard")
```

OUTPUT：

```
---
title: Test Dashboard
output: 
  flexdashboard::flex_dashboard:
    orientation: columns
    vertical_layout: scroll
    runtime: shiny
---

\```{r setup, include=FALSE}
library(flexdashboard)
library(tidytext)
library(tidyverse)
library(janitor)
library(DT)
library(gghighlight)
library(knitr)
library(shiny)
library(qualtRics)
library(curl)
library(sjlabelled)
library(naniar)
library(scales)
library(lme4)
library(MASS)
library(snakecase)

\```

\```{r global, include=FALSE}
#setting global options for table scrolling and plot theme
options(DT.options = list(scrollY="100vh"))
theme_set(theme_minimal())

#this fetches all of your survey info 
surveys <- all_surveys() 

#this saves the survey responses into 
docusign_survey <- fetch_survey(surveyID = surveys$id[1], 
                                verbose = TRUE,
                                label = TRUE,
                                breakout_sets = TRUE,
                                force_request = TRUE)

#this saves the question text into a dataframe 
questions <- survey_questions(surveyID = surveys$id[1])

rename_df <- rename_variables(docusign_survey)

#this renames all of the variables
docusign_survey <- docusign_survey %>% 
                   rename_at(as.vector(rename_df$old_name), ~ as.vector(rename_df$new_labels))

#new variables
new_var <- rename_df$new_labels

#which are multi_select?
multi_select <- rename_df %>% 
                filter(ms == 1) %>% 
                dplyr::select(new_labels)
                
#relabel those NAs as No 
docusign_survey <- docusign_survey %>% 
                   purrr::modify_at(multi_select$new_labels, na_to_y)
\```

Sidebar {.sidebar}
=====================================


here is the input

\```{r}

selectInput("p_var_1", label = "Interesting Var #1",
              choices = new_var,
              multiple = TRUE)

\```

Cool Plots!
=====================================

Column {.tabset}
-------------------------------------

### this is my plot
\```{r}
renderPlot( {

make_bivariate_plot(docusign_survey, input$cool_var1, input$cool_var2)

})
\```

```

功能

make_dashboard()

我保存了每次都会重复的部分，可能希望使它们可编辑以更改滚动等，但目前只是试图证明概念。

```
make_dashboard <- function(title, sidebar, page1, fn){
  load("data/top_matter.rda")
  load("data/libraries.rda")
  load("data/main_chunk.rda")

  initial_bit <- stringr::str_c(top_matter, libraries, main_chunk, sep = "\n\n")

  intermediate <- stringr::str_c(initial_bit, sidebar, sep = "\n\n")

  total <- stringr::str_c(intermediate, page1, sep = "\n\n")

  data <- list(title = title)

  out_fn <- paste0("./", fn, ".Rmd")
  writeLines(whisker.render(total, data), con = out_fn)
}
```

make_sidebar()

```
make_sidebar <- function(sidebar_title, input_type, input_name){
top_sidebar <-
'Sidebar {.sidebar}
=====================================
'

sidebar_text <- str_c(top_sidebar, sidebar_title, sep = "\n\n")

if(input_type == "multi-select"){
  ms <- "TRUE"
} else {
  ms <- "FALSE"
}

input_one <- make_select_input(input_name, ms)

sidebar_total <- str_c(sidebar_text, "```{r}", input_one, "```", sep = "\n\n")

return(sidebar_total)

}
```

make_page()

```
make_page <- function(page_title, element_one){
top_page <-
'{{page_title}}
=====================================

Column {.tabset}
-------------------------------------'

add_element <- stringr::str_c(top_page, element_one, sep = "\n\n")

data <- list(page_title = page_title)

page <- whisker.render(add_element, data = data)

return(page)
}
```

make_plot()

```
make_plot <- function(plot_title, type = c("univariate", "bivariate"), vars){
top_plot_piece <-' {{plot_title}}
\```{r}
renderPlot( {
'

if(type == "univariate"){
  plot_piece <-
'make_univariate_plot(docusign_survey, input${{vars}})

})

\```'
  total_plot <- stringr::str_c(top_plot_piece, plot_piece, sep = "\n\n")

  data <- list(plot_title = plot_title,
               vars = vars)
  plot_chunk <- whisker.render(total_plot, data = data)

} else{
  plot_piece <-
'make_bivariate_plot(docusign_survey, input${{var_1}}, input${{var_2}})

})
\```'

  total_plot <- stringr::str_c(top_plot_piece, plot_piece, sep = "\n\n")

  data <- list(plot_title = plot_title,
               var_1 = vars[1],
               var_2 = vars[2])
  plot_chunk <- whisker.render(total_plot, data = data)
}

return(plot_chunk)
}
```