Merge pull request #260 from r-spatial/stars_EP

fixes for stars categorical & legend
r-spatial · Feb 13, 2020 · c496538 · c496538
2 parents df63f63 + 3f86553
commit c496538
Show file tree

Hide file tree

Showing 3 changed files with 20 additions and 13 deletions.
diff --git a/R/legend.R b/R/legend.R
@@ -285,12 +285,19 @@ addRasterLegend <- function(x,
                             col.regions,
                             na.color) {
 
-  is.fact <- is.factor(x)
+  is.fact <- if (inherits(x, "stars"))
+		is.factor(x[[1]])
+  	else
+		is.factor(x)
 
   if (is.fact) {
     vals <- as.character(x[])
   } else if (inherits(x, "stars")) {
-    vals = as.vector(x[, , , 1][[1]][])
+	stopifnot (length(dim(x)) <= 3)
+	if (length(dim(x)) == 3)
+    	vals = as.vector(x[, , , 1][[1]][])
+	else
+    	vals = as.vector(x[[1]])
   } else {
     vals <- x[] # orig values needed for legend creation later on
   }

diff --git a/R/mapView.R b/R/mapView.R
@@ -343,10 +343,13 @@ setMethod('mapView', signature(x = 'stars'),
 
             # method = match.arg(method)
             if(length(dim(x)) == 2) layer = x[[1]] else layer = x[[1]][, , band]
-            if (is.null(at)) at <- lattice::do.breaks(
-              extendLimits(range(layer, na.rm = TRUE)),
-              256
-            )
+			# EJP: handle factors first
+            if (is.null(at)) {
+                at = if (is.factor(x[[1]]))
+                        as.vector(layer)
+                     else
+                        lattice::do.breaks(extendLimits(range(layer, na.rm = TRUE)), 256)
+            }
 
             if (mapviewGetOption("platform") == "leaflet") {
               leaflet_stars(x,

diff --git a/R/stars.R b/R/stars.R
@@ -65,7 +65,6 @@ addStarsImage <- function(map,
                         maxBytes = maxBytes)
 }
 
-
 leaflet_stars = function(x,
                          band,
                          map,
@@ -107,14 +106,15 @@ leaflet_stars = function(x,
     #           gdal = TRUE,
     #           ...)
   } else {
-    is.fact = FALSE # raster::is.factor(x)
+    is.fact = is.factor(x[[1]]) # raster::is.factor(x)
     # ext = raster::extent(raster::projectExtent(x, crs = llcrs))
     m = initMap(map, map.types, sf::st_crs(x)$proj4string, viewer.suppress = viewer.suppress)
     # x = rasterCheckSize(x, maxpixels = maxpixels)
     # x = starsCheckAdjustProjection(x, method)
     ext = createExtent(sf::st_transform(sf::st_as_sfc(sf::st_bbox(x)), crs = 4326))
     # if (!is.na(raster::projection(x)) & trim) x = trim(x)
     # if (is.fact) x = raster::as.factor(x)
+	# EJP FIXME: to be corrected for dim(x)>3:
     if(length(dim(x)) == 2) layer = x[[1]] else layer = x[[1]][, , band]
     # if (is.null(values)) {
     #   # if (is.fact) {
@@ -132,7 +132,7 @@ leaflet_stars = function(x,
     if (is.fact) {
       ### delete at some stage!!! ###
       pal = leaflet::colorFactor(palette = col.regions,
-                                 domain = seq(0, 255, 1),
+                                 domain = seq(1, length.out = length(levels(x[[1]]))),
                                  na.color = na.color)
       # pal2 = pal
     } else {
@@ -200,11 +200,8 @@ leaflet_stars = function(x,
 }
 
 
-
-
-
-
 stars2Array = function(x, band = 1) {
+  # FIXME: t.b.fixed if dim(x)>3:
   if(length(dim(x)) == 2) layer = x[[1]] else layer = x[[1]][, , band]
   paste(
     sapply(seq(nrow(x[[1]])), function(i) {