Skip to content

Commit

Permalink
automated backw. comp.
Browse files Browse the repository at this point in the history
  • Loading branch information
mtennekes committed Apr 18, 2024
1 parent 72d957c commit 04ccd90
Show file tree
Hide file tree
Showing 9 changed files with 137 additions and 231 deletions.
53 changes: 53 additions & 0 deletions R/misc_v3_comp.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,53 @@
v3_only = function(fun) {
setdiff(funs_v3[[fun]], funs_v4[[fun]])
}

v3_start_message = function() {
if (!.TMAP$v3) {
message("tmap v3 code detected:")
.TMAPv3 = TRUE
}
invisible(NULL)
}

v3_reset_flag = function() {
.TMAPv3 = FALSE
invisible(NULL)
}


v3_instead = function(args_called, old, new, fun, extra_called = character()) {
args = args_called$args
called = args_called$called

if (old %in% called) {
args[[new]] = args[[old]]
args[[old]] = NULL

# may be needed to trigger something (e.g. "shape" to use symbols instead of dots)
if (length(extra_called)) {
called = unique(c(called, extra_called))
}
message(paste0(fun, ": (v3->v4), use '", new, "' instead of '", old, "'"))
}
list(args = args, called = called)
}

v3_instead_value = function(args_called, old, new, fun, value_old, value_new) {
args = args_called$args
called = args_called$called

if (old %in% called) {
if (identical(args[[old]], value_old)) {
args[[old]] = NULL
args[[new]] = value_new
if (is.null(value_old)) value_old = "NULL"
message(paste0(fun, ": (v3->v4), use '", new, " = ", value_new, "' instead of '", old, " = ", value_old, "'"))
list(args = args, called = called)
} else {
v3_instead(args_called, old, new, fun)
}
} else {
list(args = args, called = called)
}
}
4 changes: 4 additions & 0 deletions R/onLoad.R
Original file line number Diff line number Diff line change
Expand Up @@ -18,6 +18,10 @@
assign("last_map_new", NULL, envir = .TMAP)


# flag for old v3 code
assign("v3", FALSE, envir = .TMAP)


assign("tmapStyles", .defaultTmapStyles, envir = .TMAP)
assign("tmapFormats", .defaultTmapFormats, envir = .TMAP)

