在 R markdown 文档中循环生成可格式化的小部件

Question

我想在通过 RMarkdown 生成的 HTML 页面中放置 HTML 小部件，例如 formattable（来自 formattable 包）。我需要从 for 循环中生成小部件。我怎样才能做到这一点？有或没有 print()，两者都不起作用。

这是一个示例代码（部分取自formattable homepage）：

---
title: "formattable example loop"
output: html_document
---


```{r}
library(formattable)


df <- data.frame(
  id = 1:10,
  name = c("Bob", "Ashley", "James", "David", "Jenny", 
    "Hans", "Leo", "John", "Emily", "Lee"), 
  age = c(28, 27, 30, 28, 29, 29, 27, 27, 31, 30),
  grade = c("C", "A", "A", "C", "B", "B", "B", "A", "C", "C"),
  test1_score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6),
  test2_score = c(9.1, 9.1, 9.2, 9.1, 8.9, 8.5, 9.2, 9.3, 9.1, 8.8),
  final_score = c(9, 9.3, 9.4, 9, 9, 8.9, 9.25, 9.6, 8.8, 8.7),
  registered = c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE),
  stringsAsFactors = FALSE)
for (i in 1: 10){
print(formattable(df, list(
  age = color_tile("white", "orange"),
  grade = formatter("span",
    style = x ~ ifelse(x == "A", style(color = "green", font.weight = "bold"), NA)),
  test1_score = color_bar("pink", 0.2),
  test2_score = color_bar("pink", 0.2),
  final_score = formatter("span",
    style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
    x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
  registered = formatter("span", 
    style = x ~ style(color = ifelse(x, "green", "red")),
    x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
)))
}
```

结果应该是 html_document.

中此格式表的十倍

Answer 1

试试这个（table 输出有一个小包装器，它是来自格式 table 网站的代码，因为它更容易阅读:-)

RPubs Preview

---
title: "formattable example loop"
output: html_document
---

```{r setup}
library(formattable)
library(htmltools)

df <- data.frame(
  id = 1:10,
  name = c("Bob", "Ashley", "James", "David", "Jenny", 
    "Hans", "Leo", "John", "Emily", "Lee"), 
  age = c(28, 27, 30, 28, 29, 29, 27, 27, 31, 30),
  grade = c("C", "A", "A", "C", "B", "B", "B", "A", "C", "C"),
  test1_score = c(8.9, 9.5, 9.6, 8.9, 9.1, 9.3, 9.3, 9.9, 8.5, 8.6),
  test2_score = c(9.1, 9.1, 9.2, 9.1, 8.9, 8.5, 9.2, 9.3, 9.1, 8.8),
  final_score = c(9, 9.3, 9.4, 9, 9, 8.9, 9.25, 9.6, 8.8, 8.7),
  registered = c(TRUE, FALSE, TRUE, FALSE, TRUE, TRUE, TRUE, FALSE, FALSE, FALSE),
  stringsAsFactors = FALSE)

show_plot <- function(plot_object) {
  div(style="margin:auto;text-align:center", plot_object)
}
```

```{r}
do.call(div, lapply(1:10, function(i) {

show_plot(print(formattable(df, list(
  age = color_tile("white", "orange"),
  grade = formatter("span",
    style = x ~ ifelse(x == "A", style(color = "green", font.weight = "bold"), NA)),
  test1_score = color_bar("pink", 0.2),
  test2_score = color_bar("pink", 0.2),
  final_score = formatter("span",
    style = x ~ style(color = ifelse(rank(-x) <= 3, "green", "gray")),
    x ~ sprintf("%.2f (rank: %02d)", x, rank(-x))),
  registered = formatter("span", 
    style = x ~ style(color = ifelse(x, "green", "red")),
    x ~ icontext(ifelse(x, "ok", "remove"), ifelse(x, "Yes", "No")))
))))

}))
```

Answer 2

解决方案：

这是一种依赖于 knitr 的 knit_child 函数的方法。

1.创建所有可格式化的小部件并将它们存储在列表中

table_list <- lapply(X = list('First_Table' = df_1,
                              'Second_Table' = df_2),
                     FUN = formattable)

2。对于每个小部件，创建一个临时的、基本的 RMD 文件，其中包含一个打印小部件的块

rmd_paths <- c("TEMP_First_Table.rmd", "TEMP_Second_Table.rmd")
names(rmd_paths) <- c("First_Table", "Second_Table")

for (table_name in c("First_Table", "Second_Table")) {
    sink(file = rmd_paths[table_name])
    cat("  \n",
        "```{r, echo = FALSE}",
            "table_list[[table_name]]"
        "```",
        sep = "  \n")
    sink()
}

3。在一个新块中，使用 knitr::knit_child() 编织 RMD 文件并将结果包含在您的文档中。

```{r, results='asis'}
    for (table_name in c("First_Table", "Second_Table") {
        cat(knitr::knit_child(rmd_paths[[table_name]],
                              quiet= TRUE))
        file.remove(rmd_paths[[table_name]]
}
```

完整的 RMD 示例：

这是一个完整的示例，它将 iris 数据拆分为三个单独的数据帧（每个物种一个）并为每个单独的数据帧创建一个 formattable。

---
title: "Example"
output: html_document
---


```{r create_tables}
library(formattable)

df_list <- split(x = iris,
                 f = iris$Species)

table_list <- lapply(df_list, formattable)
```

```{r create_temp_rmd_files, echo=FALSE}

dir.create(path = "temp_rmd")

temp_rmd_list <- list()

for (table_name in names(table_list)) {

  temp_rmd_path <- paste0("temp_rmd/", table_name, ".rmd")
  temp_rmd_list[[table_name]] <- temp_rmd_path


  sink(file = temp_rmd_path)
  cat("  \n",
        "### ", table_name, "  \n",
        "```{r, echo=FALSE}", "  \n",
        'table_list[[table_name]]',
        "  \n",
        "```",
      "  \n",
      sep = "")
  sink()
}
```

```{r knit_temp_rmd_files, echo=FALSE, results='asis'}

for (table_name in names(table_list)) {

  # Knit the temporary RMD file
  cat(knitr::knit_child(temp_rmd_list[[table_name]],
                        quiet = TRUE))

  # Delete the temporary RMD file
  file.remove(temp_rmd_list[[table_name]])
}

```

在 R markdown 文档中循环生成可格式化的小部件

Generate formattable widgets in a loop in an R markdown document

for-loop

r

r-markdown

htmlwidgets

解决方案：

完整的 RMD 示例：