R/breaks.R

In r-lib/scales: Scale Functions for Visualization

#' Equally spaced breaks
#'
#' Useful for numeric, date, and date-time scales.
#'
#' @param width Distance between each break. Either a number, or for
#'   date/times, a single string of the form `"{n} {unit}"`, e.g. "1 month",
#'   "5 days". Unit can be of one "sec", "min", "hour", "day", "week",
#'   "month", "year".
#' @param offset Use if you don't want breaks to start at zero, or on a
#'   conventional date or time boundary such as the 1st of January or midnight.
#'   Either a number, or for date/times, a single string of the form
#'   `"{n} {unit}"`, as for `width`.
#'
#'   `offset` can be a vector, which will accumulate in the order given. This
#'   is mostly useful for dates, where e.g. `c("3 months", "5 days")` will
#'   offset by three months and five days, which is useful for the UK tax year.
#'   Note that due to way that dates are rounded, there's no guarantee that
#'   `offset = c(x, y)` will give the same result as `offset = c(y, x)`.
#'
#' @return
#' All `breaks_()` functions return a function for generating breaks. These
#' functions takes, as their first argument a vector of values that represent
#' the data range to provide breaks for. Some will optionally take a second
#' argument that allows you to specify the number of breaks to recieve.
#'
#' @export
#' @examples
#' demo_continuous(c(0, 100))
#' demo_continuous(c(0, 100), breaks = breaks_width(10))
#' demo_continuous(c(0, 100), breaks = breaks_width(20, -4))
#' demo_continuous(c(0, 100), breaks = breaks_width(20, 4))
#'
#' # This is also useful for dates
#' one_month <- as.POSIXct(c("2020-05-01", "2020-06-01"))
#' demo_datetime(one_month)
#' demo_datetime(one_month, breaks = breaks_width("1 week"))
#' demo_datetime(one_month, breaks = breaks_width("5 days"))
#' # This is so useful that scale_x_datetime() has a shorthand:
#' demo_datetime(one_month, date_breaks = "5 days")
#'
#' # hms times also work
#' one_hour <- hms::hms(hours = 0:1)
#' demo_time(one_hour)
#' demo_time(one_hour, breaks = breaks_width("15 min"))
#' demo_time(one_hour, breaks = breaks_width("600 sec"))
#'
#' # Offets are useful for years that begin on dates other than the 1st of
#' # January, such as the UK financial year, which begins on the 1st of April.
#' three_years <- as.POSIXct(c("2020-01-01", "2021-01-01", "2022-01-01"))
#' demo_datetime(
#'   three_years,
#'   breaks = breaks_width("1 year", offset = "3 months")
#' )
#'
#' # The offset can be a vector, to create offsets that have compound units,
#' # such as the UK fiscal (tax) year, which begins on the 6th of April.
#' demo_datetime(
#'   three_years,
#'   breaks = breaks_width("1 year", offset = c("3 months", "5 days"))
#' )
breaks_width <- function(width, offset = 0) {
  force_all(width, offset)

  function(x) {
    x <- fullseq(x, width)
    for (i in offset) {
      x <- offset_by(x, i)
    }
    x
  }
}

#' Automatic breaks for numeric axes
#'
#' Uses Wilkinson's extended breaks algorithm as implemented in the
#' \pkg{labeling} package.
#'
#' @param n Desired number of breaks. You may get slightly more or fewer
#'   breaks that requested.
#' @param ... other arguments passed on to [labeling::extended()]
#'
#' @inherit breaks_width return
#'
#' @references Talbot, J., Lin, S., Hanrahan, P. (2010) An Extension of
#'  Wilkinson's Algorithm for Positioning Tick Labels on Axes, InfoVis
#'  2010 <http://vis.stanford.edu/files/2010-TickLabels-InfoVis.pdf>.
#' @export
#' @examples
#' demo_continuous(c(0, 10))
#' demo_continuous(c(0, 10), breaks = breaks_extended(3))
#' demo_continuous(c(0, 10), breaks = breaks_extended(10))
breaks_extended <- function(n = 5, ...) {
  n_default <- n
  function(x, n = n_default) {
    x <- x[is.finite(x)]
    if (length(x) == 0) {
      return(numeric())
    }

    rng <- range(x)
    labeling::extended(rng[1], rng[2], n, ...)
  }
}

