R/bboxtools.R

In prettymapr: Scale Bar, North Arrow, and Pretty Margins in R

#' Create a Bounding Box
#'
#' Convencience method to create a bounding box like that returned by \code{sp::bbox()}.
#' To generate a bounding box from lists of lat/lon values use \code{sp::bbox(cbind(lons, lats))}.
#'
#' @param n North bounding latitude
#' @param e East bounding longitude
#' @param s South bounding latitude
#' @param w West bounding longitude
#' @return A 2x2 matrix describing a bounding box like that returned by \code{sp::bbox()}
#' @seealso sp::bbox
#' @examples makebbox(45.125, -64.25, 44.875, -64.75)
#'
#' @export
makebbox <- function(n, e, s, w) {

  if (isTRUE(n < s)) {
    warning("North less than south. Check order?")
  }

  if (isTRUE(e < w)) {
    warning("East less than west. Check order?")
  }

  matrix(c(w, s, e, n), byrow=FALSE, ncol=2, dimnames=list(c("x", "y"), c("min", "max")))
}

#' Query The Interwebs For A Bounding Box
#'
#' Use the PickPoint.io API or Google API to
#' retreive a bounding box for the given query. Note that if
#' you would like to use \code{google} as a source, you must agree to the Google
#' API terms and conditions.
#'
#' @param querystring The search query. Passing a vector in will find the bounding box that contains
#'                    all bounding boxes returned.
#' @param ... Additional paramters to be passed on to \link{geocode}. Passing \code{source="google"}
#'   may be useful if google is desired as a source. Use \code{options(prettymapr.geosource="google")}
#'   to permanently use \code{google} as a source.
#' @return A 2x2 matrix describing a bounding box like that returned by \code{sp::bbox()}
#'
#' @examplesIf identical(Sys.getenv("R_PRETTYMAPR_HAS_API_KEY"), "true")
#' #don't test to speed up checking time
#' \donttest{
#' searchbbox("kings county, NS")
#' searchbbox("University Ave. Wolfville NS", source="google")
#' searchbbox("Wolfville ns", source="google")
#' searchbbox(c("Vermont", "Nova Scotia"))
#' }
#'
#' @export
#'
searchbbox <- function(querystring, ...) {

  d <- geocode(querystring, output="data.frame", limit=1, ...)
  if(nrow(d) > 1) {
    makebbox(max(d$bbox_n), max(d$bbox_e), min(d$bbox_s), min(d$bbox_w))
  } else {
    makebbox(d$bbox_n, d$bbox_e, d$bbox_s, d$bbox_w)
  }
}

#' Zoom the extents of a bounding box
#'
#' Manipulate the extents of a bounding box by zooming and moving an
#' existing bbox. This is helpful when manipulating the extents of a
#' plot created by \code{canvec.qplot()}
#'
#' @param bbox An existing bbox
#' @param factor A factor to zoom by. >1 will zoom in, <1 will zoom out.
#' If a vector is passed, the first element will zoom the X extent, the
#' second element will zoom the Y extent.
#' @param offset A vector describing the X and Y offset that should be applied.
#' @return A zoomed bounding box.
#'
#' @examples
#' box1 <- makebbox(45, -64, 44, -65)
#' zoombbox(box1, c(.2,.5))
#'
#' @export
#'
zoombbox <- function(bbox, factor=1, offset=c(0,0)) {
  lons <- bbox[1,]
  lats <- bbox[2,]
  clon <- mean(lons) + offset[1]
  clat <- mean(lats) + offset[2]

  if(length(factor)>1) {
    factorx <- factor[1]
    factory <- factor[2]
  } else {
    factorx <- factor
    factory <- factor
  }

  newwidth <- (lons[2]-lons[1]) / factorx
  newheight <- (lats[2]-lats[1]) / factory

  makebbox(clat+newheight/2.0, clon+newwidth/2.0, clat-newheight/2.0, clon-newwidth/2.0)
}

#' Combine bounding boxes
#'
#' Create a single bounding box that encloses all of the bounding boxes.
#'
#' @param ... An arbitrary number of bounding boxes as generated by \code{sp::bbox},
#'            \link{makebbox} or \link{searchbbox}
#'
#' @return A single bounding box that contains all of its arguments.
#' @export
#'
#' @examples
#'
#' box1 <- makebbox(45, -64, 44, -65)
#' box2 <- makebbox(45.5, -64.5, 44.5, -65.6)
#' mergebbox(box1, box2)
#'
mergebbox <- function(...) {
  coords <- t(cbind(...))
  makebbox(max(coords[, 2]), max(coords[, 1]), min(coords[, 2]), min(coords[, 1]))
}