如何在 RMarkdown 文档的循环中绘制旭日形图？答案

【问题标题】：How to plot a sunburst plot in a loop in a RMarkdown document?如何在 RMarkdown 文档的循环中绘制旭日形图？
【发布时间】：2019-05-20 14:35:39
【问题描述】：

我的目标是创建一个 HTML R Markdown 报告，我想在其中合并多个旭日形图，每个我感兴趣的实体一个。旭日形是使用sunburstRlibrary 绘制的。每个图表都应该在其各自的选项卡中。

问题是我不知道如何在选项卡中实际显示图表。我尝试将图形分配给一个变量并 printing 或 plotting 它，但无济于事。我也尝试过跳过分配并对对象的调用做一些事情，但也没有成功。由于 sunburstR 对象也是htmlwidget，我还查看了该软件包的手册，但即使在那里我也找不到帮助。问题似乎是我在循环中执行此操作，为了实现我的目标，我需要在标记为results='asis' 的单元格中运行代码，这会阻碍图表的显示。

下面的问题有点简单，但完美地展示了我正在努力解决的问题（例如：https://github.com/timelyportfolio/sunburstR/blob/master/inst/examples/example_calendar.R 的修改版本）。一段可自我维持的 Markdown 代码，用于重现该问题（请注意，下面的所有内容都是 R Markdown 文件（.Rmd 扩展名），应该像这样运行）：

---
title: "Markdown with sunburst graphs - example"
author: "User"
date: "`r paste('Date: ', Sys.Date())`"
output: html_document
---

```{r load-packages, include=FALSE}
library(sunburstR)
library(dplyr)
library(knitr)
```

```{r data-preparation}
df <- data.frame(
  date = seq.Date(
    as.Date('2014-01-01'),
    as.Date('2016-12-31'),
    by = "days"
  ),
  stringsAsFactors = FALSE
)

df$year = format(df$date, "%Y")
df$quarter = paste0("Q", ceiling(as.numeric(format(df$date,"%m"))/3))
df$month = format(df$date, "%b")
df$count = rep(1, nrow(df))
```

# Graphs per year {.tabset .tabset-fade #results}

```{r plot-per-year, results='asis'}
for(year_ in unique(df$year)){
  cat(paste0("## ", year_, "\n\n"))
  df_year <- df %>% filter(year == year_) %>% mutate(path=paste(quarter, month, sep="-"))
  print(kable(head(df_year, 5), format="markdown"))
  sunburst(data.frame(xtabs(count~path,df_year))) # what to do here to display the graph?
}
```

我还包含了一个 kable 对象以供参考，因为它在浏览器中打开的文档中实际上是可见的（未显示旭日形图）。你对如何让它工作有什么建议吗？

【问题讨论】：

标签： r r-markdown sunburst-diagram

【解决方案1】：

这段代码有点乱，没有优化，但应该提供解决方案。一般来说，在循环中创建htmlwidgets 的解决方案是tagList(lapply(... create htmlwidget... )，如DT issue 中所述。但是，由于我们试图将每个图表包装在选项卡中，因此解决方案变得混乱。我们将需要手动创建选项卡，然后将图表单独创建为选项卡内容。

---
title: "Markdown with sunburst graphs - example"
author: "User"
date: "`r paste('Date: ', Sys.Date())`"
output: 
  html_document: 
    keep_md: yes
    self_contained: no
---

```{r load-packages, include=FALSE}
library(sunburstR)
library(dplyr)
library(knitr)
library(htmltools)
```

```{r data-preparation}
df <- data.frame(
  date = seq.Date(
    as.Date('2014-01-01'),
    as.Date('2016-12-31'),
    by = "days"
  ),
  stringsAsFactors = FALSE
)

df$year = format(df$date, "%Y")
df$quarter = paste0("Q", ceiling(as.numeric(format(df$date,"%m"))/3))
df$month = format(df$date, "%b")
df$count = rep(1, nrow(df))
```

# Graphs per year

```{r tabs-per-year, results='asis', warning=FALSE, echo=FALSE}
htmltools::tags$ul(
  class = "nav nav-pills",
  role = "tablist",
  lapply(unique(df$year), function(year_) {
    if(year_ == unique(df$year)[1]) {
      class = "active"
    } else {
      class = ""
    }
    htmltools::tags$li(
      role = "presentation",
      class = class,
      htmltools::tags$a(
        role="tab",
        "data-toggle" = "tab",
        href = paste0("#", "year-", year_),
        year_
      )
    )
  })
)
```

```{r charts-per-year, results='asis', warning=FALSE, echo=FALSE}
htmltools::tags$div(
  class = "tab-content",
  lapply(unique(df$year), function(year_) {
    if(year_ == unique(df$year[1])) {
      class = "active in"
    } else {
      class = ""
    }
    df_year <- df %>% filter(year == year_) %>% mutate(path=paste(quarter, month, sep="-"))
    htmltools::tags$div(
      id = paste0("year-", year_),
      role = "tabpanel",
      class = paste0("tab-pane tabbed-pane fade ", class),
      sunburst(data.frame(xtabs(count~path,df_year))) # what to do here to display the graph?
    )
  })
)  
```

【讨论】：