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