在 Rmarkdown 中动态创建选项卡不适用于 ggplot 而它适用于 plotly
Dynamic creation of tabs in Rmarkdown does not work for ggplot while it does for plotly
我一直愿意在 rmarkdown 中动态创建 tab 内容。
我创建了一个 in_tabs 似乎适用于除 ggplot 绘图之外的所有内容。
它的工作方式是创建 Rmd 在选项卡中显示嵌套列表所必需的代码。
以下可重现的示例显示了该问题：
---
title: "test"
output: html_document
---
```{r setup, include = FALSE}
library(ggplot2)
library(plotly)
l1 <- list(p1 = data.frame(x=1:10, y=1:10))
l2 <- list(p2 = data.frame(x=100:110, y=100:110))
gplot <- function(data) {
p <- ggplot(data) + aes(x=x, y=y) + geom_point() + geom_line()
return(p)
}
gplotly <- function(data) {
p <- ggplot(data) + aes(x=x, y=y) + geom_point() + geom_line()
return(ggplotly(p))
}
```
```{r, code, include = FALSE}
in_tabs <- function(l, labels = names(l), level, knit = TRUE, close_tabset = FALSE) {
if(is.null(labels)) {
stop("labels are NULL, it is required not to be so that the tabs have proper names")
}
names(l) <- labels
rmd_code <- lapply(seq_along(l), FUN = function(i) obj_to_rmd(l[[i]], name = names(l)[i], level = level + 1L))
if(isTRUE(getOption("knitr.in.progress"))) {
res <- knitr::knit(text = unlist(rmd_code), quiet = TRUE)
cat(res)
} else {
if(!knit) {
cat(unlist(rmd_code))
} else {
return(l)
}
}
if(close_tabset) {
cat(paste(get_section(level), "{.unlisted .unnumbered .toc-ignore .tabset}", "\n"))
}
}
get_section <- function(level) {
paste(rep("#", times = level), collapse = "")
}
get_tabset <- function(obj) {
ifelse(inherits(obj, "list"), "{.tabset}", "")
}
obj_to_rmd <- function(obj, parent_name = "l", name, level) {
section_code <- sprintf("%s %s %s\n", get_section(level), name, get_tabset(obj))
if(!inherits(obj, "list")) {
rmd_code <- c("```{r, echo = FALSE}\n",
sprintf("%s$`%s`\n", parent_name, name),
"```\n",
"\n")
} else {
rmd_code <- c("\n",
lapply(X = seq_along(obj),
FUN = function(i) obj_to_rmd(obj[[i]], sprintf("%s$`%s`", parent_name, name), names(obj)[i], level + 1L)))
}
return(c(section_code, rmd_code))
}
```
# plot 1 {.tabset}
```{r, plot-01, results = "asis"}
in_tabs(lapply(l1, FUN = gplot), labels = names(l1), level = 1L)
```
# plot 2 {.tabset}
```{r, plot-02, results = "asis"}
in_tabs(lapply(l2, FUN = gplot), labels = names(l2), level = 1L)
```
# plot 3 {.tabset}
```{r, plot-03, results = "asis"}
in_tabs(lapply(l1, FUN = gplotly), labels = names(l1), level = 1L)
```
# plot 4 {.tabset}
```{r, plot-04, results = "asis"}
in_tabs(lapply(l2, FUN = gplotly), labels = names(l2), level = 1L)
```
我得到的输出是：
你可以看到第一个图实际上与第二个图相同的问题，但它不应该!!!
当使用 plotly（或我测试过的任何其他东西）时，它按预期工作，如图 3 和 4
所示
你能帮我解决一下吗，我很高兴测试 obj_to_rmd 接收到的对象 class。
PS: rmd 代码 in_tabs 生成可以被 运行 in_tabs(..., knit = FALSE) 看到。例如
in_tabs(lapply(l1, FUN = gplot), labels = names(l1), level = 1L, knit = FALSE)
## p1
```{r, echo = FALSE}
plot(l$`p1`)
```
我不是 100% 确定所有细节，因此您必须记住，答案可能涉及一些猜测。
编织文档时knitr运行ggplot2代码并将结果图保存为png，其中文件名是块的名称。
据我检查由 knitr 生成的 md 文件（通过将 keep_md: true 添加到 YAML），您的代码的问题是，“全部”图保存在相同的文件名 unnamed-chunk-1-1.png 下，即你的两个 ggplot 块在最后的 md:
中看起来像这样
<!-- -->
这也可以通过查看仅包含一个 png.
的 figure-html 文件夹来了解。
换句话说，您的代码基本上可以正常工作，但您将永久覆盖 png，因此您最终得到的文档只显示最后保存的绘图。这也是您的代码适用于 ggplotly 的原因，因为在这种情况下，呈现图表所需的 HTML/JS 代码直接添加到 md 文件中。
在正常情况下knitr 确保所有绘图都保存在唯一的文件名下。我只能猜测为什么在您的情况下会失败。我的猜测是，问题是您在调用 knitr::knit(text = unlist(rmd_code), quiet = TRUE) 时分别编织每个块，即每个未命名的块都具有相同的名称，并且每个 ggplot 都相应地保存在相同的文件名下。
话虽如此，为了达到您想要的结果，您可以为每个动态代码块添加一个唯一的名称，以便每个图都保存在一个唯一的文件名下。
作为快速解决方案，我向您的 in_tabs 和 obj_to_rmd 函数添加了一个 id 参数。在 in_tabs 的情况下， id 是主文档中块的简单标识符，而在 obj_to_rmd 的情况下，我还通过 id = paste(id, i, sep = "-") 添加了列表元素的标识符:
---
title: "test"
output:
html_document:
keep_md: true
---
```{r setup, include = FALSE}
library(ggplot2)
library(plotly)
d1 <- data.frame(x = 1:10, y = 1:10)
d2 <- data.frame(x = 100:110, y = 100:110)
l1 <- list(p1 = d1)
l2 <- list(p1 = d2, p2 = d1)
gplot <- function(data) {
ggplot(data) +
aes(x = x, y = y) +
geom_point() +
geom_line()
}
```
```{r, code, include = FALSE}
in_tabs <- function(l, labels = names(l), level, knit = TRUE, close_tabset = FALSE, id) {
if (is.null(labels)) {
stop("labels are NULL, it is required not to be so that the tabs have proper names")
}
names(l) <- labels
rmd_code <- lapply(seq_along(l), FUN = function(i) obj_to_rmd(l[[i]], name = names(l)[i], level = level + 1L, id = paste(id, i, sep = "-")))
if (isTRUE(getOption("knitr.in.progress"))) {
res <- knitr::knit(text = unlist(rmd_code), quiet = TRUE)
cat(res)
} else {
if (!knit) {
cat(unlist(rmd_code))
} else {
return(l)
}
}
if (close_tabset) {
cat(paste(get_section(level), "{.unlisted .unnumbered .toc-ignore .tabset}", "\n"))
}
}
get_section <- function(level) {
paste(rep("#", times = level), collapse = "")
}
get_tabset <- function(obj) {
if (inherits(obj, "list")) "{.tabset}" else ""
}
obj_to_rmd <- function(obj, parent_name = "l", name, level, id) {
section_code <- sprintf("%s %s %s\n", get_section(level), name, get_tabset(obj))
if (!inherits(obj, "list")) {
rmd_code <- c(
sprintf("```{r plot-%s, echo = FALSE}\n", id),
sprintf("%s$`%s`\n", parent_name, name),
"```\n",
"\n"
)
} else {
rmd_code <- c(
"\n",
lapply(
X = seq_along(obj),
FUN = function(i) obj_to_rmd(obj[[i]], sprintf("%s$`%s`", parent_name, name), names(obj)[i], level + 1L)
)
)
}
return(c(section_code, rmd_code))
}
```
# plot 1 {.tabset}
```{r, plot-01, results = "asis"}
p1 <- lapply(l1, FUN = gplot)
in_tabs(p1, labels = names(l1), level = 1L, id = 1)
```
# plot 2 {.tabset}
```{r, plot-02, results = "asis"}
p2 <- lapply(l2, FUN = gplot)
in_tabs(p2, labels = names(l2), level = 1L, id = 2)
```
正如 stefan 所提到的，问题出在 ggplot 的 id 上，因为它们以某种方式具有相同的代码块，即使您将这些块命名为 differently.I 不知道这种行为的原因，但您可以通过设置
绕过它
```{r, include=FALSE}
options(knitr.duplicate.label = "allow")
```
在文档的开头。这应该够了吧。它将为您的每个地块提供不同的块名称。您可以通过从 ggplots 中删除 results = "asis" 来验证它们是否不再具有相同的 ID。
## ## p1
##
## <img src="test_files/figure-html/unnamed-chunk-2-1.png" width="672" />
## ## p2
##
## <img src="test_files/figure-html/unnamed-chunk-1-2-1.png" width="672" />
您可以在 bookdown.org
阅读更多关于允许重复区块的信息
我一直愿意在 rmarkdown 中动态创建 tab 内容。
我创建了一个 in_tabs 似乎适用于除 ggplot 绘图之外的所有内容。
它的工作方式是创建 Rmd 在选项卡中显示嵌套列表所必需的代码。
以下可重现的示例显示了该问题：
---
title: "test"
output: html_document
---
```{r setup, include = FALSE}
library(ggplot2)
library(plotly)
l1 <- list(p1 = data.frame(x=1:10, y=1:10))
l2 <- list(p2 = data.frame(x=100:110, y=100:110))
gplot <- function(data) {
p <- ggplot(data) + aes(x=x, y=y) + geom_point() + geom_line()
return(p)
}
gplotly <- function(data) {
p <- ggplot(data) + aes(x=x, y=y) + geom_point() + geom_line()
return(ggplotly(p))
}
```
```{r, code, include = FALSE}
in_tabs <- function(l, labels = names(l), level, knit = TRUE, close_tabset = FALSE) {
if(is.null(labels)) {
stop("labels are NULL, it is required not to be so that the tabs have proper names")
}
names(l) <- labels
rmd_code <- lapply(seq_along(l), FUN = function(i) obj_to_rmd(l[[i]], name = names(l)[i], level = level + 1L))
if(isTRUE(getOption("knitr.in.progress"))) {
res <- knitr::knit(text = unlist(rmd_code), quiet = TRUE)
cat(res)
} else {
if(!knit) {
cat(unlist(rmd_code))
} else {
return(l)
}
}
if(close_tabset) {
cat(paste(get_section(level), "{.unlisted .unnumbered .toc-ignore .tabset}", "\n"))
}
}
get_section <- function(level) {
paste(rep("#", times = level), collapse = "")
}
get_tabset <- function(obj) {
ifelse(inherits(obj, "list"), "{.tabset}", "")
}
obj_to_rmd <- function(obj, parent_name = "l", name, level) {
section_code <- sprintf("%s %s %s\n", get_section(level), name, get_tabset(obj))
if(!inherits(obj, "list")) {
rmd_code <- c("```{r, echo = FALSE}\n",
sprintf("%s$`%s`\n", parent_name, name),
"```\n",
"\n")
} else {
rmd_code <- c("\n",
lapply(X = seq_along(obj),
FUN = function(i) obj_to_rmd(obj[[i]], sprintf("%s$`%s`", parent_name, name), names(obj)[i], level + 1L)))
}
return(c(section_code, rmd_code))
}
```
# plot 1 {.tabset}
```{r, plot-01, results = "asis"}
in_tabs(lapply(l1, FUN = gplot), labels = names(l1), level = 1L)
```
# plot 2 {.tabset}
```{r, plot-02, results = "asis"}
in_tabs(lapply(l2, FUN = gplot), labels = names(l2), level = 1L)
```
# plot 3 {.tabset}
```{r, plot-03, results = "asis"}
in_tabs(lapply(l1, FUN = gplotly), labels = names(l1), level = 1L)
```
# plot 4 {.tabset}
```{r, plot-04, results = "asis"}
in_tabs(lapply(l2, FUN = gplotly), labels = names(l2), level = 1L)
```
我得到的输出是：
你可以看到第一个图实际上与第二个图相同的问题，但它不应该!!!
当使用 plotly（或我测试过的任何其他东西）时，它按预期工作，如图 3 和 4
你能帮我解决一下吗，我很高兴测试 obj_to_rmd 接收到的对象 class。
PS: rmd 代码 in_tabs 生成可以被 运行 in_tabs(..., knit = FALSE) 看到。例如
in_tabs(lapply(l1, FUN = gplot), labels = names(l1), level = 1L, knit = FALSE)
## p1
```{r, echo = FALSE}
plot(l$`p1`)
```
我不是 100% 确定所有细节，因此您必须记住，答案可能涉及一些猜测。
编织文档时knitr运行ggplot2代码并将结果图保存为png，其中文件名是块的名称。
据我检查由 knitr 生成的 md 文件（通过将 keep_md: true 添加到 YAML），您的代码的问题是，“全部”图保存在相同的文件名 unnamed-chunk-1-1.png 下，即你的两个 ggplot 块在最后的 md:
<!-- -->
这也可以通过查看仅包含一个 png.
figure-html 文件夹来了解。
换句话说，您的代码基本上可以正常工作，但您将永久覆盖 png，因此您最终得到的文档只显示最后保存的绘图。这也是您的代码适用于 ggplotly 的原因，因为在这种情况下，呈现图表所需的 HTML/JS 代码直接添加到 md 文件中。
在正常情况下knitr 确保所有绘图都保存在唯一的文件名下。我只能猜测为什么在您的情况下会失败。我的猜测是，问题是您在调用 knitr::knit(text = unlist(rmd_code), quiet = TRUE) 时分别编织每个块，即每个未命名的块都具有相同的名称，并且每个 ggplot 都相应地保存在相同的文件名下。
话虽如此，为了达到您想要的结果，您可以为每个动态代码块添加一个唯一的名称，以便每个图都保存在一个唯一的文件名下。
作为快速解决方案，我向您的 in_tabs 和 obj_to_rmd 函数添加了一个 id 参数。在 in_tabs 的情况下， id 是主文档中块的简单标识符，而在 obj_to_rmd 的情况下，我还通过 id = paste(id, i, sep = "-") 添加了列表元素的标识符:
---
title: "test"
output:
html_document:
keep_md: true
---
```{r setup, include = FALSE}
library(ggplot2)
library(plotly)
d1 <- data.frame(x = 1:10, y = 1:10)
d2 <- data.frame(x = 100:110, y = 100:110)
l1 <- list(p1 = d1)
l2 <- list(p1 = d2, p2 = d1)
gplot <- function(data) {
ggplot(data) +
aes(x = x, y = y) +
geom_point() +
geom_line()
}
```
```{r, code, include = FALSE}
in_tabs <- function(l, labels = names(l), level, knit = TRUE, close_tabset = FALSE, id) {
if (is.null(labels)) {
stop("labels are NULL, it is required not to be so that the tabs have proper names")
}
names(l) <- labels
rmd_code <- lapply(seq_along(l), FUN = function(i) obj_to_rmd(l[[i]], name = names(l)[i], level = level + 1L, id = paste(id, i, sep = "-")))
if (isTRUE(getOption("knitr.in.progress"))) {
res <- knitr::knit(text = unlist(rmd_code), quiet = TRUE)
cat(res)
} else {
if (!knit) {
cat(unlist(rmd_code))
} else {
return(l)
}
}
if (close_tabset) {
cat(paste(get_section(level), "{.unlisted .unnumbered .toc-ignore .tabset}", "\n"))
}
}
get_section <- function(level) {
paste(rep("#", times = level), collapse = "")
}
get_tabset <- function(obj) {
if (inherits(obj, "list")) "{.tabset}" else ""
}
obj_to_rmd <- function(obj, parent_name = "l", name, level, id) {
section_code <- sprintf("%s %s %s\n", get_section(level), name, get_tabset(obj))
if (!inherits(obj, "list")) {
rmd_code <- c(
sprintf("```{r plot-%s, echo = FALSE}\n", id),
sprintf("%s$`%s`\n", parent_name, name),
"```\n",
"\n"
)
} else {
rmd_code <- c(
"\n",
lapply(
X = seq_along(obj),
FUN = function(i) obj_to_rmd(obj[[i]], sprintf("%s$`%s`", parent_name, name), names(obj)[i], level + 1L)
)
)
}
return(c(section_code, rmd_code))
}
```
# plot 1 {.tabset}
```{r, plot-01, results = "asis"}
p1 <- lapply(l1, FUN = gplot)
in_tabs(p1, labels = names(l1), level = 1L, id = 1)
```
# plot 2 {.tabset}
```{r, plot-02, results = "asis"}
p2 <- lapply(l2, FUN = gplot)
in_tabs(p2, labels = names(l2), level = 1L, id = 2)
```
正如 stefan 所提到的，问题出在 ggplot 的 id 上，因为它们以某种方式具有相同的代码块，即使您将这些块命名为 differently.I 不知道这种行为的原因，但您可以通过设置
绕过它```{r, include=FALSE}
options(knitr.duplicate.label = "allow")
```
在文档的开头。这应该够了吧。它将为您的每个地块提供不同的块名称。您可以通过从 ggplots 中删除 results = "asis" 来验证它们是否不再具有相同的 ID。
## ## p1
##
## <img src="test_files/figure-html/unnamed-chunk-2-1.png" width="672" />
## ## p2
##
## <img src="test_files/figure-html/unnamed-chunk-1-2-1.png" width="672" />
您可以在 bookdown.org
阅读更多关于允许重复区块的信息