another experiment

Intro Thoughts

Step 0. Status Quo: base ggplot2

library(tidyverse)

gapminder::gapminder %>% 
  filter(continent == "Americas") %>% 
  mutate(is_argentina = country == "Argentina") %>% 
  arrange(is_argentina) %>%
  mutate(country = fct_inorder(country)) %>% 
  ggplot() + 
    aes(x = year, y = lifeExp, group = country) + 
  geom_point() + 
  geom_line(lwd = 3) + 
  aes(color = is_argentina) + 
  scale_color_manual(values = c("grey50", "magenta"))

Step 1. define compute. test.

compute_panel_highlight_lines <- function(data, scales){

data %>% 
  arrange(highlight_condition) %>%
  mutate(group = fct_inorder(grouping))
  
}

# test
gapminder::gapminder %>% 
  filter(continent == "Americas") %>% 
  mutate(highlight_condition = country == "Argentina") %>% 
  select(x = year, y = lifeExp, grouping = country, highlight_condition) %>% 
  compute_panel_highlight_lines()

## # A tibble: 300 × 5
##        x     y grouping highlight_condition group  
##    <int> <dbl> <fct>    <lgl>               <fct>  
##  1  1952  40.4 Bolivia  FALSE               Bolivia
##  2  1957  41.9 Bolivia  FALSE               Bolivia
##  3  1962  43.4 Bolivia  FALSE               Bolivia
##  4  1967  45.0 Bolivia  FALSE               Bolivia
##  5  1972  46.7 Bolivia  FALSE               Bolivia
##  6  1977  50.0 Bolivia  FALSE               Bolivia
##  7  1982  53.9 Bolivia  FALSE               Bolivia
##  8  1987  57.3 Bolivia  FALSE               Bolivia
##  9  1992  60.0 Bolivia  FALSE               Bolivia
## 10  1997  62.0 Bolivia  FALSE               Bolivia
## # ℹ 290 more rows

step 2 pass to ggproto. test

statHighlight <- ggproto("statHighlight",
                         Stat,
                         # panel is needed to ensure 
                         # that highlighted groups sits on top.
                         compute_panel = compute_panel_highlight_lines,
                         default_aes = aes(color = after_stat(highlight_condition)),
                         required_aes = c("x", "y", "grouping","highlight_condition")
                         )

# test.
gapminder::gapminder %>% 
  filter(continent == "Americas") %>% 
  ggplot() + 
  aes(x = year, y = lifeExp, 
      grouping = country, 
      highlight_condition = country == "Argentina") + 
  geom_point() + 
  geom_line(color = "grey") + 
  layer(geom = "line", stat = statHighlight, position = "identity",
        params = list(linewidth = 3, alpha = 1))

Step 3. make user-facing function & test. (I’m not being very careful here about default selection)

geom_line_highlight <- function(mapping = NULL, # global aesthetics will be used if NULL
  data = NULL, # global data will be used if NULL
  position = "identity", 
  na.rm = FALSE, 
  show.legend = NA,
  inherit.aes = TRUE, 
  ...  ) {
  
  layer(geom = "line", stat = statHighlight, 
    data = data, 
    mapping = mapping,
    position = position, 
    show.legend = show.legend, 
    inherit.aes = inherit.aes,
    params = list(na.rm = na.rm, ...)
  )
  
  
}

# test
gapminder::gapminder %>% 
  filter(continent == "Americas") %>% 
  ggplot() + 
  aes(x = year, y = lifeExp, 
      grouping = country,
      highlight_condition = country == "Bolivia") + 
  geom_point() + 
  geom_line_highlight(linewidth = 3) 

knitr::knit_exit()