R中的金字塔/山脉图

gywdnpxw  于 2023-02-27  发布在  其他
关注(0)|答案(2)|浏览(165)

我很想做一个情节,类似于这个:

有没有办法在R中做到这一点,最好使用ggplot 2?
以下是一些示例数据:

data <- data.table(label = c("Wolf", "Car", "Building", 
                             "Bike", "Flower", "Mountain"), 
                   pct = c(17.4, 51.1, 25.6, 18, 40.2, 24.2))

多谢了!
到目前为止,不幸的是,我还没能从R那里找到任何这样的例子。

j9per5c4

j9per5c41#

与Allan的方法非常相似,但在颜色和细节方面花费的精力要少得多。

library(tidyverse)

width <- 3
mountain <- function(x, y) {
  data.frame(
    x = x - y * c(-1, 0, 1) * width,
    y = y * c(0, 1, 0)
  )
}

dat <- data |>
  mutate(
    label_num = as.numeric(factor(label)),
    pct = pct / 100
  ) |>
  group_by(label) |>
  reframe(data = mountain(label_num, pct)) |>
  ungroup() |>
  unnest(data) |>
  mutate(label = reorder(label, -y)) 

ggplot(dat, aes(x, y, group = label, fill = label)) +
  geom_polygon() +
  geom_text(aes(
    y = y / 2,
    label = scales::percent(y, accuracy = 1),
    hjust = case_match(x, 1 ~ -0.1, 6 ~ 1.1, .default = .5),
    color = after_scale(prismatic::best_contrast(fill))
  ), data = ~ subset(.x, y > 0), vjust = 1,
  size = 5, fontface = "bold") +
  geom_text(aes(
    label = label,
    hjust = case_match(x, 1 ~ -.1, 6 ~ 1.1, .default = .5),

  ), data = ~ subset(.x, y > 0), vjust = 0, nudge_y = .025,
  size = 4, color = "black", fontface = "bold") +
  scale_x_continuous(expand = c(0, 0), breaks = 1:6, labels = levels(factor(data$label))) +
  scale_y_continuous(expand = c(0, 0, .05, 0)) +
  scale_fill_brewer(palette = "Set1") +
  coord_equal(xlim = c(1, 6), ratio = width) +
  theme_light() +
  theme(
    axis.text = element_blank(),
    axis.ticks = element_blank(),
    axis.line = element_blank(),
    panel.grid = element_blank(),
    panel.border = element_blank()
  ) +
  guides(fill = "none") +
  labs(x = NULL, y = NULL)

nwsw7zdq

nwsw7zdq2#

我不知道有什么原生软件包可以制作这种类型的图,但我们可以使用您的数据制作一些简单的多边形,剩下的只是样式:

library(tidyverse)

data %>%
  mutate(id = row_number(),
         label = factor(label, label)) %>%
  group_by(label) %>%
  reframe(x = id + c(-0.67, 0.67, 0, -0.67),
          y = c(0, 0, pct, 0)) %>%
  ggplot(aes(x, y, fill = label)) +
  geom_hline(yintercept = 60, linetype = 3, color = 'orange') +
  geom_polygon() +
  geom_text(data = data, 
            aes(x = seq_along(label), y = 8, label = paste0(pct, '%')),
            color = 'white', size = 6, fontface = 'bold') +
  geom_text(data = data, 
            aes(x = seq_along(label), y = pct, label = label),
            nudge_y = 4, fontface = 'bold', size = 5, color = 'gray30') + 
  scale_fill_manual(values = c('#5db6a4', '#f4cda4', '#3e979d', 
                               '#ed5176', '#f67a82', 'deepskyblue4')) +
  theme_void() +
  theme(legend.position = 'none',
        plot.title = element_text(color = 'gray30', size = 25,
                                  hjust = 0.05),
        plot.margin = margin(20, 20, 20, 20)) +
  ggtitle('Nouns in our data frame')

相关问题