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, which_id = "Argentina"){
data %>%
mutate(ind_id = id %in% which_id) %>%
arrange(ind_id) %>%
mutate(group = fct_inorder(id))
}
# test
gapminder::gapminder %>%
filter(continent == "Americas") %>%
select(x = year, y = lifeExp, id = country) %>%
compute_panel_highlight_lines
## # A tibble: 300 × 5
## x y id ind_id 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,
compute_group = compute_panel_highlight_lines,
default_aes = aes(color = after_stat(ind_id)),
required_aes = c("x", "y", "id")
)
# test.
gapminder::gapminder %>%
filter(continent == "Americas") %>%
ggplot() +
aes(x = year, y = lifeExp, id = country) +
geom_point() +
geom_line(color = "grey") +
layer(geom = "line", stat = statHighlight, position = "identity",
params = list(linewidth = 3, alpha = 1, which_id = "Peru"))
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, id = country) +
geom_point() +
geom_line_highlight(which_id = "Bolivia")
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))
}
Step 4.ab. test both components together
gapminder::gapminder %>%
filter(continent == "Americas") %>%
ggplot() +
aes(x = year, y = lifeExp, id = country) +
geom_point() +
geom_line_highlight(which_id = "Bolivia") +
scale_color_manual_2()
Step 4.ba. bundle into pseudo geom (layer+scale)
geom_line_highlight_w_scale <- function(val1 = "grey", highlight_color = "pink", ...){
list(geom_line_highlight(...),
scale_color_manual_2(val1 = val1, val2 = highlight_color)
)
}
Step 4bb test the geom-scale
gapminder::gapminder %>%
filter(continent == "Americas") %>%
ggplot() +
aes(x = year, y = lifeExp, id = country) +
geom_point() +
geom_line_highlight_w_scale(which_id = "Colombia",
linewidth = 4,
highlight_color = "goldenrod3")
gapminder::gapminder %>%
filter(continent == "Americas") %>%
ggplot() +
aes(x = year, y = lifeExp, id = country) +
geom_point() +
geom_line_highlight_w_scale(which_id = "Chile",
val1 = "white",
highlight_color = "darkred",
linewidth = 2)
4bb test overwrite scale
last_plot() +
scale_color_manual(values = c("gray", "red"),
breaks = c(F,T),
labels = c("Peers", "Chile"))
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
Other data.
data <- tibble::tribble(
~x, ~group, ~y, ~measure, ~base,
"FY18", "aaa", 0.5603448, 260, 464,
"FY15", "aaa", 0.5081269, 1313, 2584,
"FY19", "aaa", 0.5799373, 185, 319,
"FY16", "aaa", 0.5225225, 580, 1110,
"FY13", "aaa", 0.4779116, 595, 1245,
"FY17", "aaa", 0.5502471, 334, 607,
"FY14", "aaa", 0.5339007, 1882, 3525,
"FY20", "aaa", 0.4960998, 318, 641,
"FY21", "aaa", 0.4765840, 173, 363,
"FY21", "bbb", 0.5135802, 208, 405,
"FY20", "bbb", 0.5384615, 259, 481,
"FY17", "bbb", 0.4628099, 56, 121,
"FY18", "bbb", 0.5474453, 75, 137,
"FY15", "bbb", 0.4705882, 72, 153,
"FY19", "bbb", 0.6083916, 87, 143,
"FY14", "bbb", 0.5097087, 105, 206,
"FY16", "bbb", 0.5395683, 75, 139,
"FY13", "bbb", 0.5432099, 132, 243,
"FY14", "ccc", 0.5326591, 2528, 4746,
"FY21", "ccc", 0.4320038, 899, 2081,
"FY13", "ccc", 0.5420887, 3265, 6023,
"FY16", "ccc", 0.5075188, 810, 1596,
"FY15", "ccc", 0.5116469, 1252, 2447,
"FY18", "ccc", 0.4206349, 477, 1134,
"FY17", "ccc", 0.4564565, 456, 999,
"FY19", "ccc", 0.4651429, 407, 875,
"FY20", "ccc", 0.4759398, 633, 1330
)
data %>%
mutate(group = factor(group)) %>%
mutate(x = factor(x)) %>%
ggplot() +
aes(x = x, y = y, id = group) +
geom_line_highlight_w_scale(which_id = "ccc",
linewidth = 3,
highlight_color = "darkred")
gghighlight
library(tidyverse)
gapminder::gapminder %>%
filter(continent == "Oceania") %>%
filter(year > 1995) %>%
ggplot() +
aes(x = year, y = lifeExp, group = country, color = country) +
geom_line()
last_plot()$layers |> length()
## [1] 1
last_plot() +
gghighlight::gghighlight(country %in% c("New Zealand"),
unhighlighted_colour = "darkgrey",
use_direct_label = F)
## Warning: The `unhighlighted_colour` argument of `gghighlight()` is deprecated as of
## gghighlight 0.2.0.
## ℹ Please use the `unhighlighted_params` argument instead.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
## Warning: Tried to calculate with group_by(), but the calculation failed.
## Falling back to ungrouped filter operation...
last_plot()$layers
## [[1]]
## mapping: x = ~highlight..........1, y = ~highlight..........2, colour = ~highlight..........3, group = ~highlight..........group, fill = NULL
## geom_line: na.rm = FALSE, orientation = NA
## stat_identity: na.rm = FALSE
## position_identity
##
## [[2]]
## mapping: x = ~year, y = ~lifeExp, colour = ~country, group = ~country
## geom_line: na.rm = FALSE, orientation = NA
## stat_identity: na.rm = FALSE
## position_identity
layer_data(i = 1)
## x y group PANEL flipped_aes colour linewidth linetype alpha
## 1 1997 78.830 1 1 FALSE darkgrey 0.5 1 NA
## 2 2002 80.370 1 1 FALSE darkgrey 0.5 1 NA
## 3 2007 81.235 1 1 FALSE darkgrey 0.5 1 NA
## 4 1997 77.550 2 1 FALSE darkgrey 0.5 1 NA
## 5 2002 79.110 2 1 FALSE darkgrey 0.5 1 NA
## 6 2007 80.204 2 1 FALSE darkgrey 0.5 1 NA
layer_data(i = 2)
## colour x y group PANEL flipped_aes linewidth linetype alpha
## 1 #F8766D 1997 77.550 1 1 FALSE 0.5 1 NA
## 2 #F8766D 2002 79.110 1 1 FALSE 0.5 1 NA
## 3 #F8766D 2007 80.204 1 1 FALSE 0.5 1 NA
gapminder::gapminder %>%
filter(continent == "Americas") %>%
ggplot() +
aes(x = year, y = lifeExp, group = country, color = country) +
geom_line() +
scale_color_viridis_d() +
gghighlight::gghighlight(country %in% c("Bolivia", "Chile"),
unhighlighted_colour = "darkgrey",
use_direct_label = F)
## Warning: Tried to calculate with group_by(), but the calculation failed.
## Falling back to ungrouped filter operation...
last_plot() +
scale_color_manual(values = c("orange", "orange")) +
facet_wrap(~country)
## Scale for colour is already present.
## Adding another scale for colour, which will replace the existing scale.
Function approach
my_lines_w_highlight_plotter <- function(data, x, y, group, ids){
data %>%
mutate(ind_in_ids = {{group}} %in% ids) %>%
arrange(ind_in_ids) %>%
mutate(group = fct_inorder({{group}})) %>%
ggplot() +
aes(x = {{x}}, y = {{y}}, group = {{group}}) +
geom_point() +
geom_line(lwd = 3) +
aes(color = ind_in_ids) +
scale_color_manual(values = c("grey50", "magenta"))
}
gapminder::gapminder %>%
filter(continent == "Americas") %>%
my_lines_w_highlight_plotter(x = year, y = lifeExp,
group = country, ids = "Argentina")
