Draw arrow between two ggplot pie charts - r

Question

Is there a way to draw an arrow between two pie charts using coordinates from the outer circle of the two pie charts as start and end position? My arrow is drawn by trying with different x's and y's.
#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

Here's a possible approach.:
Step 0. Create pie charts, & convert them to a list of 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)
Step 1. Define centre coordinates / radius for each pie:
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)
)
Step 2. Calculate the appropriate start & end arrow coordinates for each combination of pies, taking into account each pie's size (assuming each pie can have a different radius value):
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)
Step 3. Convert pie center / radius into x & y min/max coordinates:
pie.coords <- pie.coords %>%
mutate(xmin = center.x - radius,
xmax = center.x + radius,
ymin = center.y - radius,
ymax = center.y + radius)
Step 4. Define function to create an annotation_custom() layer for each pie (this is optional; I just don't want to type the same thing repeatedly for each pie):
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)
}
Step 5. Putting it all together:
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

I ended up with this figure which is mostly the code of Z.Lin with a few small modifications:
Step 0
Here I have only added more pies and subsetted the datasets of the pies:
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)
Step 1
No fundamental modifications:
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)
)
Step 2
I modified the length of the arrows by multiplying with a "fudge factor" of .85 (I tried different values until the endpoint fitted with the pies). I wanted only some of the arrows between the pies so I included more filtering. I added a factor for the different colours of arrows.
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'))
Step 3 and step 4
No changes of the code of Z.Lin.
Step 5
I moved all the filtering of the arrow.coords to Step 2. I modified the formatting of the arrows (thicker and with varying colour) and added labels to the arrows. In addition I added coord_fixed(ratio = 1) to ensure that one unit of x has the same length as one unit of 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