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

Question

是否有一种方法可以使用两个饼图的外圆上的坐标作为开始和结束位置，在两个饼图之间绘制箭头？我的箭头是通过尝试使用不同的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

Answer 1

这是一种可能的方法。

第0步。创建饼图，并将其转换为grob列表：

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的最小/最大坐标：

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()

Answer 2

我最终得到了这个图，该图主要是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步

我通过乘以0.85的“软键系数”来修改箭头的长度（我尝试使用不同的值，直到端点与饼匹配）。我只希望饼之间有一些箭头，所以我添加了更多过滤功能。我为箭头的不同颜色添加了一个因素。

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