1#' Positional scales for binning continuous data (x & y) 2#' 3#' `scale_x_binned()` and `scale_y_binned()` are scales that discretize 4#' continuous position data. You can use these scales to transform continuous 5#' inputs before using it with a geom that requires discrete positions. An 6#' example is using `scale_x_binned()` with [geom_bar()] to create a histogram. 7#' 8#' @inheritParams binned_scale 9#' 10#' @family position scales 11#' @name scale_binned 12#' @aliases NULL 13#' 14#' @examples 15#' # Create a histogram by binning the x-axis 16#' ggplot(mtcars) + 17#' geom_bar(aes(mpg)) + 18#' scale_x_binned() 19NULL 20 21#' @rdname scale_binned 22#' 23#' @export 24scale_x_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, 25 breaks = waiver(), labels = waiver(), limits = NULL, 26 expand = waiver(), oob = squish, na.value = NA_real_, 27 right = TRUE, show.limits = FALSE, trans = "identity", 28 guide = waiver(), position = "bottom") { 29 binned_scale( 30 ggplot_global$x_aes, 31 scale_name = "position_b", palette = identity, name = name, breaks = breaks, 32 labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, 33 n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, 34 show.limits = show.limits, guide = guide, position = position, super = ScaleBinnedPosition 35 ) 36} 37 38#' @rdname scale_binned 39#' 40#' @export 41scale_y_binned <- function(name = waiver(), n.breaks = 10, nice.breaks = TRUE, 42 breaks = waiver(), labels = waiver(), limits = NULL, 43 expand = waiver(), oob = squish, na.value = NA_real_, 44 right = TRUE, show.limits = FALSE, trans = "identity", 45 guide = waiver(), position = "left") { 46 binned_scale( 47 ggplot_global$y_aes, 48 scale_name = "position_b", palette = identity, name = name, breaks = breaks, 49 labels = labels, limits = limits, expand = expand, oob = oob, na.value = na.value, 50 n.breaks = n.breaks, nice.breaks = nice.breaks, right = right, trans = trans, 51 show.limits = show.limits, guide = guide, position = position, super = ScaleBinnedPosition 52 ) 53} 54 55#' @rdname ggplot2-ggproto 56#' @format NULL 57#' @usage NULL 58#' @export 59ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned, 60 after.stat = FALSE, 61 62 train = function(self, x) { 63 if (!is.numeric(x)) { 64 abort("Binned scales only support continuous data") 65 } 66 67 if (length(x) == 0 || self$after.stat) return() 68 self$range$train(x) 69 }, 70 71 map = function(self, x, limits = self$get_limits()) { 72 breaks <- self$get_breaks(limits) 73 all_breaks <- unique(sort(c(limits[1], breaks, limits[2]))) 74 75 if (self$after.stat) { 76 # Backtransform to original scale 77 x_binned <- cut(x, seq_len(length(all_breaks) + 1) - 0.5, 78 labels = FALSE, 79 include.lowest = TRUE, 80 right = self$right 81 ) 82 (x - x_binned + .5) * diff(all_breaks)[x_binned] + all_breaks[x_binned] 83 } else { 84 x <- as.numeric(self$oob(x, limits)) 85 x <- ifelse(!is.na(x), x, self$na.value) 86 x_binned <- cut(x, all_breaks, 87 labels = FALSE, 88 include.lowest = TRUE, 89 right = self$right 90 ) 91 92 x_binned # Return integer form so stat treat it like a discrete scale 93 } 94 }, 95 reset = function(self) { 96 self$after.stat <- TRUE 97 limits <- self$get_limits() 98 breaks <- self$get_breaks(limits) 99 self$range$reset() 100 self$range$train(c(limits, breaks)) 101 }, 102 103 get_breaks = function(self, limits = self$get_limits()) { 104 breaks <- ggproto_parent(ScaleBinned, self)$get_breaks(limits) 105 if (self$show.limits) { 106 breaks <- sort(unique(c(self$get_limits(), breaks))) 107 } 108 breaks 109 } 110) 111