具有构面功能的 R 饼图圆环图

Question

以下代码可以正常工作并生成所需的图表，如下所示:

library(tidyverse)
library(ggiraphExtra)

library(moonBook)

ggPieDonut(data = acs, mapping = aes(pies = Dx, donuts = smoking), interactive = TRUE)

想知道如何使用构面功能构建饼图。我的尝试如下:

ggPieDonut(data = acs, mapping = aes(pies = Dx, donuts = smoking), interactive = TRUE) +
  facet_wrap(facets = vars(sex))
NULL

Answer 1

问题

您尝试中的代码不起作用，因为当 interactive = TRUE , ggPieDonut()不返回 ggplot，而是返回 htmlwidget:

ggPieDonut(
  data = acs, 
  mapping = aes(pies = Dx, donuts = smoking), 
  interactive = TRUE
) %>% class()
#> [1] "girafe"     "htmlwidget"

和facet_wrap()仅适用于 ggplots。

如果更改为interactive = FALSE你遇到另一个问题:

ggPieDonut(
  data = acs, 
  mapping = aes(pies = Dx, donuts = smoking), 
  interactive = FALSE
) + 
  facet_wrap(~sex)
#> Error in `combine_vars()`:
#> ! At least one layer must contain all faceting variables: `sex`.

几何对象不包含 sex 的两个值，所以facet_wrap()不知道如何面对它。

可能的解决方法

解决方案是在数据的不同子集上创建两个图，并使用 patchwork合并两个图:

library(patchwork)

p1 <- 
  acs %>% 
  filter(sex == "Male") %>% 
  ggPieDonut(mapping = aes(pies = Dx, donuts = smoking), interactive = FALSE) + 
  labs(title = "Male")

p2 <- 
  acs %>% 
  filter(sex == "Female") %>% 
  ggPieDonut(mapping = aes(pies = Dx, donuts = smoking), interactive = FALSE) + 
  labs(title = "Female")

p1 + p2

输出:

---

更新 1 - 作为函数

正如 @MikkoMarttila 所建议的，最好将其创建为函数。如果我要重用这个函数，我可能会这样写:

make_faceted_plot <- function(data, pie, donut, facet_by) {
  data %>% 
    dplyr::pull( {{facet_by}} ) %>% 
    unique() %>% 
    purrr::map(
      ~ data %>% 
        dplyr::filter( {{facet_by}} == .x) %>% 
        ggiraphExtra::ggPieDonut(
          ggplot2::aes(pies = {{pie}}, donuts = {{donut}}), 
          interactive = FALSE
        ) + 
        ggplot2::labs(title = .x)
    ) %>% 
    patchwork::wrap_plots() 
}

然后，这可以用于对我们想要的任意多个类别和任何数据集进行分面，例如:

library(patchwork)
library(dplyr)

# Expandable example data
df <- data.frame(
  eyes = sample(c("Blue", "Bown", "Green"), size = 100, replace = TRUE),
  hair = sample(c("blonde", "brunette", "raven"), size = 100, replace = TRUE),
  sex = sample(c("male", "female"), size = 100, replace = TRUE)
)

df %>% 
  make_faceted_plot(
    pie = eyes,
    donut = sex,
    facet_by = hair
  )

同样，正如 @MikkoMarttila 所建议的，这可以通过管道输入 ggiraph::girafe(code = print(.))添加一些交互性。

---

更新 2 - 更改标签

OP 希望静态和交互式图中的标签相同。

静态图和交互式图的标签都存储在 <the plot object>$plot_env 内。 。从这里开始，只需环顾四周，并将静态标签替换为交互式标签即可。由于交互式标签包含 HTML 标签，因此我们首先进行一些清理。我会将其包装在一个函数中，如下所示:

change_label <- function(plot) {
  
  plot$plot_env$Pielabel <- 
    plot$plot_env$data2$label %>% 
    stringr::str_replace_all("<br>", "\n") %>% 
    stringr::str_replace("\\(", " \\(")
  
  plot$plot_env$label2 <- 
    plot$plot_env$dat1$label %>% 
    stringr::str_replace_all("<br>", "\n") %>% 
    stringr::str_replace("\\(", " \\(") %>% 
    stringr::str_remove("(NSTEMI\\n|STEMI\\n|Unstable Angina\n)")
  
  
  plot
}

将此功能添加到 make_plot()我们得到了我们想要的标签:

make_faceted_plot <- function(data, pie, donut, facet_by) {
  data %>% 
    dplyr::pull( {{facet_by}} ) %>% 
    unique() %>% 
    purrr::map(
      ~ data %>% 
        dplyr::filter( {{facet_by}} == .x) %>% 
        ggiraphExtra::ggPieDonut(
          ggplot2::aes(pies = {{pie}}, donuts = {{donut}}), 
          interactive = FALSE
        ) + 
        ggplot2::labs(title = .x)
    ) %>% 
    purrr::map(change_label) %>% # <-- added change_label() here
    patchwork::wrap_plots() 
}

acs %>% 
  make_faceted_plot(
    pie = Dx,
    donut = smoking,
    facet_by = sex
  )