devpart

library(tidyverse)

mod_full <- lm(mpg ~ cyl + disp + hp + drat + wt + qsec, data = mtcars)
mod_g1 <- lm(mpg ~ cyl + disp + hp, data = mtcars)
mod_g2 <- lm(mpg ~ drat + wt + qsec, data = mtcars)

dat <- data.frame(full_r2 = summary(mod_full)$r.square, 
                     g1_r2 = summary(mod_g1)$r.square, 
                     g2_r2 = summary(mod_g2)$r.square) %>% 
  mutate(g1_ind = full_r2 - g2_r2, 
         g2_ind = full_r2 - g1_r2) %>% 
  mutate(g1_start = 0, 
         g1_end = g1_r2,
         g2_start = g1_ind,
         g2_end = full_r2) %>% 
  gather(key, value, 
         -full_r2, 
         -g1_r2, 
         -g2_r2, 
         -g1_ind) %>% 
  separate(key, into = c("group", "pos")) %>% 
  spread(pos, value)


tick_breaks <-c(dat$start, dat$end, 1)
ymin = tick_breaks[-length(tick_breaks)]
ymax = tick_breaks[-1]

# adjust this for the height of the ticks separating %s
df_annotate <- data.frame(ymin = ymin,
                          ymax = ymax,
                          x = 0,
                          height=0.75)
df_label <- data.frame(value = c(paste0(round((ymax - ymin)*100, 0), "%"), ""),
                      position = c((ymax - ymin)/2 + ymin, 1))

ggplot(dat) + 
  # adjust size to change bar width
  geom_linerange(aes(ymin = start, ymax = end, x = group, colour = group),
                 size = 5) + 
  geom_hline(aes(yintercept = full_r2),
             colour = "red") + 
  geom_hline(yintercept = c(0, 1)) + 
  geom_segment(data = dat %>% filter(group == "g1"), 
               aes(x = 0.5, y = end, xend = 1.5, yend = end)) + 
  geom_segment(data = dat %>% filter(group == "g2"), 
               aes(x = 1.5, y = start, xend = 2.5, yend = start)) + 
  # adjust to change colour of bars
  scale_colour_manual(values = c("#984ea3", "#4daf4a")) + 
  scale_y_continuous(breaks = df_label$position, labels = df_label$value) + 
  geom_errorbar(data = df_annotate, aes(x, ymin=ymin, ymax=ymax, width=height)) + 
  coord_flip() + 
  geom_text(aes(y = full_r2, x = 2.2, 
                label = paste0(round(full_r2*100, 0), "%")), 
            hjust = -0.1, colour = "red") + 
  # can add in the name of the groups in the next two geom_texts, currently just %
  geom_text(aes(y = g1_ind + (g2_r2/2), x = 2, 
                label = c(paste0(round(g2_r2*100, 0), "%"))), hjust = 0) + 
  geom_text(aes(y = (g1_r2)/2, x = 1, 
                label = c(paste0(round(g1_r2*100, 0), "%"))), hjust = 0) + 
  theme(panel.border = element_blank(),
        legend.position = "none",
        axis.ticks.x = element_line(linetype=0),
        axis.ticks.y = element_blank(),
        axis.text.y = element_blank(),
        axis.title.x = element_blank(),
        axis.title.y = element_text(angle = 0, hjust = 1, vjust = 0.5))