I have 6 plots which I want to align neatly in a two-step manner (see picture). Preferably, I'd like to add nice arrows.
Any ideas?
UPD. As my question started to gather negative feedback, I want to clarify that I've checked all the (partially) related questions at SO and found no indication on how to position ggplots freely on a "canvas". Moreover, I cannot think of a single way to draw arrows between the plots. I'm not asking for a ready made solution. Please, just indicate the way.
Here's an attempt at the layout you want. It requires some formatting by hand, but you can probably automate much of that by taking advantage of the coordinate system built into the plot layout. Also, you may find that grid.curve is better than grid.bezier (which I used) for getting the arrow curves shaped exactly the way you want.
I know just enough about grid to be dangerous, so I'd be interested in any suggestions for improvements. Anyway, here goes...
Load the packages we'll need, create a couple of utility grid objects, and create a plot to lay out:
library(ggplot2)
library(gridExtra)
# Empty grob for spacing
#b = rectGrob(gp=gpar(fill="white", col="white"))
b = nullGrob() # per #baptiste's comment, use nullGrob() instead of rectGrob()
# grid.bezier with a few hard-coded settings
mygb = function(x,y) {
grid.bezier(x=x, y=y, gp=gpar(fill="black"),
arrow=arrow(type="closed", length=unit(2,"mm")))
}
# Create a plot to arrange
p = ggplot(mtcars, aes(wt, mpg)) +
geom_point()
Create the main plot arrangement. Use the empty grob b that we created above for spacing the plots:
grid.arrange(arrangeGrob(p, b, p, p, heights=c(0.3,0.1,0.3,0.3)),
b,
arrangeGrob(b, p, p, b, p, heights=c(0.07,0.3, 0.3, 0.03, 0.3)),
ncol=3, widths=c(0.45,0.1,0.45))
Add the arrows:
# Switch to viewport for first set of arrows
vp = viewport(x = 0.5, y=.75, width=0.09, height=0.4)
pushViewport(vp)
#grid.rect(gp=gpar(fill="black", alpha=0.1)) # Use this to see where your viewport is located on the full graph layout
# Add top set of arrows
mygb(x=c(0,0.8,0.8,1), y=c(1,0.8,0.6,0.6))
mygb(x=c(0,0.6,0.6,1), y=c(1,0.4,0,0))
# Up to "main" viewport (the "full" canvas of the main layout)
popViewport()
# New viewport for lower set of arrows
vp = viewport(x = 0.6, y=0.38, width=0.15, height=0.3, just=c("right","top"))
pushViewport(vp)
#grid.rect(gp=gpar(fill="black", alpha=0.1)) # Use this to see where your viewport is located on the full graph layout
# Add bottom set of arrows
mygb(x=c(1,0.8,0.8,0), y=c(1,0.9,0.9,0.9))
mygb(x=c(1,0.7,0.4,0), y=c(1,0.8,0.4,0.4))
And here's the resulting plot:
Probably using ggplot with annotation_custom here is a more convenient approach. First, we generate sample plots.
require(ggplot2)
require(gridExtra)
require(bezier)
# generate sample plots
set.seed(17)
invisible(
sapply(paste0("gg", 1:6), function(ggname) {
assign(ggname, ggplotGrob(
ggplot(data.frame(x = rnorm(10), y = rnorm(10))) +
geom_path(aes(x,y), size = 1,
color = colors()[sample(1:length(colors()), 1)]) +
theme_bw()),
envir = as.environment(1)) })
)
After that we can plot them inside a bigger ggplot.
# necessary plot
ggplot(data.frame(a=1)) + xlim(1, 20) + ylim(1, 32) +
annotation_custom(gg1, xmin = 1, xmax = 9, ymin = 23, ymax = 31) +
annotation_custom(gg2, xmin = 11, xmax = 19, ymin = 21, ymax = 29) +
annotation_custom(gg3, xmin = 11, xmax = 19, ymin = 12, ymax = 20) +
annotation_custom(gg4, xmin = 1, xmax = 9, ymin = 10, ymax = 18) +
annotation_custom(gg5, xmin = 1, xmax = 9, ymin = 1, ymax = 9) +
annotation_custom(gg6, xmin = 11, xmax = 19, ymin = 1, ymax = 9) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(9, 10, 10, 11), y = c(27, 27, 25, 25)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(9, 10, 10, 11), y = c(27, 27, 18, 18)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 9), y = c(12, 11, 11, 11)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 9), y = c(12, 11, 11, 9)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
geom_path(data = as.data.frame(bezier(t = 0:100/100, p = list(x = c(15, 15, 12, 12), y = c(12, 10.5, 10.5, 9)))),
aes(x = V1, y = V2), size = 1, arrow = arrow(length = unit(.01, "npc"), type = "closed")) +
theme(rect = element_blank(),
line = element_blank(),
text = element_blank(),
plot.margin = unit(c(0,0,0,0), "mm"))
Here we use bezier function from bezier package to generate coordinates for geom_path. Maybe one should look for some additional information about bezier curves and their control points to make connections between plots look prettier. Now the resulting plot is following.
Thanks a lot for your tips and especially #eipi10 for an actual implementation of them - the answer is great.
I found a native ggplot solution which I want to share.
UPD While I was typing this answer, #inscaven posted his answer with basically the same idea. The bezier package gives more freedom to create neat curved arrows.
ggplot2::annotation_custom
The simple solution is to use ggplot's annotation_custom to position the 6 plots over the "canvas" ggplot.
The script
Step 1. Load the required packages and create the list of 6 square ggplots. My initial need was to arrange 6 maps, thus, I trigger theme parameter accordingly.
library(ggplot2)
library(ggthemes)
library(gridExtra)
library(dplyr)
p <- ggplot(mtcars, aes(mpg,wt))+
geom_point()+
theme_map()+
theme(aspect.ratio=1,
panel.border=element_rect(color = 'black',size=.5,fill = NA))+
scale_x_continuous(expand=c(0,0)) +
scale_y_continuous(expand=c(0,0)) +
labs(x = NULL, y = NULL)
plots <- list(p,p,p,p,p,p)
Step 2. I create a data frame for the canvas plot. I'm sure, there is a better way to this. The idea is to get a 30x20 canvas like an A4 sheet.
df <- data.frame(x=factor(sample(1:21,1000,replace = T)),
y=factor(sample(1:31,1000,replace = T)))
Step 3. Draw the canvas and position the square plot over it.
canvas <- ggplot(df,aes(x=x,y=y))+
annotation_custom(ggplotGrob(plots[[1]]),
xmin = 1,xmax = 9,ymin = 23,ymax = 31)+
annotation_custom(ggplotGrob(plots[[2]]),
xmin = 13,xmax = 21,ymin = 21,ymax = 29)+
annotation_custom(ggplotGrob(plots[[3]]),
xmin = 13,xmax = 21,ymin = 12,ymax = 20)+
annotation_custom(ggplotGrob(plots[[4]]),
xmin = 1,xmax = 9,ymin = 10,ymax = 18)+
annotation_custom(ggplotGrob(plots[[5]]),
xmin = 1,xmax = 9,ymin = 1,ymax = 9)+
annotation_custom(ggplotGrob(plots[[6]]),
xmin = 13,xmax = 21,ymin = 1,ymax = 9)+
coord_fixed()+
scale_x_discrete(expand = c(0, 0)) +
scale_y_discrete(expand = c(0, 0)) +
theme_bw()
theme_map()+
theme(panel.border=element_rect(color = 'black',size=.5,fill = NA))+
labs(x = NULL, y = NULL)
Step 4. Now we need to add the arrows. First, a data frame with arrows' coordinates is required.
df.arrows <- data.frame(id=1:5,
x=c(9,9,13,13,13),
y=c(23,23,12,12,12),
xend=c(13,13,9,9,13),
yend=c(22,19,11,8,8))
Step 5. Finally, plot the arrows.
gg <- canvas + geom_curve(data = df.arrows %>% filter(id==1),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0.1,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==2),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = -0.1,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==3),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = -0.15,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==4),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0,
arrow = arrow(type="closed",length = unit(0.25,"cm"))) +
geom_curve(data = df.arrows %>% filter(id==5),
aes(x=x,y=y,xend=xend,yend=yend),
curvature = 0.3,
arrow = arrow(type="closed",length = unit(0.25,"cm")))
The result
ggsave('test.png',gg,width=8,height=12)
Related
How can I flexibly position an inset using ggpmisc without changing the width and height of the inset itself?
library(tidyverse)
library(sf)
library(ggpmisc)
#data
nc <- st_read(system.file("gpkg/nc.gpkg", package = "sf"), quiet = TRUE) %>%
st_transform(st_crs(4326)) %>%
st_cast('POLYGON')
#create timeseries data
nc_2 <- rbind(nc %>% mutate(timepoint = 1), nc %>% mutate(timepoint = 2))
#create base plot
nc_2_base <- ggplot(data = nc_2) +
geom_sf(aes(fill = BIR74)) +
coord_sf(xlim = c(-80, -76),
ylim = c(32, 37), expand = FALSE)
#facet plot
nc_2_main <- nc_2_base + facet_wrap(~timepoint, dir = "h", ncol = 2)
#extract number of timepoints
nmax_rep_nc <- length(unique(nc_2$timepoint))
#create insets
insets_nc <- lapply(seq_len(nmax_rep_nc), function(i) {
nc_2_base + ggforce::facet_wrap_paginate(~ timepoint, nrow = 1, ncol = 1, page = i) +
coord_sf(xlim = c(-79.5, -78.5), ylim = c(34.5, 35.5)) +
theme(strip.background = element_blank(),
strip.text = element_blank(),
axis.title = element_blank(),
plot.background = element_blank(),
legend.position = "none")
})
To position the insets you need to create a tibble with x, y indicating the position you want. Here, I want them in the bottom left corner so specify x = 0.0 and y = 0 (x, y can be 0 - 1 from the vignette here) and I want the size of the insets to be 50% of the main plot (vp.width = 0.5, vp.height = 0.5):
insets_nc_tibble <- tibble(x = rep(0.0, nmax_rep_nc),
y = rep(0.0, nmax_rep_nc),
plot = insets_nc,
timepoint = unique(nc_2$timepoint))
#add inset to plot:
nc_2_main +
geom_rect(xmin = -79.5, xmax = -78.5, ymin = 34.5, ymax = 35.5,
fill = NA, colour = "red", size = 1.5) +
geom_plot_npc(data = insets_nc_tibble,
aes(npcx = x, npcy = y, label = plot,
vp.width = 0.5, vp.height = 0.5))
which produces this plot:
But the inset isn't correctly in the bottom left corner (0, 0) as I wanted. How can I keep the inset this size but move it so it is directly in the corner?
If I reduce the size of the inset it seems to help but this is completely trial and error and I don't want to reduce the size of the inset.
#reduce size
nc_2_main +
geom_rect(xmin = -79.5, xmax = -78.5, ymin = 34.5, ymax = 35.5,
fill = NA, colour = "red", size = 1.5) +
geom_plot_npc(data = insets_nc_tibble,
aes(npcx = x, npcy = y, label = plot,
vp.width = 0.5, vp.height = 0.25))
This produces this plot which is better positioning but not the correct size I want:
Note, you can also specify corner by string but this doesn't help:
#insets_nc_tibble <- tibble(x = rep("left", nmax_rep_nc),
# y = rep("bottom", nmax_rep_nc),
# plot = insets_nc,
# timepoint = unique(nc_2$timepoint))
This question is a follow up to my previous answer and others here.
I don't understand how changing the size, changes the position. I thought specifying x, y = 0, 0 means the bottom left corner of the inset should be set to 0, 0 but doesn't seem the case here?
Any ideas?
thanks
This looks like a bug. I will investigate why there is a shift of 0.5 degrees in the x axis.
Here is a temporary workaround using the non-noc version of the geom and shifting the x coordinates by -0.5 degrees:
insets_nc_tibble1 <- tibble(x = rep(-80, nmax_rep_nc),
y = rep(31.5, nmax_rep_nc),
plot = insets_nc,
timepoint = unique(nc_2$timepoint))
#add inset to plot:
nc_2_main +
geom_rect(xmin = -79.5, xmax = -78.5, ymin = 34.5, ymax = 35.5,
fill = NA, colour = "red", size = 1.5) +
geom_plot(data = insets_nc_tibble1,
aes(x = x, y = y, label = plot),
vp.width = 0.5, vp.height = 0.5)
The reason is that the grid viewport for the rendered plot is larger than the plot itself. Whether this a feature or a bug in 'ggplot2' is difficult to say as lat and lot would be otherwise distorted. Can be seen by printing the ggplot and then running grid::showViewport(). This seems to be the result of using fixed coordinates so that the inset plot cannot stretch to fill the available space in the viewport.
I've created a plot withgeom_rect and added the annotation with geom_text_repel but when I want to create several plots where I zoom in part of the original plot. The labels of the regions outside the zoom area also appear.
This is a minimal example:
start = c(1, 5,8, 14, 19, 25)
end =c(3, 6,12, 16, 22, 30)
label = c(1,2,3, 4, 5, 6)
library(ggplot2)
library(ggrepel)
regions = tibble::tibble(label, start, end)
ggplot() +
scale_x_continuous() +
scale_y_continuous(name = "") +
geom_rect(
data = regions,
mapping = aes(
xmin = start,
xmax = end,
ymin = 1.5,
ymax = 1.8),
color = "black",
fill = "#56B4E9"
) +
geom_text_repel(
data = regions,
aes(
x = start + (end - start) / 2,
y = 1.8,
label = label,
),
size = 10,
force_pull = 0,
nudge_y = 0.05,
direction = "x",
angle = 90,
vjust = 0,
segment.size = 0.5,
) +
ylim(1.38, 2.2) +
ylab("") +
xlab("") +
theme_minimal()
This code generates this plot:
I want to zoom into box 3, so I tried adding + xlim(8,12) or +facet_zoom(xlim = c(8, 12)) but The zoomed plot has the annotation (labels) of box 1, box2, ... on the side as you can see here (1,2 in the right and 4,5,6 on the left of the zoomed plot)
and similar result with + xlim(8,12)
How can I remove the labels (annotation) outside the zoomed area (1,2 in the right and 4,5,6 on the left of the zoomed plot?)
There are two quick fixes I can think of, where the first is the one you already mentioned. Perhaps you mistyped it, as I can run it fine.
Set xlim(8,12)
library(ggrepel)
start = c(1, 5,8, 14, 19, 25)
end =c(3, 6,12, 16, 22, 30)
label = c(1,2,3, 4, 5, 6)
regions = data.frame(label, start, end)
ggplot() +
scale_x_continuous() +
scale_y_continuous(name = "") +
geom_rect(
data = regions,
mapping = aes(
xmin = start,
xmax = end,
ymin = 1.5,
ymax = 1.8),
color = "black",
fill = "#56B4E9"
) +
geom_text_repel(
data = regions,
aes(
x = start + (end - start) / 2,
y = 1.8,
label = label,
),
size = 10,
force_pull = 0,
nudge_y = 0.05,
direction = "x",
angle = 90,
vjust = 0,
segment.size = 0.5,
) +
ylim(1.38, 2.2) +
xlim(8, 12) +
ylab("") +
xlab("") +
theme_minimal()
If I run this I obtain the following image
However, using xlim() is not always advised as it throws away all the other points which do not meet the condition. Although for your case that might be favourable.
Subsetting regions and zooming in properly using coord_cartesian().
ggplot() +
scale_x_continuous() +
scale_y_continuous(name = "") +
geom_rect(
data = regions,
mapping = aes(
xmin = start,
xmax = end,
ymin = 1.5,
ymax = 1.8),
color = "black",
fill = "#56B4E9"
) +
geom_text_repel(
data = subset(regions, label == 3),
aes(
x = start + (end - start) / 2,
y = 1.8,
label = label,
),
size = 10,
force_pull = 0,
nudge_y = 0.05,
direction = "x",
angle = 90,
vjust = 0,
segment.size = 0.5,
) +
ylim(1.38, 2.2) +
coord_cartesian(xlim = c(8, 12)) +
ylab("") +
xlab("") +
theme_minimal()
This produces the same image (as far as I can tell)
I tried lately to annotate a graph with boxes above a ggplot.
Here is what I want:
I found a way using grid, but I find it too complicated, and I am quite sure there is a better way to do it, more ggplot2 friendly. Here is the example and my solution:
the data:
y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
x2 = c(4,7,10),
politiquecat = c(1:3),
politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
colorpal <- viridis::inferno(n=3,direction = -1)
plot
the main plot
p <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1,
xmax = x2,
ymin = 0,
ymax = 300,
fill = as.factor(politiquecat)),
fill = colorpal,
color = "black",
size = 0.3,
alpha = 0.2)+
theme(plot.margin=unit(c(60, 5.5, 5.5, 5.5), "points"))+
coord_cartesian(clip = 'off')
the annotation part
Here is the part I am not happy with:
for (i in 1:dim(mesure_pol)[1]) {
text <- textGrob(label = mesure_pol[i,"politique"], gp = gpar(fontsize=7,fontface="bold"),hjust = 0.5)
rg <- rectGrob(x = text$x, y = text$y, width = stringWidth(text$label) - unit(3,"mm") ,
height = stringHeight(text$label) ,gp = gpar(fill=colorpal[i],alpha = 0.3))
p <- p + annotation_custom(
grob = rg,
ymin = mesure_pol[i,"y"], # Vertical position of the textGrob
ymax = mesure_pol[i,"y"],
xmin = mesure_pol[i,"x_median"], # Note: The grobs are positioned outside the plot area
xmax = mesure_pol[i,"x_median"]) +
annotation_custom(
grob = text,
ymin = mesure_pol[i,"y"], # Vertical position of the textGrob
ymax = mesure_pol[i,"y"],
xmin = mesure_pol[i,"x_median"], # Note: The grobs are positioned outside the plot area
xmax = mesure_pol[i,"x_median"])
}
Is there a simplier/nicer way to obtain similar result ? I tried with annotate, label but without any luck.
An alternative approach to achieve the desired result would be to make the annotations via a second ggplot which could be glued to the main plot via e.g. patchwork.
For the annotation plot I basically used your code for the main plot, added a geom_text layer, get rid of the axix, etc. via theme_void and set the limits in line with main plot. Main difference is that I restrict the y-axis to a 0 to 1 scale. Besides that I shifted the xmin, xmax, ymin and ymax values to add some space around the rectangels (therefore it is important to set the limits).
library(ggplot2)
library(patchwork)
y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
x2 = c(4,7,10),
politiquecat = c(1:3),
politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
colorpal <- viridis::inferno(n=3,direction = -1)
p <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1,
xmax = x2,
ymin = 0,
ymax = 300,
fill = as.factor(politiquecat)),
fill = colorpal,
color = "black",
size = 0.3,
alpha = 0.2)
ann <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1 + 1,
xmax = x2 - 1,
ymin = 0.2,
ymax = 0.8,
fill = as.factor(politiquecat)),
fill = colorpal,
color = "black",
size = 0.3,
alpha = 0.2) +
geom_text(aes(x = x_median, y = .5, label = politique), vjust = .8, fontface = "bold", color = "black") +
coord_cartesian(xlim = c(1, 10), ylim = c(0, 1)) +
theme_void()
ann / p +
plot_layout(heights = c(1, 4))
By setting a second x-axis and filling the background of the new axis labels with element_markdown from the ggtext package. You may achieve this:
Here is the code:
library(ggtext)
y2 <- 350
mesure_pol <- data.frame(x1 = c(1,4,7),
x2 = c(4,7,10),
politiquecat = c(1:3),
politique = c("Phase 1\n","Phase 2\n","Phase 3\n"),
y = c(y2,y2,y2)
)
mesure_pol$x_median <- (mesure_pol$x1 + mesure_pol$x2)/2
p <- ggplot(data = mesure_pol) +
geom_rect(aes(xmin = x1,
xmax = x2,
ymin = 0,
ymax = 300,
fill = as.factor(politiquecat)),
fill = c("yellow", "red", "black"),
color = "black",
size = 0.3,
alpha = 0.2) +
scale_x_continuous(sec.axis = dup_axis(name = "",
breaks = c(2.5, 5.5, 8.5),
labels = c("Phase 1", "Phase 2", "Phase 3"))) +
theme(plot.margin=unit(c(60, 5.5, 5.5, 5.5), "points"),
axis.ticks.x.top = element_blank(),
axis.text.x.top = element_markdown(face = "bold",
size = 12,
fill = adjustcolor(c("yellow", "red", "black"),
alpha.f = .2)))+
coord_cartesian(clip = 'off')
I'm aiming at building a bar plot with arrows at the end of bars. I went for geom_segment with arrow defined. I want to map one column onto transparency, but the alpha aesthetic doesn't seem to work fine with arrow object. Here's the code snippet:
tibble(y = c(10, 20, 30), n = c(300, 100, 200), transparency = c(10, 2, 4)) %>%
ggplot() + geom_segment(aes(x = 0, xend = n, y = y, yend = y, alpha = transparency),
colour = 'red', size = 10, arrow = arrow(length = unit(1.5, 'cm'), type = 'closed')) +
scale_y_continuous(limits = c(5, 35))
It can be easily observed that arrow object doesn't look well with lower values of alpha, showing its skeleton instead of plain, transparent shape. Is there a way to prevent it?
We can create a new geom, geom_arrowbar, that we can use like any other geom, so in your case it would give the desired plot by just doing:
tibble(y = c(10, 20, 30), n = c(300, 100, 200), transparency = c(10, 2, 4)) %>%
ggplot() +
geom_arrowbar(aes(x = n, y = y, alpha = transparency), fill = "red") +
scale_y_continuous(limits = c(5, 35)) +
scale_x_continuous(limits = c(0, 350))
And it contains 3 parameters, column_width, head_width and head_length that allow you to change the shape of the arrow if you don't like the defaults. We can also specify the fill colour and other aesthetics as needed:
tibble(y = c(10, 20, 30), n = c(300, 100, 200), transparency = c(10, 2, 4)) %>%
ggplot() +
geom_arrowbar(aes(x = n, y = y, alpha = transparency, fill = as.factor(n)),
column_width = 1.8, head_width = 1.8, colour = "black") +
scale_y_continuous(limits = c(5, 35)) +
scale_x_continuous(limits = c(0, 350))
The only snag being that we have to write it first!
Following the examples in the extending ggplot2 vignette, we can define our geom_arrowbar in the same way that other geoms are defined, except we want to be able to pass in our 3 parameters that control the shape of the arrow. These are added to the params list of the resultant layer object, which will be used to create our arrows layer:
library(tidyverse)
geom_arrowbar <- function(mapping = NULL, data = NULL, stat = "identity",
position = "identity", na.rm = FALSE, show.legend = NA,
inherit.aes = TRUE, head_width = 1, column_width = 1,
head_length = 1, ...)
{
layer(geom = GeomArrowBar, mapping = mapping, data = data, stat = stat,
position = position, show.legend = show.legend, inherit.aes = inherit.aes,
params = list(na.rm = na.rm, head_width = head_width,
column_width = column_width, head_length = head_length, ...))
}
Now "all" that remains is to define what a GeomArrowBar is. This is effectively a ggproto class definition. The most important part of it is the draw_panel member function, which takes each line of our dataframe and converts it into arrow shapes. After some basic maths to work out from the x and y co-ordinates as well as our various shape parameters what the shape of the arrow should be, it produces one grid::polygonGrob for each line of our data and stores it in a gTree. This forms the graphical component of the layer.
GeomArrowBar <- ggproto("GeomArrowBar", Geom,
required_aes = c("x", "y"),
default_aes = aes(colour = NA, fill = "grey20", size = 0.5, linetype = 1, alpha = 1),
extra_params = c("na.rm", "head_width", "column_width", "head_length"),
draw_key = draw_key_polygon,
draw_panel = function(data, panel_params, coord, head_width = 1,
column_width = 1, head_length = 1) {
hwidth <- head_width / 5
wid <- column_width / 10
len <- head_length / 10
data2 <- data
data2$x[1] <- data2$y[1] <- 0
zero <- coord$transform(data2, panel_params)$x[1]
coords <- coord$transform(data, panel_params)
make_arrow_y <- function(y, wid, hwidth) {
c(y - wid/2, y - wid/2, y - hwidth/2, y, y + hwidth/2, y + wid/2, y + wid/2)
}
make_arrow_x <- function(x, len){
if(x < zero) len <- -len
return(c(zero, x - len, x - len , x, x - len, x - len, zero))
}
my_tree <- grid::gTree()
for(i in seq(nrow(coords))){
my_tree <- grid::addGrob(my_tree, grid::polygonGrob(
make_arrow_x(coords$x[i], len),
make_arrow_y(coords$y[i], wid, hwidth),
default.units = "native",
gp = grid::gpar(
col = coords$colour[i],
fill = scales::alpha(coords$fill[i], coords$alpha[i]),
lwd = coords$size[i] * .pt,
lty = coords$linetype[i]))) }
my_tree}
)
This implementation is far from perfect. It is missing some important functionality, such as sensible default axis limits and the ability to coord_flip, and it will produce unaesthetic results if the arrow heads are longer than the whole column (though you might not want to use such a plot in that situation anyway). It will, however, sensibly have the arrow pointing to the left if you have a negative value. A better implementation might also add an option for empty arrow heads.
In short, it would need a lot of tweaks to iron out these (and other) bugs and make it production-ready, but it's good enough to produce some nice charts without too much effort in the meantime.
Created on 2020-03-08 by the reprex package (v0.3.0)
You could use geom_gene_arrow from library(gggenes)
data.frame(y=c(10, 20, 30), n=c(300, 100, 200), transparency=c(10, 2, 4)) %>%
ggplot() +
geom_gene_arrow(aes(xmin = 0, xmax = n, y = y, alpha = transparency),
arrowhead_height = unit(6, "mm"), fill='red') +
scale_y_continuous(limits = c(5, 35))
I would like to add labels to the end of lines in ggplot, avoid them overlapping, and avoid them moving around during animation.
So far I can put the labels in the right place and hold them static using geom_text, but the labels overlap, or I can prevent them overlapping using geom_text_repel but the labels do not appear where I want them to and then dance about once the plot is animated (this latter version is in the code below).
I thought a solution might involve effectively creating a static layer in ggplot (p1 below) then adding an animated layer (p2 below), but it seems not.
How do I hold some elements of a plot constant (i.e. static) in an animated ggplot? (In this case, the labels at the end of lines.)
Additionally, with geom_text the labels appear as I want them - at the end of each line, outside of the plot - but with geom_text_repel, the labels all move inside the plotting area. Why is this?
Here is some example data:
library(dplyr)
library(ggplot2)
library(gganimate)
library(ggrepel)
set.seed(99)
# data
static_data <- data.frame(
hline_label = c("fixed_label_1", "fixed_label_2", "fixed_label_3", "fixed_label_4",
"fixed_label_5", "fixed_label_6", "fixed_label_7", "fixed_label_8",
"fixed_label_9", "fixed_label_10"),
fixed_score = c(2.63, 2.45, 2.13, 2.29, 2.26, 2.34, 2.34, 2.11, 2.26, 2.37))
animated_data <- data.frame(condition = c("a", "b")) %>%
slice(rep(1:n(), each = 10)) %>%
group_by(condition) %>%
mutate(time_point = row_number()) %>%
ungroup() %>%
mutate(score = runif(20, 2, 3))
and this is the code I am using for my animated plot:
# colours for use in plot
condition_colours <- c("red", "blue")
# plot static background layer
p1 <- ggplot(static_data, aes(x = time_point)) +
scale_x_continuous(breaks = seq(0, 10, by = 2), expand = c(0, 0)) +
scale_y_continuous(breaks = seq(2, 3, by = 0.10), limits = c(2, 3), expand = c(0, 0)) +
# add horizontal line to show existing scores
geom_hline(aes(yintercept = fixed_score), alpha = 0.75) +
# add fixed labels to the end of lines (off plot)
geom_text_repel(aes(x = 11, y = fixed_score, label = hline_label),
hjust = 0, size = 4, direction = "y", box.padding = 1.0) +
coord_cartesian(clip = 'off') +
guides(col = F) +
labs(title = "[Title Here]", x = "Time", y = "Mean score") +
theme_minimal() +
theme(panel.grid.minor = element_blank(),
plot.margin = margin(5.5, 120, 5.5, 5.5))
# animated layer
p2 <- p1 +
geom_point(data = animated_data,
aes(x = time_point, y = score, colour = condition, group = condition)) +
geom_line(data = animated_data,
aes(x = time_point, y = score, colour = condition, group = condition),
show.legend = FALSE) +
scale_color_manual(values = condition_colours) +
geom_segment(data = animated_data,
aes(xend = time_point, yend = score, y = score, colour = condition),
linetype = 2) +
geom_text(data = animated_data,
aes(x = max(time_point) + 1, y = score, label = condition, colour = condition),
hjust = 0, size = 4) +
transition_reveal(time_point) +
ease_aes('linear')
# render animation
animate(p2, nframes = 50, end_pause = 5, height = 1000, width = 1250, res = 120)
Suggestions for consideration:
The specific repelling direction / amount / etc. in geom_text_repel is determined by a random seed. You can set seed to a constant value in order to get the same repelled positions in each frame of animation.
I don't think it's possible for repelled text to go beyond the plot area, even if you turn off clipping & specify some repel range outside plot limits. The whole point of that package is to keep text labels away from one another while remaining within the plot area. However, you can extend the plot area & use geom_segment instead of geom_hline to plot the horizontal lines, such that these lines stop before they reach the repelled text labels.
Since there are more geom layers using animated_data as their data source, it would be cleaner to put animated_data & associated common aesthetic mappings in the top level ggplot() call, rather than static_data.
Here's a possible implementation. Explanation in annotations:
p3 <- ggplot(animated_data,
aes(x = time_point, y = score, colour = condition, group = condition)) +
# static layers (assuming 11 is the desired ending point)
geom_segment(data = static_data,
aes(x = 0, xend = 11, y = fixed_score, yend = fixed_score),
inherit.aes = FALSE, colour = "grey25") +
geom_text_repel(data = static_data,
aes(x = 11, y = fixed_score, label = hline_label),
hjust = 0, size = 4, direction = "y", box.padding = 1.0, inherit.aes = FALSE,
seed = 123, # set a constant random seed
xlim = c(11, NA)) + # specify repel range to be from 11 onwards
# animated layers (only specify additional aesthetic mappings not mentioned above)
geom_point() +
geom_line() +
geom_segment(aes(xend = time_point, yend = score), linetype = 2) +
geom_text(aes(x = max(time_point) + 1, label = condition),
hjust = 0, size = 4) +
# static aesthetic settings (limits / expand arguments are specified in coordinates
# rather than scales, margin is no longer specified in theme since it's no longer
# necessary)
scale_x_continuous(breaks = seq(0, 10, by = 2)) +
scale_y_continuous(breaks = seq(2, 3, by = 0.10)) +
scale_color_manual(values = condition_colours) +
coord_cartesian(xlim = c(0, 13), ylim = c(2, 3), expand = FALSE) +
guides(col = F) +
labs(title = "[Title Here]", x = "Time", y = "Mean score") +
theme_minimal() +
theme(panel.grid.minor = element_blank()) +
# animation settings (unchanged)
transition_reveal(time_point) +
ease_aes('linear')
animate(p3, nframes = 50, end_pause = 5, height = 1000, width = 1250, res = 120)