diff --git a/NEWS.md b/NEWS.md index 254c49abd1..c4da2e4725 100644 --- a/NEWS.md +++ b/NEWS.md @@ -114,6 +114,7 @@ * More informative error for mismatched `direction`/`theme(legend.direction = ...)` arguments (#4364, #4930). * `guide_coloursteps()` and `guide_bins()` sort breaks (#5152). + * `guide_axis()` gains a `minor.ticks` argument to draw minor ticks (#4387). * `guide_axis()` gains a `cap` argument that can be used to trim the axis line to extreme breaks (#4907). * `guide_colourbar()` and `guide_coloursteps()` merge properly when one diff --git a/R/guide-.R b/R/guide-.R index ae774d30c9..a3f449b9ed 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -351,7 +351,14 @@ Guide <- ggproto( }, # Renders tickmarks - build_ticks = function(key, elements, params, position = params$position) { + build_ticks = function(key, elements, params, position = params$position, + length = elements$ticks_length) { + if (!inherits(elements, "element")) { + elements <- elements$ticks + } + if (!inherits(elements, "element_line")) { + return(zeroGrob()) + } if (!is.list(key)) { breaks <- key @@ -365,8 +372,7 @@ Guide <- ggproto( return(zeroGrob()) } - tick_len <- rep(elements$ticks_length %||% unit(0.2, "npc"), - length.out = n_breaks) + tick_len <- rep(length %||% unit(0.2, "npc"), length.out = n_breaks) # Resolve mark mark <- unit(rep(breaks, each = 2), "npc") @@ -375,12 +381,12 @@ Guide <- ggproto( pos <- unname(c(top = 1, bottom = 0, left = 0, right = 1)[position]) dir <- -2 * pos + 1 pos <- unit(rep(pos, 2 * n_breaks), "npc") - dir <- rep(vec_interleave(0, dir), n_breaks) * tick_len + dir <- rep(vec_interleave(dir, 0), n_breaks) * tick_len tick <- pos + dir # Build grob flip_element_grob( - elements$ticks, + elements, x = tick, y = mark, id.lengths = rep(2, n_breaks), flip = position %in% c("top", "bottom") diff --git a/R/guide-axis.R b/R/guide-axis.R index 581370b49d..6f15c1f23e 100644 --- a/R/guide-axis.R +++ b/R/guide-axis.R @@ -14,6 +14,8 @@ #' @param n.dodge The number of rows (for vertical axes) or columns (for #' horizontal axes) that should be used to render the labels. This is #' useful for displaying labels that would otherwise overlap. +#' @param minor.ticks Whether to draw the minor ticks (`TRUE`) or not draw +#' minor ticks (`FALSE`, default). #' @param cap A `character` to cut the axis line back to the last breaks. Can #' be `"none"` (default) to draw the axis line along the whole panel, or #' `"upper"` and `"lower"` to draw the axis to the upper or lower break, or @@ -42,16 +44,15 @@ #' # can also be used to add a duplicate guide #' p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis()) guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL, - n.dodge = 1, cap = "none", order = 0, - position = waiver()) { - + n.dodge = 1, minor.ticks = FALSE, cap = "none", + order = 0, position = waiver()) { + check_bool(minor.ticks) if (is.logical(cap)) { check_bool(cap) cap <- if (cap) "both" else "none" } cap <- arg_match0(cap, c("none", "both", "upper", "lower")) - new_guide( title = title, @@ -59,6 +60,7 @@ guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL, check.overlap = check.overlap, angle = angle, n.dodge = n.dodge, + minor.ticks = minor.ticks, cap = cap, # parameter @@ -87,6 +89,7 @@ GuideAxis <- ggproto( direction = NULL, angle = NULL, n.dodge = 1, + minor.ticks = FALSE, cap = "none", order = 0, check.overlap = FALSE @@ -100,9 +103,37 @@ GuideAxis <- ggproto( line = "axis.line", text = "axis.text", ticks = "axis.ticks", - ticks_length = "axis.ticks.length" + minor = "axis.minor.ticks", + major_length = "axis.ticks.length", + minor_length = "axis.minor.ticks.length" ), + extract_key = function(scale, aesthetic, minor.ticks, ...) { + major <- Guide$extract_key(scale, aesthetic, ...) + if (!minor.ticks) { + return(major) + } + + minor_breaks <- scale$get_breaks_minor() + minor_breaks <- setdiff(minor_breaks, major$.value) + minor_breaks <- minor_breaks[is.finite(minor_breaks)] + + if (length(minor_breaks) < 1) { + return(major) + } + + minor <- data_frame0(!!aesthetic := scale$map(minor_breaks)) + minor$.value <- minor_breaks + minor$.type <- "minor" + + if (nrow(major) > 0) { + major$.type <- "major" + vec_rbind(major, minor) + } else { + minor + } + }, + extract_params = function(scale, params, ...) { params$name <- paste0(params$name, "_", params$aesthetic) params @@ -185,7 +216,7 @@ GuideAxis <- ggproto( }, setup_elements = function(params, elements, theme) { - axis_elem <- c("line", "text", "ticks", "ticks_length") + axis_elem <- c("line", "text", "ticks", "minor", "major_length", "minor_length") is_char <- vapply(elements[axis_elem], is.character, logical(1)) axis_elem <- axis_elem[is_char] elements[axis_elem] <- lapply( @@ -225,26 +256,17 @@ GuideAxis <- ggproto( "horizontal" } - # TODO: delete following comment at some point: - # I found the 'position_*'/'non-position_*' and '*_dim' names confusing. - # For my own understanding, these have been renamed as follows: - # * 'aes' and 'orth_aes' for the aesthetic direction and the direction - # orthogonal to the aesthetic direction, respectively. - # * 'para_sizes' and 'orth_size(s)' for the dimension parallel to the - # aesthetic and orthogonal to the aesthetic respectively. - # I also tried to trim down the verbosity of the variable names a bit - new_params <- c("aes", "orth_aes", "para_sizes", "orth_size", "orth_sizes", "vertical", "measure_gtable", "measure_text") if (direction == "vertical") { params[new_params] <- list( "y", "x", "heights", "width", "widths", - TRUE, gtable_width, grobWidth + TRUE, gtable_width, width_cm ) } else { params[new_params] <- list( "x", "y", "widths", "height", "heights", - FALSE, gtable_height, grobHeight + FALSE, gtable_height, height_cm ) } @@ -275,7 +297,32 @@ GuideAxis <- ggproto( ) }, + build_ticks = function(key, elements, params, position = params$opposite) { + + major <- Guide$build_ticks( + vec_slice(key, (key$.type %||% "major") == "major"), + elements$ticks, params, position, + elements$major_length + ) + + if (!params$minor.ticks) { + return(major) + } + + minor <- Guide$build_ticks( + vec_slice(key, (key$.type %||% "major") == "minor"), + elements$minor, params, position, + elements$minor_length + ) + grobTree(major, minor, name = "ticks") + }, + build_labels = function(key, elements, params) { + + if (".type" %in% names(key)) { + key <- vec_slice(key, key$.type == "major") + } + labels <- validate_labels(key$.label) n_labels <- length(labels) @@ -309,10 +356,20 @@ GuideAxis <- ggproto( measure <- params$measure_text - length <- elements$ticks_length - spacer <- max(unit(0, "pt"), -1 * length) - labels <- do.call(unit.c, lapply(grobs$labels, measure)) - title <- measure(grobs$title) + # Ticks + major_cm <- convertUnit(elements$major_length, "cm", valueOnly = TRUE) + range <- range(0, major_cm) + if (params$minor.ticks && !inherits(elements$minor, "element_blank")) { + minor_cm <- convertUnit(elements$minor_length, "cm", valueOnly = TRUE) + range <- range(range, minor_cm) + } + + length <- unit(range[2], "cm") + spacer <- max(unit(0, "pt"), unit(-1 * diff(range), "cm")) + + # Text + labels <- unit(measure(grobs$label), "cm") + title <- unit(measure(grobs$title), "cm") sizes <- unit.c(length, spacer, labels, title) if (params$lab_first) { diff --git a/R/theme-defaults.R b/R/theme-defaults.R index fd565307bb..da315e2e25 100644 --- a/R/theme-defaults.R +++ b/R/theme-defaults.R @@ -147,6 +147,7 @@ theme_grey <- function(base_size = 11, base_family = "", axis.ticks.length.y = NULL, axis.ticks.length.y.left = NULL, axis.ticks.length.y.right = NULL, + axis.minor.ticks.length = rel(0.75), axis.title.x = element_text( margin = margin(t = half_line / 2), vjust = 1 @@ -478,6 +479,7 @@ theme_void <- function(base_size = 11, base_family = "", axis.ticks.length.y = NULL, axis.ticks.length.y.left = NULL, axis.ticks.length.y.right = NULL, + axis.minor.ticks.length = unit(0, "pt"), legend.box = NULL, legend.key.size = unit(1.2, "lines"), legend.position = "right", @@ -559,6 +561,7 @@ theme_test <- function(base_size = 11, base_family = "", axis.ticks.length.y = NULL, axis.ticks.length.y.left = NULL, axis.ticks.length.y.right = NULL, + axis.minor.ticks.length = rel(0.75), axis.title.x = element_text( margin = margin(t = half_line / 2), vjust = 1 diff --git a/R/theme-elements.R b/R/theme-elements.R index ba275e398c..4dda819879 100644 --- a/R/theme-elements.R +++ b/R/theme-elements.R @@ -441,12 +441,14 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { axis.line.y = el_def("element_line", "axis.line"), axis.line.y.left = el_def("element_line", "axis.line.y"), axis.line.y.right = el_def("element_line", "axis.line.y"), + axis.text.x = el_def("element_text", "axis.text"), axis.text.x.top = el_def("element_text", "axis.text.x"), axis.text.x.bottom = el_def("element_text", "axis.text.x"), axis.text.y = el_def("element_text", "axis.text"), axis.text.y.left = el_def("element_text", "axis.text.y"), axis.text.y.right = el_def("element_text", "axis.text.y"), + axis.ticks.length = el_def("unit"), axis.ticks.length.x = el_def(c("unit", "rel"), "axis.ticks.length"), axis.ticks.length.x.top = el_def(c("unit", "rel"), "axis.ticks.length.x"), @@ -454,12 +456,14 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { axis.ticks.length.y = el_def(c("unit", "rel"), "axis.ticks.length"), axis.ticks.length.y.left = el_def(c("unit", "rel"), "axis.ticks.length.y"), axis.ticks.length.y.right = el_def(c("unit", "rel"), "axis.ticks.length.y"), + axis.ticks.x = el_def("element_line", "axis.ticks"), axis.ticks.x.top = el_def("element_line", "axis.ticks.x"), axis.ticks.x.bottom = el_def("element_line", "axis.ticks.x"), axis.ticks.y = el_def("element_line", "axis.ticks"), axis.ticks.y.left = el_def("element_line", "axis.ticks.y"), axis.ticks.y.right = el_def("element_line", "axis.ticks.y"), + axis.title.x = el_def("element_text", "axis.title"), axis.title.x.top = el_def("element_text", "axis.title.x"), axis.title.x.bottom = el_def("element_text", "axis.title.x"), @@ -467,6 +471,27 @@ el_def <- function(class = NULL, inherit = NULL, description = NULL) { axis.title.y.left = el_def("element_text", "axis.title.y"), axis.title.y.right = el_def("element_text", "axis.title.y"), + axis.minor.ticks.x.top = el_def("element_line", "axis.ticks.x.top"), + axis.minor.ticks.x.bottom = el_def("element_line", "axis.ticks.x.bottom"), + axis.minor.ticks.y.left = el_def("element_line", "axis.ticks.y.left"), + axis.minor.ticks.y.right = el_def("element_line", "axis.ticks.y.right"), + + axis.minor.ticks.length = el_def(c("unit", "rel")), + axis.minor.ticks.length.x = el_def(c("unit", "rel"), "axis.minor.ticks.length"), + axis.minor.ticks.length.x.top = el_def( + c("unit", "rel"), c("axis.minor.ticks.length.x", "axis.ticks.length.x.top") + ), + axis.minor.ticks.length.x.bottom = el_def( + c("unit", "rel"), c("axis.minor.ticks.length.x", "axis.ticks.length.x.bottom") + ), + axis.minor.ticks.length.y = el_def(c("unit", "rel"), "axis.minor.ticks.length"), + axis.minor.ticks.length.y.left = el_def( + c("unit", "rel"), c("axis.minor.ticks.length.y", "axis.ticks.length.y.left") + ), + axis.minor.ticks.length.y.right = el_def( + c("unit", "rel"), c("axis.minor.ticks.length.y", "axis.ticks.length.y.right") + ), + legend.background = el_def("element_rect", "rect"), legend.margin = el_def("margin"), legend.spacing = el_def("unit"), diff --git a/R/theme.R b/R/theme.R index 33cf0244cd..fd4a445e32 100644 --- a/R/theme.R +++ b/R/theme.R @@ -48,8 +48,13 @@ #' `axis.ticks.y.left`, `axis.ticks.y.right`). `axis.ticks.*.*` inherits from #' `axis.ticks.*` which inherits from `axis.ticks`, which in turn inherits #' from `line` +#' @param axis.minor.ticks.x.top,axis.minor.ticks.x.bottom,axis.minor.ticks.y.left,axis.minor.ticks.y.right, +#' minor tick marks along axes ([element_line()]). `axis.minor.ticks.*.*` +#' inherit from the corresponding major ticks `axis.ticks.*.*`. #' @param axis.ticks.length,axis.ticks.length.x,axis.ticks.length.x.top,axis.ticks.length.x.bottom,axis.ticks.length.y,axis.ticks.length.y.left,axis.ticks.length.y.right #' length of tick marks (`unit`) +#' @param axis.minor.ticks.length,axis.minor.ticks.length.x,axis.minor.ticks.length.x.top,axis.minor.ticks.length.x.bottom,axis.minor.ticks.length.y,axis.minor.ticks.length.y.left,axis.minor.ticks.length.y.right +#' length of minor tick marks (`unit`), or relative to `axis.ticks.length` when provided with `rel()`. #' @param axis.line,axis.line.x,axis.line.x.top,axis.line.x.bottom,axis.line.y,axis.line.y.left,axis.line.y.right #' lines along axes ([element_line()]). Specify lines along all axes (`axis.line`), #' lines for each plane (using `axis.line.x` or `axis.line.y`), or individually @@ -302,6 +307,10 @@ theme <- function(line, axis.ticks.y, axis.ticks.y.left, axis.ticks.y.right, + axis.minor.ticks.x.top, + axis.minor.ticks.x.bottom, + axis.minor.ticks.y.left, + axis.minor.ticks.y.right, axis.ticks.length, axis.ticks.length.x, axis.ticks.length.x.top, @@ -309,6 +318,13 @@ theme <- function(line, axis.ticks.length.y, axis.ticks.length.y.left, axis.ticks.length.y.right, + axis.minor.ticks.length, + axis.minor.ticks.length.x, + axis.minor.ticks.length.x.top, + axis.minor.ticks.length.x.bottom, + axis.minor.ticks.length.y, + axis.minor.ticks.length.y.left, + axis.minor.ticks.length.y.right, axis.line, axis.line.x, axis.line.x.top, diff --git a/man/guide_axis.Rd b/man/guide_axis.Rd index 086ba0b25a..d2efadff8e 100644 --- a/man/guide_axis.Rd +++ b/man/guide_axis.Rd @@ -9,6 +9,7 @@ guide_axis( check.overlap = FALSE, angle = NULL, n.dodge = 1, + minor.ticks = FALSE, cap = "none", order = 0, position = waiver() @@ -31,6 +32,9 @@ you probably want.} horizontal axes) that should be used to render the labels. This is useful for displaying labels that would otherwise overlap.} +\item{minor.ticks}{Whether to draw the minor ticks (\code{TRUE}) or not draw +minor ticks (\code{FALSE}, default).} + \item{cap}{A \code{character} to cut the axis line back to the last breaks. Can be \code{"none"} (default) to draw the axis line along the whole panel, or \code{"upper"} and \code{"lower"} to draw the axis to the upper or lower break, or diff --git a/man/theme.Rd b/man/theme.Rd index e433fe7206..7672d42c5a 100644 --- a/man/theme.Rd +++ b/man/theme.Rd @@ -31,6 +31,10 @@ theme( axis.ticks.y, axis.ticks.y.left, axis.ticks.y.right, + axis.minor.ticks.x.top, + axis.minor.ticks.x.bottom, + axis.minor.ticks.y.left, + axis.minor.ticks.y.right, axis.ticks.length, axis.ticks.length.x, axis.ticks.length.x.top, @@ -38,6 +42,13 @@ theme( axis.ticks.length.y, axis.ticks.length.y.left, axis.ticks.length.y.right, + axis.minor.ticks.length, + axis.minor.ticks.length.x, + axis.minor.ticks.length.x.top, + axis.minor.ticks.length.x.bottom, + axis.minor.ticks.length.y, + axis.minor.ticks.length.y.left, + axis.minor.ticks.length.y.right, axis.line, axis.line.x, axis.line.x.top, @@ -139,8 +150,13 @@ for each axis (using \code{axis.ticks.x.bottom}, \code{axis.ticks.x.top}, \verb{axis.ticks.*} which inherits from \code{axis.ticks}, which in turn inherits from \code{line}} +\item{axis.minor.ticks.x.top, axis.minor.ticks.x.bottom, axis.minor.ticks.y.left, axis.minor.ticks.y.right, }{minor tick marks along axes (\code{\link[=element_line]{element_line()}}). \verb{axis.minor.ticks.*.*} +inherit from the corresponding major ticks \verb{axis.ticks.*.*}.} + \item{axis.ticks.length, axis.ticks.length.x, axis.ticks.length.x.top, axis.ticks.length.x.bottom, axis.ticks.length.y, axis.ticks.length.y.left, axis.ticks.length.y.right}{length of tick marks (\code{unit})} +\item{axis.minor.ticks.length, axis.minor.ticks.length.x, axis.minor.ticks.length.x.top, axis.minor.ticks.length.x.bottom, axis.minor.ticks.length.y, axis.minor.ticks.length.y.left, axis.minor.ticks.length.y.right}{length of minor tick marks (\code{unit}), or relative to \code{axis.ticks.length} when provided with \code{rel()}.} + \item{axis.line, axis.line.x, axis.line.x.top, axis.line.x.bottom, axis.line.y, axis.line.y.left, axis.line.y.right}{lines along axes (\code{\link[=element_line]{element_line()}}). Specify lines along all axes (\code{axis.line}), lines for each plane (using \code{axis.line.x} or \code{axis.line.y}), or individually for each axis (using \code{axis.line.x.bottom}, \code{axis.line.x.top}, diff --git a/tests/testthat/_snaps/geom-hex/hex-bin-plot-in-polar-coordinates.svg b/tests/testthat/_snaps/geom-hex/hex-bin-plot-in-polar-coordinates.svg index a1d64e9da4..a5d0e7ad77 100644 --- a/tests/testthat/_snaps/geom-hex/hex-bin-plot-in-polar-coordinates.svg +++ b/tests/testthat/_snaps/geom-hex/hex-bin-plot-in-polar-coordinates.svg @@ -166,14 +166,14 @@ count - - - - - - - - + + + + + + + + 2.5 5.0 7.5 diff --git a/tests/testthat/_snaps/geom-hex/hex-bin-plot-with-sqrt-transformed-y.svg b/tests/testthat/_snaps/geom-hex/hex-bin-plot-with-sqrt-transformed-y.svg index bb7623336a..3ef7c5378d 100644 --- a/tests/testthat/_snaps/geom-hex/hex-bin-plot-with-sqrt-transformed-y.svg +++ b/tests/testthat/_snaps/geom-hex/hex-bin-plot-with-sqrt-transformed-y.svg @@ -164,14 +164,14 @@ count - - - - - - - - + + + + + + + + 2.5 5.0 7.5 diff --git a/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg b/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg index 0e624b23b8..55c430bb5c 100644 --- a/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg +++ b/tests/testthat/_snaps/geom-hex/single-hex-bin-with-width-and-height-of-0-1.svg @@ -56,8 +56,8 @@ count - - + + 1 single hex bin with width and height of 0.1 diff --git a/tests/testthat/_snaps/geom-raster/1-x-3-just-0-0.svg b/tests/testthat/_snaps/geom-raster/1-x-3-just-0-0.svg index d6925d5277..3cda3a9d4a 100644 --- a/tests/testthat/_snaps/geom-raster/1-x-3-just-0-0.svg +++ b/tests/testthat/_snaps/geom-raster/1-x-3-just-0-0.svg @@ -57,16 +57,16 @@ z - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/geom-raster/1-x-3-set-limits.svg b/tests/testthat/_snaps/geom-raster/1-x-3-set-limits.svg index 0d7aa1e7e9..e2ebc6bbc9 100644 --- a/tests/testthat/_snaps/geom-raster/1-x-3-set-limits.svg +++ b/tests/testthat/_snaps/geom-raster/1-x-3-set-limits.svg @@ -59,16 +59,16 @@ z - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/geom-raster/1-x-3.svg b/tests/testthat/_snaps/geom-raster/1-x-3.svg index f5cf7f593a..40b3a41601 100644 --- a/tests/testthat/_snaps/geom-raster/1-x-3.svg +++ b/tests/testthat/_snaps/geom-raster/1-x-3.svg @@ -55,16 +55,16 @@ z - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/geom-raster/3-x-1-just-0-0.svg b/tests/testthat/_snaps/geom-raster/3-x-1-just-0-0.svg index 090bf3e379..22d38e2920 100644 --- a/tests/testthat/_snaps/geom-raster/3-x-1-just-0-0.svg +++ b/tests/testthat/_snaps/geom-raster/3-x-1-just-0-0.svg @@ -57,16 +57,16 @@ z - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/geom-raster/3-x-1-set-limits.svg b/tests/testthat/_snaps/geom-raster/3-x-1-set-limits.svg index f1493847f4..d979920d86 100644 --- a/tests/testthat/_snaps/geom-raster/3-x-1-set-limits.svg +++ b/tests/testthat/_snaps/geom-raster/3-x-1-set-limits.svg @@ -59,16 +59,16 @@ z - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/geom-raster/3-x-1.svg b/tests/testthat/_snaps/geom-raster/3-x-1.svg index 81c8824ccb..66a91af91e 100644 --- a/tests/testthat/_snaps/geom-raster/3-x-1.svg +++ b/tests/testthat/_snaps/geom-raster/3-x-1.svg @@ -55,16 +55,16 @@ z - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/geom-raster/3-x-2-just-0-0.svg b/tests/testthat/_snaps/geom-raster/3-x-2-just-0-0.svg index 9c47db029b..436e69545e 100644 --- a/tests/testthat/_snaps/geom-raster/3-x-2-just-0-0.svg +++ b/tests/testthat/_snaps/geom-raster/3-x-2-just-0-0.svg @@ -60,18 +60,18 @@ z - - - - - - - - - - - - + + + + + + + + + + + + 1 2 3 diff --git a/tests/testthat/_snaps/geom-raster/3-x-2-set-limits.svg b/tests/testthat/_snaps/geom-raster/3-x-2-set-limits.svg index 87dbec7788..3da4913fe1 100644 --- a/tests/testthat/_snaps/geom-raster/3-x-2-set-limits.svg +++ b/tests/testthat/_snaps/geom-raster/3-x-2-set-limits.svg @@ -62,18 +62,18 @@ z - - - - - - - - - - - - + + + + + + + + + + + + 1 2 3 diff --git a/tests/testthat/_snaps/geom-raster/3-x-2.svg b/tests/testthat/_snaps/geom-raster/3-x-2.svg index 3662119bd7..072a3983c2 100644 --- a/tests/testthat/_snaps/geom-raster/3-x-2.svg +++ b/tests/testthat/_snaps/geom-raster/3-x-2.svg @@ -58,18 +58,18 @@ z - - - - - - - - - - - - + + + + + + + + + + + + 1 2 3 diff --git a/tests/testthat/_snaps/guides/guide-bins-can-show-arrows.svg b/tests/testthat/_snaps/guides/guide-bins-can-show-arrows.svg index 3a553b96cc..442087e8c3 100644 --- a/tests/testthat/_snaps/guides/guide-bins-can-show-arrows.svg +++ b/tests/testthat/_snaps/guides/guide-bins-can-show-arrows.svg @@ -68,9 +68,9 @@ - - - + + + 1.5 2.0 2.5 diff --git a/tests/testthat/_snaps/guides/guide-bins-can-show-limits.svg b/tests/testthat/_snaps/guides/guide-bins-can-show-limits.svg index c398df926b..d2271a703e 100644 --- a/tests/testthat/_snaps/guides/guide-bins-can-show-limits.svg +++ b/tests/testthat/_snaps/guides/guide-bins-can-show-limits.svg @@ -66,11 +66,11 @@ - - - - - + + + + + 1 1.5 2.0 diff --git a/tests/testthat/_snaps/guides/guide-bins-can-show-ticks.svg b/tests/testthat/_snaps/guides/guide-bins-can-show-ticks.svg index 18d41ecf3e..27ba63dfb1 100644 --- a/tests/testthat/_snaps/guides/guide-bins-can-show-ticks.svg +++ b/tests/testthat/_snaps/guides/guide-bins-can-show-ticks.svg @@ -59,12 +59,12 @@ - - - - - - + + + + + + 1.5 2.0 3.0 diff --git a/tests/testthat/_snaps/guides/guide-bins-looks-as-it-should.svg b/tests/testthat/_snaps/guides/guide-bins-looks-as-it-should.svg index 39c44206df..14885226bf 100644 --- a/tests/testthat/_snaps/guides/guide-bins-looks-as-it-should.svg +++ b/tests/testthat/_snaps/guides/guide-bins-looks-as-it-should.svg @@ -66,9 +66,9 @@ - - - + + + 1.5 2.0 2.5 diff --git a/tests/testthat/_snaps/guides/guide-bins-sets-labels-when-limits-is-in-breaks.svg b/tests/testthat/_snaps/guides/guide-bins-sets-labels-when-limits-is-in-breaks.svg index b558c84e13..aadb4a0b81 100644 --- a/tests/testthat/_snaps/guides/guide-bins-sets-labels-when-limits-is-in-breaks.svg +++ b/tests/testthat/_snaps/guides/guide-bins-sets-labels-when-limits-is-in-breaks.svg @@ -297,11 +297,11 @@ - - - - - + + + + + 1 2 3 diff --git a/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins-2.svg b/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins-2.svg index 644678f65a..4139ddca47 100644 --- a/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins-2.svg +++ b/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins-2.svg @@ -297,11 +297,11 @@ - - - - - + + + + + 2000 2002 2004 diff --git a/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins-3.svg b/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins-3.svg index c0a8fc0cff..5a89f75984 100644 --- a/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins-3.svg +++ b/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins-3.svg @@ -297,12 +297,12 @@ - - - - - - + + + + + + 1999 2000 2002 diff --git a/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins.svg b/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins.svg index 837acb103a..db8bce73dd 100644 --- a/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins.svg +++ b/tests/testthat/_snaps/guides/guide-bins-understands-coinciding-limits-and-bins.svg @@ -297,11 +297,11 @@ - - - - - + + + + + 1999 2000 2002 diff --git a/tests/testthat/_snaps/guides/guide-bins-work-horizontally.svg b/tests/testthat/_snaps/guides/guide-bins-work-horizontally.svg index 3bddc3b3cb..587e0b20c3 100644 --- a/tests/testthat/_snaps/guides/guide-bins-work-horizontally.svg +++ b/tests/testthat/_snaps/guides/guide-bins-work-horizontally.svg @@ -66,9 +66,9 @@ - - - + + + 1.5 2.0 2.5 diff --git a/tests/testthat/_snaps/guides/guide-title-and-text-positioning-and-alignment-via-themes.svg b/tests/testthat/_snaps/guides/guide-title-and-text-positioning-and-alignment-via-themes.svg index 09233a4cf7..97e54fd3fb 100644 --- a/tests/testthat/_snaps/guides/guide-title-and-text-positioning-and-alignment-via-themes.svg +++ b/tests/testthat/_snaps/guides/guide-title-and-text-positioning-and-alignment-via-themes.svg @@ -58,14 +58,14 @@ x - - - - - - - - + + + + + + + + 25 50 75 diff --git a/tests/testthat/_snaps/guides/guides-with-minor-ticks.svg b/tests/testthat/_snaps/guides/guides-with-minor-ticks.svg new file mode 100644 index 0000000000..e661ca1969 --- /dev/null +++ b/tests/testthat/_snaps/guides/guides-with-minor-ticks.svg @@ -0,0 +1,139 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +10 +2 +10 +3 +10 +4 +10 +5 +100 +200 +300 +400 + + + + + + + + + + + + +100 +200 +300 +400 + + + + + + + + + +10 +2 +10 +3 +10 +4 +10 +5 +wt +disp +guides with minor ticks + + diff --git a/tests/testthat/_snaps/guides/horizontal-gap-of-1cm-between-guide-and-guide-text.svg b/tests/testthat/_snaps/guides/horizontal-gap-of-1cm-between-guide-and-guide-text.svg index 11b0044813..c3591ec4e8 100644 --- a/tests/testthat/_snaps/guides/horizontal-gap-of-1cm-between-guide-and-guide-text.svg +++ b/tests/testthat/_snaps/guides/horizontal-gap-of-1cm-between-guide-and-guide-text.svg @@ -58,16 +58,16 @@ y - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/guides/legend-inside-plot-bottom-left-of-legend-at-center.svg b/tests/testthat/_snaps/guides/legend-inside-plot-bottom-left-of-legend-at-center.svg index 2bf9fc2fa0..86ccc60920 100644 --- a/tests/testthat/_snaps/guides/legend-inside-plot-bottom-left-of-legend-at-center.svg +++ b/tests/testthat/_snaps/guides/legend-inside-plot-bottom-left-of-legend-at-center.svg @@ -54,16 +54,16 @@ 1:3 - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/guides/legend-inside-plot-bottom-left.svg b/tests/testthat/_snaps/guides/legend-inside-plot-bottom-left.svg index 2ccc33b55a..62b74251c4 100644 --- a/tests/testthat/_snaps/guides/legend-inside-plot-bottom-left.svg +++ b/tests/testthat/_snaps/guides/legend-inside-plot-bottom-left.svg @@ -54,16 +54,16 @@ 1:3 - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/guides/legend-inside-plot-centered.svg b/tests/testthat/_snaps/guides/legend-inside-plot-centered.svg index 7b5535e219..58268d3724 100644 --- a/tests/testthat/_snaps/guides/legend-inside-plot-centered.svg +++ b/tests/testthat/_snaps/guides/legend-inside-plot-centered.svg @@ -54,16 +54,16 @@ 1:3 - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/guides/legend-inside-plot-top-right.svg b/tests/testthat/_snaps/guides/legend-inside-plot-top-right.svg index 9e40f28f1d..4411920b60 100644 --- a/tests/testthat/_snaps/guides/legend-inside-plot-top-right.svg +++ b/tests/testthat/_snaps/guides/legend-inside-plot-top-right.svg @@ -54,16 +54,16 @@ 1:3 - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/guides/multi-line-guide-title-works.svg b/tests/testthat/_snaps/guides/multi-line-guide-title-works.svg index ff7dc3c3bf..3d9c7438f5 100644 --- a/tests/testthat/_snaps/guides/multi-line-guide-title-works.svg +++ b/tests/testthat/_snaps/guides/multi-line-guide-title-works.svg @@ -60,16 +60,16 @@ continuous colorscale - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/guides/one-combined-colorbar-for-colour-and-fill-aesthetics.svg b/tests/testthat/_snaps/guides/one-combined-colorbar-for-colour-and-fill-aesthetics.svg index b8ca13811b..9d656ece9f 100644 --- a/tests/testthat/_snaps/guides/one-combined-colorbar-for-colour-and-fill-aesthetics.svg +++ b/tests/testthat/_snaps/guides/one-combined-colorbar-for-colour-and-fill-aesthetics.svg @@ -58,20 +58,20 @@ value - - - - - - - - - - - - - - + + + + + + + + + + + + + + 1 2 3 diff --git a/tests/testthat/_snaps/guides/padding-in-legend-box.svg b/tests/testthat/_snaps/guides/padding-in-legend-box.svg index d55d3978fb..e8776944d0 100644 --- a/tests/testthat/_snaps/guides/padding-in-legend-box.svg +++ b/tests/testthat/_snaps/guides/padding-in-legend-box.svg @@ -54,16 +54,16 @@ 1:3 - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/guides/rotated-guide-titles-and-labels.svg b/tests/testthat/_snaps/guides/rotated-guide-titles-and-labels.svg index 1a4de9074b..fa41704f31 100644 --- a/tests/testthat/_snaps/guides/rotated-guide-titles-and-labels.svg +++ b/tests/testthat/_snaps/guides/rotated-guide-titles-and-labels.svg @@ -69,16 +69,16 @@ value - - - - - - - - - - + + + + + + + + + + 5.0 7.5 10.0 diff --git a/tests/testthat/_snaps/guides/vertical-gap-of-1cm-between-guide-title-and-guide.svg b/tests/testthat/_snaps/guides/vertical-gap-of-1cm-between-guide-title-and-guide.svg index 9abc788f7d..a2fd873e1e 100644 --- a/tests/testthat/_snaps/guides/vertical-gap-of-1cm-between-guide-title-and-guide.svg +++ b/tests/testthat/_snaps/guides/vertical-gap-of-1cm-between-guide-title-and-guide.svg @@ -58,16 +58,16 @@ y - - - - - - - - - - + + + + + + + + + + 1.0 1.5 2.0 diff --git a/tests/testthat/_snaps/guides/white-to-red-colorbar-thick-black-ticks-green-frame.svg b/tests/testthat/_snaps/guides/white-to-red-colorbar-thick-black-ticks-green-frame.svg index 8c10cc5ff0..a10cf6f3e1 100644 --- a/tests/testthat/_snaps/guides/white-to-red-colorbar-thick-black-ticks-green-frame.svg +++ b/tests/testthat/_snaps/guides/white-to-red-colorbar-thick-black-ticks-green-frame.svg @@ -59,16 +59,16 @@ x - - - - - - - - - - + + + + + + + + + + 0.0 0.5 1.0 diff --git a/tests/testthat/_snaps/guides/white-to-red-colorbar-white-ticks-no-frame.svg b/tests/testthat/_snaps/guides/white-to-red-colorbar-white-ticks-no-frame.svg index 16b1604f52..068063c944 100644 --- a/tests/testthat/_snaps/guides/white-to-red-colorbar-white-ticks-no-frame.svg +++ b/tests/testthat/_snaps/guides/white-to-red-colorbar-white-ticks-no-frame.svg @@ -58,16 +58,16 @@ x - - - - - - - - - - + + + + + + + + + + 0.0 0.5 1.0 diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R index 65ff1a6b4d..6f7e241c92 100644 --- a/tests/testthat/test-guides.R +++ b/tests/testthat/test-guides.R @@ -495,6 +495,31 @@ test_that("Axis titles won't be blown away by coord_*()", { # expect_doppelganger("guide titles with coord_sf()", plot + coord_sf()) }) +test_that("guide_axis() draws minor ticks correctly", { + p <- ggplot(mtcars, aes(wt, disp)) + + geom_point() + + theme(axis.ticks.length = unit(1, "cm"), + axis.ticks.x.bottom = element_line(linetype = 2), + axis.ticks.length.x.top = unit(-0.5, "cm"), + axis.minor.ticks.x.bottom = element_line(colour = "red"), + axis.minor.ticks.length.y.left = unit(-0.5, "cm"), + axis.minor.ticks.length.x.top = unit(-0.5, "cm"), + axis.minor.ticks.length.x.bottom = unit(0.75, "cm"), + axis.minor.ticks.length.y.right = unit(5, "cm")) + + scale_x_continuous(labels = math_format()) + + guides( + # Test for styling and style inheritance + x = guide_axis(minor.ticks = TRUE), + # # Test for opposed lengths + y = guide_axis(minor.ticks = TRUE), + # # Test for flipped lenghts + x.sec = guide_axis(minor.ticks = TRUE), + # # Test that minor.length doesn't influence spacing when no minor ticks are drawn + y.sec = guide_axis(minor.ticks = FALSE) + ) + expect_doppelganger("guides with minor ticks", p) +}) + test_that("absent titles don't take up space", { p <- ggplot(mtcars, aes(disp, mpg, colour = factor(cyl))) + diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R index 7bf37c90e1..e6e6cfdb55 100644 --- a/tests/testthat/test-theme.R +++ b/tests/testthat/test-theme.R @@ -509,6 +509,23 @@ test_that("Theme validation behaves as expected", { expect_snapshot_error(validate_element("A", "aspect.ratio", tree)) }) +test_that("Minor tick length supports biparental inheritance", { + my_theme <- theme_gray() + theme( + axis.ticks.length = unit(1, "cm"), + axis.ticks.length.y.left = unit(1, "pt"), + axis.minor.ticks.length.y = unit(1, "inch"), + axis.minor.ticks.length = rel(0.5) + ) + expect_equal( # Inherits rel(0.5) from minor, 1cm from major + calc_element("axis.minor.ticks.length.x.bottom", my_theme), + unit(1, "cm") * 0.5 + ) + expect_equal( # Inherits 1inch directly from minor + calc_element("axis.minor.ticks.length.y.left", my_theme), + unit(1, "inch") + ) +}) + # Visual tests ------------------------------------------------------------ test_that("aspect ratio is honored", {