correct positioning of ggplot insets with ggpmisc in facet - r

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.

Related

R: How to set full transparency in a quantile line in geom_density_ridges

First of all, some data similar to what I am working with.
rawdata <- data.frame(Score = rnorm(1000, seq(1, 0, length.out = 10), sd = 1),
Group = rep(LETTERS[1:3], 10000))
rawdata$Score <- ifelse(rawdata$Group == "A", rawdata$Score+2,rawdata$Score)
rawdata$Score <- ifelse(rawdata$Group == "C", rawdata$Score-2,rawdata$Score)
stdev <- c(10.78,10.51,9.42)
col <- c("#004d8d", "#cc2701", "#e5b400")
Now, the code of my geom_density_ridges with quantile lines, which in this case they will be white.
p <- ggplot(rawdata, aes(x = Score, y = Group)) +
scale_y_discrete() +
geom_rect(inherit.aes = FALSE, mapping = aes(ymin = 0, ymax = Inf, xmin = -0.1 * min(stdev), xmax = 0.1 * max(stdev)),
fill = "grey", alpha = 0.5) +
geom_density_ridges(scale = -0.5, size = 1, alpha=0.5, show.legend = FALSE,
quantile_lines = TRUE, quantiles = c(0.025, 0.975),
vline_color = "white", aes(fill = Group)) +
scale_color_manual(values = col) +
scale_fill_manual(values = col) +
labs(title="Toy Graph", y="Group", x="Value") +
coord_flip(xlim = c(-8, 8), ylim = NULL, expand = TRUE, clip = "on")
p
An we obtain the following plot, which is perfectly adjusted to expectation.
Now I was wondering if there was a way to make only this little white quantile line transparent to the background. I tried first to set the vline_color = "transparent" and leaving the aes(fill = Group) at the end of geom_density_ridges at the logic that options where drew in order but it gets transparent not to the different shades of grey background but to the density fill (so the quantile line disappears), which is not what I am trying to achieve.
Thanks in advance for your ideas!
Colors can be modified with scales::alpha. This can be passed to your color argument.
library(ggridges)
library(ggplot2)
rawdata <- data.frame(Score = rnorm(1000, seq(1, 0, length.out = 10), sd = 1),
Group = rep(LETTERS[1:3], 10000))
rawdata$Score <- ifelse(rawdata$Group == "A", rawdata$Score+2,rawdata$Score)
rawdata$Score <- ifelse(rawdata$Group == "C", rawdata$Score-2,rawdata$Score)
stdev <- c(10.78,10.51,9.42)
col <- c("#004d8d", "#cc2701", "#e5b400")
ggplot(rawdata, aes(x = Score, y = Group)) +
scale_y_discrete() +
geom_rect(inherit.aes = FALSE, mapping = aes(ymin = 0, ymax = Inf, xmin = -0.1 * min(stdev), xmax = 0.1 * max(stdev)),
fill = "grey", alpha = 0.5) +
geom_density_ridges(scale = -0.5, size = 1, alpha=0.5, show.legend = FALSE,
quantile_lines = TRUE, quantiles = c(0.025, 0.975),
### The only change is here
vline_color = alpha("white", .5), aes(fill = Group)) +
scale_color_manual(values = col) +
scale_fill_manual(values = col) +
labs(title="Toy Graph", y="Group", x="Value") +
coord_flip(xlim = c(-8, 8), ylim = NULL, expand = TRUE, clip = "on")
#> Picking joint bandwidth of 0.148
#> Warning: Using the `size` aesthietic with geom_segment was deprecated in ggplot2 3.4.0.
#> ℹ Please use the `linewidth` aesthetic instead.
Created on 2022-11-14 with reprex v2.0.2
No, if you make something transparent you will see what's underneath, which is the density plot.
However, you can replicate the visual effect of "seeing through to the background" by simply setting the line colour to the same as the background.
Your grey rectangle is currently plotted underneath the density plots, therefore the "background" doesn't have a single colour. This can be solved by plotting it on top instead. Instead of a 50% grey with 50% alpha, you can replicate the same effect with a 0% grey (aka black) with a 25% alpha. Move the geom_rect later than the density plots and it will be layered on top.
Finally, your geom_rect is being called once for each row of raw_data, since it inherits the same data as the main plot. You probably don't want that, so specify a (dummy) data source instead.
ggplot(rawdata, aes(x = Score, y = Group)) +
scale_y_discrete() +
geom_density_ridges(scale = -0.5, size = 1, alpha=0.5, show.legend = FALSE,
quantile_lines = TRUE, quantiles = c(0.025, 0.975),
vline_color = "grey90", aes(fill = Group)) +
scale_color_manual(values = col) +
scale_fill_manual(values = col) +
labs(title="Toy Graph", y="Group", x="Value") +
geom_rect(data=data.frame(), inherit.aes = FALSE, mapping = aes(
ymin = 0, ymax = Inf, xmin = -0.1 * min(stdev), xmax = 0.1 * max(stdev)
), fill = "black", alpha = 0.25) +
coord_flip(xlim = c(-8, 8), ylim = NULL, expand = TRUE, clip = "on")
Note: I'm not sure the background colour is really "grey90", I've eyeballed it. You may want to specify it explicitly with theme if you want to be exact.
If you want literal see-through portions of your density curves, you will need to make the gaps yourself:
library(tidyverse)
rawdata %>%
mutate(GroupNum = as.numeric(as.factor(Group))) %>%
group_by(GroupNum, Group) %>%
summarise(yval = first(GroupNum) - density(Score)$y,
xval = density(Score)$x,
q025 = quantile(Score, 0.025),
q975 = quantile(Score, 0.975)) %>%
mutate(Q = ifelse(xval < q025, 'low', ifelse(xval > q975, 'hi', 'mid'))) %>%
ggplot(aes(xval, yval, group = interaction(Group, Q))) +
geom_line(size = 1) +
geom_ribbon(aes(ymax = GroupNum, ymin = yval, fill = Group),
color = NA, alpha = 0.5, outline.type = 'full',
data = . %>% filter(abs(q025 - xval) > 0.03 &
abs(q975 - xval) > 0.03)) +
coord_flip() +
scale_fill_manual(values = col) +
scale_y_continuous(breaks = 1:3, labels = levels(factor(rawdata$Group)),
name = 'Group') +
labs(x = 'Score')

