improved static basemaps

R/tmapGridAux.R

@@ -37,34 +37,45 @@ tmapGridTilesPrep = function(a, bs, id, o) {
  }
 
  xs = mapply(function(b, z) {
-
  m = tryCatch({
- maptiles::get_tiles(x = b, provider = a$server[1], zoom = z, crop = FALSE, ) 
+ maptiles::get_tiles(x = b, provider = a$server[1], zoom = z, crop = FALSE) 
  }, error = function(e) {
  tryCatch({
  maptiles::get_tiles(x = b, provider = a$server[1], zoom = z - 1, crop = FALSE) 
  }, error = function(e) {
  NULL
  })
  })
- names(m)[1:3] = c("red", "green", "blue")
+ if (!is.null(m)) {
+ names(m)[1:3] = c("red", "green", "blue")
+ if (terra::nlyr(m) == 4) names(m)[4] = "alpha"
+
+ } else {
+ message("Tiles from ", a$server[1], " at zoom level ", z, " couldn't be loaded")
+ }
  m
  }, bs, zs, SIMPLIFY = FALSE)
 
- if (isproj) xs = mapply(function(x,b) {
- ex = terra::ext(as.vector(b[c(1,3,2,4)]))
- asp = (ex[2] - ex[1]) / (ex[4] - ex[3])
-
- tot = terra::ncell(x) * 2
-
- nc = round(sqrt(tot * asp))
- nr = round(tot / nc)
+ if (isproj) {
+ if (!all(vapply(xs, is.null, FUN.VALUE = logical(1)))) {
+ message("Tiles from ", a$server[1], " will be projected so details (e.g. text) could appear blurry")
+ xs = mapply(function(x,b) {
+ if (is.null(x)) return(NULL)
+
+ ex = terra::ext(as.vector(b[c(1,3,2,4)]))
+ asp = (ex[2] - ex[1]) / (ex[4] - ex[3])
+
+ tot = terra::ncell(x) * 2
+
+ nc = round(sqrt(tot * asp))
+ nr = round(tot / nc)
+
+ r = terra::rast(ex, nrows = nr, ncols = nc, crs = crs$wkt)
+ terra::project(x, r, method = "near")
+ }, xs, bs_orig, SIMPLIFY = FALSE)
+ }
+ }
 
- r = terra::rast(ex, nrows = nr, ncols = nc, crs = crs$wkt)
- terra::project(x, r, method = "near")
- }, xs, bs_orig, SIMPLIFY = FALSE)
-
-
  ss = lapply(xs, function(x) {
  if (is.null(x)) NULL else do.call(tmapShape, list(shp = x, is.main = FALSE, crs = crs, bbox = NULL, unit=NULL, filter=NULL, shp_name = "x", smeta = list(), o = o))
  })
@@ -76,7 +87,12 @@ tmapGridTilesPrep = function(a, bs, id, o) {
  if (is.null(s)) return(NULL)
  d = s$dt
  d[, c("col", "legnr") := do.call(srgb$FUN, list(x1 = red, x2 = green, x3 = blue, scale = srgb, legend = list(), o = o, aes = "col", layer = "raster", sortRev = NA, bypass_ord = TRUE))]
- d[, col_alpha:=1L]
+ if ("alpha" %in% names(d)) {
+ d[, col_alpha:=alpha/255]
+ d[is.na(col_alpha), col_alpha:=0]
+ } else {
+ d[, col_alpha:=1L]
+ }
  d
  })
 
@@ -85,9 +101,11 @@ tmapGridTilesPrep = function(a, bs, id, o) {
  })
 
 
+ bmaps_shpTHs = structure(list(shpTMs), names = id)
+ bmaps_dts = structure(list(ds), names = id)
 
