|
| 1 | +#' @include guide-axis.R |
| 2 | +NULL |
| 3 | + |
| 4 | +#' Axis with logarithmic tick marks |
| 5 | +#' |
| 6 | +#' This axis guide replaces the placement of ticks marks at intervals in |
| 7 | +#' log10 space. |
| 8 | +#' |
| 9 | +#' @param long,mid,short A [grid::unit()] object or [rel()] object setting |
| 10 | +#' the (relative) length of the long, middle and short ticks. Numeric values |
| 11 | +#' are interpreted as [rel()] objects. The [rel()] values are used to multiply |
| 12 | +#' values of the `axis.ticks.length` theme setting. |
| 13 | +#' @param prescale_base Base of logarithm used to transform data manually. The |
| 14 | +#' default, `NULL`, will use the scale transformation to calculate positions. |
| 15 | +#' Only set `prescale_base` if the data has already been log-transformed. |
| 16 | +#' When using a log-transform in the position scale or in `coord_trans()`, |
| 17 | +#' keep the default `NULL` argument. |
| 18 | +#' @param negative_small When the scale limits include 0 or negative numbers, |
| 19 | +#' what should be the smallest absolute value that is marked with a tick? |
| 20 | +#' @param short_theme A theme [element][element_line()] for customising the |
| 21 | +#' display of the shortest ticks. Must be a line or blank element, and |
| 22 | +#' it inherits from the `axis.minor.ticks` setting for the relevant position. |
| 23 | +#' @param expanded Whether the ticks should cover the range after scale |
| 24 | +#' expansion (`TRUE`, default), or be restricted to the scale limits |
| 25 | +#' (`FALSE`). |
| 26 | +#' @inheritParams guide_axis |
| 27 | +#' @inheritDotParams guide_axis -minor.ticks |
| 28 | +#' |
| 29 | +#' @export |
| 30 | +#' |
| 31 | +#' @examples |
| 32 | +#' # A standard plot |
| 33 | +#' p <- ggplot(msleep, aes(bodywt, brainwt)) + |
| 34 | +#' geom_point(na.rm = TRUE) |
| 35 | +#' |
| 36 | +#' # The logticks axis works well with log scales |
| 37 | +#' p + scale_x_log10(guide = "axis_logticks") + |
| 38 | +#' scale_y_log10(guide = "axis_logticks") |
| 39 | +#' |
| 40 | +#' # Or with log-transformed coordinates |
| 41 | +#' p + coord_trans(x = "log10", y = "log10") + |
| 42 | +#' guides(x = "axis_logticks", y = "axis_logticks") |
| 43 | +#' |
| 44 | +#' # When data is transformed manually, one should provide `prescale_base` |
| 45 | +#' # Keep in mind that this axis uses log10 space for placement, not log2 |
| 46 | +#' p + aes(x = log2(bodywt), y = log10(brainwt)) + |
| 47 | +#' guides( |
| 48 | +#' x = guide_axis_logticks(prescale_base = 2), |
| 49 | +#' y = guide_axis_logticks(prescale_base = 10) |
| 50 | +#' ) |
| 51 | +#' |
| 52 | +#' # A plot with both positive and negative extremes, pseudo-log transformed |
| 53 | +#' set.seed(42) |
| 54 | +#' p2 <- ggplot(data.frame(x = rcauchy(1000)), aes(x = x)) + |
| 55 | +#' geom_density() + |
| 56 | +#' scale_x_continuous( |
| 57 | +#' breaks = c(-10^(4:0), 0, 10^(0:4)), |
| 58 | +#' trans = "pseudo_log" |
| 59 | +#' ) |
| 60 | +#' |
| 61 | +#' # The log ticks are mirrored when 0 is included |
| 62 | +#' p2 + guides(x = "axis_logticks") |
| 63 | +#' |
| 64 | +#' # To control the tick density around 0, one can set `negative_small` |
| 65 | +#' p2 + guides(x = guide_axis_logticks(negative_small = 1)) |
| 66 | +guide_axis_logticks <- function( |
| 67 | + long = 2.25, |
| 68 | + mid = 1.5, |
| 69 | + short = 0.75, |
| 70 | + prescale_base = NULL, |
| 71 | + negative_small = 0.1, |
| 72 | + short_theme = element_line(), |
| 73 | + expanded = TRUE, |
| 74 | + cap = "none", |
| 75 | + ... |
| 76 | +) { |
| 77 | + if (is.logical(cap)) { |
| 78 | + check_bool(cap) |
| 79 | + cap <- if (cap) "both" else "none" |
| 80 | + } |
| 81 | + cap <- arg_match0(cap, c("none", "both", "upper", "lower")) |
| 82 | + |
| 83 | + if (is_bare_numeric(long)) long <- rel(long) |
| 84 | + if (is_bare_numeric(mid)) mid <- rel(mid) |
| 85 | + if (is_bare_numeric(short)) short <- rel(short) |
| 86 | + |
| 87 | + check_fun <- function(x) (is.rel(x) || is.unit(x)) && length(x) == 1 |
| 88 | + what <- "a {.cls rel} or {.cls unit} object of length 1" |
| 89 | + check_object(long, check_fun, what) |
| 90 | + check_object(mid, check_fun, what) |
| 91 | + check_object(short, check_fun, what) |
| 92 | + check_number_decimal( |
| 93 | + negative_small, min = 1e-100, # minimal domain of scales::log_trans |
| 94 | + allow_infinite = FALSE, |
| 95 | + allow_null = TRUE |
| 96 | + ) |
| 97 | + check_bool(expanded) |
| 98 | + check_inherits(short_theme, c("element_blank", "element_line")) |
| 99 | + |
| 100 | + new_guide( |
| 101 | + available_aes = c("x", "y"), |
| 102 | + prescale_base = prescale_base, |
| 103 | + negative_small = negative_small, |
| 104 | + expanded = expanded, |
| 105 | + long = long, |
| 106 | + mid = mid, |
| 107 | + short = short, |
| 108 | + cap = cap, |
| 109 | + minor.ticks = TRUE, |
| 110 | + short_theme = short_theme, |
| 111 | + ..., |
| 112 | + super = GuideAxisLogticks |
| 113 | + ) |
| 114 | +} |
| 115 | + |
| 116 | +#' @rdname ggplot2-ggproto |
| 117 | +#' @format NULL |
| 118 | +#' @usage NULL |
| 119 | +#' @export |
| 120 | +GuideAxisLogticks <- ggproto( |
| 121 | + "GuideAxisLogticks", GuideAxis, |
| 122 | + |
| 123 | + params = defaults( |
| 124 | + list( |
| 125 | + prescale_base = NULL, |
| 126 | + negative_small = 0.1, |
| 127 | + minor.ticks = TRUE, # for spacing calculation |
| 128 | + long = 2.25, |
| 129 | + mid = 1.5, |
| 130 | + short = 0.75, |
| 131 | + expanded = TRUE, |
| 132 | + short_theme = NULL |
| 133 | + ), |
| 134 | + GuideAxis$params |
| 135 | + ), |
| 136 | + |
| 137 | + # Here we calculate a 'shadow key' that only applies to the tickmarks. |
| 138 | + extract_params = function(scale, params, ...) { |
| 139 | + |
| 140 | + if (scale$is_discrete()) { |
| 141 | + cli::cli_abort("Cannot calculate logarithmic ticks for discrete scales.") |
| 142 | + } |
| 143 | + |
| 144 | + aesthetic <- params$aesthetic |
| 145 | + params$name <- paste0(params$name, "_", aesthetic) |
| 146 | + params |
| 147 | + |
| 148 | + # Reconstruct a transformation if user has prescaled data |
| 149 | + if (!is.null(params$prescale_base)) { |
| 150 | + trans_name <- scale$scale$trans$name |
| 151 | + if (trans_name != "identity") { |
| 152 | + cli::cli_warn(paste0( |
| 153 | + "The {.arg prescale_base} argument will override the scale's ", |
| 154 | + "{.field {trans_name}} transformation in log-tick positioning." |
| 155 | + )) |
| 156 | + } |
| 157 | + trans <- log_trans(base = params$prescale_base) |
| 158 | + } else { |
| 159 | + trans <- scale$scale$trans |
| 160 | + } |
| 161 | + |
| 162 | + # Reconstruct original range |
| 163 | + limits <- trans$inverse(scale$get_limits()) |
| 164 | + has_negatives <- any(limits <= 0) |
| 165 | + |
| 166 | + if (!has_negatives) { |
| 167 | + start <- floor(log10(min(limits))) - 1L |
| 168 | + end <- ceiling(log10(max(limits))) + 1L |
| 169 | + } else { |
| 170 | + params$negative_small <- params$negative_small %||% 0.1 |
| 171 | + start <- floor(log10(abs(params$negative_small))) |
| 172 | + end <- ceiling(log10(max(abs(limits)))) + 1L |
| 173 | + } |
| 174 | + |
| 175 | + # Calculate tick marks |
| 176 | + tens <- 10^seq(start, end, by = 1) |
| 177 | + fives <- tens * 5 |
| 178 | + ones <- as.vector(outer(setdiff(2:9, 5), tens)) |
| 179 | + |
| 180 | + if (has_negatives) { |
| 181 | + # Filter and mirror ticks around 0 |
| 182 | + tens <- tens[tens >= params$negative_small] |
| 183 | + tens <- c(tens, -tens, 0) |
| 184 | + fives <- fives[fives >= params$negative_small] |
| 185 | + fives <- c(fives, -fives) |
| 186 | + ones <- ones[ones >= params$negative_small] |
| 187 | + ones <- c(ones, -ones) |
| 188 | + } |
| 189 | + |
| 190 | + # Set ticks back into transformed space |
| 191 | + ticks <- trans$transform(c(tens, fives, ones)) |
| 192 | + nticks <- c(length(tens), length(fives), length(ones)) |
| 193 | + |
| 194 | + logkey <- data_frame0( |
| 195 | + !!aesthetic := ticks, |
| 196 | + .type = rep(1:3, times = nticks) |
| 197 | + ) |
| 198 | + |
| 199 | + # Discard out-of-bounds ticks |
| 200 | + range <- if (params$expanded) scale$continuous_range else scale$get_limits() |
| 201 | + logkey <- vec_slice(logkey, ticks >= range[1] & ticks <= range[2]) |
| 202 | + |
| 203 | + # Adjust capping based on these ticks instead of regular ticks |
| 204 | + if (params$cap %in% c("both", "upper")) { |
| 205 | + params$decor[[aesthetic]][2] <- max(logkey[[aesthetic]]) |
| 206 | + } |
| 207 | + if (params$cap %in% c("both", "lower")) { |
| 208 | + params$decor[[aesthetic]][1] <- min(logkey[[aesthetic]]) |
| 209 | + } |
| 210 | + |
| 211 | + params$logkey <- logkey |
| 212 | + params |
| 213 | + }, |
| 214 | + |
| 215 | + transform = function(self, params, coord, panel_params) { |
| 216 | + params <- GuideAxis$transform(params, coord, panel_params) |
| 217 | + # Also transform the logkey |
| 218 | + params$logkey <- coord$transform(params$logkey, panel_params) |
| 219 | + params |
| 220 | + }, |
| 221 | + |
| 222 | + override_elements = function(params, elements, theme) { |
| 223 | + elements <- GuideAxis$override_elements(params, elements, theme) |
| 224 | + length <- elements$major_length |
| 225 | + |
| 226 | + # Inherit short ticks from minor ticks |
| 227 | + elements$short <- combine_elements(params$short_theme, elements$minor) |
| 228 | + |
| 229 | + # Multiply rel units with theme's tick length |
| 230 | + tick_length <- lapply(params[c("long", "mid", "short")], function(x) { |
| 231 | + if (is.unit(x)) x else unclass(x) * length |
| 232 | + }) |
| 233 | + tick_length <- inject(unit.c(!!!tick_length)) |
| 234 | + elements$tick_length <- tick_length |
| 235 | + |
| 236 | + # We replace the lengths so that spacing calculation works out as intended |
| 237 | + elements$major_length <- max(tick_length) |
| 238 | + elements$minor_length <- min(tick_length) |
| 239 | + elements |
| 240 | + }, |
| 241 | + |
| 242 | + build_ticks = function(key, elements, params, position = params$opposite) { |
| 243 | + # Instead of passing regular key, we pass the logkey |
| 244 | + key <- params$logkey |
| 245 | + long <- Guide$build_ticks( |
| 246 | + vec_slice(key, key$.type == 1L), |
| 247 | + elements$ticks, params, position, |
| 248 | + elements$tick_length[1L] |
| 249 | + ) |
| 250 | + |
| 251 | + mid <- Guide$build_ticks( |
| 252 | + vec_slice(key, key$.type == 2L), |
| 253 | + elements$minor, params, position, |
| 254 | + elements$tick_length[2L] |
| 255 | + ) |
| 256 | + |
| 257 | + short <- Guide$build_ticks( |
| 258 | + vec_slice(key, key$.type == 3L), |
| 259 | + elements$short, params, position, |
| 260 | + elements$tick_length[3L] |
| 261 | + ) |
| 262 | + grobTree(long, mid, short, name = "ticks") |
| 263 | + } |
| 264 | +) |
0 commit comments