annotate ggplot above plot

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

How to stop ggrepel labels moving between gganimate frames in R/ggplot2?

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)

Positioning x-axis text/label along x-axis based on another field in the data using ggplot

I would like to place each x-axis text/label based on another field. Is there a native way in ggplot2 to achieve this? Presently I am doing it through geom_text. Here are my data and the plot.I have two issues with this approach -
Labels are falling inside the plot area
For a facet the labels should only appear at the bottom-most subplots as below
not in all subplots as is the case below (my plot). (The above image was taken from here)
library(ggplot2)
library(magrittr)
mydata = data.frame(expand.grid(Tag = c('A','B','C'),
Year = 2010:2011,PNo = paste0("X-",1:4)),Value = round(runif(24,1,20)))
mydata$dist = ifelse(mydata$Tag == 'A',0,ifelse(mydata$Tag=='B',2,7))
mydata %>% ggplot(aes(x = dist,y = Value,fill = factor(Year))) +
geom_bar(stat='summary',position = 'dodge',fun.y='mean',width=1) +
facet_wrap(~PNo,ncol=2) +
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank()) +
geom_text(aes(x = dist,label = Tag),color = 'black',size=4,angle = 0,show.legend = F)
I would like to place Tag labels based on dist.
I notice that you have accepted an answer elsewhere, and that you have answered you own question here. But they don't quite answer your original question. In particular, the labels are still inside the plot panel. I offer two possibilities, but neither being straightforward.
The first uses a version of annotation_custom. The default annotation_custom draws the annotation in all panels. But with a small alteration (taken from here), it can be made to draw annotations in selected panels - for your plot, the lower two panels.
library(ggplot2)
library(magrittr)
mydata = data.frame(expand.grid(Tag = c('A', 'B', 'C'),
Year = 2010:2011, PNo = paste0("X-", 1:4)), Value = round(runif(24,1,20)))
mydata$dist = ifelse(mydata$Tag == 'A', 0, ifelse(mydata$Tag == 'B', 2, 7))
# The bar plot. Note extra margin above x-axis title.
# This gives space for the annotations between the panel and the title.
p1 = mydata %>% ggplot() +
geom_bar(aes(x = dist, y = Value, fill = factor(Year)),
width = 1, stat = 'identity', position = "dodge") +
facet_wrap(~PNo, ncol = 2) +
theme(axis.text.x = element_blank(),
axis.ticks.x = element_blank(),
axis.title.x = element_text(margin = margin(t = 2, unit = "lines")))
# Baptiste's modification to annotation_custom
annotation_custom2 =
function (grob, xmin = -Inf, xmax = Inf, ymin = -Inf, ymax = Inf, data) {
layer(data = data, stat = StatIdentity, position = PositionIdentity,
geom = ggplot2:::GeomCustomAnn,
inherit.aes = TRUE, params = list(grob = grob,
xmin = xmin, xmax = xmax,
ymin = ymin, ymax = ymax))
}
# The plot with annotations. (ymin and ymax set to -Inf
# draws the annotation at the bottom of the panel.
# vjust = 1.5 drops them below the panel).
for (i in 1:length(unique(mydata$Tag))) {
p1 = p1 + annotation_custom2(
grob = textGrob(label = unique(mydata$Tag)[i], vjust = 1.5,
gp = gpar(col = 'red', cex = 1)),
xmin = unique(mydata$dist)[i],
xmax = unique(mydata$dist)[i],
ymin = -Inf,
ymax = -Inf,
data=data.frame(PNo=c("X-3", "X-4") )) # The two bottom panels
}
# The annotations are placed outside the panels.
# Therefore, have to turn off clipping to the panels.
g1 = ggplotGrob(p1)
g1$layout$clip[grepl("panel", g1$layout$name)] = "off"
# Draw the chart
grid.newpage()
grid.draw(g1)
The second draws two charts: p1 is your bar plot, and p2 contains the labels only. The trick is to get the x-axes in the two charts to be the same. Then, plot panels are extracted from p2, and placed into a p1, but into a new row just below p1's plot panel.
library(ggplot2)
library(magrittr)
mydata = data.frame(expand.grid(Tag = c('A', 'B', 'C'),
Year = 2010:2011,PNo = paste0("X-", 1:4)),Value = round(runif(24, 1, 20)))
mydata$dist = ifelse(mydata$Tag == 'A', 0, ifelse(mydata$Tag == 'B', 2, 7))
# The bar plot
p1 = mydata %>% ggplot(aes(x = dist, y = Value, fill = factor(Year))) +
geom_bar(stat = 'summary', position = 'dodge',fun.y = 'mean', width = 1) +
facet_wrap(~PNo, ncol = 2) +
theme(axis.text.x = element_blank(), axis.ticks.x = element_blank())
# To get the range of x values -
# so that the extent of the x-axis in p1 and in the following p2 are the same
gd = ggplot_build(p1)
xrange = gd$layout$panel_params[[1]]$x.range # xrange used in p2 (see below)
# Plot with labels (A, B, and C) only
p2 = mydata %>% ggplot(aes(x = dist, y = Value)) +
facet_wrap(~PNo, ncol = 2) +
geom_label(aes(x = dist, y = 0, label = Tag), size = 6, inherit.aes = F, color = 'red') +
### geom_text(aes(x = dist, y = 0, label = Tag), size=6, color = 'red') + ### Alternative style for labels
scale_x_continuous(lim = xrange, expand = c(0,0)) +
theme_bw() +
theme(panel.grid = element_blank(),
panel.border = element_rect(colour = NA))
# Grab a plot panel from p2
g2 = ggplotGrob(p2)
panels = subset(g2$layout, grepl("panel", g2$layout$name), t:r)
panels = subset(panels, t == min(t))
g2 = g2[unique(panels$t), min(panels$l):max(panels$r)]
# Add a row to p1 to take the plot panels
library(gtable)
library(grid)
g1 <- ggplotGrob(p1)
pos = max(subset(g1$layout, grepl("panel", g1$layout$name), t))
g1 = gtable_add_rows(g1, height = unit(2, "lines"), pos = pos)
# Add the panel (g2) to the new row
g1 = gtable_add_grob(g1,g2, t = pos + 1, l = min(panels$l), r = max(panels$r))
# Draw the chart
grid.newpage()
grid.draw(g1)
I tried to solve the problem myself but was facing some issue. I posted another question on SO here. Together the answer and question solves this question to some extent. Here is a possible solution.
p <- mydata %>% ggplot(aes(x = dist,y = Value,fill = factor(Year))) +geom_bar(stat='summary',position = 'dodge',fun.y='mean',width = 1) +
facet_wrap(~PNo,ncol=2) +
theme(axis.text.x = element_blank(),axis.ticks.x = element_blank()) +
geom_label(data = mydata %>% dplyr::filter(PNo %in% c('X-3','X-4')),aes(x = dist,y=0,label = Tag),size=6,inherit.aes=F,color = 'red')
library(grid)
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip[grep("panel-2-\\d+", gt$layout$name)] <- "off"
grid.draw(gt)

Align multiple plots with varying spacings and add arrows between them

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)

Resources