From 1695722ade42ec6220077228b02693928b99915a Mon Sep 17 00:00:00 2001 From: tim-salabim Date: Sun, 22 Jan 2017 17:27:33 +0100 Subject: [PATCH 1/4] add support for simple features MULTIPOLYGON. lines to follow --- R/normalize-sf.R | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/R/normalize-sf.R b/R/normalize-sf.R index 056b09f0f..95fd28815 100644 --- a/R/normalize-sf.R +++ b/R/normalize-sf.R @@ -43,22 +43,24 @@ polygonData.sfc <- function(obj) { #' @export polygonData.MULTIPOLYGON <- function(obj) { - n <- vapply(obj, length, integer(1)) - if (any(n > 1L)) { - warning( - "leaflet currently does not support MULTIPOLYGONS. Taking first", - call. = FALSE) - } - - lapply(obj, function(x) sf_coords(x[[1]])) + unlist( + structure( + lapply(obj, function(x) lapply(x, sf_coords)), + bbox = sf_bbox(obj) + ), recursive = FALSE + ) } #' @export polygonData.MULTILINESTRING <- polygonData.MULTIPOLYGON #' @export polygonData.POLYGON <- function(obj) { - lapply(obj, sf_coords) + structure( + lapply(obj, sf_coords), + bbox = sf_bbox(obj) + ) } + #' @export polygonData.LINESTRING <- polygonData.POLYGON From 766842874f62a3371a4aca3606b8b2b75fb9a9ce Mon Sep 17 00:00:00 2001 From: tim-salabim Date: Sat, 9 Sep 2017 11:02:29 +0200 Subject: [PATCH 2/4] delete local version of normalize-sf --- R/normalize-sf.R | 100 ----------------------------------------------- 1 file changed, 100 deletions(-) delete mode 100644 R/normalize-sf.R diff --git a/R/normalize-sf.R b/R/normalize-sf.R deleted file mode 100644 index 95fd28815..000000000 --- a/R/normalize-sf.R +++ /dev/null @@ -1,100 +0,0 @@ -# metaData ---------------------------------------------------------------- - -#' @export -metaData.sf <- function(obj) { - obj -} - -# pointsData -------------------------------------------------------------- - -#' @export -pointData.sf <- function(obj) { - geometry <- obj[[attr(obj, "sf_column")]] - pointData(geometry) -} - -#' @export -pointData.sfc_POINT <- function(obj) { - check_crs(obj) - - structure( - sf_coords(do.call("rbind", obj)), - bbox = sf_bbox(obj) - ) -} - -# polygonData ------------------------------------------------------------- - -#' @export -polygonData.sf <- function(obj) { - geometry <- obj[[attr(obj, "sf_column")]] - polygonData(geometry) -} - -#' @export -polygonData.sfc <- function(obj) { - check_crs(obj) - - structure( - lapply(obj, polygonData), - bbox = sf_bbox(obj) - ) -} - -#' @export -polygonData.MULTIPOLYGON <- function(obj) { - unlist( - structure( - lapply(obj, function(x) lapply(x, sf_coords)), - bbox = sf_bbox(obj) - ), recursive = FALSE - ) -} -#' @export -polygonData.MULTILINESTRING <- polygonData.MULTIPOLYGON - -#' @export -polygonData.POLYGON <- function(obj) { - structure( - lapply(obj, sf_coords), - bbox = sf_bbox(obj) - ) -} - -#' @export -polygonData.LINESTRING <- polygonData.POLYGON - - -# helpers ----------------------------------------------------------------- - -check_crs <- function(x) { - crs <- sf::st_crs(x) - - # Don't have enough information to check - if (is.na(crs)) - return() - - if (identical(sf::st_is_longlat(x), FALSE)) { - warning("sf layer is not long-lat data", call. = FALSE) - } - - if (!grepl("+datum=WGS84", crs$proj4string, fixed = TRUE)) { - warning( - "sf layer has inconsistent datum (", crs$proj4string, ").\n", - "Need '+proj=longlat +datum=WGS84'", - call. = FALSE - ) - } - -} - -sf_coords <- function(x) { - structure( - as.data.frame(x), - names = c("lng", "lat") - ) -} - -sf_bbox <- function(x) { - matrix(sf::st_bbox(x), ncol = 2, byrow = FALSE) -} From 0102062e4f730ed5b975b477c857a52255b7b14d Mon Sep 17 00:00:00 2001 From: tim-salabim Date: Sat, 9 Sep 2017 13:18:25 +0200 Subject: [PATCH 3/4] add method argument to addRasterImage, fixes #219 and #461. --- R/layers.R | 16 +++++++++++++--- man/addRasterImage.Rd | 9 +++++++-- 2 files changed, 20 insertions(+), 5 deletions(-) diff --git a/R/layers.R b/R/layers.R index 1bead2d20..0a589b9d9 100644 --- a/R/layers.R +++ b/R/layers.R @@ -209,6 +209,10 @@ epsg3857 <- "+proj=merc +a=6378137 +b=6378137 +lat_ts=0.0 +lon_0=0.0 +x_0=0.0 +y #' the caller's responsibility to ensure that \code{x} is already projected, #' and that \code{extent(x)} is expressed in WGS84 latitude/longitude #' coordinates +#' @param method the method used for computing values of the new, projected raster image. +#' \code{"bilinear"} (the default) is appropriate for continuous data, +#' \code{"ngb"} - nearest neighbor - is appropriate for categorical data. +#' Ignored if \code{project = FALSE}. See \code{\link{projectRaster}} for details. #' @param maxBytes the maximum number of bytes to allow for the projected image #' (before base64 encoding); defaults to 4MB. #' @@ -231,12 +235,14 @@ addRasterImage <- function( layerId = NULL, group = NULL, project = TRUE, + method = c("bilinear", "ngb"), maxBytes = 4*1024*1024 ) { stopifnot(inherits(x, "RasterLayer")) if (project) { - projected <- projectRasterForLeaflet(x) + method <- match.arg(method, c("bilinear", "ngb")) + projected <- projectRasterForLeaflet(x, method) } else { projected <- x } @@ -266,8 +272,12 @@ addRasterImage <- function( #' @rdname addRasterImage #' @export -projectRasterForLeaflet <- function(x) { - raster::projectRaster(x, raster::projectExtent(x, crs = sp::CRS(epsg3857))) +projectRasterForLeaflet <- function(x, method) { + raster::projectRaster( + x, + raster::projectExtent(x, crs = sp::CRS(epsg3857)), + method = method + ) } #' @rdname remove diff --git a/man/addRasterImage.Rd b/man/addRasterImage.Rd index d51a95d3f..851afdecc 100644 --- a/man/addRasterImage.Rd +++ b/man/addRasterImage.Rd @@ -7,9 +7,9 @@ \usage{ addRasterImage(map, x, colors = "Spectral", opacity = 1, attribution = NULL, layerId = NULL, group = NULL, project = TRUE, - maxBytes = 4 * 1024 * 1024) + method = c("bilinear", "ngb"), maxBytes = 4 * 1024 * 1024) -projectRasterForLeaflet(x) +projectRasterForLeaflet(x, method) } \arguments{ \item{map}{a map widget object} @@ -35,6 +35,11 @@ the caller's responsibility to ensure that \code{x} is already projected, and that \code{extent(x)} is expressed in WGS84 latitude/longitude coordinates} +\item{method}{the method used for computing values of the new, projected raster image. +\code{"bilinear"} (the default) is appropriate for continuous data, +\code{"ngb"} - nearest neighbor - is appropriate for categorical data. +Ignored if \code{project = FALSE}. See \code{\link{projectRaster}} for details.} + \item{maxBytes}{the maximum number of bytes to allow for the projected image (before base64 encoding); defaults to 4MB.} } From 480e15a08ba703eb2a83c64f316f301e98697e68 Mon Sep 17 00:00:00 2001 From: tim-salabim Date: Sat, 9 Sep 2017 13:19:09 +0200 Subject: [PATCH 4/4] add argument elementId to leaflet. fixes #411 --- R/leaflet.R | 8 ++++++-- man/leaflet.Rd | 5 ++++- 2 files changed, 10 insertions(+), 3 deletions(-) diff --git a/R/leaflet.R b/R/leaflet.R index 427f81c29..8841f6801 100644 --- a/R/leaflet.R +++ b/R/leaflet.R @@ -21,12 +21,15 @@ #' @param height the height of the map #' @param padding the padding of the map #' @param options the map options +#' @param elementId Use an explicit element ID for the widget +#' (rather than an automatically generated one). #' @return A HTML widget object, on which we can add graphics layers using #' \code{\%>\%} (see examples). #' @example inst/examples/leaflet.R #' @export leaflet <- function(data = NULL, width = NULL, height = NULL, - padding = 0, options = leafletOptions()) { + padding = 0, options = leafletOptions(), + elementId = NULL) { # Validate the CRS if specified if(!is.null(options[['crs']]) && @@ -61,7 +64,8 @@ leaflet <- function(data = NULL, width = NULL, height = NULL, }) } widget - } + }, + elementId = elementId ) if (crosstalk::is.SharedData(data)) { diff --git a/man/leaflet.Rd b/man/leaflet.Rd index e27097d3e..98f4df6b6 100644 --- a/man/leaflet.Rd +++ b/man/leaflet.Rd @@ -7,7 +7,7 @@ \title{Create a Leaflet map widget} \usage{ leaflet(data = NULL, width = NULL, height = NULL, padding = 0, - options = leafletOptions()) + options = leafletOptions(), elementId = NULL) leafletOptions(minZoom = NULL, maxZoom = NULL, crs = leafletCRS(), worldCopyJump = NULL, ...) @@ -33,6 +33,9 @@ spatial data frames from the \pkg{sf} package.} \item{options}{the map options} +\item{elementId}{Use an explicit element ID for the widget +(rather than an automatically generated one).} + \item{minZoom}{Minimum zoom level of the map. Overrides any minZoom set on map layers.} \item{maxZoom}{Maximum zoom level of the map. This overrides any maxZoom set on map layers.}