R 以编程方式创建的可反应块不会显示在 Rmarkdown 中

Question

我有这个数据框

products <- c("Product1", "Product2", "Product3")
departments <- c("Dept1", "Dept2", "Dept3")
campaigns <- c("Campaign1", "Campaign2", "Campaign3", "Campaign4", "Campaign5")
agents <- c("Agent1", "Agent2", "Agent3", "Agent4", "Agent5")

combinations <- expand.grid(Product = products, 
                            Department = departments, 
                            Campaign = campaigns, 
                            Agent = agents)

grouped_data <- combinations %>%
  group_by(Product, Department, Campaign, Agent) %>%
  summarize(Total_Sales = sum(Sales), 
            Average_Sales = mean(Sales))

我想以编程方式在 Rmarkdown 中打印，而不是在文档中手动创建这么多部分，所以我创建了这个函数：

render_content <- function(dataframe) {
  split_data <- split(dataframe, f = list(dataframe$Product, dataframe$Campaign))
  
  for (product in unique(dataframe$Product)) {
    cat(paste0("<h2>", product, "</h2>\n"))
    product_data <- split_data[grepl(product, names(split_data))]
    
    for (campaign in unique(dataframe$Campaign)) {
      campaign_key <- paste(product, campaign, sep = ".")
      
      if (campaign_key %in% names(product_data)) {
        cat(paste0("<h3>", campaign, "</h3>\n"))
        table_html <- reactable(product_data[[campaign_key]], 
                                defaultPageSize = 5, 
                                minRows = 0)
        cat(as.character(htmltools::as.tags(table_html)))
      }
    }
  }
}

我把这个块放到我的 rmarkdown 文档中，但只渲染了 h2 和 h3 标签，我相信这与在文档中包含标签的必要性有关，所以我尝试了它的几种变体，但没有任何帮助。

{r, include=FALSE}
htmltools::tagList(reactable())

{r results='asis', echo=FALSE}
render_content(grouped_data)

Answer 1

这是一个可重复的示例，说明了如何实现目标的一种方法。它使用子文档。

下一部分是您的主要 .Rmd 文件。

---
title: "A title"
output: html_document
---

```{r setup, include=TRUE}
knitr::opts_chunk$set(echo = TRUE)

library(tidyverse)
## {reactable} used with namespace
```

# Data

```{r}
dat <- expand.grid(
  products = c(paste("prd", 1:3, sep = "_")),
  departments = c(paste("dept", 1:3, sep = "_")),
  campaigns = c(paste("camp", 1:3, sep = "_") ),
  agents = c(paste("agent", 1:3, sep = "_"))
  ) %>% 
  mutate(sales = rnorm(81, 5000, 500)) %>% 
  filter(!(products == "prd_1" & campaigns == "camp_3")) 
```

Exclude the combination of product 1 and campaign 3 since it might be another
interesting way to see that the headers/sections will be generated correctly.

# Function(s)

```{r}
func_render_content <- function(x_dat) {
  
  param_env <- new.env()
  param_env$x_dat <- x_dat
  
  for(product_i in unique(x_dat$products)) {
    cat(paste0("<h2>", product_i, "</h2>\n"))
    
    product_data <- x_dat %>% filter(products == product_i)
    
    for(campaign_i in unique(x_dat$campaigns)) {
      
      if(campaign_i %in% unique(product_data$campaigns)) {
        cat(paste0("<h3>", campaign_i, "</h3>\n"))
        
        param_env$product_i <- product_i
        param_env$campaign_i <- campaign_i
        
        cat(knitr::knit_child(
          'so-content.Rmd', 
          envir = param_env, 
          quiet = TRUE
          ))
        
        cat("\n\nThat's it on", product_i, "and", campaign_i, "end of sentence.")
      }
    }
  }
}
```

```{r}
func_render_content_your_attempt <- function(x_dat) {
  
  for (product_i in unique(x_dat$products)) {
    cat(paste0("<h2>", product_i, "</h2>\n"))
    
    product_data <- x_dat %>% filter(products == product_i)
    
    for (campaign_i in unique(x_dat$campaigns)) {
      
      if (campaign_i %in% unique(product_data$campaigns)) {
        cat(paste0("<h3>", campaign_i, "</h3>\n"))
        
        x_dat %>% 
          filter(products == product_i & campaigns == campaign_i) %>% 
          reactable::reactable(defaultPageSize = 5)
      }
    }
  }
}
```

# This works

```{r, results='asis'}
func_render_content(dat)
```

# Your attempt, does not what you want

In the sense of completeness.

```{r, results='asis'}
func_render_content_your_attempt(dat)
```

下一部分是一个单独的 .Rmd 文件，名为

so-content.Rmd

。

---
title: "section-content"
---

```{r, echo=FALSE}
x_dat %>% 
  filter(products == product_i & campaigns == campaign_i) %>% 
  reactable::reactable(defaultPageSize = 5)
``` 

Answer 2

类似于与 ggplotly

、

DT

 或其他 html 小部件相关的其他答案（例如，在 Rmarkdown

中的

for

循环中使用 plotly

 和 

DT

），您可以使用 

results='asis'

，在里面打印您的表格使用 

for

 的 

print(htmltools::tagList(...))

 循环，作为重要的一步，确保包含 JS 依赖项，我在一个单独的代码块中调用 

reactable(mtcars)

，我已为其设置了 

include=FALSE

:

---
title: "Untitled"
output: html_document
date: "2024-01-20"
---

```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE)
```

```{r message=FALSE}
library(tidyverse)
library(reactable)
```

```{r}
products <- c("Product1", "Product2", "Product3")
departments <- c("Dept1", "Dept2", "Dept3")
campaigns <- c("Campaign1", "Campaign2", "Campaign3", "Campaign4", "Campaign5")
agents <- c("Agent1", "Agent2", "Agent3", "Agent4", "Agent5")

combinations <- expand.grid(
  Product = products,
  Department = departments,
  Campaign = campaigns,
  Agent = agents
)

grouped_data <- combinations %>%
  mutate(Sales = 1) |>
  group_by(Product, Department, Campaign, Agent) %>%
  summarize(
    Total_Sales = sum(Sales),
    Average_Sales = mean(Sales),
    .groups = "drop"
  )
```

```{r include=FALSE}
# Init step to ensure that JS dependencies are included in the HTML doc
reactable(mtcars)
```

```{r}
render_content <- function(dataframe) {
  split_data <- split(dataframe, f = list(dataframe$Product, dataframe$Campaign))

  for (product in unique(dataframe$Product)) {
    cat(paste0("<h2>", product, "</h2>\n"))
    product_data <- split_data[grepl(product, names(split_data))]

    for (campaign in unique(dataframe$Campaign)) {
      campaign_key <- paste(product, campaign, sep = ".")

      if (campaign_key %in% names(product_data)) {
        cat(paste0("<h3>", campaign, "</h3>\n"))
        table_html <- reactable(product_data[[campaign_key]],
          defaultPageSize = 5,
          minRows = 0
        )
        print(htmltools::tagList(table_html))
      }
    }
  }
}
```

```{r results='asis', echo=FALSE}
render_content(grouped_data)
```