From ca1aa8a3d3aa3d2bc6d365ef9e2eccba38f1b053 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Tue, 17 Sep 2024 00:01:41 +0200 Subject: [PATCH] Fence primitive (#19) * rename colour guides (#11) * abstract range param extraction * abstract range justification * draft guide * abstract checking if in range * theme customisation * document * fixup mistakes * add test * integrate into `guide_axis_nested()` --- NAMESPACE | 10 +- NEWS.md | 6 +- R/guide_axis_nested.R | 51 ++- ...uide_colourbar_custom.R => guide_colbar.R} | 14 +- R/{guide_colour_ring.R => guide_colring.R} | 18 +- ..._coloursteps_custom.R => guide_colsteps.R} | 14 +- R/key-range.R | 45 ++ R/primitive-box.R | 39 +- R/primitive-bracket.R | 40 +- R/primitive-fence.R | 414 ++++++++++++++++++ R/themes.R | 19 +- R/utils.R | 8 + README.Rmd | 4 +- README.md | 7 +- man/figures/README-composition-1.svg | 4 +- man/gguidance-package.Rd | 1 + man/gguidance_extensions.Rd | 11 +- man/guide_axis_custom.Rd | 6 +- man/guide_axis_nested.Rd | 23 +- ...de_colourbar_custom.Rd => guide_colbar.Rd} | 24 +- ...{guide_colour_ring.Rd => guide_colring.Rd} | 22 +- ...oloursteps_custom.Rd => guide_colsteps.Rd} | 24 +- man/guide_subtitle.Rd | 6 +- man/primitive_box.Rd | 1 + man/primitive_bracket.Rd | 1 + man/primitive_fence.Rd | 125 ++++++ man/primitive_labels.Rd | 1 + man/primitive_line.Rd | 1 + man/primitive_spacer.Rd | 1 + man/primitive_ticks.Rd | 1 + man/primitive_title.Rd | 1 + man/theme_guide.Rd | 9 +- .../primitive-facet-legend.svg | 125 ++++++ .../primitive-fence-cartesian.svg | 104 +++++ .../primitive-fence-radial.svg | 104 +++++ tests/testthat/test-guide_colour_ring.R | 8 +- tests/testthat/test-guide_colourbar_custom.R | 10 +- .../testthat/test-guide_coloursteps_custom.R | 10 +- tests/testthat/test-primitive-fence.R | 86 ++++ vignettes/articles/keys.Rmd | 2 +- vignettes/articles/tour.Rmd | 30 +- 41 files changed, 1216 insertions(+), 214 deletions(-) rename R/{guide_colourbar_custom.R => guide_colbar.R} (91%) rename R/{guide_colour_ring.R => guide_colring.R} (97%) rename R/{guide_coloursteps_custom.R => guide_colsteps.R} (91%) create mode 100644 R/primitive-fence.R rename man/{guide_colourbar_custom.Rd => guide_colbar.Rd} (91%) rename man/{guide_colour_ring.Rd => guide_colring.Rd} (89%) rename man/{guide_coloursteps_custom.Rd => guide_colsteps.Rd} (91%) create mode 100644 man/primitive_fence.Rd create mode 100644 tests/testthat/_snaps/primitive-fence/primitive-facet-legend.svg create mode 100644 tests/testthat/_snaps/primitive-fence/primitive-fence-cartesian.svg create mode 100644 tests/testthat/_snaps/primitive-fence/primitive-fence-radial.svg create mode 100644 tests/testthat/test-primitive-fence.R diff --git a/NAMESPACE b/NAMESPACE index 1fe9874..fafcdd4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -10,10 +10,11 @@ export(GizmoDensity) export(GizmoGrob) export(GizmoHistogram) export(GizmoStepcap) -export(GuideColourRing) +export(GuideColring) export(GuideSubtitle) export(PrimitiveBox) export(PrimitiveBracket) +export(PrimitiveFence) export(PrimitiveLabels) export(PrimitiveLine) export(PrimitiveSpacer) @@ -42,9 +43,9 @@ export(gizmo_histogram) export(gizmo_stepcap) export(guide_axis_custom) export(guide_axis_nested) -export(guide_colour_ring) -export(guide_colourbar_custom) -export(guide_coloursteps_custom) +export(guide_colbar) +export(guide_colring) +export(guide_colsteps) export(guide_subtitle) export(key_auto) export(key_bins) @@ -60,6 +61,7 @@ export(key_sequence) export(new_compose) export(primitive_box) export(primitive_bracket) +export(primitive_fence) export(primitive_labels) export(primitive_line) export(primitive_spacer) diff --git a/NEWS.md b/NEWS.md index b2876d7..0db2f75 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,9 +18,9 @@ Full guides are guides that you can just drop in the `guides()` function or as `guide` argument to scales. * `guide_axis_custom()` as an axis guide. -* `guide_colourbar_custom()` as a continuous colour/fill guide. -* `guide_coloursteps_custom()` as a binned colour/fill guide. -* `guide_colour_ring()` as a continuous colour/fill guide. +* `guide_colbar_custom()` as a continuous colour/fill guide. +* `guide_colsteps_custom()` as a binned colour/fill guide. +* `guide_colring()` as a continuous colour/fill guide. * `guide_subtitle()` as a colour/fill guide. ## Gizmos diff --git a/R/guide_axis_nested.R b/R/guide_axis_nested.R index 8c42be3..f469fd6 100644 --- a/R/guide_axis_nested.R +++ b/R/guide_axis_nested.R @@ -16,14 +16,14 @@ #' @inheritParams primitive_line #' @inheritParams primitive_ticks #' @inheritParams primitive_bracket -#' @param ... Arguments passed on to [`primitive_bracket()`] or -#' [`primitive_box()`]. +#' @param ... Arguments passed on to [`primitive_bracket()`], +#' [`primitive_box()`] or [`primitive_fence()`]. #' #' @details #' Under the hood, this guide is a [stack composition][compose_stack] of a #' [line][primitive_line], [ticks][primitive_ticks], optionally -#' [labels][primitive_labels] and either [bracket][primitive_bracket] or -#' [box][primitive_box] primitives. +#' [labels][primitive_labels] and either [bracket][primitive_bracket], +#' [box][primitive_box] or [fence][primitive_fence] primitives. #' #' By default, the [`key = "range_auto"`][key_range] will incorporate the 0th #' level labels inferred from the scale's labels. These labels will look like @@ -61,6 +61,13 @@ #' p + guides(x = guide_axis_nested(type = "box")) + #' theme_guide(box = element_rect("limegreen", "forestgreen")) #' +#' # Using fences instead of brackets + styling of fences +#' p + guides(x = guide_axis_nested(type = "fence", rail = "inner")) + +#' theme_guide( +#' fence.post = element_line("tomato"), +#' fence.rail = element_line("dodgerblue") +#' ) +#' #' # Use as annotation of a typical axis #' # `regular_key` controls display of typical axis #' ggplot(mpg, aes(displ, hwy)) + @@ -70,21 +77,21 @@ #' regular_key = key_manual(c(2, 2.5, 3, 5, 7)) #' )) guide_axis_nested <- function( - key = "range_auto", - regular_key = "auto", - type = "bracket", - title = waiver(), - theme = NULL, - angle = waiver(), - cap = "none", - bidi = FALSE, - oob = "squish", - drop_zero = TRUE, - pad_discrete = 0.4, - levels_text = NULL, - ..., - order = 0, - position = waiver() + key = "range_auto", + regular_key = "auto", + type = "bracket", + title = waiver(), + theme = NULL, + angle = waiver(), + cap = "none", + bidi = FALSE, + oob = "squish", + drop_zero = TRUE, + pad_discrete = NULL, + levels_text = NULL, + ..., + order = 0, + position = waiver() ) { theme <- theme %||% theme() @@ -92,10 +99,12 @@ guide_axis_nested <- function( theme$gguidance.guide.spacing %||% unit(0, "cm") nesting <- switch( - arg_match0(type, c("bracket", "box")), + arg_match0(type, c("bracket", "box", "fence")), bracket = primitive_bracket, - box = primitive_box + box = primitive_box, + fence = primitive_fence ) + pad_discrete <- pad_discrete %||% switch(type, fence = 0.5, 0.4) if (identical(key, "range_auto")) { labels <- new_guide( diff --git a/R/guide_colourbar_custom.R b/R/guide_colbar.R similarity index 91% rename from R/guide_colourbar_custom.R rename to R/guide_colbar.R index 1f934d6..5b89919 100644 --- a/R/guide_colourbar_custom.R +++ b/R/guide_colbar.R @@ -42,30 +42,30 @@ #' # The colourbar shows caps when values are out-of-bounds (oob) #' p + scale_colour_viridis_c( #' limits = c(10, NA), -#' guide = "colourbar_custom" +#' guide = "colbar" #' ) #' #' # It also shows how oob values are handled #' p + scale_colour_viridis_c( #' limits = c(10, NA), oob = scales::oob_squish, -#' guide = "colourbar_custom" +#' guide = "colbar" #' ) #' #' # Adjusting the type of cap #' p + scale_colour_viridis_c( #' limits = c(10, 30), oob = scales::oob_squish, -#' guide = guide_colourbar_custom(shape = "round") +#' guide = guide_colbar(shape = "round") #' ) #' #' # One-sided ticks #' p + scale_colour_viridis_c( -#' guide = guide_colourbar_custom(second_guide = "none") +#' guide = guide_colbar(second_guide = "none") #' ) #' #' # Colour bar with minor breaks #' p + scale_colour_viridis_c( #' minor_breaks = scales::breaks_width(1), -#' guide = guide_colourbar_custom(key = "minor") +#' guide = guide_colbar(key = "minor") #' ) #' #' # Using log ticks on a colourbar @@ -73,9 +73,9 @@ #' geom_point(aes(colour = bodywt), na.rm = TRUE) + #' scale_colour_viridis_c( #' transform = "log10", -#' guide = guide_colourbar_custom(key = "log") +#' guide = guide_colbar(key = "log") #' ) -guide_colourbar_custom <- function( +guide_colbar <- function( title = waiver(), key = "auto", first_guide = "axis_custom", diff --git a/R/guide_colour_ring.R b/R/guide_colring.R similarity index 97% rename from R/guide_colour_ring.R rename to R/guide_colring.R index c0998c2..93bf899 100644 --- a/R/guide_colour_ring.R +++ b/R/guide_colring.R @@ -46,22 +46,22 @@ #' scale_colour_gradientn(colours = my_pal) #' #' # Standard colour ring -#' p + guides(colour = "colour_ring") +#' p + guides(colour = "colring") #' #' # As an arc -#' p + guides(colour = guide_colour_ring( +#' p + guides(colour = guide_colring( #' start = 1.25 * pi, end = 2.75 * pi #' )) #' #' # Removing the inner tick marks -#' p + guides(colour = guide_colour_ring(inner_guide = "none")) +#' p + guides(colour = guide_colring(inner_guide = "none")) #' #' # Include labels on the inner axis -#' p + guides(colour = guide_colour_ring(show_labels = "both")) +#' p + guides(colour = guide_colring(show_labels = "both")) #' #' # Passing an argument to inner/outer guides -#' p + guides(colour = guide_colour_ring(angle = 0)) -guide_colour_ring <- function( +#' p + guides(colour = guide_colring(angle = 0)) +guide_colring <- function( title = waiver(), key = "auto", start = 0, @@ -103,7 +103,7 @@ guide_colour_ring <- function( show_labels = show_labels, position = position, available_aes = available_aes, - super = GuideColourRing + super = GuideColring ) } @@ -113,8 +113,8 @@ guide_colour_ring <- function( #' @rdname gguidance_extensions #' @format NULL #' @usage NULL -GuideColourRing <- ggproto( - "GuideColourRing", Compose, +GuideColring <- ggproto( + "GuideColring", Compose, params = new_params( guides = list(), guide_params = list(), diff --git a/R/guide_coloursteps_custom.R b/R/guide_colsteps.R similarity index 91% rename from R/guide_coloursteps_custom.R rename to R/guide_colsteps.R index a0cb422..0417f44 100644 --- a/R/guide_coloursteps_custom.R +++ b/R/guide_colsteps.R @@ -40,41 +40,41 @@ #' # The colour steps show caps when values are out-of-bounds #' p + scale_colour_viridis_b( #' limits = c(10, NA), -#' guide = "coloursteps_custom" +#' guide = "colsteps" #' ) #' #' # It also shows how oob values are handled #' p + scale_colour_viridis_b( #' limits = c(10, 30), oob = scales::oob_censor, -#' guide = "coloursteps_custom" +#' guide = "colsteps" #' ) #' #' # Adjusting the type of cap #' p + scale_colour_viridis_b( #' limits = c(10, 30), -#' guide = guide_coloursteps_custom(shape = "round") +#' guide = guide_colsteps(shape = "round") #' ) #' #' # The default is to use the breaks as-is #' p + scale_colour_viridis_b( #' limits = c(10, 30), breaks = c(10, 20, 25), -#' guide = "coloursteps_custom" +#' guide = "colsteps" #' ) #' #' # But the display can be set to use evenly spaced steps #' p + scale_colour_viridis_b( #' limits = c(10, 30), breaks = c(10, 20, 25), -#' guide = guide_coloursteps_custom(key = key_bins(even.steps = TRUE)) +#' guide = guide_colsteps(key = key_bins(even.steps = TRUE)) #' ) #' #' # Using tick marks by swapping side guides #' p + scale_colour_viridis_b( -#' guide = guide_coloursteps_custom( +#' guide = guide_colsteps( #' first_guide = "axis_custom", #' second_guide = "axis_custom" #' ) #' ) -guide_coloursteps_custom <- function( +guide_colsteps <- function( title = waiver(), key = "bins", first_guide = "axis_custom", diff --git a/R/key-range.R b/R/key-range.R index 8905e86..6b76c31 100644 --- a/R/key-range.R +++ b/R/key-range.R @@ -291,6 +291,36 @@ range_from_label <- function( df } +justify_ranges <- function(key, levels, element, level_elements) { + + if (is_blank(element)) { + return(key) + } + + ends <- intersect(c("thetaend", "xend", "yend"), names(key)) + if (length(ends) < 1) { + return(key) + } + starts <- gsub("end$", "", ends[1]) + + just_name <- switch(ends[1], yend = "vjust", "hjust") + just <- element[[just_name]] %||% 0.5 + + if (!is.null(level_elements)) { + just <- map_dbl(level_elements, function(x) x[[just_name]] %||% just) + just <- just[match(key$.level, levels)] + } + + key[[starts]] <- switch( + ends[1], + thetaend = justify_range(key$theta, key$thetaend, just, theta = TRUE), + xend = justify_range(key$x, key$xend, just), + yend = justify_range(key$y, key$yend, just) + ) + + key +} + justify_range <- function(start, end, just, theta = FALSE) { if (theta) { add <- end < start @@ -337,6 +367,21 @@ disjoin_ranges <- function(ranges) { ranges } +extract_range_params <- function(scale, params, ...) { + params$position <- params$position %|W|% NULL + params$limits <- scale$get_limits() + + new_names <- c("start", "end") + aesthetic <- params$aesthetic + if (aesthetic %in% c("x", "y")) { + new_names <- paste0(aesthetic, c("", "end")) + } else if (is_theta(params$position)) { + new_names <- c("x", "xend") + } + params$key <- rename(params$key, c("start", "end"), new_names) + params +} + setup_range_params <- function(params) { if (params$aesthetic %in% c("x", "y")) { # parameters are already transformed diff --git a/R/primitive-box.R b/R/primitive-box.R index 60f79da..0bbf1b0 100644 --- a/R/primitive-box.R +++ b/R/primitive-box.R @@ -117,20 +117,7 @@ PrimitiveBox <- ggproto( extract_key = range_extract_key, - extract_params = function(scale, params, ...) { - params <- primitive_extract_params(scale, params, ...) - - aesthetic <- params$aesthetic - - if (aesthetic %in% c("x", "y")) { - params$key <- - rename(params$key, c("start", "end"), paste0(aesthetic, c("", "end"))) - } else if (is_theta(params$position)) { - params$key <- - rename(params$key, c("start", "end"), c("x", "xend")) - } - params - }, + extract_params = extract_range_params, extract_decor = function(scale, aesthetic, key, ...) { @@ -175,27 +162,11 @@ PrimitiveBox <- ggproto( text_levels <- rep0(params$levels_text, length.out = nlevels) # Justify labels along their ranges - if (!is_blank(elements$text)) { + key <- justify_ranges(key, levels, elements$text, text_levels) - hjust <- elements$text$hjust - vjust <- elements$text$vjust - - if (!is.null(text_levels)) { - hjust <- map_dbl(text_levels, function(x) x$hjust %||% hjust) - hjust <- hjust[match(key$.level, levels)] - vjust <- map_dbl(text_levels, function(x) x$vjust %||% vjust) - vjust <- vjust[match(key$.label, levels)] - } - - if (is_theta(position)) { - add <- if (position == "theta.sec") pi else 0 - key$theta <- justify_range(key$theta, key$thetaend, hjust, theta = TRUE) - key <- polar_xy(key, key$r, key$theta + add, params$bbox) - } else if ("xend" %in% names(key)) { - key$x <- justify_range(key$x, key$xend, hjust) - } else if ("yend" %in% names(key)) { - key$y <- justify_range(key$y, key$yend, vjust) - } + if (is_theta(position)) { + add <- if (position == "theta.sec") pi else 0 + key <- polar_xy(key, key$r, key$theta + add, params$bbox) } grobs <- vector("list", nlevels) diff --git a/R/primitive-bracket.R b/R/primitive-bracket.R index 04febf2..b31170c 100644 --- a/R/primitive-bracket.R +++ b/R/primitive-bracket.R @@ -142,18 +142,7 @@ PrimitiveBracket <- ggproto( extract_key = range_extract_key, - extract_params = function(scale, params, ...) { - params <- primitive_extract_params(scale, params, ...) - aesthetic <- params$aesthetic - if (aesthetic %in% c("x", "y")) { - params$key <- - rename(params$key, c("start", "end"), paste0(aesthetic, c("", "end"))) - } else if (is_theta(params$position)) { - params$key <- - rename(params$key, c("start", "end"), c("x", "xend")) - } - params - }, + extract_params = extract_range_params, extract_decor = function(scale, aesthetic, position, key, bracket, ...) { bracket <- resolve_bracket(bracket) @@ -202,28 +191,11 @@ PrimitiveBracket <- ggproto( text_levels <- rep0(params$levels_text, length.out = nlevels) # Justify labels along their ranges - if (!is_blank(elements$text)) { - - hjust <- elements$text$hjust - vjust <- elements$text$vjust - - # If we have custom elements, take justification from there - if (!is.null(text_levels)) { - hjust <- map_dbl(text_levels, function(x) x$hjust %||% hjust) - hjust <- hjust[match(key$.level, levels)] - vjust <- map_dbl(text_levels, function(x) x$vjust %||% vjust) - vjust <- vjust[match(key$.level, levels)] - } - - if (is_theta(position)) { - add <- if (position == "theta.sec") pi else 0 - key$theta <- justify_range(key$theta, key$thetaend, hjust, theta = TRUE) - key <- polar_xy(key, key$r, key$theta + add, params$bbox) - } else if ("xend" %in% names(key)) { - key$x <- justify_range(key$x, key$xend, hjust) - } else if ("yend" %in% names(key)) { - key$y <- justify_range(key$y, key$yend, vjust) - } + key <- justify_ranges(key, levels, elements$text, text_levels) + + if (is_theta(position)) { + add <- if (position == "theta.sec") pi else 0 + key <- polar_xy(key, key$r, key$theta + add, params$bbox) } if (is_blank(elements$line) || is_empty(decor)) { diff --git a/R/primitive-fence.R b/R/primitive-fence.R new file mode 100644 index 0000000..e488685 --- /dev/null +++ b/R/primitive-fence.R @@ -0,0 +1,414 @@ +# Constructor ------------------------------------------------------------- + +#' Guide primitive: fence +#' +#' This function constructs a fence [guide primitive][guide-primitives]. The +#' customisation options are easier to understand if we view fence 'post' as the +#' vertical pieces of a real world fence, and the 'rail' as the horizontal +#' pieces. +#' +#' @inheritParams primitive_bracket +#' @param rail A `` giving an option for how to display fence +#' railing. Can be either `"none"` (default) to display no railings, `"inner"` +#' to draw one rail closer to the plot panel, `"outer"` to display one rail +#' farther from the plot panel, or `"both"` to sandwich the labels between +#' rails. +#' @param levels_post,levels_rail A list of `` objects to +#' customise how fence posts and rails are displayed at every level. +#' +#' @return A `` primitive guie that can be used inside other +#' guides. +#' @family primitives +#' @export +#' +#' @details +#' # Styling options +#' +#' Below are the [theme][ggplot2::theme] options that determine the styling of +#' this guide, which may differ depending on whether the guide is used in an +#' axis or legend context. +#' +#' Common to both types is the following: +#' +#' * `gguidance.fence.post` an [``][ggplot2::element_line] for the +#' line used to draw the pieces orthogonal to the direction of the scale. +#' * `gguidance.fence.rail` an [``][ggplot2::element_line] for the +#' line used to draw the pieces parallel to the direction of the scale. +#' +#' ## As an axis guide +#' +#' * `axis.text.{x/y}.{position}` an [``][ggplot2::element_text] +#' for the text displayed. +#' +#' ## As a legend guide +#' +#' * `legend.text` an [``][ggplot2::element_text] for the text +#' displayed. +#' +#' +#' @examples +#' # A standard plot +#' p <- ggplot(mpg, aes(interaction(drv, year), displ)) + +#' geom_point() +#' +#' key <- key_range_manual(c(2, 4), c(5, 6), c("A", "B")) +#' +#' # Adding as secondary guides +#' p + guides( +#' x.sec = primitive_fence(rail = "inner"), +#' y.sec = primitive_fence(key = key, rail = "outer") +#' ) +primitive_fence <- function( + key = "range_auto", + rail = "none", + angle = waiver(), + oob = "squish", + drop_zero = TRUE, + pad_discrete = 0.5, + levels_text = NULL, + levels_post = NULL, + levels_rail = NULL, + theme = NULL, + position = waiver() +) { + + key <- resolve_key(key) + oob <- arg_match0(oob, c("squish", "censor", "none")) + rail <- arg_match0(rail, c("none", "inner", "outer", "both")) + check_bool(drop_zero) + check_number_decimal(pad_discrete, allow_infinite = FALSE) + check_list_of( + levels_text, + c("element_text", "element_blank", "NULL"), + allow_null = TRUE + ) + check_list_of( + levels_post, + c("element_line", "element_blank", "NULL"), + allow_null = TRUE + ) + check_list_of( + levels_rail, + c("element_line", "element_blank", "NULL"), + allow_null = TRUE + ) + + new_guide( + key = key, + oob = oob, + rail = rail, + angle = angle, + drop_zero = drop_zero, + pad_discrete = pad_discrete, + levels_text = levels_text, + levels_post = levels_post, + levels_rail = levels_rail, + theme = theme, + position = position, + available_aes = c("any", "x", "y", "r", "theta"), + super = PrimitiveFence + ) +} + +# Class ------------------------------------------------------------------- + +#' @export +#' @rdname gguidance_extensions +#' @format NULL +#' @usage NULL +PrimitiveFence <- ggproto( + "PrimitiveFence", Guide, + + params = new_params( + key = NULL, oob = "squish", drop_zero = TRUE, + pad_discrete = 0.5, angle = waiver(), + levels_text = NULL, levels_post = NULL, levels_rail = NULL, + rail = "none" + ), + + hashables = exprs(key, decor), + + elements = list( + position = list( + text = "axis.text", + post = I("gguidance.fence.post"), + rail = I("gguidance.fence.rail") + ), + legend = list( + text = "legend.text", + post = I("gguidance.fence.post"), + rail = I("gguidance.fence.rail") + ) + ), + + extract_key = range_extract_key, + + extract_params = extract_range_params, + + extract_decor = function(scale, aesthetic, position, key, ...) { + + levels <- sort(unique(key$.level)) + key <- vec_slice(key, key$.draw) + if (nrow(key) < 1) { + return(NULL) + } + + # Take unique positions by level + split <- vec_split(c(key$start, key$end), c(key$.level, key$.level)) + split$val <- lapply(split$val, unique) + + decor <- data_frame0( + !!aesthetic := unlist(split$val), + .level = min(levels), + .level_end = rep(split$key, lengths(split$val)) + ) + decor <- vec_slice(decor, order(decor$.level_end, decor[[aesthetic]])) + + # We don't want fencepost of outer pieces poke through the railing of + # the inner pieces. + for (lvl in levels[-1L]) { + lower <- which(key$.level == lvl - 1L) + current <- which(decor$.level_end >= lvl) + if (length(current) < 1 || length(lower) < 1) { + next + } + trim <- in_ranges( + decor[[aesthetic]][current], + start = key$start[lower], + end = key$end[lower] + ) + decor$.level[current[trim]] <- lvl + } + keep <- !duplicated(decor[c(aesthetic, ".level")], fromLast = TRUE) + vec_slice(decor, keep) + }, + + transform = function(self, params, coord, panel_params) { + params$key <- + transform_key(params$key, params$position, coord, panel_params) + params$decor <- + transform_key(params$decor, params$position, coord, panel_params) + params$bbox <- panel_params$bbox %||% list(x = c(0, 1), y = c(0, 1)) + params + }, + + setup_params = setup_range_params, + + setup_elements = primitive_setup_elements, + + build_fence = function(key, decor, elements, params) { + + levels <- unique(c(key$.level, decor$.level, decor$.level_end)) + nlevels <- length(levels) + position <- params$position + + text_levels <- rep0(params$levels_text, length.out = nlevels) + post_levels <- rep0(params$levels_post, length.out = nlevels) + rail_levels <- rep0(params$levels_rail, length.out = nlevels) + + rail <- vec_slice(key, key$.draw) + key <- justify_ranges(key, levels, elements$text, text_levels) + + if (is_theta(position)) { + add <- if (position == "theta.sec") pi else 0 + key <- polar_xy(key, key$r, key$theta + add, params$bbox) + rail <- polar_xy(rail, rail$r, rail$theta + add, params$bbox) + } + + decor$.level <- match(decor$.level, levels) + decor$.level_end <- match(decor$.level_end, levels) + rail$.level <- match(rail$.level, levels) + + measure <- switch( + position, + left = , right = width_cm, + top = , bottom = height_cm, + get_size_attr + ) + + angle <- params$angle %|W|% NULL + text <- angle_labels(elements$text, angle, position) + offset <- elements$offset + sizes <- numeric(nlevels + 1) + grobs <- vector("list", nlevels) + + for (i in seq_len(nlevels)) { + + labels <- draw_labels( + vec_slice(key, key$.level == levels[[i]]), + combine_elements(text_levels[[i]], text), + angle = angle, offset = offset, position = position + ) + sizes[i + 1] <- measure(labels) + offset <- offset + sizes[i + 1] + + fencepost <- draw_fencepost( + vec_slice(decor, decor$.level_end == i), + combine_elements(post_levels[[i]], elements$post), + sizes = sizes[1:(i + 1)], + offset = offset, position = position + ) + + fencerail <- draw_fencerail( + vec_slice(rail, rail$.level == i), + combine_elements(rail_levels[[i]], elements$rail), + sizes = sizes[1:(i + 1)], + offset = offset, position = position, + side = params$rail, bbox = params$bbox + ) + + grobs[[i]] <- grobTree(fencepost, fencerail, labels) + } + + sizes <- sizes[-1] + if (position %in% c("top", "left")) { + grobs <- rev(grobs) + sizes <- rev(sizes) + } + + attr(grobs, "sizes") <- sizes + grobs + }, + + draw = function(self, theme, position = NULL, direction = NULL, + params = self$params) { + params <- replace_null(params, position = position, direction = direction) + params <- self$setup_params(params) + + elems <- self$setup_elements(params, self$elements, theme) + fence <- self$build_fence(params$key, params$decor, elems, params) + + if (length(fence) < 1) { + return(zeroGrob()) + } + + primitive_grob( + grob = fence, + size = unit(attr(fence, "sizes"), "cm"), + position = params$position, + name = "fence" + ) + } + +) + +# Helpers ----------------------------------------------------------------- + +draw_fencerail <- function(rail, element, sizes, offset, position, side, bbox) { + if (side == "none" || nrow(rail) < 1 || is_blank(element)) { + return(NULL) + } + + if (is_theta(position)) { + n <- as.integer(round(rail$thetaend - rail$theta) / (pi / 45)) + n <- pmax(n, 2L) + + theta <- Map(seq, rail$theta, rail$thetaend, length.out = n) + i <- rep(seq_along(theta), lengths(theta)) + + add <- as.numeric(position == "theta.sec") + xy <- data_frame0( + theta = unlist(theta) + add * pi, + r = rail$r[i], + i = i + ) + xy <- polar_xy(xy, xy$r, xy$theta, bbox) + levels <- rail$.level[i] + + if (side == "inner") { + r <- unit(rep(offset - sizes[rail$.level + 1], n), "cm") + } else if (side == "outer") { + r <- unit(rep(offset, sum(n)), "cm") + } else { + r <- unit(c( + rep(offset - sizes[rail$.level + 1], n), + rep(offset, sum(n)) + ), "cm") + xy$i <- c(1, xy$i[-1] != xy$i[-nrow(xy)]) + xy <- vec_c(xy, xy) + xy$i <- cumsum(xy$i) + } + if (add == 1) { + r <- r * -1 + } + + rails <- element_grob( + element, + x = unit(xy$x, "npc") + sin(xy$theta) * r, + y = unit(xy$y, "npc") + cos(xy$theta) * r, + id.lengths = vec_unrep(xy$i)$times + ) + return(rails) + } + + aes <- switch(position, top = , bottom = "x", left = , right = "y", "theta") + aesend <- paste0(aes, "end") + + mark <- vec_interleave(rail[[aes]], rail[[aesend]]) + if (side == "inner") { + tick <- rep(0, length(mark)) + } else if (side == "outer") { + tick <- rep(1, length(mark)) + } else { + tick <- rep(c(0, 1), each = length(mark)) + mark <- c(mark, mark) + } + mark <- unit(mark, "npc") + tick <- switch( + position, + top = , right = unit(0 + tick, "npc"), + unit(1 - tick, "npc") + ) + + args <- list(x = tick, y = mark, id.lengths = rep(2L, length(tick) / 2)) + if (position %in% c("top", "bottom")) { + args <- flip_names(args) + } + inject(element_grob(element, !!!args)) +} + +draw_fencepost <- function(decor, element, sizes, offset, position) { + if (nrow(decor) < 1 || is_blank(element)) { + return(NULL) + } + + levels <- vec_interleave(decor$.level, decor$.level_end + 1) + + if (is_theta(position)) { + add <- as.numeric(position == "theta.sec") + + angle <- rep(decor$theta, each = 2) + add * pi + x <- rep(decor$x, each = 2) + y <- rep(decor$y, each = 2) + length <- cumsum(sizes)[levels] + offset - sum(sizes) + if (add == 1) { + length <- length * -1 + } + length <- unit(length, "cm") + + ticks <- element_grob( + element, + x = unit(x, "npc") + sin(angle) * length, + y = unit(y, "npc") + cos(angle) * length, + id.lengths = rep(2, nrow(decor)) + ) + return(ticks) + } + + aes <- switch(position, top = , bottom = "x", left = , right = "y", "theta") + mark <- unit(rep(decor[[aes]], each = 2), "npc") + + tick <- unit(offset - cumsum(sizes)[levels], "cm") + tick <- switch( + position, + top = , right = unit(1, "npc") - tick, + unit(0, "npc") + tick + ) + + args <- list(x = tick, y = mark, id.lengths = rep(2L, nrow(decor))) + if (position %in% c("top", "bottom")) { + args <- flip_names(args) + } + inject(element_grob(element, !!!args)) +} + diff --git a/R/themes.R b/R/themes.R index f12b88a..d61fd46 100644 --- a/R/themes.R +++ b/R/themes.R @@ -59,6 +59,9 @@ #' `gguidance.bracket.size` element. #' @param box An [``][ggplot2::element_rect] setting the #' `gguidance.box` element. +#' @param fence,fence.post,fence.rail An +#' [``][ggplot2::element_line] setting the `gguidance.fence`, +#' `gguidance.fence.post` and `gguidance.fence.rail` respectively. #' #' @return A `` object that can be provided to a guide. #' @export @@ -109,7 +112,10 @@ theme_guide <- function( bracket = NULL, bracket.size = NULL, - box = NULL + box = NULL, + fence = NULL, + fence.post = NULL, + fence.rail = NULL ) { theme <- list( @@ -168,7 +174,10 @@ theme_guide <- function( gguidance.bracket = bracket, gguidance.bracket.size = bracket.size, - gguidance.box = box + gguidance.box = box, + gguidance.fence = fence, + gguidance.fence.post = fence.post, + gguidance.fence.rail = fence.rail ) theme <- theme[lengths(theme) > 0] theme(!!!theme) @@ -179,6 +188,9 @@ register_gguidance_elements <- function() { register_theme_elements( gguidance.bracket.size = unit(2, "mm"), gguidance.bracket = element_line(), + gguidance.fence = element_line(), + gguidance.fence.post = element_line(), + gguidance.fence.rail = element_line(), gguidance.box = element_rect(colour = "white"), gguidance.legend.minor.ticks = element_line(), gguidance.legend.minor.ticks.length = rel(0.75), @@ -194,6 +206,9 @@ register_gguidance_elements <- function() { element_tree = list( gguidance.bracket.size = el_def("unit"), gguidance.bracket = el_line("line"), + gguidance.fence = el_line("line"), + gguidance.fence.post = el_line("gguidance.fence"), + gguidance.fence.rail = el_line("gguidance.fence"), gguidance.box = el_def("element_rect", "strip.background"), gguidance.legend.minor.ticks = el_line("legend.ticks"), gguidance.legend.minor.ticks.length = el_unit("legend.ticks.length"), diff --git a/R/utils.R b/R/utils.R index be3cd87..3433942 100644 --- a/R/utils.R +++ b/R/utils.R @@ -120,6 +120,14 @@ in_range <- function(x, range) { x >= range[1] & x <= range[2] } +in_ranges <- function(x, start, end) { + lower <- pmin(start, end) + upper <- pmax(start, end) + smaller <- outer(lower, x, FUN = "<") + larger <- outer(upper, x, FUN = ">") + colSums(larger & smaller) > 0 +} + polar_xy <- function(data, r, theta, bbox) { data$x <- rescale(r * sin(theta) + 0.5, from = bbox$x) data$y <- rescale(r * cos(theta) + 0.5, from = bbox$y) diff --git a/README.Rmd b/README.Rmd index 5076358..bae65e3 100644 --- a/README.Rmd +++ b/README.Rmd @@ -56,7 +56,7 @@ base <- ggplot(mpg, aes(displ, hwy, colour = cty)) + The gguidance package offers a selection of what it calls 'complete guides'. These complete guides can just be drop-in replacement of regular guides, which you can specify using ggplot2's `guides()` function or using the `guide` argument in scales. -In the example below, we're using two custom variants of vanilla guides, namely `guide_axis_custom()` and `guide_colourbar_custom()`. These custom variants have additional options that allow a greater degree of customisation: +In the example below, we're using two custom variants of vanilla guides, namely `guide_axis_custom()` and `guide_colbar()`. These custom variants have additional options that allow a greater degree of customisation: * The axis guide has an option for bidirectional ticks. * The colourbar automatically recognises out-of-bounds values and displays this with a cap. @@ -65,7 +65,7 @@ In the example below, we're using two custom variants of vanilla guides, namely base + scale_colour_viridis_c( limits = c(NA, 30), - guide = "colourbar_custom" + guide = "colbar" ) + guides( x = guide_axis_custom(bidi = TRUE) diff --git a/README.md b/README.md index cd434ef..ce89014 100644 --- a/README.md +++ b/README.md @@ -49,9 +49,8 @@ guides’. These complete guides can just be drop-in replacement of regular guides, which you can specify using ggplot2’s `guides()` function or using the `guide` argument in scales. In the example below, we’re using two custom variants of vanilla guides, namely -`guide_axis_custom()` and `guide_colourbar_custom()`. These custom -variants have additional options that allow a greater degree of -customisation: +`guide_axis_custom()` and `guide_colbar()`. These custom variants have +additional options that allow a greater degree of customisation: - The axis guide has an option for bidirectional ticks. - The colourbar automatically recognises out-of-bounds values and @@ -61,7 +60,7 @@ customisation: base + scale_colour_viridis_c( limits = c(NA, 30), - guide = "colourbar_custom" + guide = "colbar" ) + guides( x = guide_axis_custom(bidi = TRUE) diff --git a/man/figures/README-composition-1.svg b/man/figures/README-composition-1.svg index 2e0a12b..edde539 100644 --- a/man/figures/README-composition-1.svg +++ b/man/figures/README-composition-1.svg @@ -310,7 +310,7 @@ City miles per gallon - + @@ -332,7 +332,7 @@ - + Efficient diff --git a/man/gguidance-package.Rd b/man/gguidance-package.Rd index 370c1e2..4228144 100644 --- a/man/gguidance-package.Rd +++ b/man/gguidance-package.Rd @@ -14,6 +14,7 @@ A 'ggplot2' extension that focusses on expanding the plotter's arsenal of guides Useful links: \itemize{ \item \url{https://teunbrand.github.io/gguidance/} + \item \url{https://github.com/teunbrand/gguidance} } } diff --git a/man/gguidance_extensions.Rd b/man/gguidance_extensions.Rd index 856b74e..8cc5601 100644 --- a/man/gguidance_extensions.Rd +++ b/man/gguidance_extensions.Rd @@ -1,11 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/compose-.R, R/compose-crux.R, % R/compose-ontop.R, R/compose-sandwich.R, R/compose-stack.R, -% R/gguidance-package.R, R/gizmo-barcap.R, R/gizmo-density.R, R/gizmo-grob.R, -% R/gizmo-histogram.R, R/gizmo-stepcap.R, R/guide_colour_ring.R, +% R/gguidance-package.R, R/gizmo-barcap.R, R/gizmo-density.R, +% R/gizmo-grob.R, R/gizmo-histogram.R, R/gizmo-stepcap.R, R/guide_colring.R, % R/guide_subtitle.R, R/primitive-box.R, R/primitive-bracket.R, -% R/primitive-labels.R, R/primitive-line.R, R/primitive-spacer.R, -% R/primitive-ticks.R, R/primitive-title.R +% R/primitive-fence.R, R/primitive-labels.R, R/primitive-line.R, +% R/primitive-spacer.R, R/primitive-ticks.R, R/primitive-title.R \docType{data} \name{Compose} \alias{Compose} @@ -19,10 +19,11 @@ \alias{GizmoGrob} \alias{GizmoHistogram} \alias{GizmoStepcap} -\alias{GuideColourRing} +\alias{GuideColring} \alias{GuideSubtitle} \alias{PrimitiveBox} \alias{PrimitiveBracket} +\alias{PrimitiveFence} \alias{PrimitiveLabels} \alias{PrimitiveLine} \alias{PrimitiveSpacer} diff --git a/man/guide_axis_custom.Rd b/man/guide_axis_custom.Rd index 4d281d9..5358ca5 100644 --- a/man/guide_axis_custom.Rd +++ b/man/guide_axis_custom.Rd @@ -124,9 +124,9 @@ ggplot(msleep, aes(bodywt, brainwt)) + \seealso{ Other standalone guides: \code{\link{guide_axis_nested}()}, -\code{\link{guide_colour_ring}()}, -\code{\link{guide_colourbar_custom}()}, -\code{\link{guide_coloursteps_custom}()}, +\code{\link{guide_colbar}()}, +\code{\link{guide_colring}()}, +\code{\link{guide_colsteps}()}, \code{\link{guide_subtitle}()} } \concept{standalone guides} diff --git a/man/guide_axis_nested.Rd b/man/guide_axis_nested.Rd index 94bddb5..c799146 100644 --- a/man/guide_axis_nested.Rd +++ b/man/guide_axis_nested.Rd @@ -15,7 +15,7 @@ guide_axis_nested( bidi = FALSE, oob = "squish", drop_zero = TRUE, - pad_discrete = 0.4, + pad_discrete = NULL, levels_text = NULL, ..., order = 0, @@ -87,8 +87,8 @@ the \code{drop_zero} setting.} \item{levels_text}{A list of \verb{} objects to customise how text appears at every level.} -\item{...}{Arguments passed on to \code{\link[=primitive_bracket]{primitive_bracket()}} or -\code{\link[=primitive_box]{primitive_box()}}.} +\item{...}{Arguments passed on to \code{\link[=primitive_bracket]{primitive_bracket()}}, +\code{\link[=primitive_box]{primitive_box()}} or \code{\link[=primitive_fence]{primitive_fence()}}.} \item{order}{A positive \verb{} that specifies the order of this guide among multiple guides. This controls in which order guides are merged if there @@ -108,8 +108,8 @@ be used to infer nesting structure from labels or annotate ranges. \details{ Under the hood, this guide is a \link[=compose_stack]{stack composition} of a \link[=primitive_line]{line}, \link[=primitive_ticks]{ticks}, optionally -\link[=primitive_labels]{labels} and either \link[=primitive_bracket]{bracket} or -\link[=primitive_box]{box} primitives. +\link[=primitive_labels]{labels} and either \link[=primitive_bracket]{bracket}, +\link[=primitive_box]{box} or \link[=primitive_fence]{fence} primitives. By default, the \code{\link[=key_range]{key = "range_auto"}} will incorporate the 0th level labels inferred from the scale's labels. These labels will look like @@ -143,6 +143,13 @@ p + guides(x = guide_axis_nested(bracket = "curvy")) p + guides(x = guide_axis_nested(type = "box")) + theme_guide(box = element_rect("limegreen", "forestgreen")) +# Using fences instead of brackets + styling of fences +p + guides(x = guide_axis_nested(type = "fence", rail = "inner")) + + theme_guide( + fence.post = element_line("tomato"), + fence.rail = element_line("dodgerblue") + ) + # Use as annotation of a typical axis # `regular_key` controls display of typical axis ggplot(mpg, aes(displ, hwy)) + @@ -155,9 +162,9 @@ ggplot(mpg, aes(displ, hwy)) + \seealso{ Other standalone guides: \code{\link{guide_axis_custom}()}, -\code{\link{guide_colour_ring}()}, -\code{\link{guide_colourbar_custom}()}, -\code{\link{guide_coloursteps_custom}()}, +\code{\link{guide_colbar}()}, +\code{\link{guide_colring}()}, +\code{\link{guide_colsteps}()}, \code{\link{guide_subtitle}()} } \concept{standalone guides} diff --git a/man/guide_colourbar_custom.Rd b/man/guide_colbar.Rd similarity index 91% rename from man/guide_colourbar_custom.Rd rename to man/guide_colbar.Rd index b401e90..ca4cd88 100644 --- a/man/guide_colourbar_custom.Rd +++ b/man/guide_colbar.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/guide_colourbar_custom.R -\name{guide_colourbar_custom} -\alias{guide_colourbar_custom} +% Please edit documentation in R/guide_colbar.R +\name{guide_colbar} +\alias{guide_colbar} \title{Custom colour bar guide} \usage{ -guide_colourbar_custom( +guide_colbar( title = waiver(), key = "auto", first_guide = "axis_custom", @@ -119,30 +119,30 @@ p <- ggplot(mpg, aes(displ, hwy)) + # The colourbar shows caps when values are out-of-bounds (oob) p + scale_colour_viridis_c( limits = c(10, NA), - guide = "colourbar_custom" + guide = "colbar" ) # It also shows how oob values are handled p + scale_colour_viridis_c( limits = c(10, NA), oob = scales::oob_squish, - guide = "colourbar_custom" + guide = "colbar" ) # Adjusting the type of cap p + scale_colour_viridis_c( limits = c(10, 30), oob = scales::oob_squish, - guide = guide_colourbar_custom(shape = "round") + guide = guide_colbar(shape = "round") ) # One-sided ticks p + scale_colour_viridis_c( - guide = guide_colourbar_custom(second_guide = "none") + guide = guide_colbar(second_guide = "none") ) # Colour bar with minor breaks p + scale_colour_viridis_c( minor_breaks = scales::breaks_width(1), - guide = guide_colourbar_custom(key = "minor") + guide = guide_colbar(key = "minor") ) # Using log ticks on a colourbar @@ -150,15 +150,15 @@ ggplot(msleep, aes(sleep_total, sleep_rem)) + geom_point(aes(colour = bodywt), na.rm = TRUE) + scale_colour_viridis_c( transform = "log10", - guide = guide_colourbar_custom(key = "log") + guide = guide_colbar(key = "log") ) } \seealso{ Other standalone guides: \code{\link{guide_axis_custom}()}, \code{\link{guide_axis_nested}()}, -\code{\link{guide_colour_ring}()}, -\code{\link{guide_coloursteps_custom}()}, +\code{\link{guide_colring}()}, +\code{\link{guide_colsteps}()}, \code{\link{guide_subtitle}()} } \concept{standalone guides} diff --git a/man/guide_colour_ring.Rd b/man/guide_colring.Rd similarity index 89% rename from man/guide_colour_ring.Rd rename to man/guide_colring.Rd index 29be4ea..3ba9ecb 100644 --- a/man/guide_colour_ring.Rd +++ b/man/guide_colring.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/guide_colour_ring.R -\name{guide_colour_ring} -\alias{guide_colour_ring} +% Please edit documentation in R/guide_colring.R +\name{guide_colring} +\alias{guide_colring} \title{Colour rings and arcs} \usage{ -guide_colour_ring( +guide_colring( title = waiver(), key = "auto", start = 0, @@ -89,28 +89,28 @@ p <- ggplot(mpg, aes(displ, hwy, colour = cty)) + scale_colour_gradientn(colours = my_pal) # Standard colour ring -p + guides(colour = "colour_ring") +p + guides(colour = "colring") # As an arc -p + guides(colour = guide_colour_ring( +p + guides(colour = guide_colring( start = 1.25 * pi, end = 2.75 * pi )) # Removing the inner tick marks -p + guides(colour = guide_colour_ring(inner_guide = "none")) +p + guides(colour = guide_colring(inner_guide = "none")) # Include labels on the inner axis -p + guides(colour = guide_colour_ring(show_labels = "both")) +p + guides(colour = guide_colring(show_labels = "both")) # Passing an argument to inner/outer guides -p + guides(colour = guide_colour_ring(angle = 0)) +p + guides(colour = guide_colring(angle = 0)) } \seealso{ Other standalone guides: \code{\link{guide_axis_custom}()}, \code{\link{guide_axis_nested}()}, -\code{\link{guide_colourbar_custom}()}, -\code{\link{guide_coloursteps_custom}()}, +\code{\link{guide_colbar}()}, +\code{\link{guide_colsteps}()}, \code{\link{guide_subtitle}()} } \concept{standalone guides} diff --git a/man/guide_coloursteps_custom.Rd b/man/guide_colsteps.Rd similarity index 91% rename from man/guide_coloursteps_custom.Rd rename to man/guide_colsteps.Rd index 22c7309..451d27b 100644 --- a/man/guide_coloursteps_custom.Rd +++ b/man/guide_colsteps.Rd @@ -1,10 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/guide_coloursteps_custom.R -\name{guide_coloursteps_custom} -\alias{guide_coloursteps_custom} +% Please edit documentation in R/guide_colsteps.R +\name{guide_colsteps} +\alias{guide_colsteps} \title{Custom colour steps guide} \usage{ -guide_coloursteps_custom( +guide_colsteps( title = waiver(), key = "bins", first_guide = "axis_custom", @@ -115,36 +115,36 @@ p <- ggplot(mpg, aes(displ, hwy)) + # The colour steps show caps when values are out-of-bounds p + scale_colour_viridis_b( limits = c(10, NA), - guide = "coloursteps_custom" + guide = "colsteps" ) # It also shows how oob values are handled p + scale_colour_viridis_b( limits = c(10, 30), oob = scales::oob_censor, - guide = "coloursteps_custom" + guide = "colsteps" ) # Adjusting the type of cap p + scale_colour_viridis_b( limits = c(10, 30), - guide = guide_coloursteps_custom(shape = "round") + guide = guide_colsteps(shape = "round") ) # The default is to use the breaks as-is p + scale_colour_viridis_b( limits = c(10, 30), breaks = c(10, 20, 25), - guide = "coloursteps_custom" + guide = "colsteps" ) # But the display can be set to use evenly spaced steps p + scale_colour_viridis_b( limits = c(10, 30), breaks = c(10, 20, 25), - guide = guide_coloursteps_custom(key = key_bins(even.steps = TRUE)) + guide = guide_colsteps(key = key_bins(even.steps = TRUE)) ) # Using tick marks by swapping side guides p + scale_colour_viridis_b( - guide = guide_coloursteps_custom( + guide = guide_colsteps( first_guide = "axis_custom", second_guide = "axis_custom" ) @@ -154,8 +154,8 @@ p + scale_colour_viridis_b( Other standalone guides: \code{\link{guide_axis_custom}()}, \code{\link{guide_axis_nested}()}, -\code{\link{guide_colour_ring}()}, -\code{\link{guide_colourbar_custom}()}, +\code{\link{guide_colbar}()}, +\code{\link{guide_colring}()}, \code{\link{guide_subtitle}()} } \concept{standalone guides} diff --git a/man/guide_subtitle.Rd b/man/guide_subtitle.Rd index ba1324e..eeb4bb4 100644 --- a/man/guide_subtitle.Rd +++ b/man/guide_subtitle.Rd @@ -100,8 +100,8 @@ p + guides(colour = guide_subtitle( Other standalone guides: \code{\link{guide_axis_custom}()}, \code{\link{guide_axis_nested}()}, -\code{\link{guide_colour_ring}()}, -\code{\link{guide_colourbar_custom}()}, -\code{\link{guide_coloursteps_custom}()} +\code{\link{guide_colbar}()}, +\code{\link{guide_colring}()}, +\code{\link{guide_colsteps}()} } \concept{standalone guides} diff --git a/man/primitive_box.Rd b/man/primitive_box.Rd index 93565bf..f2b2ab8 100644 --- a/man/primitive_box.Rd +++ b/man/primitive_box.Rd @@ -106,6 +106,7 @@ p + guides( \seealso{ Other primitives: \code{\link{primitive_bracket}()}, +\code{\link{primitive_fence}()}, \code{\link{primitive_labels}()}, \code{\link{primitive_line}()}, \code{\link{primitive_spacer}()}, diff --git a/man/primitive_bracket.Rd b/man/primitive_bracket.Rd index 809e356..ceb3523 100644 --- a/man/primitive_bracket.Rd +++ b/man/primitive_bracket.Rd @@ -115,6 +115,7 @@ p + guides( \seealso{ Other primitives: \code{\link{primitive_box}()}, +\code{\link{primitive_fence}()}, \code{\link{primitive_labels}()}, \code{\link{primitive_line}()}, \code{\link{primitive_spacer}()}, diff --git a/man/primitive_fence.Rd b/man/primitive_fence.Rd new file mode 100644 index 0000000..743e20f --- /dev/null +++ b/man/primitive_fence.Rd @@ -0,0 +1,125 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/primitive-fence.R +\name{primitive_fence} +\alias{primitive_fence} +\title{Guide primitive: fence} +\usage{ +primitive_fence( + key = "range_auto", + rail = "none", + angle = waiver(), + oob = "squish", + drop_zero = TRUE, + pad_discrete = 0.5, + levels_text = NULL, + levels_post = NULL, + levels_rail = NULL, + theme = NULL, + position = waiver() +) +} +\arguments{ +\item{key}{A \link[=key_range]{range key} specification. See more information +in the linked topic.} + +\item{rail}{A \verb{} giving an option for how to display fence +railing. Can be either \code{"none"} (default) to display no railings, \code{"inner"} +to draw one rail closer to the plot panel, \code{"outer"} to display one rail +farther from the plot panel, or \code{"both"} to sandwich the labels between +rails.} + +\item{angle}{A specification for the text angle. Compared to setting the \code{angle} argument +in \code{\link[ggplot2:element]{element_text()}}, this argument uses some +heuristics to automatically pick the \code{hjust} and \code{vjust} that you +probably want. Can be one of the following: +\itemize{ +\item \code{NULL} to take angles and justification settings directly from the theme. +\item \code{\link[ggplot2:waiver]{waiver()}} to allow reasonable defaults in special +cases. +\item A \verb{} between -360 and 360 for the text angle in degrees. +}} + +\item{oob}{A method for dealing with out-of-bounds (oob) ranges. Can be one +of \code{"squish"}, \code{"censor"} or \code{"none"}.} + +\item{drop_zero}{A \verb{} whether to drop near-zero width ranges +(\code{TRUE}, default) or preserve them (\code{FALSE}).} + +\item{pad_discrete}{A \verb{} giving the amount ranges should be +extended when given as a discrete variable. This is applied after +the \code{drop_zero} setting.} + +\item{levels_text}{A list of \verb{} objects to customise how +text appears at every level.} + +\item{levels_post, levels_rail}{A list of \verb{} objects to +customise how fence posts and rails are displayed at every level.} + +\item{theme}{A \code{\link[ggplot2:theme]{}} object to style the guide individually or +differently from the plot's theme settings. The \code{theme} argument in the +guide overrides and is combined with the plot's theme.} + +\item{position}{A \verb{} giving the location of the guide. Can be one of \code{"top"}, +\code{"bottom"}, \code{"left"} or \code{"right"}.} +} +\value{ +A \verb{} primitive guie that can be used inside other +guides. +} +\description{ +This function constructs a fence \link[=guide-primitives]{guide primitive}. The +customisation options are easier to understand if we view fence 'post' as the +vertical pieces of a real world fence, and the 'rail' as the horizontal +pieces. +} +\section{Styling options}{ +Below are the \link[ggplot2:theme]{theme} options that determine the styling of +this guide, which may differ depending on whether the guide is used in an +axis or legend context. + +Common to both types is the following: +\itemize{ +\item \code{gguidance.fence.post} an \code{\link[ggplot2:element]{}} for the +line used to draw the pieces orthogonal to the direction of the scale. +\item \code{gguidance.fence.rail} an \code{\link[ggplot2:element]{}} for the +line used to draw the pieces parallel to the direction of the scale. +} +\subsection{As an axis guide}{ +\itemize{ +\item \verb{axis.text.\{x/y\}.\{position\}} an \code{\link[ggplot2:element]{}} +for the text displayed. +} +} + +\subsection{As a legend guide}{ +\itemize{ +\item \code{legend.text} an \code{\link[ggplot2:element]{}} for the text +displayed. +} +} +} + +\examples{ +# A standard plot +p <- ggplot(mpg, aes(interaction(drv, year), displ)) + + geom_point() + +key <- key_range_manual(c(2, 4), c(5, 6), c("A", "B")) + +# Adding as secondary guides +p + guides( + x.sec = primitive_fence(rail = "inner"), + y.sec = primitive_fence(key = key, rail = "outer") +) +} +\seealso{ +Other primitives: +\code{\link{primitive_box}()}, +\code{\link{primitive_bracket}()}, +\code{\link{primitive_labels}()}, +\code{\link{primitive_line}()}, +\code{\link{primitive_spacer}()}, +\code{\link{primitive_ticks}()}, +\code{\link{primitive_title}()} +} +\concept{primitives} diff --git a/man/primitive_labels.Rd b/man/primitive_labels.Rd index a7417f8..7ec5736 100644 --- a/man/primitive_labels.Rd +++ b/man/primitive_labels.Rd @@ -83,6 +83,7 @@ p + guides( Other primitives: \code{\link{primitive_box}()}, \code{\link{primitive_bracket}()}, +\code{\link{primitive_fence}()}, \code{\link{primitive_line}()}, \code{\link{primitive_spacer}()}, \code{\link{primitive_ticks}()}, diff --git a/man/primitive_line.Rd b/man/primitive_line.Rd index 26d9fbc..94c2a28 100644 --- a/man/primitive_line.Rd +++ b/man/primitive_line.Rd @@ -77,6 +77,7 @@ p + guides( Other primitives: \code{\link{primitive_box}()}, \code{\link{primitive_bracket}()}, +\code{\link{primitive_fence}()}, \code{\link{primitive_labels}()}, \code{\link{primitive_spacer}()}, \code{\link{primitive_ticks}()}, diff --git a/man/primitive_spacer.Rd b/man/primitive_spacer.Rd index d11a9db..f2c7e2c 100644 --- a/man/primitive_spacer.Rd +++ b/man/primitive_spacer.Rd @@ -54,6 +54,7 @@ ggplot(mpg, aes(displ, hwy)) + Other primitives: \code{\link{primitive_box}()}, \code{\link{primitive_bracket}()}, +\code{\link{primitive_fence}()}, \code{\link{primitive_labels}()}, \code{\link{primitive_line}()}, \code{\link{primitive_ticks}()}, diff --git a/man/primitive_ticks.Rd b/man/primitive_ticks.Rd index bbbfbd4..d42b702 100644 --- a/man/primitive_ticks.Rd +++ b/man/primitive_ticks.Rd @@ -81,6 +81,7 @@ p + guides(x.sec = primitive_ticks(), y.sec = primitive_ticks()) Other primitives: \code{\link{primitive_box}()}, \code{\link{primitive_bracket}()}, +\code{\link{primitive_fence}()}, \code{\link{primitive_labels}()}, \code{\link{primitive_line}()}, \code{\link{primitive_spacer}()}, diff --git a/man/primitive_title.Rd b/man/primitive_title.Rd index 9892170..4e8db18 100644 --- a/man/primitive_title.Rd +++ b/man/primitive_title.Rd @@ -76,6 +76,7 @@ p + guides( Other primitives: \code{\link{primitive_box}()}, \code{\link{primitive_bracket}()}, +\code{\link{primitive_fence}()}, \code{\link{primitive_labels}()}, \code{\link{primitive_line}()}, \code{\link{primitive_spacer}()}, diff --git a/man/theme_guide.Rd b/man/theme_guide.Rd index b0bf420..d4b2f98 100644 --- a/man/theme_guide.Rd +++ b/man/theme_guide.Rd @@ -32,7 +32,10 @@ theme_guide( margin = NULL, bracket = NULL, bracket.size = NULL, - box = NULL + box = NULL, + fence = NULL, + fence.post = NULL, + fence.rail = NULL ) } \arguments{ @@ -110,6 +113,10 @@ element.} \item{box}{An \code{\link[ggplot2:element]{}} setting the \code{gguidance.box} element.} + +\item{fence, fence.post, fence.rail}{An +\code{\link[ggplot2:element]{}} setting the \code{gguidance.fence}, +\code{gguidance.fence.post} and \code{gguidance.fence.rail} respectively.} } \value{ A \verb{} object that can be provided to a guide. diff --git a/tests/testthat/_snaps/primitive-fence/primitive-facet-legend.svg b/tests/testthat/_snaps/primitive-fence/primitive-facet-legend.svg new file mode 100644 index 0000000..8af5d25 --- /dev/null +++ b/tests/testthat/_snaps/primitive-fence/primitive-facet-legend.svg @@ -0,0 +1,125 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +15 +20 +25 +30 +35 + + + + + + + + + + +100 +200 +300 +400 +disp +mpg + + + +A + + + +B + + +A + + +B + + + +C +primitive_facet legend + + diff --git a/tests/testthat/_snaps/primitive-fence/primitive-fence-cartesian.svg b/tests/testthat/_snaps/primitive-fence/primitive-fence-cartesian.svg new file mode 100644 index 0000000..0745c2b --- /dev/null +++ b/tests/testthat/_snaps/primitive-fence/primitive-fence-cartesian.svg @@ -0,0 +1,104 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +3 + + + +2 + + + +1 + + + + + + + +1999 +2008 +4 +f +r +4 +f +r +1999 +1999 +1999 +2008 +2008 +2008 + + + + + + + +4 +f +r +4 +f +r + + + +A +A + + + +B +B +displ +interaction(drv, year) +primitive_fence cartesian + + diff --git a/tests/testthat/_snaps/primitive-fence/primitive-fence-radial.svg b/tests/testthat/_snaps/primitive-fence/primitive-fence-radial.svg new file mode 100644 index 0000000..89e1de8 --- /dev/null +++ b/tests/testthat/_snaps/primitive-fence/primitive-fence-radial.svg @@ -0,0 +1,104 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +A +A + + + +B +B + + + +1 + + + +2 + + + +3 + + + + + + + +1999 +2008 +4 +f +r +4 +f +r +1999 +1999 +1999 +2008 +2008 +2008 + + + + + + + +4 +f +r +4 +f +r +displ +interaction(drv, year) +primitive_fence radial + + diff --git a/tests/testthat/test-guide_colour_ring.R b/tests/testthat/test-guide_colour_ring.R index 7b67e3f..2478442 100644 --- a/tests/testthat/test-guide_colour_ring.R +++ b/tests/testthat/test-guide_colour_ring.R @@ -1,4 +1,4 @@ -test_that("guide_colour_ring looks as it should", { +test_that("guide_colring looks as it should", { # vdiffr's device doesn't support clipping paths yet, so we just ignore # warnings for now @@ -17,7 +17,7 @@ test_that("guide_colour_ring looks as it should", { legend.axis.line = element_line(colour = "dodgerblue") )), theme = theme(gguidance.guide.spacing = unit(0, "cm"))) - standard_ring <- guides(colour = guide_colour_ring( + standard_ring <- guides(colour = guide_colring( nbin = 15, outer_guide = outline, inner_guide = outline )) @@ -27,7 +27,7 @@ test_that("guide_colour_ring looks as it should", { "standard ring", pring ) - pring <- p + guides(colour = guide_colour_ring( + pring <- p + guides(colour = guide_colring( nbin = 15, outer_guide = outline, inner_guide = outline, show_labels = "inner" )) @@ -50,7 +50,7 @@ test_that("guide_colour_ring looks as it should", { "conical", pring ) - pring <- p + guides(colour = guide_colour_ring( + pring <- p + guides(colour = guide_colring( nbin = 15, outer_guide = outline, inner_guide = outline, start = 0.25 * pi, end = 1.75 * pi )) diff --git a/tests/testthat/test-guide_colourbar_custom.R b/tests/testthat/test-guide_colourbar_custom.R index 23d7df1..d65a944 100644 --- a/tests/testthat/test-guide_colourbar_custom.R +++ b/tests/testthat/test-guide_colourbar_custom.R @@ -1,14 +1,14 @@ -test_that("guide_colourbar_custom works in all positions", { +test_that("guide_colbar works in all positions", { base <- ggplot(mtcars, aes(disp, mpg, colour = cyl)) + geom_point(shape = 21) + scale_colour_viridis_c( oob = oob_squish, guide = compose_stack( - guide_colourbar_custom(show = c(FALSE, FALSE)), - guide_colourbar_custom(show = c(TRUE, FALSE)), - guide_colourbar_custom(show = c(FALSE, TRUE)), - guide_colourbar_custom(show = c(TRUE, TRUE)) + guide_colbar(show = c(FALSE, FALSE)), + guide_colbar(show = c(TRUE, FALSE)), + guide_colbar(show = c(FALSE, TRUE)), + guide_colbar(show = c(TRUE, TRUE)) ) ) + theme( diff --git a/tests/testthat/test-guide_coloursteps_custom.R b/tests/testthat/test-guide_coloursteps_custom.R index 99368f5..2035f02 100644 --- a/tests/testthat/test-guide_coloursteps_custom.R +++ b/tests/testthat/test-guide_coloursteps_custom.R @@ -1,4 +1,4 @@ -test_that("guide_colourbar_custom works in all positions", { +test_that("guide_colsteps works in all positions", { key <- key_bins(show.limits = TRUE) base <- ggplot(mtcars, aes(disp, mpg, colour = cyl)) + @@ -6,10 +6,10 @@ test_that("guide_colourbar_custom works in all positions", { scale_colour_viridis_c( oob = oob_squish, guide = compose_stack( - guide_coloursteps_custom(show = c(FALSE, FALSE)), - guide_coloursteps_custom(show = c(TRUE, FALSE)), - guide_coloursteps_custom(show = c(FALSE, TRUE)), - guide_coloursteps_custom(show = c(TRUE, TRUE)) + guide_colsteps(show = c(FALSE, FALSE)), + guide_colsteps(show = c(TRUE, FALSE)), + guide_colsteps(show = c(FALSE, TRUE)), + guide_colsteps(show = c(TRUE, TRUE)) ) ) + theme( diff --git a/tests/testthat/test-primitive-fence.R b/tests/testthat/test-primitive-fence.R new file mode 100644 index 0000000..eee8f64 --- /dev/null +++ b/tests/testthat/test-primitive-fence.R @@ -0,0 +1,86 @@ + +test_that("primitive_fence works as axis", { + + base <- ggplot(mpg, aes(displ, interaction(drv, year))) + + geom_blank() + + theme_test() + + theme( + panel.background = element_rect(fill = NA, colour = "grey80"), + panel.grid.major = element_line(colour = "grey90"), + panel.border = element_blank(), + axis.line = element_line() + ) + + p <- base + + guides( + y = primitive_fence(rail = "both"), + y.sec = primitive_fence( + rail = "none", + key = key_range_auto(reverse = TRUE), drop_zero = FALSE + ), + x = primitive_fence( + rail = "inner", + key = key_range_manual(start = c(2, 4), end = c(5, 7), name = c("A\nA", "B\nB")), + levels_post = list(NULL, element_line("red")) + ), + x.sec = primitive_fence( + rail = "outer", + key = key_range_manual( + start = c(2, 4, 3), end = c(5, 7, 6), name = c("1", "2", "3"), + level = c(1, 2, 3) + ) + ) + ) + + vdiffr::expect_doppelganger("primitive_fence cartesian", p) + + p <- base + + coord_radial(start = 0.25 * pi, end = 1.75 * pi, inner.radius = 0.5) + + guides( + r = primitive_fence(rail = "both"), + r.sec = primitive_fence( + angle = 0, rail = "none", + key = key_range_auto(reverse = TRUE), drop_zero = FALSE + ), + theta = primitive_fence( + rail = "inner", + key = key_range_manual(start = c(2, 4), end = c(5, 7), name = c("A\nA", "B\nB")), + levels_post = list(NULL, element_line("red")) + ), + theta.sec = primitive_fence( + rail = "outer", + key = key_range_manual( + start = c(2, 4, 3), end = c(5, 7, 6), name = c("1", "2", "3"), + level = c(1, 2, 3) + ) + ) + ) + + vdiffr::expect_doppelganger("primitive_fence radial", p) +}) + + +test_that("primitive_bracket works as legend", { + + p <- ggplot(mtcars) + + aes( + x = disp, y = mpg, + colour = hp, + fill = hp + ) + + geom_point() + + guides( + colour = primitive_fence(key = key_range_manual( + c(100, 200), c(250, 300), c("A", "B") + ), rail = "outer"), + fill = primitive_fence(key = key_range_manual( + c(100, 150, 200), c(300, 300, 300), c("A", "B", "C") + ), position = "bottom", rail = "inner") + ) + + theme( + legend.box.just = "center" + ) + + vdiffr::expect_doppelganger("primitive_facet legend", p) + +}) diff --git a/vignettes/articles/keys.Rmd b/vignettes/articles/keys.Rmd index f9e1eeb..75d73dc 100644 --- a/vignettes/articles/keys.Rmd +++ b/vignettes/articles/keys.Rmd @@ -61,7 +61,7 @@ ggplot(msleep, aes(sleep_total, brainwt, colour = bodywt)) + scale_y_log10(guide = guide_axis_custom(key = logkey)) + scale_colour_viridis_c( trans = "log10", - guide = guide_colourbar_custom(key = logkey) + guide = guide_colbar(key = logkey) ) ``` diff --git a/vignettes/articles/tour.Rmd b/vignettes/articles/tour.Rmd index 623d053..538041a 100644 --- a/vignettes/articles/tour.Rmd +++ b/vignettes/articles/tour.Rmd @@ -235,8 +235,8 @@ First, we'll take a gander at some variants of colour bars before we gander at r Two variants for colour guides exist in {gguidance}: -1. `guide_colourbar_custom()` that reflects `guide_colourbar()` -2. `guide_coloursteps_custom()` that reflects `guide_coloursteps()`. +1. `guide_colbar()` that reflects `guide_colourbar()` +2. `guide_colsteps()` that reflects `guide_coloursteps()`. When used in a standard fashion, they look very similar to their vanilla counterparts. @@ -247,15 +247,15 @@ standard <- standard + labs(colour = "City Miles\nper Gallon") standard + - scale_colour_viridis_c(guide = "colourbar_custom") + + scale_colour_viridis_c(guide = "colbar") + labs(title = "Custom colour bar") standard + - scale_colour_viridis_b(guide = "coloursteps_custom") + + scale_colour_viridis_b(guide = "colsteps") + labs(title = "Custom colour steps") ``` -Please not that the following paragraphs apply equally to `guide_coloursteps_custom()`, but we'll take `guide_colourbar_custom()` for examples. +Please not that the following paragraphs apply equally to `guide_colsteps()`, but we'll take `guide_colbar()` for examples. #### Caps @@ -269,7 +269,7 @@ The bars display that these data are out-of-bounds by the gray 'caps' at the two standard + scale_colour_viridis_c( limits = c(10, 30), - guide = "colourbar_custom" + guide = "colbar" ) ``` @@ -279,7 +279,7 @@ You can change the out-of-bounds strategy, the `oob` argument of the scale, to h standard + scale_colour_viridis_c( limits = c(10, 30), oob = oob_squish, - guide = "colourbar_custom" + guide = "colbar" ) ``` @@ -288,7 +288,7 @@ You can also force the caps to appear, even when there are no out-of-bounds data ```{r} standard + scale_colour_viridis_c( - guide = guide_colourbar_custom( + guide = guide_colbar( show = c(FALSE, TRUE), oob = "squish" ) @@ -300,7 +300,7 @@ The shape of the cap needn't be a triangle. You can set the shape to any of the ```{r} standard + scale_colour_viridis_c( - guide = guide_colourbar_custom( + guide = guide_colbar( show = TRUE, oob = "squish", shape = "arch" ) @@ -350,7 +350,7 @@ hourglass_cap <- cbind( standard + scale_colour_viridis_c( - guide = guide_colourbar_custom( + guide = guide_colbar( show = TRUE, oob = "squish", shape = hourglass_cap ) @@ -365,7 +365,7 @@ It becomes easier to see once you wash away their make-up with `vanilla = FALSE` ```{r} standard + scale_colour_viridis_c( - guide = guide_colourbar_custom(vanilla = FALSE) + guide = guide_colbar(vanilla = FALSE) ) ``` @@ -384,7 +384,7 @@ brackets <- standard + scale_colour_viridis_c( minor_breaks = breaks_width(1), - guide = guide_colourbar_custom( + guide = guide_colbar( first_guide = guide_axis_custom("minor"), second_guide = brackets ) @@ -434,14 +434,14 @@ housing + ``` This is already much better, but the guide itself does a poor job of displaying the cyclical nature of months. -To have this better reflected in the guide, you can use `guide_colour_ring()`. +To have this better reflected in the guide, you can use `guide_colring()`. ```{r} housing + scale_colour_gradientn( colours = periodic_pal, limits = c(1, 13), breaks = 1:12, - guide = "colour_ring" + guide = "colring" ) ``` @@ -453,7 +453,7 @@ housing + scale_colour_gradientn( colours = periodic_pal, limits = c(1, 13), breaks = 1:12, minor_breaks = breaks_width(0.25), - guide = guide_colour_ring( + guide = guide_colring( outer_guide = guide_axis_custom("minor"), inner_guide = "none" )