R/coord_panel_ranges.r

Defines functions coord_panel_ranges

Documented in coord_panel_ranges

#' @title Zoom in or out for specific facet panels
#' @description 任意のfacetパネルをズームする.
#' @param panel_ranges Limits of axes or an axis.
#' @param expand Add margin to each axes or an axis, Default: TRUE
#' @param default Is this the default coordinate system? If `FALSE` (the default),
#'   then replacing this coordinate system with another one creates a message alerting
#'   the user that the coordinate system is being replaced. If `TRUE`, that warning
#'   is suppressed. NOTE: This argument explanation was cited from ggplot2::coord_cartesian
#' @param clip Should drawing be clipped to the extent of the plot panel? A
#'   setting of `"on"` (the default) means yes, and a setting of `"off"`
#'   means no. In most cases, the default of `"on"` should not be changed,
#'   as setting `clip = "off"` can cause unexpected results. It allows
#'   drawing of data points anywhere on the plot, including in the plot margins. If
#'   limits are set via `xlim` and `ylim` and some data points fall outside those
#'   limits, then those data points may show up in places such as the axes, the
#'   legend, the plot title, or the plot margins. NOTE: This argument explanation
#'   was cited from ggplot2::coord_cartesian
#' @return ggproto object
#' @details See vignette("coord_panel_ranges")
#' @references
#'  \url{https://andburch.github.io/ggplot_facets}
#'  \url{https://stackoverflow.com/questions/63550588/ggplot2coord-cartesian-on-facets}
#' @examples
#' library(frabento)
#' library(ggplot2)
#' library(magrittr)
#' 
#' theme_set(theme_linedraw(base_family = "Helvetica", base_line_size = 0.3) +
#'           theme(aspect.ratio = 1/1, legend.position = c(0.75, 0.25)))
#' 
#' ggplot(iris, aes(x = Sepal.Length, y = Sepal.Width)) +
#'     geom_point(aes(color = Species)) +
#'     geom_rect(data = .  %>% dplyr::filter(Species == "versicolor"),
#'               xmin = 5.5, xmax = 6.5, ymin = 2.5, ymax = 3,
#'               color = "red", linewidth = 1, fill = NA) +
#'     facet_wrap(~ Species, scale = "free", ncol = 2) +
#'     coord_panel_ranges(panel_ranges = list(
#'         list(NULL),
#'         list(x = c(5.4, 6.6), y = c(2.4, 3.1)),
#'         list(NULL)
#'     ))
#' @seealso
#'  \code{\link[ggplot2]{ggproto}}
#'  \code{\link[ggplot2]{coord_cartesian}}
#' @rdname coord_panel_ranges
#' @import ggplot2
#' @export
coord_panel_ranges <- function(panel_ranges, expand = TRUE, default = FALSE,
                               clip = "on") {
    UniquePanelCoords <- ggplot2::ggproto(
      "UniquePanelCoords", ggplot2::CoordCartesian,

      num_of_panels = 1,
      panel_counter = 1,
      panel_ranges = NULL,

      setup_layout = function(self, layout, params) {
        self$num_of_panels <- length(unique(layout$PANEL))
        self$panel_counter <- 1
        layout
      },

      setup_panel_params =  function(self, scale_x, scale_y, params = list()) {
        if (!is.null(self$panel_ranges) & length(self$panel_ranges) != self$num_of_panels)
          stop("Number of panel ranges does not equal the number supplied")

        train_cartesian <- function(scale, limits, name, given_range = NULL) {
          if (is.null(given_range)) {
#         range <- ggplot2:::scale_range(scale, limits, self$expand)
              expansion <- ggplot2:::default_expansion(scale, expand = self$expand)
              range <- ggplot2:::expand_limits_scale(scale, expansion,
                                                     coord_limits = self$limits[[name]])
          } else {
              range <- given_range
          }

#       out <- scale$break_info(range)
#       out$arrange <- scale$axis_order()
#       names(out) <- paste(name, names(out), sep = ".")
#       out
          out <- list(
            ggplot2:::view_scale_primary(scale, limits, range),
            sec = ggplot2:::view_scale_secondary(scale, limits, range),
            arrange = scale$axis_order(),
            range = range
        )
        names(out) <- c(name, paste0(name, ".", names(out)[-1]))
        out
        }

        cur_panel_ranges <- self$panel_ranges[[self$panel_counter]]
        if (self$panel_counter < self$num_of_panels)
          self$panel_counter <- self$panel_counter + 1
        else
          self$panel_counter <- 1

        c(train_cartesian(scale_x, self$limits$x, "x", cur_panel_ranges$x),
          train_cartesian(scale_y, self$limits$y, "y", cur_panel_ranges$y))
      }
    )
    ggplot2::ggproto(NULL, UniquePanelCoords, panel_ranges = panel_ranges,
                     expand = expand, default = default, clip = clip)
}
JK-junkin/frabento documentation built on Oct. 20, 2023, noon