R/coord.R

In teunbrand/ggvctrcoords: Coordinates and scales for ggplot2 using the vctrs package

# User facing -------------------------------------------------------------

#' Cartesian coordinates for vctrs
#'
#' @inheritParams ggplot2::coord_cartesian
#'
#' @export
#'
#' @examples
#' NULL
coord_cartesian_vctr <- function(xlim = NULL, ylim = NULL,
                                 expand = TRUE, default = FALSE,
                                 clip = "on") {
  ggproto(NULL, CoordCartesianVctr,
          limits = list(x = xlim, y = ylim),
          expand = expand,
          default = default,
          clip = clip)
}

# ggproto -----------------------------------------------------------------

CoordCartesianVctr <- ggproto(
  "CoordCartesianVctr",
  CoordCartesian,
  setup_panel_params = function(self, scale_x, scale_y, params = list()) {
    c(
      view_scales_from_scale_vctr(scale_x, self$limits$x, self$expand),
      view_scales_from_scale_vctr(scale_y, self$limits$y, self$expand)
    )
  },
  transform = function(data, panel_params) {
    if (!inherits(panel_params$x$scale, "ScaleContinuousVctr") &&
        !inherits(panel_params$y$scale, "ScaleContinuousVctr")) {
      return(ggproto_parent(CoordCartesian, self)$transform(data, panel_params))
    }
    oldclass <- class(data)
    data <- unclass(data)
    scales <- ggplot2:::aes_to_scale(names(data))

    is_x <- scales == "x"
    xtypes <- names(data)[is_x]

    is_y <- scales == "y"
    ytypes <- names(data)[is_y]

    if (inherits(panel_params$x$scale, "ScaleContinuousVctr")) {
      trans_x <- panel_params$x$scale$final_transformer
      if (!is.null(trans_x)) {
        data[is_x] <- mapply(trans_x, x = data[is_x],
                             limits = panel_params$x$continuous_range,
                             method = xtypes, SIMPLIFY = FALSE)
      }
    } else {
      trans_x <- panel_params$x$rescale
      if (!is.null(trans_x)) {
        data[is_x] <- lapply(data[is_x], trans_x)
      }
    }

    if (inherits(panel_params$y$scale, "ScaleContinuousVctr")) {
      trans_y <- panel_params$y$scale$final_transformer
      if (!is.null(trans_y)) {
        data[is_y] <- mapply(trans_y, y = data[is_y],
                             limits = panel_params$y$continuous_range,
                             method = ytypes, SIMPLIFY = FALSE)
      }
    } else {
      trans_y <- panel_params$y$rescale
      if (!is.null(trans_y)) {
        data[is_y] <- lapply(data[is_y], trans_y)
      }
    }

    class(data) <- oldclass
    # At this point the data should be ready to be fed into drawing functions
    ggplot2:::transform_position(data,
                                 scales::squish_infinite,
                                 scales::squish_infinite)
  }
)