evgeni_geom_parallel_slopes.md

library(tidyverse)


# Geom creation -----------------------------------------------------------
StatParallelSlopes <- ggproto(
  "StatParallelSlopes", Stat,
  
  required_aes = c("x", "y"),
  
  compute_panel = function(data, scales, params) {
    if (!("group" %in% names(data))) {
      stop("Supply grouping variable (group, color, or fill).", call. = FALSE)
    }
    
    # Create model data
    model_data <- data.frame(
      x = data[["x"]], y = data[["y"]], group = as.factor(data[["group"]])
    )
    
    # Fit parallel slopes model
    mod <- lm(y ~ x + group, data = model_data)
    
    # Replace actual y-values with ones from parallel slopes model (predicted at
    # x-points from actual data). This approach works only because linear model
    # is supported, as its plotted lines don't have curvature. Otherwise, output
    # lines might be not "smooth enough".
    data$y <- predict(mod)
    
    data
  }
)

geom_parallel_slopes <- function(mapping = NULL, data = NULL,
                                 position = "identity", na.rm = FALSE,
                                 show.legend = NA, inherit.aes = TRUE,
                                 ...) {
  layer(
    geom = "line", stat = StatParallelSlopes, data = data, mapping = mapping,
    position = position, params = list(na.rm = na.rm, ...),
    inherit.aes = inherit.aes, show.legend = show.legend
  )
}

# From ModernDive Chapter 6
library(moderndive)
evals_ch6 <- evals %>%
  select(ID, score, age, gender)

# Interaction
ggplot(evals_ch6, aes(x = age, y = score, color = gender)) +
  geom_point() +
  labs(x = "Age", y = "Teaching Score", color = "Gender") +
  geom_smooth(method = "lm", se = FALSE)

# Parallel slopes
ggplot(evals_ch6, aes(x = age, y = score, color = gender)) +
  geom_point() +
  labs(x = "Age", y = "Teaching Score", color = "Gender") +
  geom_parallel_slopes(size = 2)

^{Created on 2019-10-28 by the reprex package (v0.3.0)}