Nothing
#' 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]))
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.