Annotate several regression lines produced with geom_smooth

Viewed 192

I have a figure with 16 regression lines and I need to be able to identify them. Using a color gradient or symbols or different line types do not really help. My idea therefore is, to just (haha) annotate every line. Therefore, I build a dataset (hpAnnotatedLines) with the different maximum x values. This is the position the text should start. However, I have no idea how to automatically extract the respective y values of the predicted regression lines at the maximum x-axis values, which is different for each line.

Please find a smaller data set using mtcars as an example

library(ggplot2)
library(dplyr)
library(ggrepel)

#just select the data I need
mtcars1 <- select(mtcars, disp,cyl,hp)
mtcars1$cyl <- as.factor(mtcars1$cyl)

#extract max values
mtcars2 <- mtcars1  %>% 
  group_by(cyl) %>% 
  summarise(Max.disp= max(disp)) 
#build dataset for the annotation layer
#note that hp was done by hand. Here I need help
hpAnnotatedLines <- data.frame(cyl=levels(mtcars2$cyl),
                                disp=mtcars2$Max.disp,
                                hp=c(90,100,210))

#example plot
ggplot(mtcars, aes(x=disp, y=hp, color = factor(cyl))) +
  geom_point() +
  geom_smooth(method=lm)+
  coord_cartesian(xlim = c(min(mtcars$disp), max(mtcars$disp) + 50)) +
  geom_text_repel(
    data = hpAnnotatedLines,
    aes(label = cyl),
    size = 3,
    nudge_x = 1)

example plot

3 Answers

Instead of extracting the fitted values you could add the labels via geom_text by switching the stat to smooth and setting the label aesthetic via after_stat such that only the last point of each regression line gets labelled:

library(ggplot2)
library(dplyr)

myfun <- function(x, color) {
  data.frame(x = x, color = color) %>% 
    group_by(color) %>% 
    mutate(label = ifelse(x %in% max(x), as.character(color), "")) %>% 
    pull(label)
}

ggplot(mtcars, aes(x=disp, y=hp, color = factor(cyl))) +
  geom_point() +
  geom_smooth(method=lm) +
  geom_text(aes(label = after_stat(myfun(x, color))), 
            stat = "smooth", method = "lm", hjust = 0, size = 3, nudge_x = 1, show.legend = FALSE) +
  coord_cartesian(xlim = c(min(mtcars$disp), max(mtcars$disp) + 50))

It's a bit of a hack, but you can extract the data from the compiled plot object. For example first make the plot without the labels,

myplot <- ggplot(mtcars, aes(x=disp, y=hp, color = factor(cyl))) +
  geom_point() +
  geom_smooth(method=lm)+
  coord_cartesian(xlim = c(min(mtcars$disp), max(mtcars$disp) + 50))

Then use ggplot_build to get the data from the second layer (The geom_smooth layer) and transform it back into the names used by your data. Here we find the largest x value per group, and then take that y value.

pobj <- ggplot_build(myplot)
hpAnnotatedLines <- pobj$data[[2]] %>% group_by(group) %>% 
  top_n(1, x) %>% 
  transmute(disp=x, hp=y, cyl=levels(mtcars$cyl)[group])

Then add an additional layer to your plot

myplot + 
  geom_text_repel(
    data = hpAnnotatedLines,
    aes(label = cyl),
    size = 3,
    nudge_x = 1)

If your data is not that huge, you can extract the predictions out using augment() from broom and take that with the largest value:

library(broom)
library(dplyr)
library(ggplot2)

hpAnn = mtcars %>% group_by(cyl) %>% 
do(augment(lm(hp ~ disp,data=.))) %>% 
top_n(1,disp) %>%
select(cyl,disp,.fitted) %>% 
rename(hp = .fitted)

# A tibble: 3 x 3
# Groups:   cyl [3]
    cyl  disp    hp
  <dbl> <dbl> <dbl>
1     4  147.  96.7
2     6  258   99.9
3     8  472  220. 

Then plot:

ggplot(mtcars, aes(x=disp, y=hp, color = factor(cyl))) +
geom_point() +
geom_smooth(method=lm)+
coord_cartesian(xlim = c(min(mtcars$disp), max(mtcars$disp) + 50))+
geom_text_repel(
    data = hpAnn,
    aes(label = cyl),
    size = 3,
    nudge_x = 1)

enter image description here

Related