Re-write coord-sf to accept bbox

coord-sf-rewrite.R

add_bbox_nudge_x <- function (b, i) {
  if (length(i) == 1) {
    b[c(1, 3)] <- b[c(1, 3)] + c(i, -i)
  } else {
    b[c(1, 3)] <- b[c(1, 3)] + c(i[1], i[2])
  }
  
  b
}

add_bbox_nudge_y <- function (b, i) {
  if (length(i) == 1) {
    b[c(2, 4)] <- b[c(2, 4)] + c(i, -i)
  } else {
    b[c(2, 4)] <- b[c(2, 4)] + c(i[1], i[2])
  }
  
  b
}

st_xlim <- function (x) UseMethod("st_xlim")
st_xlim.sf   <- function (x) st_bbox(x)[c(1, 3)]
st_xlim.sfc  <- st_xlim.sf
st_xlim.bbox <- function (x) x[c(1, 3)]

st_ylim <- function (x) UseMethod("st_ylim")
st_ylim.sf   <- function (x) st_bbox(x)[c(2, 4)]
st_ylim.sfc  <- st_ylim.sf
st_ylim.bbox <- function (x) x[c(2, 4)]

st_xdist <- function (x) UseMethod("st_xdist")
st_ydist <- function (x) UseMethod("st_ydist")

st_xdist.sf <- function (x) {
  xlim <- st_xlim(x)
  xlim[2] - xlim[1]
}

st_xdist.sfc <- st_xdist.sf

st_xdist.bbox <- function (x) {
  x[2] - x[1]
}

st_ydist.sf <- function (x) {
  ylim <- st_ylim(x)
  ylim[2] - ylim[1]
}

st_ydist.sfc <- st_ydist.sf

st_ydist.bbox <- function (x) {
  x[2] - x[1]
}

coord_sf <- function (lims = NULL, xlim = NULL, ylim = NULL, expand = TRUE, crs = NULL, 
                      datum = sf::st_crs(4326), label_graticule = waiver(), label_axes = waiver(), 
                      ndiscr = 100, default = FALSE, clip = "on") {
  if (is.waive(label_graticule) && is.waive(label_axes)) {
    label_graticule <- ""
    label_axes <- "--EN"
  }
  else {
    label_graticule <- label_graticule %|W|% ""
    label_axes <- label_axes %|W|% ""
  }
  if (is.character(label_axes)) {
    label_axes <- parse_axes_labeling(label_axes)
  }
  else if (!is.list(label_axes)) {
    stop("Panel labeling format not recognized.", call. = FALSE)
    label_axes <- list(left = "N", bottom = "E")
  }
  if (is.character(label_graticule)) {
    label_graticule <- unlist(strsplit(label_graticule, ""))
  }
  else {
    stop("Graticule labeling format not recognized.", 
         call. = FALSE)
    label_graticule <- ""
  }
   
  if (!is.null(lims)) {
    xlim <- st_xlim(lims)
    ylim <- st_ylim(lims)
  }
  
  ggproto(NULL, CoordSf, limits = list(x = xlim, y = ylim), 
          datum = datum, crs = crs, label_axes = label_axes, label_graticule = label_graticule, 
          ndiscr = ndiscr, expand = expand, default = default, 
          clip = clip)
}