Merge branch 'master' into mouseevent

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: leafem
 Title: 'leaflet' Extensions for 'mapview'
-Version: 0.2.3.9002
+Version: 0.2.3.9005
 Authors@R:
     c(person(given = "Tim",
              family = "Appelhans",
@@ -85,7 +85,9 @@ Suggests:
     lwgeom,
     mapdeck,
     plainview,
-    stars
+    stars,
+    terra,
+    tools
 Encoding: UTF-8
 LazyData: false
 RoxygenNote: 7.3.1

NAMESPACE

@@ -25,17 +25,22 @@ export(clip2sfc)
 export(colorOptions)
 export(garnishMap)
 export(imagequeryOptions)
+export(hideLogo)
 export(paintRules)
 export(removeHomeButton)
+export(removeLogo)
 export(removeMouseCoordinates)
+export(showLogo)
 export(updateLayersControl)
+export(updateLogo)
 importFrom(base64enc,base64encode)
 importFrom(grDevices,col2rgb)
 importFrom(grDevices,colors)
 importFrom(grDevices,rgb)
 importFrom(leaflet,addRasterImage)
 importFrom(leaflet,colorNumeric)
 importFrom(leaflet,expandLimits)
+importFrom(leaflet,filterNULL)
 importFrom(leaflet,getMapData)
 importFrom(leaflet,gridOptions)
 importFrom(leaflet,invokeMethod)

NEWS

@@ -1,4 +1,4 @@
-leafem 0.2.3.9002 (2024-05-29)
+leafem 0.2.3.9005 (2024-06-01)
 
 features and improvements
 

NEWS.md

@@ -1,4 +1,4 @@
-# leafem 0.2.3.9002 (2024-05-29)
+# leafem 0.2.3.9005 (2024-06-01)
 
 #### ✨ features and improvements
 

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", "near"),
   ...
 ) {
 
@@ -72,25 +74,66 @@ 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 (!terra::same.crs(x, "EPSG:3857")) {
+      if (isRaster) {
+        x = raster::projectRaster(x, raster::projectExtent(x, "EPSG:3857"))
+      }
+      if (isTerra) {
+        x = terra::project(x, y = "EPSG:3857", method = method)
+      }
+    }
 
     mat <- cbind(x[[r]][],
                  x[[g]][],
                  x[[b]][])
 
   } else if (inherits(x, "stars")) {
+    raster_is_factor <- is.factor(x[[1]])
+    method <- match.arg(method)
+    if (method == "auto") {
+      if (raster_is_factor) {
+        method <- "near"
+      } else {
+        method <- "bilinear"
+      }
+    }
+    x = suppressWarnings(
+      stars::st_warp(x, crs = "EPSG:3857", method = method, use_gdal = TRUE)
+    )
 
     mat <- cbind(as.vector(x[[1]][, , r]),
                  as.vector(x[[1]][, , g]),
                  as.vector(x[[1]][, , b]))
 
   } 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 +155,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)

R/addStarsImage.R

@@ -41,7 +41,7 @@ addStarsImage <- function(
   , layerId = NULL
   , group = NULL
   , project = FALSE
-  , method = c("auto", "bilinear", "ngb")
+  , method = c("auto", "bilinear", "near")
   , maxBytes = 4 * 1024 * 1024
   , options = gridOptions()
   , data = getMapData(map)
@@ -71,7 +71,7 @@ addStarsImage <- function(
   method <- match.arg(method)
   if (method == "auto") {
     if (raster_is_factor) {
-      method <- "ngb"
+      method <- "near"
     } else {
       method <- "bilinear"
     }
@@ -84,7 +84,7 @@ addStarsImage <- function(
   if (project) {
     # if we should project the data
     if (utils::packageVersion("stars") >= "0.4-1") {
-      projected = stars::st_warp(x, crs = 3857)
+      projected = stars::st_warp(x, crs = 3857, method = method, use_gdal = TRUE)
     } else {
       projected <- sf::st_transform(x, crs = 3857)
     }
@@ -108,7 +108,7 @@ addStarsImage <- function(
   }
 
   if (!is.function(colors)) {
-    if (method == "ngb") {
+    if (method == "near") {
       # 'factors'
       colors <- leaflet::colorFactor(
         colors, domain = NULL, na.color = "#00000000", alpha = TRUE
@@ -152,10 +152,12 @@ addStarsImage <- function(
   map = leaflet::invokeMethod(
     map, data, "addRasterImage", uri, latlng,
     layerId, group, options
-  ) %>%
-    leaflet::expandLimits(
-      c(bounds[2], bounds[4]),
-      c(bounds[1], bounds[3])
-    )
+  )
+
+  leaflet::expandLimits(
+    map,
+    c(bounds[2], bounds[4]),
+    c(bounds[1], bounds[3])
+  )
 
 }

R/imagequery.R

@@ -87,6 +87,13 @@ addImageQuery = function(map,
         projected <- sf::st_transform(x, crs = 4326)
       }
     }
+    if (inherits(x, "SpatRaster")) {
+      projected = terra::project(
+        x
+        , "epsg:4326"
+        , method = "near"
+      )
+    }
     if (inherits(x, "Raster")) {
       projected = raster::projectRaster(
         x