1#' Transformed Cartesian coordinate system
2#'
3#' `coord_trans()` is different to scale transformations in that it occurs after
4#' statistical transformation and will affect the visual appearance of geoms - there is
5#' no guarantee that straight lines will continue to be straight.
6#'
7#' Transformations only work with continuous values: see
8#' [scales::trans_new()] for list of transformations, and instructions
9#' on how to create your own.
10#'
11#' @inheritParams coord_cartesian
12#' @param x,y Transformers for x and y axes or their names.
13#' @param limx,limy **Deprecated**: use `xlim` and `ylim` instead.
14#' @export
15#' @examples
16#' \donttest{
17#' # See ?geom_boxplot for other examples
18#'
19#' # Three ways of doing transformation in ggplot:
20#' #  * by transforming the data
21#' ggplot(diamonds, aes(log10(carat), log10(price))) +
22#'   geom_point()
23#' #  * by transforming the scales
24#' ggplot(diamonds, aes(carat, price)) +
25#'   geom_point() +
26#'   scale_x_log10() +
27#'   scale_y_log10()
28#' #  * by transforming the coordinate system:
29#' ggplot(diamonds, aes(carat, price)) +
30#'   geom_point() +
31#'   coord_trans(x = "log10", y = "log10")
32#'
33#' # The difference between transforming the scales and
34#' # transforming the coordinate system is that scale
35#' # transformation occurs BEFORE statistics, and coordinate
36#' # transformation afterwards.  Coordinate transformation also
37#' # changes the shape of geoms:
38#'
39#' d <- subset(diamonds, carat > 0.5)
40#'
41#' ggplot(d, aes(carat, price)) +
42#'   geom_point() +
43#'   geom_smooth(method = "lm") +
44#'   scale_x_log10() +
45#'   scale_y_log10()
46#'
47#' ggplot(d, aes(carat, price)) +
48#'   geom_point() +
49#'   geom_smooth(method = "lm") +
50#'   coord_trans(x = "log10", y = "log10")
51#'
52#' # Here I used a subset of diamonds so that the smoothed line didn't
53#' # drop below zero, which obviously causes problems on the log-transformed
54#' # scale
55#'
56#' # With a combination of scale and coordinate transformation, it's
57#' # possible to do back-transformations:
58#' ggplot(diamonds, aes(carat, price)) +
59#'   geom_point() +
60#'   geom_smooth(method = "lm") +
61#'   scale_x_log10() +
62#'   scale_y_log10() +
63#'   coord_trans(x = scales::exp_trans(10), y = scales::exp_trans(10))
64#'
65#' # cf.
66#' ggplot(diamonds, aes(carat, price)) +
67#'   geom_point() +
68#'   geom_smooth(method = "lm")
69#'
70#' # Also works with discrete scales
71#' df <- data.frame(a = abs(rnorm(26)),letters)
72#' plot <- ggplot(df,aes(a,letters)) + geom_point()
73#'
74#' plot + coord_trans(x = "log10")
75#' plot + coord_trans(x = "sqrt")
76#' }
77coord_trans <- function(x = "identity", y = "identity", xlim = NULL, ylim = NULL,
78                        limx = "DEPRECATED", limy = "DEPRECATED", clip = "on", expand = TRUE) {
79  if (!missing(limx)) {
80    warn("`limx` argument is deprecated; please use `xlim` instead.")
81    xlim <- limx
82  }
83  if (!missing(limy)) {
84    warn("`limy` argument is deprecated; please use `ylim` instead.")
85    ylim <- limy
86  }
87
88  # resolve transformers
89  if (is.character(x)) x <- as.trans(x)
90  if (is.character(y)) y <- as.trans(y)
91
92  ggproto(NULL, CoordTrans,
93    trans = list(x = x, y = y),
94    limits = list(x = xlim, y = ylim),
95    expand = expand,
96    clip = clip
97  )
98}
99
100
101#' @rdname ggplot2-ggproto
102#' @format NULL
103#' @usage NULL
104#' @export
105CoordTrans <- ggproto("CoordTrans", Coord,
106  is_free = function() TRUE,
107  distance = function(self, x, y, panel_params) {
108    max_dist <- dist_euclidean(panel_params$x.range, panel_params$y.range)
109    dist_euclidean(self$trans$x$transform(x), self$trans$y$transform(y)) / max_dist
110  },
111
112  backtransform_range = function(self, panel_params) {
113    list(
114      x = self$trans$x$inverse(panel_params$x.range),
115      y = self$trans$y$inverse(panel_params$y.range)
116    )
117  },
118
119  range = function(self, panel_params) {
120    list(
121      x = panel_params$x.range,
122      y = panel_params$y.range
123    )
124  },
125
126  transform = function(self, data, panel_params) {
127    trans_x <- function(data) transform_value(self$trans$x, data, panel_params$x.range)
128    trans_y <- function(data) transform_value(self$trans$y, data, panel_params$y.range)
129
130    new_data <- transform_position(data, trans_x, trans_y)
131
132    warn_new_infinites(data$x, new_data$x, "x")
133    warn_new_infinites(data$y, new_data$y, "y")
134
135    transform_position(new_data, squish_infinite, squish_infinite)
136  },
137
138  setup_panel_params = function(self, scale_x, scale_y, params = list()) {
139    c(
140      train_trans(scale_x, self$limits$x, self$trans$x, "x", self$expand),
141      train_trans(scale_y, self$limits$y, self$trans$y, "y", self$expand)
142    )
143  },
144
145  render_bg = function(panel_params, theme) {
146    guide_grid(
147      theme,
148      panel_params$x.minor,
149      panel_params$x.major,
150      panel_params$y.minor,
151      panel_params$y.major
152    )
153  },
154
155  render_axis_h = function(panel_params, theme) {
156    arrange <- panel_params$x.arrange %||% c("secondary", "primary")
157
158    list(
159      top = render_axis(panel_params, arrange[1], "x", "top", theme),
160      bottom = render_axis(panel_params, arrange[2], "x", "bottom", theme)
161    )
162  },
163
164  render_axis_v = function(panel_params, theme) {
165    arrange <- panel_params$y.arrange %||% c("primary", "secondary")
166
167    list(
168      left = render_axis(panel_params, arrange[1], "y", "left", theme),
169      right = render_axis(panel_params, arrange[2], "y", "right", theme)
170    )
171  }
172)
173
174transform_value <- function(trans, value, range) {
175  if (is.null(value))
176    return(value)
177  rescale(trans$transform(value), 0:1, range)
178}
179
180train_trans <- function(scale, coord_limits, trans, name, expand = TRUE) {
181  expansion <- default_expansion(scale, expand = expand)
182  scale_trans <- scale$trans %||% identity_trans()
183  coord_limits <- coord_limits %||% scale_trans$inverse(c(NA, NA))
184
185  if (scale$is_discrete()) {
186    continuous_ranges <- expand_limits_discrete_trans(
187      scale$get_limits(),
188      expansion,
189      coord_limits,
190      trans,
191      range_continuous = scale$range_c$range
192    )
193  } else {
194    # transform user-specified limits to scale transformed space
195    coord_limits <- scale$trans$transform(coord_limits)
196    continuous_ranges <- expand_limits_continuous_trans(
197      scale$get_limits(),
198      expansion,
199      coord_limits,
200      trans
201    )
202  }
203
204  # calculate break information
205  out <- scale$break_info(continuous_ranges$continuous_range)
206
207  # range in coord space has already been calculated
208  # needs to be in increasing order for transform_value() to work
209  out$range <- range(continuous_ranges$continuous_range_coord)
210
211  # major and minor values in coordinate data
212  out$major_source <- transform_value(trans, out$major_source, out$range)
213  out$minor_source <- transform_value(trans, out$minor_source, out$range)
214  out$sec.major_source <- transform_value(trans, out$sec.major_source, out$range)
215  out$sec.minor_source <- transform_value(trans, out$sec.minor_source, out$range)
216
217  out <- list(
218    range = out$range,
219    labels = out$labels,
220    major = out$major_source,
221    minor = out$minor_source,
222    sec.labels = out$sec.labels,
223    sec.major = out$sec.major_source,
224    sec.minor = out$sec.minor_source
225  )
226  names(out) <- paste(name, names(out), sep = ".")
227  out
228}
229
230#' Generate warning when finite values are transformed into infinite values
231#'
232#' @param old_values A vector of pre-transformation values.
233#' @param new_values A vector of post-transformation values.
234#' @param axis Which axis the values originate from (e.g. x, y).
235#' @noRd
236warn_new_infinites <- function(old_values, new_values, axis) {
237  if (any(is.finite(old_values) & !is.finite(new_values))) {
238    warn(glue("Transformation introduced infinite values in {axis}-axis"))
239  }
240}
241