1#' Cartesian coordinates 2#' 3#' The Cartesian coordinate system is the most familiar, and common, type of 4#' coordinate system. Setting limits on the coordinate system will zoom the 5#' plot (like you're looking at it with a magnifying glass), and will not 6#' change the underlying data like setting limits on a scale will. 7#' 8#' @param xlim,ylim Limits for the x and y axes. 9#' @param expand If `TRUE`, the default, adds a small expansion factor to 10#' the limits to ensure that data and axes don't overlap. If `FALSE`, 11#' limits are taken exactly from the data or `xlim`/`ylim`. 12#' @param default Is this the default coordinate system? If `FALSE` (the default), 13#' then replacing this coordinate system with another one creates a message alerting 14#' the user that the coordinate system is being replaced. If `TRUE`, that warning 15#' is suppressed. 16#' @param clip Should drawing be clipped to the extent of the plot panel? A 17#' setting of `"on"` (the default) means yes, and a setting of `"off"` 18#' means no. In most cases, the default of `"on"` should not be changed, 19#' as setting `clip = "off"` can cause unexpected results. It allows 20#' drawing of data points anywhere on the plot, including in the plot margins. If 21#' limits are set via `xlim` and `ylim` and some data points fall outside those 22#' limits, then those data points may show up in places such as the axes, the 23#' legend, the plot title, or the plot margins. 24#' @export 25#' @examples 26#' # There are two ways of zooming the plot display: with scales or 27#' # with coordinate systems. They work in two rather different ways. 28#' 29#' p <- ggplot(mtcars, aes(disp, wt)) + 30#' geom_point() + 31#' geom_smooth() 32#' p 33#' 34#' # Setting the limits on a scale converts all values outside the range to NA. 35#' p + scale_x_continuous(limits = c(325, 500)) 36#' 37#' # Setting the limits on the coordinate system performs a visual zoom. 38#' # The data is unchanged, and we just view a small portion of the original 39#' # plot. Note how smooth continues past the points visible on this plot. 40#' p + coord_cartesian(xlim = c(325, 500)) 41#' 42#' # By default, the same expansion factor is applied as when setting scale 43#' # limits. You can set the limits precisely by setting expand = FALSE 44#' p + coord_cartesian(xlim = c(325, 500), expand = FALSE) 45#' 46#' # Simiarly, we can use expand = FALSE to turn off expansion with the 47#' # default limits 48#' p + coord_cartesian(expand = FALSE) 49#' 50#' # You can see the same thing with this 2d histogram 51#' d <- ggplot(diamonds, aes(carat, price)) + 52#' stat_bin2d(bins = 25, colour = "white") 53#' d 54#' 55#' # When zooming the scale, the we get 25 new bins that are the same 56#' # size on the plot, but represent smaller regions of the data space 57#' d + scale_x_continuous(limits = c(0, 1)) 58#' 59#' # When zooming the coordinate system, we see a subset of original 50 bins, 60#' # displayed bigger 61#' d + coord_cartesian(xlim = c(0, 1)) 62coord_cartesian <- function(xlim = NULL, ylim = NULL, expand = TRUE, 63 default = FALSE, clip = "on") { 64 ggproto(NULL, CoordCartesian, 65 limits = list(x = xlim, y = ylim), 66 expand = expand, 67 default = default, 68 clip = clip 69 ) 70} 71 72#' @rdname ggplot2-ggproto 73#' @format NULL 74#' @usage NULL 75#' @export 76CoordCartesian <- ggproto("CoordCartesian", Coord, 77 78 is_linear = function() TRUE, 79 is_free = function() TRUE, 80 81 distance = function(x, y, panel_params) { 82 max_dist <- dist_euclidean(panel_params$x$dimension(), panel_params$y$dimension()) 83 dist_euclidean(x, y) / max_dist 84 }, 85 86 range = function(panel_params) { 87 list(x = panel_params$x$dimension(), y = panel_params$y$dimension()) 88 }, 89 90 backtransform_range = function(self, panel_params) { 91 self$range(panel_params) 92 }, 93 94 transform = function(data, panel_params) { 95 data <- transform_position(data, panel_params$x$rescale, panel_params$y$rescale) 96 transform_position(data, squish_infinite, squish_infinite) 97 }, 98 99 setup_panel_params = function(self, scale_x, scale_y, params = list()) { 100 c( 101 view_scales_from_scale(scale_x, self$limits$x, self$expand), 102 view_scales_from_scale(scale_y, self$limits$y, self$expand) 103 ) 104 }, 105 106 setup_panel_guides = function(self, panel_params, guides, params = list()) { 107 aesthetics <- c("x", "y", "x.sec", "y.sec") 108 names(aesthetics) <- aesthetics 109 110 # resolve the specified guide from the scale and/or guides 111 guides <- lapply(aesthetics, function(aesthetic) { 112 resolve_guide( 113 aesthetic, 114 panel_params[[aesthetic]], 115 guides, 116 default = guide_axis(), 117 null = guide_none() 118 ) 119 }) 120 121 # resolve the guide definition as a "guide" S3 122 guides <- lapply(guides, validate_guide) 123 124 # if there is an "position" specification in the scale, pass this on to the guide 125 # ideally, this should be specified in the guide 126 guides <- lapply(aesthetics, function(aesthetic) { 127 guide <- guides[[aesthetic]] 128 scale <- panel_params[[aesthetic]] 129 # position could be NULL here for an empty scale 130 guide$position <- guide$position %|W|% scale$position 131 guide 132 }) 133 134 panel_params$guides <- guides 135 panel_params 136 }, 137 138 train_panel_guides = function(self, panel_params, layers, default_mapping, params = list()) { 139 aesthetics <- c("x", "y", "x.sec", "y.sec") 140 names(aesthetics) <- aesthetics 141 142 panel_params$guides <- lapply(aesthetics, function(aesthetic) { 143 axis <- substr(aesthetic, 1, 1) 144 guide <- panel_params$guides[[aesthetic]] 145 guide <- guide_train(guide, panel_params[[aesthetic]]) 146 guide <- guide_transform(guide, self, panel_params) 147 guide <- guide_geom(guide, layers, default_mapping) 148 guide 149 }) 150 151 panel_params 152 }, 153 154 labels = function(self, labels, panel_params) { 155 positions_x <- c("top", "bottom") 156 positions_y <- c("left", "right") 157 158 list( 159 x = lapply(c(1, 2), function(i) { 160 panel_guide_label( 161 panel_params$guides, 162 position = positions_x[[i]], 163 default_label = labels$x[[i]] 164 ) 165 }), 166 y = lapply(c(1, 2), function(i) { 167 panel_guide_label( 168 panel_params$guides, 169 position = positions_y[[i]], 170 default_label = labels$y[[i]]) 171 }) 172 ) 173 }, 174 175 render_bg = function(panel_params, theme) { 176 guide_grid( 177 theme, 178 panel_params$x$break_positions_minor(), 179 panel_params$x$break_positions(), 180 panel_params$y$break_positions_minor(), 181 panel_params$y$break_positions() 182 ) 183 }, 184 185 render_axis_h = function(panel_params, theme) { 186 list( 187 top = panel_guides_grob(panel_params$guides, position = "top", theme = theme), 188 bottom = panel_guides_grob(panel_params$guides, position = "bottom", theme = theme) 189 ) 190 }, 191 192 render_axis_v = function(panel_params, theme) { 193 list( 194 left = panel_guides_grob(panel_params$guides, position = "left", theme = theme), 195 right = panel_guides_grob(panel_params$guides, position = "right", theme = theme) 196 ) 197 } 198) 199 200view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) { 201 expansion <- default_expansion(scale, expand = expand) 202 limits <- scale$get_limits() 203 continuous_range <- expand_limits_scale(scale, expansion, limits, coord_limits = coord_limits) 204 aesthetic <- scale$aesthetics[1] 205 206 view_scales <- list( 207 view_scale_primary(scale, limits, continuous_range), 208 sec = view_scale_secondary(scale, limits, continuous_range), 209 arrange = scale$axis_order(), 210 range = continuous_range 211 ) 212 names(view_scales) <- c(aesthetic, paste0(aesthetic, ".", names(view_scales)[-1])) 213 214 view_scales 215} 216 217panel_guide_label <- function(guides, position, default_label) { 218 guide <- guide_for_position(guides, position) %||% guide_none(title = NULL) 219 guide$title %|W|% default_label 220} 221 222panel_guides_grob <- function(guides, position, theme) { 223 guide <- guide_for_position(guides, position) %||% guide_none() 224 guide_gengrob(guide, theme) 225} 226 227guide_for_position <- function(guides, position) { 228 has_position <- vapply( 229 guides, 230 function(guide) identical(guide$position, position), 231 logical(1) 232 ) 233 234 guides <- guides[has_position] 235 guides_order <- vapply(guides, function(guide) as.numeric(guide$order)[1], numeric(1)) 236 Reduce(guide_merge, guides[order(guides_order)]) 237} 238