Expand Down
3 changes: 3 additions & 0 deletions R/print.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,9 @@ print.tmap = function(x, return.asp = FALSE, show = TRUE, vp = NULL, knit = FALS
res = step4_plot(x4, vp = vp, return.asp = return.asp, show = show, knit = knit, args)
if (dev) timing_add("step 4")
if (dev) timing_eval()

v3_reset_flag()

#if (return.asp) return(asp) else invisible(NULL)
if (knit && tmap_graphics_name() == "Leaflet") {
kp = get("knit_print", asNamespace("knitr"))
Expand Down
116 changes: 34 additions & 82 deletions R/qtm.R
Original file line number Diff line number Diff line change
Expand Up @@ -90,106 +90,47 @@ qtm <- function(shp,
style=NULL,
format=NULL,
...) {

args <- c(as.list(environment()), list(...))
shp_name <- deparse(substitute(shp))[1]
called <- names(match.call(expand.dots = TRUE)[-1])

vv_col = "col"
vv_text = c("text", "text_col", "text_size")
vv_oher = c("fill", "size", "shape", "lwd", "lty", "fill_alpha", "col_alpha")

vv_attr = c(".scale", ".legend", ".free", ".chart")


v3 = c("symbols.size", "symbols.col", "symbols.shape", "dots.col",
"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)) {
args$size = args$symbols.size
args$symbols.size = NULL
called = unique(c(called, "shape"))
mes = paste0(mes, "; use 'size' instead of 'symbols.size'")
}
if ("symbols.col" %in% names(args)) {
args$fill = args$symbols.col
args$symbols.col = NULL
called = unique(c(called, "shape"))
mes = paste0(mes, "; use 'fill' instead of 'symbols.col'")
} else if ("dots.col" %in% names(args)) {
args$fill = args$dots.col
args$dots.col = NULL
mes = paste0(mes, "; use 'fill' instead of 'dots.col'")
}

if ("lines.lwd" %in% names(args)) {
args$lwd = args$lines.lwd
args$lines.lwd = NULL
mes = paste0(mes, "; use 'lwd' instead of 'lines.lwd'")
}
if ("lines.col" %in% names(args)) {
args$col = args$lines.col
args$lines.col = NULL
mes = paste0(mes, "; use 'col' instead of 'lines.col'")
}
if ("raster" %in% names(args)) {
args$col = args$raster
args$raster = NULL
mes = paste0(mes, "; use 'col' instead of 'raster'")
}
if ("borders" %in% names(args)) {
if (is.null(args$borders)) {
args$borders = NULL
args$col = NA
mes = paste0(mes, "; use 'col = NA' instead of 'borders = NULL'")
} else {
args$col = args$borders
args$borders = NULL
mes = paste0(mes, "; use 'col' instead of 'borders'")
}
}

if ("text.size" %in% names(args)) {
args$text_size = args$text.size
args$text.size = NULL
mes = paste0(mes, "; use 'text_size' instead of 'text.size'")
}
if ("text.col" %in% names(args)) {
args$text_col = args$text.col
args$text.col = NULL
mes = paste0(mes, "; use 'text_col' instead of 'text.col'")
}

message(mes)

if (any(v3_only("qtm") %in% names(args))) {
v3_start_message()
args_called = list(args = args, called = called) |>
v3_instead("symbols.size", "size", "qtm", extra_called = "shape") |>
v3_instead("symbols.col", "size", "qtm", extra_called = "shape") |>
v3_instead("dots.col", "fill", "qtm") |>
v3_instead("lines.lwd", "lwd", "qtm") |>
v3_instead("lines.col", "col", "qtm") |>
v3_instead("raster", "col", "qtm") |>
v3_instead_value("borders", "col", "qtm", value_old = NULL, value_new = NA) |>
v3_instead("text.size", "text_size", "qtm") |>
v3_instead("text.col", "text_col", "qtm") |>
v3_instead("projection", "crs", "qtm")
args = args_called$args
called = args_called$called
}

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

if (missing(shp) || is.character(shp)) {

viewargs <- args[intersect(names(args), names(formals(tm_view)))]

if (!missing(shp)) viewargs$bbox <- shp

g <- c(tm_basemap(basemaps), tm_tiles(overlays), do.call("tm_view", viewargs))
attr(g, "qtm_shortcut") <- TRUE
class(g) <- "tmap"
return(g)
}


nms_shp = intersect(names(args), names(formals(tm_shape)))
g = do.call(tm_shape, args[nms_shp])

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

if (is_rst) {
nms_rst = intersect(names(args), names(formals(tm_raster)))
nms_rst = intersect(names(args), funs_v4$tm_raster)
args_rst = args[nms_rst]

if (!any(c("col", "raster") %in% called)) {
Expand All @@ -202,11 +143,8 @@ qtm <- function(shp,

g = g + do.call(tm_raster, c(args_rst, args_rst_v3))
} else {
nms_all = intersect(names(args), names(formals(tm_sf)))
args_all = args[nms_all]

for (f in c("tm_polygons", "tm_lines", "tm_symbols")) {
nms_f = intersect(names(args), names(formals(f)))
nms_f = intersect(names(args), funs_v4[[f]])
args_f = args[nms_f]
nms_other = intersect(setdiff(names(args), c(nms_f, nms_shp, "basemaps", "overlays", "style", "format")), called)
args_other = args[nms_other]
Expand All @@ -218,7 +156,9 @@ qtm <- function(shp,
if (f == "tm_polygons") {
if (length(args_other)) {
# v3 confusion: tm_polygons used col while qtm used fill, therefore, tm_polygons will be called will col
args_f$col = args_f$fill
args_f$border.col = args_f$col
args_f$col = args$fill
args_f$fill = NULL
}
}

Expand All @@ -230,7 +170,7 @@ qtm <- function(shp,
text_ = substr(names(args), 1, 5) == "text_"
names(args)[text_] = substr(names(args)[text_], 6, nchar(names(args)[text_]))

nms_f = intersect(names(args), names(formals(tm_text)))
nms_f = intersect(names(args), funs_v4$tm_text)
args_f = args[nms_f]
nms_other = intersect(setdiff(names(args), c(nms_f, nms_shp, "basemaps", "overlays", "style", "format")), called)
args_other = args[nms_other]
Expand All @@ -240,6 +180,18 @@ qtm <- function(shp,

}

nms_fct = intersect(names(args), names(formals(tm_facets)))
if (length(nms_fct)) {
g = g + do.call(tm_facets, args[nms_fct])
}

if (!is.null(args$basemaps)) {
g = g + do.call(tm_basemap, list(server = args$basemaps))
}
if (!is.null(args$overlays)) {
g = g + do.call(tm_tiles, list(server = args$overlays))
}


assign("last_map_new", match.call(), envir = .TMAP)
attr(g, "qtm_shortcut") <- FALSE
Expand Down
1 change: 0 additions & 1 deletion R/step1_rearrange.R
Original file line number Diff line number Diff line change
Expand Up @@ -8,7 +8,6 @@ step1_rearrange = function(tmel) {
assign("shapeLib", list(), envir = .TMAP)
assign("justLib", list(), envir = .TMAP)


# find shape, (aesthetic) layer, facet, and other elements
is_tms = vapply(tmel, inherits, "tm_shape", FUN.VALUE = logical(1))
is_tml = vapply(tmel, inherits, "tm_layer", FUN.VALUE = logical(1))
Expand Down
Binary file modified R/sysdata.rda
Binary file not shown.
13 changes: 2 additions & 11 deletions R/tm_layers_polygons.R
Original file line number Diff line number Diff line change
Expand Up @@ -127,17 +127,8 @@ tm_polygons = function(fill = tm_const(),
args = list(...)
args_called = as.list(match.call()[-1]) #lapply(as.list(match.call()[-1]), eval, envir = parent.frame())

v3 = c("alpha", "palette", "convert2density", "area", "n",
"style", "style.args", "as.count", "breaks", "interval.closure",
"labels", "drop.levels", "midpoint", "stretch.palette", "contrast",
"colorNA", "textNA", "showNA", "colorNULL", "thres.poly", "title",
"legend.show", "legend.format", "legend.is.portrait", "legend.reverse",
"legend.hist", "legend.hist.title", "legend.z", "legend.hist.z",
"interactive", "auto.palette.mapping", "max.categories")


if (any(v3 %in% names(args))) {
message("tm_polygons: Deprecated tmap v3 code detected. Code translated to v4")
if (any(v3_only("tm_polygons") %in% names(args))) {
v3_start_message()
if (!("style" %in% names(args))) {
if (!"breaks" %in% names(args)) {
style = "pretty"
Expand Down
41 changes: 41 additions & 0 deletions data-raw/sysdata.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,41 @@
## v3 functions and arguments
library(remotes)
install_github("r-tmap/tmap@v3")

library(tmap)

get_tmap_funs = function() {
nms = getNamespaceExports("tmap")
funs = lapply(nms, function(f) {
g = get(f)
if (is.function(g)) {
x = setdiff(names(do.call(formals, list(g))), "...")
if (is.null(x)) x = character()
x
} else {
NULL
}
})
names(funs) = nms
funs[!sapply(funs, is.null)]
}

funs_v3 = get_tmap_funs()

funs_v3$tm_polygons = unique(c(funs_v3$tm_fill, funs_v3$tm_polygons, funs_v3$tm_borders))


## v4 functions and arguments
devtools::load_all()

funs_v4 = get_tmap_funs()
usethis::use_data(funs_v3, funs_v4, internal = TRUE, overwrite = TRUE)









Loading

0 comments on commit 04ccd90

Please sign in to comment.