Нарисуйте стрелку между двумя круговыми диаграммами 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

Я закончил с этой цифрой, которая в основном представляет собой код 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

Я перенес всю фильтрацию стрелки.кордов в Шаг 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

Answer 2

Вот возможный подход.

Шаг 0 . Создавайте круговые диаграммы и конвертируйте их в список гробов:

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