Fixed position text annotation on facets - r

I having some trouble in text annotation using ggplot2. I hope someone here, can help me out.
I want to annotate differing text to fix position on all faceted plots. I could not find any solutions, how to do this when I use "free_y" scale.
I used this code:
library(ggplot2)
library(grid)
## Data.
d1 = data.frame(sim1 = runif(100), n1 = 500, y1 = runif(100),
group1 = rep(c("A", "B"), each = 250))
d2 = d1[!duplicated(d1$group1), ]
## Consistent number for all plot.
grob1 <- grobTree(textGrob(paste("N = ", d2[, 2]),
x = 0.01, y = 0.95, hjust = 0,
gp = gpar(col = "black", fontsize = 13,
fontface = "bold")))
## Varying number for facets.
grob2 <- grobTree(textGrob(d2$sim1, x = 0.01, y = 0.85, hjust = 0,
gp = gpar(col = "black", fontsize = 13,
fontface = "bold")))
grob3 <- grobTree(textGrob(d2$y1, x = 0.01, y = 0.75, hjust = 0,
gp = gpar(col = "black", fontsize = 13,
fontface = "bold")))
## Plot.
ggplot(d1, aes(log2(sim1))) +
geom_density() +
scale_x_continuous("") +
scale_y_continuous("") +
facet_wrap(~ group1, ncol = 1, scales = "free_y") +
annotation_custom(grob1) +
annotation_custom(grob2) +
annotation_custom(grob3)
However, it always annotates the first element to all plots.

Well, I agree with #baptiste. Here is an idea -- first create a data frame.
ann_text = data.frame(x= c(...), value= c(...), lab=c(...) )
In this, first two vectors will locate the positions and last one is vector of labels. Then use --
geom_text(data = ann_text, aes(label=lab), size= 5, colour = "red", fontface= ...)
etc.

Related

How to predefine legend colours based on value range using ggplot2 and RColorBrewer?

