rggplot2colorsinsetsgeom-segment

How do I place insets at exact positions on a ggplot and set the colors of geom_segment?


I'm creating an illustration of how loess works. My two queries are at the end of this question. First, setup:

library(tidyverse)
data(melanoma, package = "lattice")
mela <- as_tibble(melanoma)
tric = function(x) if_else(abs(x) < 1, (1 - abs(x)^3)^3, 0)
scl = function(x) (x - min(x))/(max(x) - min(x))
mela1 <- mela %>%
  slice(1:9) %>%
  mutate(dist = abs(year - year[5]),
         scaled = scl(dist),
         weight = tric(scaled)
  )
mod1 <- lm(incidence ~ year, data = mela1, weights = weight) %>%
  augment(., mela1)
mela2 <- mela %>%
  slice(10:18) %>%
  mutate(dist = abs(year - year[5]),
         scaled = scl(dist),
         weight = tric(scaled)
  )
mod2 <- lm(incidence ~ year, data = mela2, weights = weight) %>%
  augment(., mela2)
mela3 <- mela %>%
  slice(19:27) %>%
  mutate(dist = abs(year - year[5]),
         scaled = scl(dist),
         weight = tric(scaled)
  )
mod3 <- lm(incidence ~ year, data = mela3, weights = weight) %>%
  augment(., mela3)
mela4 <- mela %>%
  slice(28:37) %>%
  mutate(dist = abs(year - year[5]),
         scaled = scl(dist),
         weight = tric(scaled)
  )
mod4 <- lm(incidence ~ year, data = mela4, weights = weight) %>%
  augment(., mela4)

The main plot:

col <- rainbow_hcl(start = 12, 4, l = 20)
colB <- rainbow_hcl(start = 12, 4, l = 100)
main <- ggplot(data = mela, aes(x = year, y = incidence)) +
# segment 1
  geom_segment(
    aes(x = 1936, xend = 1944, y = 2.115717, yend = 2.115717)) +
# segment 2
  geom_segment(
    aes(x = 1945, xend = 1953, y = 3.473217, yend = 3.473217)) +
# segment 3
  geom_segment(
    aes(x = 1954, xend = 1962, y = 1.170247, yend = 1.170247)) +
# segment 4
  geom_segment(
    aes(x = 1963, xend = 1972, y = 2.7, yend = 2.7)) +
  geom_point(data = mod1, color = col[1], shape = 1) +
  geom_point(data = mod2, color = col[2], shape = 0) +
  geom_point(data = mod3, color = col[4], shape = 5) +
  geom_point(data = mod4, color = col[3], shape = 2) +
  geom_line(data = mod1, aes(x = year, y = .fitted), color = col[1]) +
  geom_line(data = mod2, aes(x = year, y = .fitted), color = col[2]) +
  geom_line(data = mod3, aes(x = year, y = .fitted), color = col[4]) +
  geom_line(data = mod4, aes(x = year, y = .fitted), color = col[3]) +
  scale_x_continuous(breaks = c(1940, 1949, 1958, 1967))

Insets

inset1 <- ggplot(data = mod1, aes(x = year, y = weight)) +
  geom_line(color = col[1]) +
  geom_area(fill = colB[1]) +
  theme_void()
inset2 <- ggplot(data = mod2, aes(x = year, y = weight)) +
  geom_line(color = col[12) +
  geom_area(fill = colB[2]) +
  theme_void()
inset3 <- ggplot(data = mod3, aes(x = year, y = weight)) +
  geom_line(color = col[3]) +
  geom_area(fill = colB[3]) +
  theme_void()
inset4 <- ggplot(data = mod4, aes(x = year, y = weight)) +
  geom_line(color = col[4]) +
  geom_area(fill = colB[4]) +
  theme_void()

Question 1: How do I place the four insets so that the y = 0 of the weight function is at the height of the corresponding geom_segment? I would like the inset heights = 2 in the main figure coordinates.

Question 2: How do I set the color of each segment to the color of the corresponding inset?


Solution

  • Not sure whether I got everything right. But I tried my best. (; You could simplify your code considerably

    1. ... by binding you models data into one dataframe and also the data for the segments.
    2. ... mapping on aesthetics and setting the colors and shape via some named vectors and scale_xxx_manual

    For your insets there is no need to make separate plots and trying to put them into the main plot. You could simply add them via an additional geom_line and a geom_ribbon. To get the heights of the segments join the segments data to the models data so that you can set the starting value for the geom_ribbon according to the y value of the segment

    library(tidyverse)
    library(broom)
    library(colorspace)
    
    col <- setNames(col, c("mod1", "mod2", "mod4", "mod3"))
    colB <- setNames(colB, c("mod1", "mod2", "mod4", "mod3"))
    shapes <- setNames(c(1, 0, 5, 2), c("mod1", "mod2", "mod3", "mod4"))
    
    mods <- list(mod1 = mod1, mod2 = mod2, mod3 = mod3, mod4 = mod4) %>% 
      bind_rows(.id = "mod")
    
    # segments data
    dseg <- tribble(
      ~mod, ~x, ~xend, ~y,
      "mod1", 1936, 1944, 2.115717,
      "mod2", 1945, 1953, 3.473217,
      "mod3", 1954, 1962, 1.170247,
      "mod4", 1963, 1972, 2.7,
    )
    
    main <- ggplot(data = mela, aes(x = year, y = incidence)) +
      geom_segment(data = dseg, aes(x = x, xend = xend, y = y, yend = y, color = mod)) +
      geom_point(data = mods, aes(color = mod, shape = mod)) +
      geom_line(data = mods, aes(x = year, y = .fitted, color = mod)) +
      scale_color_manual(values = col) +
      scale_shape_manual(values = shapes) +
      scale_x_continuous(breaks = c(1940, 1949, 1958, 1967)) +
      guides(color = FALSE, shape = FALSE, fill = FALSE)
    
    mods1 <- left_join(mods, select(dseg, mod, y), by = "mod")
    
    # Add insets
    main +
      geom_line(data = mods1, aes(x = year, y = weight + y, color = mod, group = mod)) +
      geom_ribbon(data = mods1, aes(x = year, ymin = y, ymax = weight + y, fill = mod, group = mod)) +
      scale_fill_manual(values = colB)