Merge pull request #81 from trafficonese/rgb_terra

fix: fixes #68 accept terra objects in addRasterRGB

DESCRIPTION

@@ -86,6 +86,7 @@ Suggests:
     mapdeck,
     plainview,
     stars,
+    terra,
     tools
 Encoding: UTF-8
 LazyData: false

R/addRasterRGB.R

@@ -23,6 +23,7 @@
 #'   If both `domain` and `quantiles` are set to NULL, stretching is applied
 #'   based on min-max values.
 #' @param na.color the color to be used for NA pixels
+#' @inheritParams leaflet::addRasterImage
 #' @param ... additional arguments passed on to \code{\link{addRasterImage}}
 #'
 #' @author
@@ -59,6 +60,7 @@ addRasterRGB <- function(
   quantiles = c(0, 1),
   domain = NULL,
   na.color = "#BEBEBE80",
+  method = c("auto", "bilinear", "ngb"),
   ...
 ) {
 
@@ -72,7 +74,32 @@ addRasterRGB <- function(
     }
   }
 
-  if (inherits(x, "Raster")) {
+  isRaster <- inherits(x, "Raster")
+  isTerra <- inherits(x, "SpatRaster")
+
+  if (isRaster || isTerra) {
+    method <- match.arg(method)
+    if (method == "auto") {
+      if (isRaster) {
+        raster_is_factor <- raster::is.factor(x[[r]])
+        has_colors = FALSE
+      }
+      if (isTerra) {
+        raster_is_factor <- terra::is.factor(x[[r]])
+        # there 1.5-50 has terra::has.colors(x)
+        ctab <- terra::coltab(x[[r]])[[1]]
+        has_colors <- !is.null(ctab)
+      }
+      if (raster_is_factor || has_colors) {
+        method <- "near"
+      } else {
+        method <- "bilinear"
+      }
+    }
+
+    if (isTerra && !terra::same.crs(x, "EPSG:3857")) {
+      x <- leaflet::projectRasterForLeaflet(x, method)
+    }
 
     mat <- cbind(x[[r]][],
                  x[[g]][],
@@ -86,11 +113,10 @@ addRasterRGB <- function(
 
   } else {
 
-    stop("'x' must be a Raster* or stars object.")
+    stop("'x' must be a Raster*, stars or terra object.")
 
   }
 
-
   if (!is.null(quantiles)) {
 
     for(i in seq(ncol(mat))){
@@ -112,19 +138,20 @@ addRasterRGB <- function(
     mat <- apply(mat, 2, rscl)
   }
 
-  na_indx <- apply(mat, 1, anyNA)
+  na_indx <- rowSums(is.na(mat)) > 0
   cols <- mat[, 1]
   cols[na_indx] <- na.color
   cols[!na_indx] <- grDevices::rgb(mat[!na_indx, ], alpha = 1)
   p <- function(x) cols
 
-  lyrs <- paste(r, g, b, sep = ".")
-
   dotlst = list(...)
-  dotlst = utils::modifyList(dotlst, list(map = map, colors = p))
-  out <- if (inherits(x, "Raster")) {
+  dotlst = utils::modifyList(dotlst, list(map = map, colors = p, method = method))
+  out <- if (isRaster) {
     dotlst = utils::modifyList(dotlst, list(x = x[[r]]))
     do.call(addRasterImage, dotlst)
+  } else if (isTerra) {
+    dotlst = utils::modifyList(dotlst, list(x = x[[r]], project = FALSE))
+    do.call(addRasterImage, dotlst)
   } else {
     dotlst = utils::modifyList(dotlst, list(x = x))
     do.call(addStarsImage, dotlst)