I have some data from a range of tests that I'm calculating STEN scores for. I'm aiming to visualise this data in the form of a circular bar plot and would like to set the colour gradient based on a STEN score range. For example, a score of 0-2 would be a very light colour, 2.1-4 light, 4.1-6 moderate, 6.1-8 dark and 8.1-10 very dark. My code below uses the RColorBrewer package and the "YlGn" palette, but I'm stuck on how I can predefine the colour scheme based on the example mentioned above and set this in the plot legend. The example below produces a circular bar plot containing a lowest STEN score of 4.8, so I would like this to be reflected as the moderate colour, where currently its the lightest. I essentially want the legend to show all five STEN score ranges irrespective of whether someone's data scores within each range. Hope this makes sense.
library(tidyverse)
library(RColorBrewer)
set.seed(50)
dat <- data.frame(
par = paste("par", 1:15),
test_1 = round(rnorm(15, mean = 30, sd = 5), 1),
test_2 = round(rnorm(15, mean = 30, sd = 5), 1),
test_3 = round_any(rnorm(15, mean = 90, sd = 5), 2.5),
test_4 = round(rnorm(15, mean = 5.4, sd = 0.3), 1),
test_5 = round(rnorm(15, mean = 17, sd = 1.5), 1)
)
sten_dat <- dat %>%
mutate_if(is.numeric, scale) %>%
mutate(across(c(2:6), ~ . * 2 + 5.5)) %>%
mutate(across(where(is.numeric), round, 1)) %>%
pivot_longer(!par, names_to = "test", values_to = "sten") %>%
filter(par == "par 1")
ggplot(sten_dat) +
geom_col(aes(x = str_wrap(test), y = sten, fill = sten),
position = "dodge2", alpha = 0.7, show.legend = TRUE) +
coord_polar() +
scale_y_continuous(limits = c(-1, 11), breaks = seq(0, 10, 2)) +
scale_fill_gradientn(colours = brewer.pal(name = "YlGn", n = 5))`
Simply add limits to your fill scale:
ggplot(sten_dat) +
geom_col(aes(x = str_wrap(test), y = sten, fill = sten),
position = "dodge2", alpha = 0.7, show.legend = TRUE) +
coord_polar() +
scale_y_continuous(limits = c(-1, 11), breaks = seq(0, 10, 2)) +
scale_fill_gradientn(colours = brewer.pal(name = "YlGn", n = 5),
limits = c(0, 10))
If you want the colors to be clearly "binned" in the way you describe, you can use scale_fill_stepn instead of scale_fill_gradientn
ggplot(sten_dat) +
geom_col(aes(x = str_wrap(test), y = sten, fill = sten),
position = "dodge2", alpha = 0.7, show.legend = TRUE) +
scale_y_continuous(limits = c(-1, 11), breaks = seq(0, 10, 2)) +
scale_fill_stepsn(colours = brewer.pal(name = "YlGn", n = 5),
limits = c(0, 10), breaks = 0:5 * 2) +
geomtextpath::coord_curvedpolar() +
theme_minimal() +
theme(axis.text.x = element_text(size = 16, face = 2),
panel.grid.major.x = element_blank())

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

Produce an inset in each facet of an R ggplot while preserving colours of the original facet content

I would like to produce a graphic combining four facets of a graph with insets in each facet showing a detail of the respective plot. This is one of the things I tried:
#create data frame
n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)
#do first basic plot
library(ggplot2)
plot1<-ggplot(data=data_frame, aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) +
geom_line() + theme_bw() +
labs(title ="", x = "year", y = "sd")
plot1
#make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
`10` = "2, 3, ..., 10 replicates",
`100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates",
`10000` = "1000, 2000, ..., 10000 replicates"
)
plot2 <- plot1 +
facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) +
scale_colour_gradientn(name = "number of replicates", trans = "log",
breaks = my_breaks, labels = my_breaks, colours = rainbow(20))
plot2
#extract inlays (this is where it goes wrong I think)
library(ggpmisc)
library(tibble)
library(dplyr)
inset <- tibble(x = 0.01, y = 10.01,
plot = list(plot2 +
facet_wrap( ~ max_rep, ncol=2, labeller = as_labeller(facet_names)) +
coord_cartesian(xlim = c(13, 15),
ylim = c(3, 5)) +
labs(x = NULL, y = NULL, color = NULL) +
scale_colour_gradient(guide = FALSE) +
theme_bw(10)))
plot3 <- plot2 +
expand_limits(x = 0, y = 0) +
geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot)) +
annotate(geom = "rect",
xmin = 13, xmax = 15, ymin = 3, ymax = 5,
linetype = "dotted", fill = NA, colour = "black")
plot3
That leads to the following graphic:
As you can see, the colours in the insets are wrong, and all four of them appear in each of the facets even though I only want the corresponding inset of course. I read through a lot of questions here (to even get me this far) and also some examples in the ggpmisc user guide but unfortunately I am still a bit lost on how to achieve what I want. Except maybe to do it by hand extracting four insets and then combining them with plot2. But I hope there will be a better way to do this. Thank you for your help!
Edit: better graphic now thanks to this answer, but problem remains partially unsolved:
The following code does good insets, but unfortunately the colours are not preserved. As in the above version each inset does its own rainbow colours anew instead of inheriting the partial rainbow scale from the facet it belongs to. Does anyone know why and how I could change this? In comments I put another (bad) attempt at solving this, it preserves the colors but has the problem of putting all four insets in each facet.
library(ggpmisc)
library(tibble)
library(dplyr)
# #extract inlays: good colours, but produces four insets.
# fourinsets <- tibble(#x = 0.01, y = 10.01,
# x = c(rep(0.01, 4)),
# y = c(rep(10.01, 4)),
# plot = list(plot2 +
# facet_wrap( ~ max_rep, ncol=2) +
# coord_cartesian(xlim = c(13, 15),
# ylim = c(3, 5)) +
# labs(x = NULL, y = NULL, color = NULL) +
# scale_colour_gradientn(name = "number of replicates", trans = "log", guide = FALSE,
# colours = rainbow(20)) +
# theme(
# strip.background = element_blank(),
# strip.text.x = element_blank()
# )
# ))
# fourinsets$plot
library(purrr)
pp <- map(unique(data_frame$max_rep), function(x) {
plot2$data <- plot2$data %>% filter(max_rep == x)
plot2 +
coord_cartesian(xlim = c(12, 14),
ylim = c(3, 4)) +
labs(x = NULL, y = NULL) +
theme(
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
axis.text=element_blank(),
axis.ticks=element_blank()
)
})
#pp[[2]]
inset_new <- tibble(x = c(rep(0.01, 4)),
y = c(rep(10.01, 4)),
plot = pp,
max_rep = unique(data_frame$max_rep))
final_plot <- plot2 +
geom_plot_npc(data = inset_new, aes(npcx = x, npcy = y, label = plot, vp.width = 0.3, vp.height =0.6)) +
annotate(geom = "rect",
xmin = 12, xmax = 14, ymin = 3, ymax = 4,
linetype = "dotted", fill = NA, colour = "black")
#final_plot
final_plot then looks like this:
I hope this clarifies the problem a bit. Any ideas are very welcome :)
Modifying off #user63230's excellent answer:
pp <- map(unique(data_frame$max_rep), function(x) {
plot2 +
aes(alpha = ifelse(max_rep == x, 1, 0)) +
coord_cartesian(xlim = c(12, 14),
ylim = c(3, 4)) +
labs(x = NULL, y = NULL) +
scale_alpha_identity() +
facet_null() +
theme(
strip.background = element_blank(),
strip.text.x = element_blank(),
legend.position = "none",
axis.text=element_blank(),
axis.ticks=element_blank()
)
})
Explanation:
Instead of filtering the data passed into plot2 (which affects the mapping of colours), we impose a new aesthetic alpha, where lines belonging to the other replicate numbers are assigned 0 for transparency;
Use scale_alpha_identity() to tell ggplot that the alpha mapping is to be used as-is: i.e. 1 for 100%, 0 for 0%.
Add facet_null() to override plot2's existing facet_wrap, which removes the facet for the inset.
Everything else is unchanged from the code in the question.
I think this will get you started although its tricky to get the size of the inset plot right (when you include a legend).
#set up data
library(ggpmisc)
library(tibble)
library(dplyr)
library(ggplot2)
# create data frame
n_replicates <- c(rep(1:10, 15), rep(seq(10, 100, 10), 15), rep(seq(100,
1000, 100), 15), rep(seq(1000, 10000, 1000), 15))
sim_years <- rep(sort(rep((1:15), 10)), 4)
sd_data <- rep(NA, 600)
for (i in 1:600) {
sd_data[i] <- rnorm(1, mean = exp(0.1 * sim_years[i]), sd = 1/n_replicates[i])
}
max_rep <- sort(rep(c(10, 100, 1000, 10000), 150))
data_frame <- cbind.data.frame(n_replicates, sim_years, sd_data, max_rep)
# make four facets
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(`10` = "2, 3, ..., 10 replicates", `100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates", `10000` = "1000, 2000, ..., 10000 replicates")
Get overall plot:
# overall facet plot
overall_plot <- ggplot(data = data_frame, aes(x = sim_years, y = sd_data, group = n_replicates, col = n_replicates)) +
geom_line() +
theme_bw() +
labs(title = "", x = "year", y = "sd") +
facet_wrap(~max_rep, ncol = 2, labeller = as_labeller(facet_names)) +
scale_colour_gradientn(name = "number of replicates", trans = "log", breaks = my_breaks, labels = my_breaks, colours = rainbow(20))
#plot
overall_plot
which gives:
Then from the overall plot you want to extract each plot, see here. We can map over the list to extract one at a time:
pp <- map(unique(data_frame$max_rep), function(x) {
overall_plot$data <- overall_plot$data %>% filter(max_rep == x)
overall_plot + # coord_cartesian(xlim = c(13, 15), ylim = c(3, 5)) +
labs(x = NULL, y = NULL) +
theme_bw(10) +
theme(legend.position = "none")
})
If we look at one of these (I've removed the legend) e.g.
pp[[1]]
#pp[[2]]
#pp[[3]]
#pp[[4]]
Gives:
Then we want to add these inset plots into a dataframe so that each plot has its own row:
inset <- tibble(x = c(rep(0.01, 4)),
y = c(rep(10.01, 4)),
plot = pp,
max_rep = unique(data_frame$max_rep))
Then merge this into the overall plot:
overall_plot +
expand_limits(x = 0, y = 0) +
geom_plot_npc(data = inset, aes(npcx = x, npcy = y, label = plot, vp.width = 0.8, vp.height = 0.8))
Gives:
Here is a solution based on Z. Lin's answer, but using ggforce::facet_wrap_paginate() to do the filtering and keeping colourscales consistent.
First, we can make the 'root' plot containing all the data with no facetting.
library(ggpmisc)
library(tibble)
library(dplyr)
n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)
my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
`10` = "2, 3, ..., 10 replicates",
`100` = "10, 20, ..., 100 replicates",
`1000` = "100, 200, ..., 1000 replicates",
`10000` = "1000, 2000, ..., 10000 replicates"
)
base <- ggplot(data=data_frame,
aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) +
geom_line() +
theme_bw() +
scale_colour_gradientn(
name = "number of replicates",
trans = "log10", breaks = my_breaks,
labels = my_breaks, colours = rainbow(20)
) +
labs(title ="", x = "year", y = "sd")
Next, the main plot will be just the root plot with facet_wrap().
main <- base + facet_wrap(~ max_rep, ncol = 2, labeller = as_labeller(facet_names))
Then the new part is to use facet_wrap_paginate with nrow = 1 and ncol = 1 for every max_rep, which we'll use as insets. The nice thing is that this does the filtering and it keeps colour scales consistent with the root plot.
nmax_rep <- length(unique(data_frame$max_rep))
insets <- lapply(seq_len(nmax_rep), function(i) {
base + ggforce::facet_wrap_paginate(~ max_rep, nrow = 1, ncol = 1, page = i) +
coord_cartesian(xlim = c(12, 14), ylim = c(3, 4)) +
guides(colour = "none", x = "none", y = "none") +
theme(strip.background = element_blank(),
strip.text = element_blank(),
axis.title = element_blank(),
plot.background = element_blank())
})
insets <- tibble(x = rep(0.01, nmax_rep),
y = rep(10.01, nmax_rep),
plot = insets,
max_rep = unique(data_frame$max_rep))
main +
geom_plot_npc(data = insets,
aes(npcx = x, npcy = y, label = plot,
vp.width = 0.3, vp.height = 0.6)) +
annotate(geom = "rect",
xmin = 12, xmax = 14, ymin = 3, ymax = 4,
linetype = "dotted", fill = NA, colour = "black")
Created on 2020-12-15 by the reprex package (v0.3.0)

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)

Turning off ggplot clipping deletes line segment

I'm trying to draw some arrows in the margin of a ggplot. From what I've read, you have to turn off the plot clipping to do that. However, when I do that, it deletes a line segment I have on my graph.
library(ggplot2)
library(ggrepel)
library(grid)
#----------------- Fake data practice --------------------- #
mydata <- data.frame(Labels = letters[1:14],
X_Values = seq(1, 14, 1),
Y_Values = rnorm(14, mean = 0, sd = 1),
Influence = seq(1, 14, 1))
mydata$Influencer <- factor(ifelse(mydata$Influence <= 3, 1, 0))
# --- Get min/max from data and use to set range at -1to1 or -2to2
chartMax <- ifelse(min(mydata$Y_Values) < -1 | max(mydata$Y_Values) > 1, 2, 1)
chartMin <- ifelse(chartMax == 1, -1, -2)
yTitle = "Some Title"
# --- Label setting, if greater than 0 nudge up, else nudge down
mydata$Nudger <- ifelse(mydata$Y_Values >= 0, .1, -.1)
p <- ggplot(mydata, aes(x = X_Values, y = Y_Values, group = Influencer)) +
geom_point(aes(size = Influencer, color = Influencer), shape = 18) +
geom_segment(x = 0, xend = 14, y = 0, yend = 0, color = "red", linetype = "dashed", size = 1.2, alpha = .5) +
geom_text_repel(aes(x = X_Values, y = Y_Values, label = Labels),
box.padding = .4,
point.padding = .2,
nudge_y = .1) +
scale_color_manual(values = c("grey", "blue")) +
scale_size_manual(values = c(4, 6)) +
scale_y_continuous(name = "", limits = c(chartMin, chartMax)) +
scale_x_continuous(name = yTitle,
limits = c(1, 15),
breaks = c(2,13),
labels = c("Lower", "Higher")) +
theme_classic() + theme(plot.margin = unit(c(1,3,1,2), "lines"),
legend.position="none",
axis.ticks.x=element_blank(),
axis.text.x = element_text(face = "bold"),
axis.title = element_text(face = "bold"),
axis.line.x = element_line(color = "blue"
,size = 1
,arrow =
arrow(length = unit(0.5, "cm"),
ends = "both"))) +
annotation_custom(
grob = linesGrob(arrow=arrow(type="open", ends="both", length=unit(0.5, "cm")), gp=gpar(col="blue", lwd=2)),
xmin = -1.4, xmax = -1.4, ymin = chartMin, ymax = chartMax
)
p
# Here it works and you see the red dashed line
# Turn off panel clipping
gt <- ggplot_gtable(ggplot_build(p))
gt$layout$clip[gt$layout$name == "panel"] <- "off"
grid.draw(gt)
Ideally, I want a blue arrow that runs alongside the y-axis in the margins. I think I've got that, but I can't loose my dashed red line that runs along the inside the graph.
I can't explain why this is happening (seems like a bug, I suggest raising an issue here), but I can confirm that the issue is related to the line alpha. If we delete the alpha = 0.5 argument from geom_segment then the clipping=off works without deleting the line:

Resources