- g$bmaps_shpTHs = shpTMs
- g$bmaps_dts = ds
+ g$bmaps_shpTHs = c(g$bmaps_shpTHs, bmaps_shpTHs)
+ g$bmaps_dts = c(g$bmaps_dts, bmaps_dts)
 
  assign("g", g, envir = .TMAP_GRID)
  paste0(a$server, collapse = "__")
@@ -345,8 +363,8 @@ tmapGridGridPrep = function(a, bs, id, o) {
 tmapGridTiles = function(bi, bbx, facet_row, facet_col, facet_page, id, pane, group, o) {
  g = get("g", envir = .TMAP_GRID)
 
- dt = g$bmaps_dts[[bi]]
- shpTM = g$bmaps_shpTHs[[bi]]
+ dt = g$bmaps_dts[[id]][[bi]]
+ shpTM = g$bmaps_shpTHs[[id]][[bi]]
  gp = list()
 
  if (!is.null(dt)) tmapGridRaster(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id, pane, group, o) 

R/tmapLeafletInit.R

@@ -146,7 +146,7 @@ tmapLeafletAux = function(o, q) {
  groups_check = unique(unlist(strsplit(q$group[q$group.control == "check"], split = "__", fixed = TRUE)))
 
  # remove radio button when there is only one
- if (length(groups_radio) == 1) groups_radio = character(0)
+ if (is.null(groups_radio) || length(groups_radio) == 1) groups_radio = character(0)
  if (is.null(groups_check)) groups_check = character(0)
 
  lfs = lapply(lfs, function(lfp) {

R/tmap_options.R

@@ -486,6 +486,8 @@
  basemap.server = c("Esri.WorldGrayCanvas", "OpenStreetMap", "Esri.WorldTopoMap"),
  basemap.alpha = 1,
  basemap.zoom = NA,
+ tiles.alpha = 1,
+ tiles.zoom = NA,
  overlays = NULL,
  overlays.alpha = 1,
  alpha = NA,

examples/tm_basemap.R

@@ -6,4 +6,11 @@ if (requireNamespace("maptiles")) {
  tm_basemap("OpenTopoMap") +
  tm_shape(World) + 
  tm_polygons(fill = NA, col = "black")
+
+ tm_basemap("CartoDB.PositronNoLabels") +
+ tm_shape(NLD_prov, crs = 4236) +
+ tm_borders() +
+ tm_facets_wrap("name") +
+ tm_tiles("CartoDB.PositronOnlyLabels")
+
 }

sandbox/issues.R

@@ -156,11 +156,49 @@ plot(r)
 tm_shape(r) +
  tm_raster()
 
+tm_shape(r) +
+ tm_raster(col.legend = tm_legend_hide())
+
+
 str(r)
 
 
 cat_raster = rast(system.file("raster/nlcd.tif", package = "spDataLarge"))
 
 tm_shape(cat_raster) +
  tm_raster(col.scale = tm_scale_categorical(levels.drop = TRUE),
- col.legend = tm_legend("Land cover"))
+ col.legend = tm_legend("Land cover"))
+
+
+# 819
+L7file = system.file("tif/L7_ETMs.tif", package = "stars")
+L7 = read_stars(L7file)
+
+### working but gives warning
+tm_shape(L7) + 
+ tm_rgb()
+
+ tm_raster(c(3, 2, 1))
+
+tm_shape(L7) + 
+ tm_raster(col = tm_mv_dim("band", c(3, 2, 1)), col.scale = tm_scale_rgb())
+
+tm_shape(L7) + 
+ tm_rgb(tm_mv_dim("band", c(3, 2, 1)))
+
+L7split = split(L7)
+tm_shape(L7split) + 
+ tm_rgb(tm_mv("X3", "X2", "X1"))
+
+
+
+# Warning message:
+# In value[[3L]](cond) : could not rename the data.table
+
+### not working gives error
+tm_shape(L7) + 
+ tm_rgb(3, 2, 1)
+
+# Error: palette should be a character value
+# In addition: Warning message:
+# In value[[3L]](cond) : could not rename the data.table