Merge pull request #6 from rhijmans/master

support SpatRaster

Author: tim-salabim

DESCRIPTION

@@ -24,6 +24,7 @@ Imports:
     htmlwidgets,
     lattice,
     raster,
+	terra,
     viridisLite
 Suggests:
     jpeg

NAMESPACE

@@ -7,3 +7,4 @@ import(raster)
 importFrom(grDevices,dev.off)
 importFrom(grDevices,png)
 importFrom(viridisLite,inferno)
+importFrom(terra,nlyr,spatSample,as.matrix)

R/raster.R

@@ -7,10 +7,13 @@ raster2PNG <- function(x,
                        na.color,
                        maxpixels) {
 
-  x <- rasterCheckSize(x, maxpixels = maxpixels)
-
-  mat <- t(raster::as.matrix(x))
-
+  is_spatraster <- inherits(x, "SpatRaster")
+  x <- rasterCheckSize(x, maxpixels = maxpixels, is_spatraster)
+  if (is_spatraster) {
+	mat <- t(terra::as.matrix(x, wide=TRUE))
+  } else {
+	mat <- t(raster::as.matrix(x))
+  }
   if (missing(at)) at <- lattice::do.breaks(range(mat, na.rm = TRUE), 256)
 
   cols <- lattice::level.colors(mat,
@@ -34,14 +37,12 @@ rgbStack2PNG <- function(x, r, g, b,
                          maxpixels,
                          ...) {
 
-  x <- rasterCheckSize(x, maxpixels = maxpixels)
-
-  x3 <- raster::subset(x, c(r, g, b))
-
-  mat <- cbind(x[[r]][],
-               x[[g]][],
-               x[[b]][])
+  is_spatraster <- inherits(x, "SpatRaster")
+  x <- rasterCheckSize(x, maxpixels = maxpixels, is_spatraster)
 
+  x <- x[[c(r, g, b)]]
+  mat <- values(x)
+ 
   for(i in seq(ncol(mat))){
     z <- mat[, i]
     lwr <- stats::quantile(z, quantiles[1], na.rm = TRUE)
@@ -63,13 +64,17 @@ rgbStack2PNG <- function(x, r, g, b,
 }
 
 
-rasterCheckSize <- function(x, maxpixels) {
+rasterCheckSize <- function(x, maxpixels, is_spatraster) {
   if (maxpixels < raster::ncell(x)) {
     warning(paste("maximum number of pixels for Raster* viewing is",
                   maxpixels, "; \nthe supplied Raster* has", raster::ncell(x), "\n",
                   "... decreasing Raster* resolution to", maxpixels, "pixels\n",
                   "to view full resolution set 'maxpixels = ", raster::ncell(x), "'"))
-    x <- raster::sampleRegular(x, maxpixels, asRaster = TRUE, useGDAL = TRUE)
+    if (is_spatraster) {
+		x <- terra::spatSample(x, maxpixels, "regular", as.raster = TRUE)	
+	} else {
+		x <- raster::sampleRegular(x, maxpixels, asRaster = TRUE, useGDAL = TRUE)
+	}
   }
   return(x)
 }

R/slideView.R

@@ -96,6 +96,66 @@ if ( !isGeneric('slideView') ) {
 #' @rdname slideView
 #' @aliases slideView,RasterStackBrick,RasterStackBrick-method
 
+
+setMethod("slideView", signature(img1 = "SpatRaster",
+                                 img2 = "SpatRaster"),
+          function(img1,
+                   img2,
+                   label1 = deparse(substitute(img1, env = parent.frame())),
+                   label2 = deparse(substitute(img2, env = parent.frame())),
+                   r = 3,
+                   g = 2,
+                   b = 1,
+                   col.regions = viridisLite::inferno(256),	   
+                   legend = TRUE,
+                   na.color = "#BEBEBE",
+                   maxpixels = 1e7,
+                   ...) {
+
+			if (nlyr(img1) > 1) {
+				png1 <- rgbStack2PNG(img1, r = r, g = g, b = b,
+                                 na.color = na.color,
+                                 maxpixels = maxpixels,
+                                 ...)
+			} else {
+				png1 <- raster2PNG(img1, col.regions = col.regions,
+                               na.color = na.color,
+                               maxpixels = maxpixels)
+			
+			}
+			if (nlyr(img2) > 1) {
+				png2 <- rgbStack2PNG(img2, r = r, g = g, b = b,
+                                 na.color = na.color,
+                                 maxpixels = maxpixels,
+                                 ...)
+			} else {
+				png2 <- raster2PNG(img2, col.regions = col.regions,
+                               na.color = na.color,
+                               maxpixels = maxpixels)
+			}
+
+            ## temp dir
+            dir <- tempfile()
+            dir.create(dir)
+            # r1 <- trunc(runif(1, 1000000000, 9999999999))
+            # r2 <- trunc(runif(1, 1000000000, 9999999999))
+            fl1 <- paste0(dir, "/", label1, ".png")
+            fl2 <- paste0(dir, "/", label2, ".png")
+
+            ## pngs
+            png::writePNG(png1, fl1)
+            png::writePNG(png2, fl2)
+
+            slideViewInternal(list(a="a", b="b"),
+                              img1nm = label1,
+                              img2nm = label2,
+                              filename1 = fl1,
+                              filename2 = fl2)
+          }
+
+)
+
+
 setMethod("slideView", signature(img1 = "RasterStackBrick",
                                  img2 = "RasterStackBrick"),
           function(img1,