add method argument to addRasterImage to enable neighrest neighbor interpolation when projecting categorical rasters

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

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)) {