#' @export
#' @usage NULL
#' @rdname breaks_extended
extended_breaks <- breaks_extended

#' Pretty breaks for date/times
#'
#' Uses default R break algorithm as implemented in [pretty()]. This is
#' primarily useful for date/times, as [extended_breaks()] should do a slightly
#' better job for numeric scales.
#'
#' @inheritParams breaks_extended
#' @param ... other arguments passed on to [pretty()]
#'
#' @inherit breaks_width return
#'
#' @export
#' @examples
#' one_month <- as.POSIXct(c("2020-05-01", "2020-06-01"))
#' demo_datetime(one_month)
#' demo_datetime(one_month, breaks = breaks_pretty(2))
#' demo_datetime(one_month, breaks = breaks_pretty(4))
#'
#' # Tightly spaced date breaks often need custom labels too
#' demo_datetime(one_month, breaks = breaks_pretty(12))
#' demo_datetime(one_month,
#'   breaks = breaks_pretty(12),
#'   labels = label_date_short()
#' )
breaks_pretty <- function(n = 5, ...) {
  force_all(n, ...)
  n_default <- n
  function(x, n = n_default) {
    if (zero_range(as.numeric(x))) {
      return(x[1])
    }
    breaks <- pretty(x, n, ...)
    names(breaks) <- attr(breaks, "labels")
    breaks
  }
}

#' Superseded interface to `breaks_pretty()`
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' These functions are kept for backward compatibility; you should switch
#' to [breaks_pretty()] for new code.
#'
#' @keywords internal
#' @export
#' @inheritParams breaks_pretty
pretty_breaks <- breaks_pretty

#' Breaks for timespan data
#'
#' As timespan units span a variety of bases (1000 below seconds, 60 for second
#' and minutes, 24 for hours, and 7 for days), the range of the input data
#' determines the base used for calculating breaks
#'
#' @param unit The unit used to interpret numeric data input
#'
#' @inherit breaks_width return
#'
#' @inheritParams breaks_extended
#' @export
#' @examples
#' demo_timespan(seq(0, 100), breaks = breaks_timespan())
#'
breaks_timespan <- function(unit = c("secs", "mins", "hours", "days", "weeks"), n = 5) {
  unit <- arg_match(unit)
  force(n)
  function(x) {
    x <- as.numeric(as.difftime(x, units = unit), units = "secs")
    rng <- range(x)
    diff <- rng[2] - rng[1]

    if (diff <= 2 * 60) {
      scale <- 1
    } else if (diff <= 2 * 3600) {
      scale <- 60
    } else if (diff <= 2 * 86400) {
      scale <- 3600
    } else if (diff <= 2 * 604800) {
      scale <- 86400
    } else {
      scale <- 604800
    }

    rng <- rng / scale
    breaks <- labeling::extended(
      rng[1], rng[2], n,
      Q = c(1, 2, 1.5, 4, 3),
      only.loose = FALSE
    )
    as.difftime(breaks * scale, units = "secs")
  }
}

#' Breaks for exponentially transformed data
#'
#' This breaks function typically labels zero and the last `n - 1` integers of a
#' range if that range is large enough (currently: 3). For smaller ranges, it
#' uses [`breaks_extended()`].
#'
#' @inheritParams breaks_extended
#'
#' @inherit breaks_width return
#' 
#' @export
#' @examples
#' # Small range
#' demo_continuous(c(100, 102), transform = "exp", breaks = breaks_exp())
#' # Large range
#' demo_continuous(c(0, 100), transform = "exp", breaks = breaks_exp(n = 4))
breaks_exp <- function(n = 5, ...) {
  n_default <- n
  default <- extended_breaks(n = n_default, ...)
  function(x, n = n_default) {
    # Discard -Infs
    x <- sort(pmax(x, 0))
    top <- floor(x[2])
    if (top >= 3 && abs(diff(x)) >= 3) {
      unique(c(top - seq_len(min(top, n_default - 1)) + 1, 0))
    } else {
      default(x)
    }
  }
}