如何在RMarkdown文档的循环中绘制森伯斯特图?

时间:2019-05-20 14:35:40

标签: r r-markdown sunburst-diagram

我的目标是创建一个HTML R Markdown报告,在该报告中我想合并多个旭日形图,每个感兴趣的实体一个。朝阳使用sunburstR library绘制。每个图应在其各自的标签中。

问题是我不知道如何在选项卡中实际显示图形。我尝试将图形分配给变量并对其进行printplot设置,但无济于事。我也尝试过跳过分配,并对该对象的调用进行了某些操作,但是也没有成功。由于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对象供参考,因为它实际上是在浏览器中打开的文档中可见的东西(没有旭日图)。您对如何使其工作有任何建议吗?

1 个答案:

答案 0 :(得分:0)

此代码有点凌乱且未优化,但应提供解决方案。通常,在循环中创建htmlwidgets的解决方案是针对DT issue中所述的tagList(lapply(... create htmlwidget... )。但是,由于我们试图将每个图表包装在选项卡中,因此解决方案变得混乱。我们将需要手动创建标签,然后将图表单独创建为标签内容。

---
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?
    )
  })
)  
```