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){

subset <- data %>% 
  filter(highlight_condition) %>% 
  mutate(subset = T)

data %>%
  mutate(subset = F) %>% 
  full_join(subset) %>% 
  mutate(group = fct_inorder(paste(grouping, subset)))
  
}

# test
gapminder::gapminder %>% 
  filter(year >= 2002) %>% 
  filter(continent == "Oceania") %>% 
  mutate(highlight_condition = country == "New Zealand") %>% 
  select(x = year, y = lifeExp, grouping = country, highlight_condition) %>% 
  compute_panel_highlight_lines()

## Joining with `by = join_by(x, y, grouping, highlight_condition, subset)`

## # A tibble: 6 × 6
##       x     y grouping    highlight_condition subset group            
##   <int> <dbl> <fct>       <lgl>               <lgl>  <fct>            
## 1  2002  80.4 Australia   FALSE               FALSE  Australia FALSE  
## 2  2007  81.2 Australia   FALSE               FALSE  Australia FALSE  
## 3  2002  79.1 New Zealand TRUE                FALSE  New Zealand FALSE
## 4  2007  80.2 New Zealand TRUE                FALSE  New Zealand FALSE
## 5  2002  79.1 New Zealand TRUE                TRUE   New Zealand TRUE 
## 6  2007  80.2 New Zealand TRUE                TRUE   New Zealand TRUE

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(subset)),
                         required_aes = c("x", "y", "grouping","highlight_condition")
                         )

# test.
gapminder::gapminder %>% 
  filter(year >= 2002) %>% 
  filter(continent == "Oceania") %>% 
  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))

## Joining with `by = join_by(x, y, grouping, highlight_condition, PANEL, group,
## subset)`

layer_data(i = 2)

## Joining with `by = join_by(x, y, grouping, highlight_condition, PANEL, group,
## subset)`

##      x      y    grouping highlight_condition PANEL group flipped_aes colour
## 1 2002 80.370   Australia               FALSE     1     1       FALSE   grey
## 2 2007 81.235   Australia               FALSE     1     1       FALSE   grey
## 3 2002 79.110 New Zealand               FALSE     1     2       FALSE   grey
## 4 2007 80.204 New Zealand               FALSE     1     2       FALSE   grey
##   linewidth linetype alpha
## 1       0.5        1    NA
## 2       0.5        1    NA
## 3       0.5        1    NA
## 4       0.5        1    NA

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) 

## Joining with `by = join_by(x, y, grouping, highlight_condition, PANEL, group,
## subset)`

Step 4. Specific request: preset colors - an geom + scale approach

Step 4.aa Create custom 2 color manual scale function.

scale_color_manual_2 <- function(val1 = "grey", val2 = "red"){
  
  scale_color_manual(values = c(val1, val2))
  
}

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

## Joining with `by = join_by(x, y, grouping, highlight_condition, PANEL, group,
## subset)`

layer_data(i = 2)

## Joining with `by = join_by(x, y, grouping, highlight_condition, PANEL, group,
## subset)`

##   colour    x      y    grouping highlight_condition PANEL             group
## 1   grey 2002 80.370   Australia                TRUE     1   Australia FALSE
## 2   grey 2007 81.235   Australia                TRUE     1   Australia FALSE
## 3   grey 2002 79.110 New Zealand               FALSE     1 New Zealand FALSE
## 4   grey 2007 80.204 New Zealand               FALSE     1 New Zealand FALSE
## 5    red 2002 80.370   Australia                TRUE     1    Australia TRUE
## 6    red 2007 81.235   Australia                TRUE     1    Australia TRUE
##   subset flipped_aes linewidth linetype alpha
## 1  FALSE       FALSE         3        1    NA
## 2  FALSE       FALSE         3        1    NA
## 3  FALSE       FALSE         3        1    NA
## 4  FALSE       FALSE         3        1    NA
## 5   TRUE       FALSE         3        1    NA
## 6   TRUE       FALSE         3        1    NA

last_plot() + 
  facet_wrap(~country)

## Joining with `by = join_by(x, y, grouping, highlight_condition, PANEL, group,
## subset)`
## Joining with `by = join_by(x, y, grouping, highlight_condition, PANEL, group,
## subset)`