在两个ggplot饼图之间绘制箭头

Draw arrow between two ggplot pie charts

有没有办法在两个饼图之间用两个饼图外圈的坐标作为起点和终点在两个饼图之间画一个箭头?我的箭头是通过尝试使用不同的 x 和 y 绘制的。

#pie chart 1
pie1 <- count(diamonds, cut) %>%
  ggplot() +
  geom_bar(aes(x = '', y = n, fill = cut), stat = 'identity', width = 1) +
  coord_polar('y', start = 0) +
  theme_void()+
  theme(legend.position = 'none')

#pie chart 2
pie2 <- count(diamonds, color) %>%
  ggplot() +
  geom_bar(aes(x = '', y = n, fill = color), stat = 'identity', width = 1) +
  coord_polar('y', start = 0) +
  theme_void()+
  theme(legend.position = 'none')

# Plots and arrow combined
grid.newpage()
vp_fig <- viewport() # top plot area
pushViewport(vp_fig)
grid.draw(rectGrob())
vp_pie1 <- viewport(x =.5, y= 1, width = .25, height = .25, just = c('centre', 'top')) #viewport for pie chart 1
pushViewport(vp_pie1)
grid.draw(ggplotGrob(pie1))
popViewport()
vp_pie2 <- viewport(x =.25, y= .5, width = .25, height = .25, just = c('left', 'centre')) #viewport for pie chart 2
pushViewport(vp_pie2)
grid.draw(ggplotGrob(pie2))
popViewport()
upViewport() #move to top plot area
grid.lines(x = c(.45, .37), y = c(.8, .61), arrow = arrow()) # arrow between the pie charts

这是一种可能的方法。:

步骤 0。创建饼图,并将它们转换为 grobs 列表:

pie1 <- count(diamonds, fill = cut) %>%
  ggplot() +
  geom_col(aes(x = '', y = n, fill = fill), width = 1) +
  coord_polar('y', start = 0) +
  theme_void()+
  theme(legend.position = 'none')

pie2 <- pie1 %+% count(diamonds, fill = color)

pie3 <- pie1 %+% count(diamonds, fill = clarity)

pie.list <- list(pie1 = ggplotGrob(pie1),
                 pie2 = ggplotGrob(pie2),
                 pie3 = ggplotGrob(pie3))
rm(pie1, pie2, pie3)

步骤 1。为每个饼定义中心坐标/半径:

pie.coords <- data.frame(
  pie = names(pie.list),
  center.x = c(0, 3, 5),
  center.y = c(0, 4, 2),
  radius = c(1, 1.5, 0.5)
)

步骤 2。为每个饼图组合计算适当的开始和结束箭头坐标,同时考虑每个饼图的大小(假设每个饼图可以有不同的半径值):

arrow.coords <- expand.grid(start = pie.coords$pie,
                            end = pie.coords$pie,
                            KEEP.OUT.ATTRS = FALSE,
                            stringsAsFactors = FALSE) %>%
  filter(start != end) %>%
  left_join(pie.coords, by = c("start" = "pie")) %>%
  left_join(pie.coords, by = c("end" = "pie"))
colnames(arrow.coords) <- colnames(arrow.coords) %>%
  gsub(".x$", ".start", .) %>%
  gsub(".y$", ".end", .)
arrow.coords <- arrow.coords %>%
  mutate(delta.x = center.x.end - center.x.start,
         delta.y = center.y.end - center.y.start,
         distance = sqrt(delta.x^2 + delta.y^2)) %>%
  mutate(start.x = center.x.start + radius.start / distance * delta.x,
         start.y = center.y.start + radius.start / distance * delta.y,
         end.x = center.x.end - radius.end / distance * delta.x,
         end.y = center.y.end - radius.end / distance * delta.y) %>%
  select(starts_with("start"),
         starts_with("end")) %>%
  mutate_at(vars(start, end), factor)

步骤 3。将饼图中心/半径转换为 ​​x & y min/max 坐标:

pie.coords <- pie.coords %>%
  mutate(xmin = center.x - radius,
         xmax = center.x + radius,
         ymin = center.y - radius,
         ymax = center.y + radius)

步骤 4。定义函数为每个饼图创建一个 annotation_custom() 层(这是可选的;我只是不想为每个饼图重复输入相同的内容):

annotation_custom_list <- function(pie.names){
  result <- vector("list", length(pie.names) + 1)
  for(i in seq_along(pie.names)){
    pie <- pie.names[i]

    result[[i]] <- annotation_custom(
      grob = pie.list[[pie]],
      xmin = pie.coords$xmin[pie.coords$pie == pie],
      xmax = pie.coords$xmax[pie.coords$pie == pie],
      ymin = pie.coords$ymin[pie.coords$pie == pie],
      ymax = pie.coords$ymax[pie.coords$pie == pie])
  }

  # add a blank geom layer to ensure the resulting ggplot's
  # scales extend sufficiently to show each pie
  result[[length(result)]] <- geom_blank(
    data = pie.coords %>% filter(pie %in% pie.names),
    aes(xmin = xmin, ymin = ymin, xmax = xmax, ymax = ymax)
  )
  return(result)
}

步骤 5。把它们放在一起:

ggplot() +

  # plot pie grobs
  annotation_custom_list(c("pie1", "pie2", "pie3")) +

  # plot arrows between grobs
  # (adjust the filter criteria to only plot between specific pies)
  geom_segment(data = arrow.coords %>% 
                 filter(as.integer(start) < as.integer(end)),
               aes(x = start.x, y = start.y,
                   xend = end.x, yend = end.y),
               arrow = arrow()) +

  # theme_void for clean look
  theme_void()

