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