Building from this question:
How can we adjust this code to create the same effect but in the y axis? I am having no success with keeping the size of the gap small and adding the diagonal lines to indicate discontinuity.
I also have not managed to make the text under the graph work, but that is less of a priority.
A reproducible example of my issue is below:
library(ggplot2)
library(readr)
library(dplyr)
library(tidyr)
library(gridExtra)
library(DescTools)
library(patchwork)
library(ggh4x)
set.seed(321)
# Define parameters
models <- c(1, 2, 3, 10, 11, 12)
metrics <- c(1, 2, 3)
n_repeats <- 144 # Number of times each model-metric combination repeats
# Expand grid to create all combinations of model and metric
dat <- expand.grid(model = models, metric = metrics)
dat <- dat[rep(seq_len(nrow(dat)), n_repeats), ] # Repeat the rows to match desired total size
# Add a normally distributed 'value' column
dat$value <- rnorm(nrow(dat), 20, 4)
dat2 <- data.frame(matrix(ncol = 3, nrow = 24))
x2 <- c("model", "value", "metric")
colnames(dat2) <- x2
dat2$model <- rep(13, 24)
dat2$value <- rnorm(24,10,.5)
dat2$metric <- rep(c(1,2,3),8)
df <- rbind(dat, dat2)
df <- df %>%
mutate(model = factor(model,
levels = c("13", "1", "2", "3", "10", "11", "12")),
metric = factor(metric))
desc.stats <- df %>%
group_by(model, metric) %>%
summarise(mean = mean (value),
range.lower = range(value)[1],
range.upper = range(value)[2],
median = median(value),
medianCI.lower = MedianCI(value, conf.level = 0.95, na.rm = FALSE, method = "exact", R = 10000)[2],
medianCI.upper = MedianCI(value, conf.level = 0.95, na.rm = FALSE, method = "exact", R = 10000)[3])
desc.stats
desc.stats_filtered <- desc.stats %>%
filter(model != 13)
library(grid)
text_high <- textGrob("Main model", gp=gpar(fontsize=12, fontface="bold"))
text_low <- textGrob("Secondary model", gp=gpar(fontsize=12, fontface="bold"))
p <- ggplot(desc.stats, aes(x=model, y=median, group=metric)) +
geom_point(aes(shape=metric, colour = metric)) +
geom_line(data = desc.stats_filtered, aes(colour = metric))+
scale_colour_manual(values = c("chocolate", "grey20", "blue")) + # Apply colors for fill
geom_errorbar(aes(ymin= medianCI.lower, ymax= medianCI.upper, colour = metric), width=.2) +
theme_classic() +
coord_cartesian(clip = "off", ylim = c(min(desc.stats$medianCI.lower), max(desc.stats$medianCI.upper))) +
annotation_custom(text_high,xmin=1,xmax=3,ymin=.43,ymax=.43) +
annotation_custom(text_low,xmin=5,xmax=5,ymin= .43,ymax=.43) +
annotate("segment", x = 0.5, xend = 3.4, y = .44, yend = .44) +
annotate("segment", x = 3.6, xend = 6.5, y = .44, yend = .44) +
theme(axis.title.x=element_blank(),
plot.margin = unit(c(1,1,2,1), "lines"))
# this is to make it slightly more programmatic
y1end <- 12
y2start <- 17
xsep = 0
p <- p +
guides(y = guide_axis_truncated(
trunc_lower = c(-Inf, y2start),
trunc_upper = c(y1end, Inf)
))
p
[
I don't know how to do the //
unfortunately, but how about this? I'm doing the text and segments with frames instead of annotate()
and such, and it seems to work out well. The y-axis is broken cleanly using guide_axis(cap = "both")
.
txt <- data.frame(x = c(2, 5), y = 9, lbl = c("Main model", "Secondary model"))
seg <- data.frame(x = c(0.5, 3.6), xend = c(3.4, 6.5), y = 9)
ggplot(desc.stats, aes(x=model, y=median)) +
geom_point(aes(shape=metric, colour = metric, group=metric)) +
geom_line(data = desc.stats_filtered, aes(colour = metric, group=metric))+
scale_colour_manual(values = c("chocolate", "grey20", "blue")) + # Apply colors for fill
geom_errorbar(aes(ymin= medianCI.lower, ymax= medianCI.upper, colour = metric, group=metric), width=.2) +
geom_segment(data = seg, aes(x=x, xend=xend, y=y, yend=y)) +
geom_text(data = txt, aes(x=x, y=y, label=lbl), vjust=-0.5) +
ggbreak::scale_y_break(breaks=c(12, 18), scales = 2) +
theme_classic() +
coord_cartesian(clip = "off", ylim = c(min(desc.stats$medianCI.lower), max(desc.stats$medianCI.upper))) +
guides(y = guide_axis(cap = "both")) +
theme(axis.title.x=element_blank(),
plot.margin = unit(c(1,1,2,1), "lines"))