我最终得到了这张图,它主要是 Z.Lin 的代码,并做了一些小的修改:

第 0 步 在这里,我只添加了更多的饼图并对饼图的数据集进行了子集化:

library(tidyverse)
pie1 <- count(diamonds, fill = cut) %>%
  ggplot() +
  geom_col(aes(x = '', y = n, fill = fill), width = 1) +
  coord_polar('y', start = 0) +
  scale_fill_manual(values = c('Fair'='green','Good'= 'darkgreen','Very Good'='darkblue','Premium'= 'plum','Ideal'='red'))+
  theme_void() +
  theme(legend.position = 'none')

pie2 <- pie1 %+% count(subset(diamonds, cut %in% c('Premium', 'Fair')), fill = cut)
pie3 <- pie1 %+% count(subset(diamonds, cut %in% c('Ideal', 'Good')), fill = cut)

pie4 <- pie1 %+% count(subset(diamonds, cut=='Premium'), fill = cut)
pie5 <- pie1 %+% count(subset(diamonds, cut=='Fair'), fill = cut)

pie6 <- pie1 %+% count(subset(diamonds, cut=='Ideal'), fill = cut)
pie7 <- pie1 %+% count(subset(diamonds, cut=='Good'), fill = cut)

pie.list <- list(pie1 = ggplotGrob(pie1),
                 pie2 = ggplotGrob(pie2),
                 pie3 = ggplotGrob(pie3),
                 pie4 = ggplotGrob(pie4),
                 pie5 = ggplotGrob(pie5),
                 pie6 = ggplotGrob(pie6),
                 pie7 = ggplotGrob(pie7))
rm(pie1, pie2, pie3, pie4, pie5, pie6, pie7)

步骤 1 无基本修改:

y <- c(1, (1+2*sqrt(3)), (1+4*sqrt(3))) #vector of all y

pie.coords <- data.frame(
  pie = names(pie.list),
  center.x = c(7,3,11,1,5,9,13),
  center.y = c(y[3],y[2],y[2],y[1],y[1],y[1],y[1]),
  radius = c(1,1,1,1,1,1,1)
)

步骤 2

我通过乘以 .85 的 "fudge factor" 修改了箭头的长度(我尝试了不同的值,直到端点与馅饼相匹配)。我只想要馅饼之间的一些箭头,所以我加入了更多的过滤。我为不同颜色的箭头添加了一个因素。

arrow.coords <- expand.grid(start = pie.coords$pie,
                            end = pie.coords$pie,
                            KEEP.OUT.ATTRS = FALSE,
                            stringsAsFactors = FALSE) %>%
  filter(start != end) %>% 
  filter(start %in% c('pie1', 'pie2', 'pie3')) %>% 
  filter(end != 'pie1') %>% 
  left_join(pie.coords, by = c("start" = "pie")) %>% 
  left_join(pie.coords, by = c("end" = "pie")) 
colnames(arrow.coords) <- colnames(arrow.coords) %>%
  gsub(".x$", ".start", .) %>% 
  gsub(".y$", ".end", .)
arrow.coords <- arrow.coords %>%
  mutate(delta.x = center.x.end - center.x.start,
         delta.y = center.y.end - center.y.start,
         distance = sqrt(delta.x^2 + delta.y^2)) %>%
  mutate(start.x = center.x.start + radius.start*.85 / distance * delta.x, #multiply with .85 to justify the arrow lengths
         start.y = center.y.start + radius.start*.85 / distance * delta.y,
         end.x = center.x.end - radius.end*.85 / distance * delta.x,
         end.y = center.y.end - radius.end*.85 / distance * delta.y) %>%
  select(starts_with("start"),
         starts_with("end")) %>%
  mutate_at(vars(start, end), factor) %>%
  filter(start.y>end.y) %>% 
  filter(start.y - end.y <4 & abs(start.x-end.x)<4) %>% 
  mutate(arrowType = factor(paste0(start,end))) %>% #adding factor
  mutate(arrowType=recode(arrowType, 'pie1pie2' = 'PremiumFair',  
                          'pie1pie3' = 'IdealGood',
                          'pie2pie4' = 'Premium',
                          'pie3pie6' = 'Ideal',
                          'pie2pie5' = 'Fair',
                          'pie3pie7'='Good')) 

第 3 步和第 4 步

Z.Lin的代码没有变化。

步骤 5

我将 arrow.coords 的所有过滤移至 步骤 2。我修改了箭头的格式(更粗且颜色不同)并为箭头添加了标签。此外,我添加了 coord_fixed(ratio = 1) 以确保 x 的一个单位与 y 的一个单位的长度相同。

ggplot() +

  # plot pie grobs
  annotation_custom_list(c("pie1", "pie2", "pie3", "pie4", "pie5", "pie6", "pie7")) +

  # plot arrows between grobs
  geom_segment(data = arrow.coords,
               aes(x = start.x, y = start.y,
                   xend = end.x, yend = end.y, colour = arrowType),
               arrow = arrow(), size = 3, show.legend = FALSE) +
  scale_colour_manual(values = c('Fair' = 'green','Good' ='darkgreen', 'Premium'='plum','Ideal' ='red', 'PremiumFair'='plum', 'IdealGood'='red'))+
  geom_label(data = arrow.coords, aes(x = (start.x+end.x)/2, y = (start.y+end.y)/2, label = arrowType), size = 8) +
  coord_fixed(ratio = 1) +
  theme_void() # theme_void for clean look