R中的3层圆环图

Question

我正在尝试在 R 中重新创建此图像，但是我无法弄清楚如何为圆环图添加 3 层 - 我找到的所有内容（例如，webr::PieDonut）只允许 2。使用 ggplot 我也无法重新创建它。

MRE 是：

library(ggplot2)
library(webr)
library(dplyr)

lexicon <- data.frame("Level1" = c(rep("Flavour", 11), rep("Appearance", 4)),
                  "Level2" = c(rep("Misc", 6), rep("Pungent", 5), rep("Colour", 4)),
                  "Level3" = c("Fresh", "Refreshing", "Soapy", "Minty", "Nutty", "Milky", "Peppery", "Sharp", "Horseradish", "Mustard hot", "Spicy", "Colourful"," Fresh Green", "Dark Green", "Bright Green")
)

PieDonut(lexicon, aes(Level1, Level2), title = "Salad Lexicon", showRatioDonut =FALSE, showRatioPie = FALSE)

ggplot(lexicon, aes(Level2, Level3, fill = Level1)) +
  geom_col() +
  scale_fill_viridis_d() +
  coord_polar("y")

虽然 PieDonut 适用于 2 个级别（未显示），但它不允许包含最终级别。ggplot 方法也不起作用，如下图所示。

如何在 R 中获得这种样式的图表？使用 ggplot 或基本绘图。

Answer 1

我认为一个不错的选择是在进行一些数据操作后在这里使用geom_rect。使用填充、颜色和 Alpha 比例有助于提高类别的区分度。我也会geom_textpath在这里使用，但如果有空间的话我可能会使用圆周标签：

lexicon %>%
  mutate(top_level = Level1) %>%
  pivot_longer(1:3) %>%
  group_by(name, value) %>%
  mutate(width = n()) %>%
  unique() %>%
  arrange(name) %>%
  group_by(name) %>%
  mutate(ymid = as.numeric(sub("\\D+", "", name)),
         ymax = ymid + 0.5, ymin = ymid - 0.5,
         xmin = c(0, head(cumsum(width), -1)),
         xmax = cumsum(width),
         xmid = (xmax + xmin) / 2) %>%
  ggplot(aes(xmid, ymid, fill = top_level)) +
  geom_rect(aes(xmin = xmin, xmax = xmax, ymin = ymin, ymax = ymax,
                alpha = name, color = top_level)) +
  geomtextpath::geom_textpath(aes(y = ymid + 0.25, label = value, 
                                  group = value)) +
  scale_alpha_manual(values = c(1, 0.3, 0.1)) +
  scale_fill_manual(values = c("#cd9900", "#00817e")) +
  scale_colour_manual(values = c("#cd9900", "#00817e")) +
  scale_y_continuous(limits = c(-0.5, 3.6)) +
  coord_polar() +
  theme_void() +
  theme(legend.position = "none")

Answer 2

一种选择是将数据重新整形为长数据，并在传递到 ggplot 之前进行一些手动聚合。另外我用来geomtextpath::geom_textpath添加标签：

library(ggplot2)
library(dplyr)
library(geomtextpath)

lexicon <- data.frame("Level1" = c(rep("Flavour", 11), rep("Appearance", 4)),
                      "Level2" = c(rep("Misc", 6), rep("Pungent", 5), rep("Colour", 4)),
                      "Level3" = c("Fresh", "Refreshing", "Soapy", "Minty", "Nutty", "Milky", "Peppery", "Sharp", "Horseradish", "Mustard hot", "Spicy", "Colourful"," Fresh Green", "Dark Green", "Bright Green")
)

lexicon_long <- lexicon |>
  mutate(fill = Level1) |>
  tidyr::pivot_longer(-fill, names_to = "level", values_to = "label") |>
  mutate(label = forcats::fct_inorder(label)) |> 
  count(fill, level, label) |>
  group_by(level) |>
  mutate(pct = n / sum(n))

ggplot(lexicon_long, aes(level, pct, fill = fill)) +
  geom_col(color = "white") +
  geom_textpath(aes(label = label, group = label),
                position = position_stack(vjust = .5),
                upright = TRUE, hjust = .5, size = 3
  ) +
  scale_fill_viridis_d() +
  coord_polar("y") +
  theme_void() +
  guides(fill = "none")