rggplot2axisyaxis

How can I make a discontinuous y axis in R with ggplot2?


Building from this question:

How can I make a discontinuous axis in R with ggplot2?

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

[How it looks:2

How I want it to look: enter image description here


Solution

  • 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")) 
    

    enter image description here