diff --git a/DESCRIPTION b/DESCRIPTION index 71237c5..c2c6054 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,7 @@ Imports: rlang LazyData: true Roxygen: list(markdown = TRUE) -RoxygenNote: 6.0.1.9000 +RoxygenNote: 6.1.1 Suggests: testthat, knitr, diff --git a/NEWS.md b/NEWS.md index 427b6f2..06c9bfa 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # gghighlight 0.1.0.9000 +* `gghighlight()` gets a new argument `unhighlighted_params`, which accepts a + list of parameters for the unhighlighted layer (e.g. `colour`, `fill`, `shape`, + and `size`). Accordingly, `unhighlighted_colour` is deprecated (#76). + # gghighlight 0.1.0 * Add `gghighlight()`, which replaces the current `gghighlight_line()` and `gghighlight_point()`; these functions are now deprecated. diff --git a/R/gghighlight.R b/R/gghighlight.R index a55be8e..b81757a 100644 --- a/R/gghighlight.R +++ b/R/gghighlight.R @@ -10,8 +10,8 @@ #' Number of layers to clone. #' @param max_highlight #' Max number of series to highlight. -#' @param unhighlighted_colour -#' Colour for unhighlighted geoms. +#' @param unhighlighted_params +#' Aesthetics (e.g. colour, fill, and size) for unhighlighted geoms. #' @param use_group_by #' If `TRUE`, use [dplyr::group_by()] to evaluate `predicate`. #' @param use_direct_label @@ -20,6 +20,8 @@ #' Column name for `label` aesthetics. #' @param label_params #' A list of parameters, which is passed to [ggrepel::geom_label_repel()]. +#' @param unhighlighted_colour +#' (Deprecated) Colour for unhighlighted geoms. #' #' @examples #' d <- data.frame( @@ -42,11 +44,12 @@ gghighlight <- function(..., n = NULL, max_highlight = 5L, - unhighlighted_colour = ggplot2::alpha("grey", 0.7), + unhighlighted_params = list(), use_group_by = NULL, use_direct_label = NULL, label_key = NULL, - label_params = list(fill = "white")) { + label_params = list(fill = "white"), + unhighlighted_colour = NULL) { # if use_direct_label is NULL, try to use direct labels but ignore failures # if use_direct_label is TRUE, use direct labels, otherwise stop() @@ -57,12 +60,20 @@ gghighlight <- function(..., label_key_must_exist <- FALSE } + # if fill is not specified, use colour for fill, or vice versa + unhighlighted_params <- normalize_unhighlighted_params(unhighlighted_params) + + if (!is.null(unhighlighted_colour)) { + rlang::warn("unhighlighted_colour is deprecated. Use unhighlighted_params instead.") + unhighlighted_params$colour <- unhighlighted_colour + } + structure( list( predicates = rlang::enquos(...), n = n, max_highlight = max_highlight, - unhighlighted_colour = unhighlighted_colour, + unhighlighted_params = unhighlighted_params, use_group_by = use_group_by, use_direct_label = use_direct_label, label_key_must_exist = label_key_must_exist, @@ -115,7 +126,7 @@ ggplot_add.gg_highlighter <- function(object, plot, object_name) { layers_bleached, group_infos, bleach_layer, - unhighlighted_colour = object$unhighlighted_colour + unhighlighted_params = object$unhighlighted_params ) # Sieve the upper layer. @@ -215,18 +226,20 @@ calculate_group_info <- function(data, mapping) { } } -bleach_layer <- function(layer, group_info, - unhighlighted_colour = ggplot2::alpha("grey", 0.7)) { - # Set colour and fill to grey when it is included in the mappping. - # But, if the default_aes is NA, respect it. - # (Note that this needs to be executed before modifying the layer$mapping) - params_bleached <- purrr::map( - rlang::set_names(c("colour", "fill")), - choose_bleached_colour, - geom = layer$geom, mapping = layer$mapping, bleached_colour = unhighlighted_colour - ) - params_bleached <- purrr::compact(params_bleached) - layer$aes_params <- utils::modifyList(layer$aes_params, params_bleached) +bleach_layer <- function(layer, group_info, unhighlighted_params) { + # `colour` and `fill` are special in that they needs to be specified even when + # it is not included in unhighlighted_params. But, if the default_aes is NA, + # respect it (e.g. geom_bar()'s default colour is NA). + # Note that this depends on the mapping, so this needs to be done before modifying the mapping. + unhighlighted_params$colour <- unhighlighted_params$colour %||% get_default_aes_param("colour", layer$geom, layer$mapping) + unhighlighted_params$fill <- unhighlighted_params$fill %||% get_default_aes_param("fill", layer$geom, layer$mapping) + + # c.f. https://github.com/tidyverse/ggplot2/blob/e9d4e5dd599b9f058cbe9230a6517f85f3587567/R/layer.r#L107-L108 + aes_params_bleached <- unhighlighted_params[names(unhighlighted_params) %in% layer$geom$aesthetics()] + geom_params_bleached <- unhighlighted_params[names(unhighlighted_params) %in% layer$geom$parameters(TRUE)] + + layer$aes_params <- utils::modifyList(layer$aes_params, aes_params_bleached) + layer$geom_params <- utils::modifyList(layer$geom_params, geom_params_bleached) # remove colour and fill from mapping layer$mapping[c("colour", "fill")] <- list(NULL) @@ -252,17 +265,30 @@ bleach_layer <- function(layer, group_info, layer } -choose_bleached_colour <- function(aes_name, geom, mapping, bleached_colour) { - if (!aes_name %in% geom$aesthetics()) { +default_unhighlighted_params <- list( + colour = ggplot2::alpha("grey", 0.7), + fill = ggplot2::alpha("grey", 0.7) +) + +get_default_aes_param <- function(aes_param_name, geom, mapping) { + # no default is available + if (!aes_param_name %in% names(default_unhighlighted_params)) { return(NULL) } - # if aes_name is specified in the mapping, it should be bleached. - if (!aes_name %in% names(mapping) && - aes_name %in% names(geom$default_aes) && - is.na(geom$default_aes[aes_name])) { - return(NA) + + # if it is specified in mapping, it needs to be overriden + if (aes_param_name %in% names(mapping)) { + return(default_unhighlighted_params[[aes_param_name]]) } - return(bleached_colour) + + # if the geom has default value and is NA, use NA + if (aes_param_name %in% names(geom$default_aes) && + is.na(geom$default_aes[[aes_param_name]])) { + return(NA) + } + + # otherwise, use the default grey + default_unhighlighted_params[[aes_param_name]] } sieve_layer <- function(layer, group_info, predicates, @@ -365,3 +391,17 @@ choose_col_for_filter_and_arrange <- function(data, exclude_col) { arrange = rlang::syms(names(data)[!col_idx_lgl & !col_idx_lst]) ) } + +normalize_unhighlighted_params <- function(aes_params) { + if (!is.list(aes_params)) { + rlang::abort("unhighlighted_params must be a list.") + } + + # color is an alias of colour + if (!is.null(aes_params$color)) { + aes_params$colour <- aes_params$colour %||% aes_params$color + aes_params$color <- NULL + } + + aes_params +} diff --git a/man/gghighlight-old.Rd b/man/gghighlight-old.Rd index 1d8d12e..3e5da21 100644 --- a/man/gghighlight-old.Rd +++ b/man/gghighlight-old.Rd @@ -7,14 +7,14 @@ \title{Highlight Data With Predicate} \usage{ gghighlight_line(data, mapping, predicate, max_highlight = 5L, - unhighlighted_colour = ggplot2::alpha("grey", 0.7), use_group_by = TRUE, - use_direct_label = TRUE, label_key = NULL, ..., - environment = parent.frame()) + unhighlighted_colour = ggplot2::alpha("grey", 0.7), + use_group_by = TRUE, use_direct_label = TRUE, label_key = NULL, + ..., environment = parent.frame()) gghighlight_point(data, mapping, predicate, max_highlight = 5L, - unhighlighted_colour = ggplot2::alpha("grey", 0.7), use_group_by = FALSE, - use_direct_label = TRUE, label_key = NULL, ..., - environment = parent.frame()) + unhighlighted_colour = ggplot2::alpha("grey", 0.7), + use_group_by = FALSE, use_direct_label = TRUE, label_key = NULL, + ..., environment = parent.frame()) } \arguments{ \item{data}{Default dataset to use for plot. If not already a data.frame, diff --git a/man/gghighlight.Rd b/man/gghighlight.Rd index a171878..f8917c3 100644 --- a/man/gghighlight.Rd +++ b/man/gghighlight.Rd @@ -5,9 +5,9 @@ \title{Highlight Data With Predicate} \usage{ gghighlight(..., n = NULL, max_highlight = 5L, - unhighlighted_colour = ggplot2::alpha("grey", 0.7), use_group_by = NULL, - use_direct_label = NULL, label_key = NULL, label_params = list(fill = - "white")) + unhighlighted_params = list(), use_group_by = NULL, + use_direct_label = NULL, label_key = NULL, label_params = list(fill + = "white"), unhighlighted_colour = NULL) } \arguments{ \item{...}{Expressions to filter data, which is passed to \code{\link[dplyr:filter]{dplyr::filter()}}.} @@ -16,7 +16,7 @@ gghighlight(..., n = NULL, max_highlight = 5L, \item{max_highlight}{Max number of series to highlight.} -\item{unhighlighted_colour}{Colour for unhighlighted geoms.} +\item{unhighlighted_params}{Aesthetics (e.g. colour, fill, and size) for unhighlighted geoms.} \item{use_group_by}{If \code{TRUE}, use \code{\link[dplyr:group_by]{dplyr::group_by()}} to evaluate \code{predicate}.} @@ -25,6 +25,8 @@ gghighlight(..., n = NULL, max_highlight = 5L, \item{label_key}{Column name for \code{label} aesthetics.} \item{label_params}{A list of parameters, which is passed to \code{\link[ggrepel:geom_label_repel]{ggrepel::geom_label_repel()}}.} + +\item{unhighlighted_colour}{(Deprecated) Colour for unhighlighted geoms.} } \description{ \code{gghiglight()} highlights (almost) any geoms according to the given predicates. diff --git a/tests/testthat/test-gghighlight.R b/tests/testthat/test-gghighlight.R index ba28a7e..0677e96 100644 --- a/tests/testthat/test-gghighlight.R +++ b/tests/testthat/test-gghighlight.R @@ -20,7 +20,7 @@ g_info <- list(data = d_, id = ids, key = aes(colour = type)) expect_equal_layer <- function(x, y) { x$mapping <- x$mapping[sort(names(x$mapping))] - y$mapping <- x$mapping[sort(names(y$mapping))] + y$mapping <- y$mapping[sort(names(y$mapping))] expect_equal(x, y) } @@ -88,31 +88,49 @@ aes_bleached <- aes_string(x = paste0(prefix, 1), test_that("bleach_layer() works", { # If colour is specified, colour is used as the group key. - expect_equal_layer(bleach_layer(geom_line(aes(colour = type), d), g_info, grey07), + expect_equal_layer(bleach_layer(geom_line(aes(colour = type), d), g_info, list()), geom_line(aes_bleached, d_bleached, colour = grey07)) # If colour is specified but group_key is NULL, the result is the same data. - expect_equal_layer(bleach_layer(geom_line(aes(colour = type), d), NULL, grey07), + expect_equal_layer(bleach_layer(geom_line(aes(colour = type), d), NULL, list()), geom_line(aes(colour = NULL, fill = NULL), d, colour = grey07)) # If the geom accepts fill, it is sets to grey even when it is not included in the mapping. - expect_equal_layer(bleach_layer(geom_bar(aes(colour = type), d), g_info, grey07), - geom_bar(aes_bleached, d_bleached, colour = grey07, fill = grey07)) + expect_equal_layer(bleach_layer(geom_col(aes(colour = type), d), g_info, list()), + geom_col(aes_bleached, d_bleached, colour = grey07, fill = grey07)) # If the default of colour of the geom is NA and mapping doesn't specify it, params will be NA. - expect_equal_layer(bleach_layer(geom_bar(aes(fill = type), d), g_info, grey07), - geom_bar(aes_bleached, d_bleached, colour = NA, fill = grey07)) + expect_equal_layer(bleach_layer(geom_col(aes(fill = type), d), g_info, list()), + geom_col(aes_bleached, d_bleached, colour = NA, fill = grey07)) # If colour and fill is specified at the same time, fill is used as the group key. - expect_equal_layer(bleach_layer(geom_bar(aes(colour = type, fill = type), d), g_info, grey07), - geom_bar(aes_bleached, d_bleached, colour = grey07, fill = grey07)) + expect_equal_layer(bleach_layer(geom_col(aes(colour = type, fill = type), d), g_info, list()), + geom_col(aes_bleached, d_bleached, colour = grey07, fill = grey07)) # If mapping doesn't have colour or fill, group or x aes can be used as group key. # c.f. https://github.com/yutannihilation/gghighlight/pull/17#issuecomment-390486101. - expect_equal_layer(bleach_layer(geom_bar(aes(group = type), d), g_info, grey07), - geom_bar(aes_bleached, d_bleached, colour = NA, fill = grey07)) - expect_equal_layer(bleach_layer(geom_bar(aes(x = type), d), g_info, grey07), - geom_bar(aes_bleached, d_bleached, colour = NA, fill = grey07)) + expect_equal_layer(bleach_layer(geom_col(aes(group = type), d), g_info, list()), + geom_col(aes_bleached, d_bleached, colour = NA, fill = grey07)) + expect_equal_layer(bleach_layer(geom_col(aes(x = type), d), g_info, list()), + geom_col(aes_bleached, d_bleached, colour = NA, fill = grey07)) + + # unhighlighted_params can be more detailed + expect_equal_layer(bleach_layer(geom_line(aes(colour = type), d), g_info, + list(colour = "blue", size = 3)), + geom_line(aes_bleached, d_bleached, colour = "blue", size = 3)) + + expect_equal_layer(bleach_layer(geom_col(aes(colour = type, fill = type), d), g_info, + list(colour = "blue", width = 0.5)), + geom_col(aes_bleached, d_bleached, colour = "blue", fill = grey07, width = 0.5)) + + expect_equal_layer(bleach_layer(geom_col(aes(fill = type), d), g_info, + list(fill = "blue", width = 0.5)), + # TODO: the order of fill and colour matters here... + geom_col(aes_bleached, d_bleached, fill = "blue", colour = NA, width = 0.5)) + + expect_equal_layer(bleach_layer(geom_col(aes(colour = type, fill = type), d), g_info, + list(colour = ggplot2::alpha("grey", 0.9), fill = grey07, width = 0.5)), + geom_col(aes_bleached, d_bleached, colour = ggplot2::alpha("grey", 0.9), fill = grey07, width = 0.5)) }) test_that("sieve_layer() works with simple cases", { diff --git a/tests/testthat/test-internals.R b/tests/testthat/test-internals.R index 150550f..bb67e91 100644 --- a/tests/testthat/test-internals.R +++ b/tests/testthat/test-internals.R @@ -15,3 +15,22 @@ test_that("choose_col_for_filter_and_arrange() works", { expect_equal(choose_col_for_filter_and_arrange(d1, rlang::quo(x)), !!expected) }) + +test_that("normalize_unhighlighted_params() works", { + expect_listequal <- function(x, y) { + expect_equal(!!x[sort(names(x))], !!y[sort(names(y))]) + } + + # if fill and colour is specified, respect both + expect_listequal(normalize_unhighlighted_params(list(colour = "blue", fill = "red")), + list(colour = "blue", fill = "red")) + # other parameters are left as is + expect_listequal(normalize_unhighlighted_params(list(fill = "red", size = 0.2)), + list(fill = "red", size = 0.2)) + # color is an alias of colour + expect_listequal(normalize_unhighlighted_params(list(color = "red")), + list(colour = "red")) + # if both colour and color are specified, use colour. + expect_listequal(normalize_unhighlighted_params(list(colour = "blue", color = "red")), + list(colour = "blue")) +})