Skip to content

Commit

Permalink
improved qtm: bbox and v3 comp., leaflet layer collapse enabled #851
Browse files Browse the repository at this point in the history
  • Loading branch information
mtennekes committed Apr 11, 2024
1 parent 5adcc5a commit 9559083
Show file tree
Hide file tree
Showing 3 changed files with 75 additions and 20 deletions.
78 changes: 64 additions & 14 deletions R/qtm.R
Original file line number Diff line number Diff line change
Expand Up @@ -91,6 +91,43 @@ qtm <- function(shp,
shp_name <- deparse(substitute(shp))[1]
called <- names(match.call(expand.dots = TRUE)[-1])

v3 = c("symbols.size", "symbols.col", "symbols.shape", "dots.col",
"text", "text.size", "text.col", "lines.lwd", "lines.col", "raster",
"borders", "projection")

if (any(v3 %in% names(args))) {
mes = "tmap v3 code detected"

if ("symbols.size" %in% names(args)) {
size = args$symbols.size
called = unique(c(called, "shape"))
mes = paste0(mes, "; use 'size' instead of 'symbols.size'")
}
if ("symbols.col" %in% names(args)) {
fill = args$symbols.col
called = unique(c(called, "shape"))
mes = paste0(mes, "; use 'fill' instead of 'symbols.col'")
} else if ("dots.col" %in% names(args)) {
fill = args$dots.col
mes = paste0(mes, "; use 'fill' instead of 'dots.col'")
}

if ("lines.lwd" %in% names(args)) {
lwd = args$lines.lwd
mes = paste0(mes, "; use 'lwd' instead of 'lines.lwd'")
}
if ("lines.col" %in% names(args)) {
col = args$lines.col
mes = paste0(mes, "; use 'col' instead of 'lines.col'")
}
if ("raster" %in% names(args)) {
col = args$raster
mes = paste0(mes, "; use 'col' instead of 'raster'")
}
message(mes)

}

tmapOptions <- tmap_options_mode()
show.warnings = tmapOptions$show.warnings

Expand All @@ -105,24 +142,37 @@ qtm <- function(shp,
class(g) <- "tmap"
return(g)
}



lst = c(list(size = size,
fill = fill,
col = col,
shape = shape,
lwd = lwd,
lty = lty,
fill_alpha = fill_alpha,
col_alpha = col_alpha,
zindex = zindex,
group = group,
group.control = group.control), args)
s = tm_shape(shp, crs = crs, bbox = bbox)

is_rst = inherits(shp, c("stars", "SpatRaster"))

# if shape is specified at tm_sf, symbols are drawn instead of dots
if (!"shape" %in% called) lst$shape = NULL
if (is_rst) {
lst = c(list(col = col,
zindex = zindex,
group = group,
group.control = group.control), args)
g = s + do.call(tm_raster, lst)
} else {
lst = c(list(size = size,
fill = fill,
col = col,
shape = shape,
lwd = lwd,
lty = lty,
fill_alpha = fill_alpha,
col_alpha = col_alpha,
zindex = zindex,
group = group,
group.control = group.control), args)

# if shape is specified at tm_sf, symbols are drawn instead of dots
if (!"shape" %in% called) lst$shape = NULL
g = s + do.call(tm_sf, lst)
}

g = tm_shape(shp) + do.call(tm_sf, lst)

assign("last_map_new", match.call(), envir = .TMAP)
attr(g, "qtm_shortcut") <- FALSE
Expand Down
14 changes: 9 additions & 5 deletions R/shapeTM.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,11 +9,15 @@
#' @keywords internal
shapeTM = function(shp, tmapID = NULL, bbox = NULL, ...) {
if (!is.null(bbox) && (!inherits(bbox, "bbox"))) {
tryCatch({
bbox = sf::st_bbox(bbox)
}, error = function(e) {
stop("Invalid bbox", call. = FALSE)
})
if (is.character(bbox)) {
bbox = tmaptools::geocode_OSM(bbox)$bbox
} else {
tryCatch({
bbox = sf::st_bbox(bbox)
}, error = function(e) {
stop("Invalid bbox", call. = FALSE)
})
}
}

# filter empty geometries
Expand Down
3 changes: 2 additions & 1 deletion R/tmap_options.R
Original file line number Diff line number Diff line change
Expand Up @@ -9,9 +9,10 @@
legend.position = tm_pos_in(pos.h = "right", pos.v = "bottom", align.h = "left", align.v = "top", just.h = "left", just.v = "bottom"),
crs = list(dimensions = 3857, 4326),
facet.max = 16,
#legend.bg.alpha = 0.8,
#view.legend.position = c("right", "top"),
control.position = c("left", "top"),
control.collapse = FALSE,
control.collapse = TRUE,
panel.show = FALSE,
basemap.show = TRUE,
set.bounds = FALSE,
Expand Down

0 comments on commit 9559083

Please sign in to comment.