-
Notifications
You must be signed in to change notification settings - Fork 109
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge branch 'main' into date_leading_chars
- Loading branch information
Showing
55 changed files
with
1,063 additions
and
181 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
|
|
@@ -82,6 +82,89 @@ breaks_log <- function(n = 5, base = 10) { | |
| #' @rdname breaks_log | ||
| log_breaks <- breaks_log | ||
|
|
||
| #' Minor breaks for log-10 axes | ||
| #' | ||
| #' This break function is designed to mark every power, multiples of 5 and/or 1 | ||
| #' of that power for base 10. | ||
| #' | ||
| #' @param detail Any of `1`, `5` and `10` to mark multiples of | ||
| #' powers, multiples of 5 of powers or just powers respectively. | ||
| #' @param smallest Smallest absolute value to mark when the range includes | ||
| #' negative numbers. | ||
| #' | ||
| #' @return A function to generate minor ticks. | ||
| #' @export | ||
| #' | ||
| #' @examples | ||
| #' # Standard usage with log10 scale | ||
| #' demo_log10(c(1, 1e10), minor_breaks = minor_breaks_log()) | ||
| #' # Increasing detail over many powers | ||
| #' demo_log10(c(1, 1e10), minor_breaks = minor_breaks_log(detail = 1)) | ||
| #' # Adjusting until where to draw minor breaks | ||
| #' demo_continuous( | ||
| #' c(-1000, 1000), | ||
| #' transform = asinh_trans(), | ||
| #' minor_breaks = minor_breaks_log(smallest = 1) | ||
| #' ) | ||
| minor_breaks_log <- function(detail = NULL, smallest = NULL) { | ||
| if (!is.null(detail) && (!length(detail) == 1 || !detail %in% c(1, 5, 10))) { | ||
| cli::cli_abort("The {.arg detail} argument must be one of 1, 5 or 10.") | ||
| } | ||
| if (!is.null(smallest) && | ||
| (!length(smallest) == 1 || smallest < 1e-100 || !is.finite(smallest))) { | ||
| cli::cli_abort( | ||
| "The {.arg smallest} argument must be a finite, positive, non-zero number." | ||
| ) | ||
| } | ||
| force(smallest) | ||
| function(x, ...) { | ||
|
|
||
| has_negatives <- any(x <= 0) | ||
|
|
||
| if (has_negatives) { | ||
| large <- max(abs(x)) | ||
| small <- smallest %||% min(c(1, large) * 0.1) | ||
| x <- sort(c(small * 10, large)) | ||
| } | ||
|
|
||
| start <- floor(log10(min(x))) - 1L | ||
| end <- ceiling(log10(max(x))) + 1L | ||
|
|
||
| if (is.null(detail)) { | ||
| i <- findInterval(abs(end - start), c(8, 15), left.open = TRUE) + 1L | ||
| detail <- c(1, 5, 10)[i] | ||
| } | ||
|
|
||
| ladder <- 10^seq(start, end, by = 1L) | ||
| tens <- fives <- ones <- numeric() | ||
| if (detail %in% c(10, 5, 1)) { | ||
| tens <- ladder | ||
| } | ||
| if (detail %in% c(5, 1)) { | ||
| fives <- 5 * ladder | ||
| } | ||
| if (detail == 1) { | ||
| ones <- as.vector(outer(1:9, ladder)) | ||
| ones <- setdiff(ones, c(tens, fives)) | ||
| } | ||
|
|
||
| if (has_negatives) { | ||
| tens <- tens[tens >= small] | ||
| tens <- c(tens, -tens, 0) | ||
| fives <- fives[fives >= small] | ||
| fives <- c(fives, -fives) | ||
| ones <- ones[ones >= small] | ||
| ones <- c(ones, -ones) | ||
| } | ||
|
|
||
| ticks <- c(tens, fives, ones) | ||
| n <- c(length(tens), length(fives), length(ones)) | ||
|
|
||
| attr(ticks, "detail") <- rep(c(10, 5, 1), n) | ||
| ticks | ||
| } | ||
| } | ||
|
|
||
| #' @author Thierry Onkelinx, \email{[email protected]} | ||
| #' @noRd | ||
| log_sub_breaks <- function(rng, n = 5, base = 10) { | ||
|
|
||
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| Original file line number | Diff line number | Diff line change |
|---|---|---|
| @@ -1,30 +1,62 @@ | ||
| #' Label numbers in log format (10^3, 10^6, etc) | ||
| #' | ||
| #' `label_log()` displays numbers as base^exponent, using superscript formatting. | ||
| #' `label_log()` and `format_log()` display numbers as base^exponent, using | ||
| #' superscript formatting. `label_log()` returns expressions suitable for | ||
| #' labelling in scales, whereas `format_log()` returns deparsed text. | ||
| #' | ||
| #' | ||
| #' @param x A numeric vector to format | ||
| #' @param base Base of logarithm to use | ||
| #' @param digits Number of significant digits to show for the exponent. Argument | ||
| #' is passed on to [base::format()]. | ||
| #' @param signed Should a `+` or `-` be displayed as a prefix? The | ||
| #' default, `NULL`, displays signs if there are zeroes or negative numbers | ||
| #' present. | ||
| #' @param ... Passed on to `format()`. | ||
| #' @inherit label_number return | ||
| #' @seealso [breaks_log()] for the related breaks algorithm. | ||
| #' @export | ||
| #' @family labels for log scales | ||
| #' @examples | ||
| #' demo_log10(c(1, 1e5), labels = label_log()) | ||
| #' demo_log10(c(1, 1e5), breaks = breaks_log(base = 2), labels = label_log(base = 2)) | ||
| label_log <- function(base = 10, digits = 3) { | ||
| #' format_log(c(0.1, 1, 10)) | ||
| label_log <- function(base = 10, digits = 3, signed = NULL) { | ||
| function(x) { | ||
| if (length(x) == 0) { | ||
| return(expression()) | ||
| } | ||
|
|
||
| exponent <- format(log(x, base = base), digits = digits) | ||
| text <- paste0(base, "^", exponent) | ||
| text <- format_log(x, base = base, signed = signed, digits = digits) | ||
| ret <- parse_safe(text) | ||
|
|
||
| # restore NAs from input vector | ||
| ret[is.na(x)] <- NA | ||
|
|
||
| ret | ||
| } | ||
| } | ||
|
|
||
| #' @export | ||
| #' @rdname label_log | ||
| format_log <- function(x, base = 10, signed = NULL, ...) { | ||
|
|
||
| if (length(x) == 0) { | ||
| return(character()) | ||
| } | ||
| prefix <- rep("", length(x)) | ||
| finites <- x[is.finite(x)] | ||
|
|
||
| signed <- signed %||% any(finites <= 0) | ||
| if (signed) { | ||
| sign <- sign(x) | ||
| prefix[sign == +1] <- "+" | ||
| prefix[sign == -1] <- "-" | ||
| x <- abs(x) | ||
| x[x == 0] <- 1 | ||
| } | ||
|
|
||
| exponent <- format(zapsmall(log(x, base = base)), ...) | ||
| text <- paste0(prefix, base, "^", exponent) | ||
|
|
||
| if (signed) { | ||
| text[sign == 0] <- "0" | ||
| } | ||
| text[is.na(x)] <- NA | ||
|
|
||
| text | ||
| } |
Oops, something went wrong.