diff --git a/R/tmapGridAux.R b/R/tmapGridAux.R index 735ec24b..d3d8b89e 100644 --- a/R/tmapGridAux.R +++ b/R/tmapGridAux.R @@ -37,9 +37,8 @@ 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) @@ -47,24 +46,36 @@ tmapGridTilesPrep = function(a, bs, id, o) { 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) diff --git a/R/tmapLeafletInit.R b/R/tmapLeafletInit.R index 9d38cb02..70ff25ef 100644 --- a/R/tmapLeafletInit.R +++ b/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) { diff --git a/R/tmap_options.R b/R/tmap_options.R index c3310d0f..34b01d54 100644 --- a/R/tmap_options.R +++ b/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, diff --git a/examples/tm_basemap.R b/examples/tm_basemap.R index d5091f0c..c4c6864d 100644 --- a/examples/tm_basemap.R +++ b/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") + } diff --git a/sandbox/issues.R b/sandbox/issues.R index 1f2880e8..b33cb571 100644 --- a/sandbox/issues.R +++ b/sandbox/issues.R @@ -156,6 +156,10 @@ plot(r) tm_shape(r) + tm_raster() +tm_shape(r) + + tm_raster(col.legend = tm_legend_hide()) + + str(r) @@ -163,4 +167,38 @@ 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")) \ No newline at end of file + 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