Skip to content

Commit

Permalink
new default categorical palettes (cols4all); added scalebar, minimap …
Browse files Browse the repository at this point in the history
…and mousecoords to qtm
  • Loading branch information
mtennekes committed Aug 31, 2024
1 parent 209d864 commit f84c89e
Show file tree
Hide file tree
Showing 3 changed files with 213 additions and 194 deletions.
32 changes: 22 additions & 10 deletions R/onLoad.R
Original file line number Diff line number Diff line change
@@ -1,9 +1,9 @@
# envir = environment()
.onLoad = function(...) {
options(tmap.style = "white", tmap.mode = "plot", tmap.design.mode = FALSE,
options(tmap.style = "white", tmap.mode = "plot", tmap.design.mode = FALSE,
tmap.devel.mode = FALSE)
assign("tmapOptions", .defaultTmapOptions, envir = .TMAP)

# makeActiveBinding("tmap_pals", function() {
# remove_non_letters = function(x) gsub("[-, _, \\,, (, ), \\ , \\.]", "", x)
# hcl_pals = grDevices::hcl.pals()
Expand All @@ -13,25 +13,37 @@
# base_pal = structure(as.list(base_pals), names = remove_non_letters(base_pals)),
# pals = structure(as.list(pals), names = pals))
# }, env = envir)

assign("last_map", NULL, envir = .TMAP)
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)

.TMAP$round_to = as.vector(sapply((-9):9, function(i) {
sapply(c(1, 2.5, 5), function(j) {
j*10^i
})
})) # needed for pretty ticks for continuous scale with trans enabled (like log scale)

}

pals = list(area7 = c("#FF9D9A", "#77AADD", "#F1CE63", "#2CA02C", "#B07AA1", "#9EDAE5", "#CC6677"),
area8 = c("#CC6677", "#AEC7E8", "#44BB99", "#B07AA1", "#BBCC33", "#FFAABB", "#B6992D", "#98DF8A"),
area9 = c("#EE8866", "#88CCEE", "#2CA02C", "#B07AA1", "#F1CE63", "#FFAABB", "#6699CC", "#44BB99", "#CC6677"),
area7d = c("#72190E", "#332288", "#225555", "#997700", "#437DBF", "#994F88", "#666633"),
area8d = c("#663333", "#1F77B4", "#225555", "#994F88", "#997700", "#332288", "#666633", "#661100"),
area9d = c("#72190E", "#1965B0", "#225555", "#994F88", "#997700", "#332288", "#666633", "#663333", "#437DBF"),
line7 = c("#1F77B4", "#2CA02C", "#E73F74", "#6699CC", "#994F88", "#117733", "#D37295"),
line8 = c("#DC050C", "#1F77B4", "#117733", "#994F88", "#999933", "#D37295", "#6699CC", "#E73F74"),
line9 = c("#EE3377", "#1F77B4", "#117733", "#CF1C90", "#999933", "#994455", "#6699CC", "#D37295", "#DC050C"))
cols4all::c4a_load(cols4all::c4a_data(pals, types = "cat", series = "c4a"), overwrite = TRUE)


}

#' @export
#' @keywords internal
Expand Down
81 changes: 42 additions & 39 deletions R/qtm.R
Original file line number Diff line number Diff line change
@@ -1,20 +1,20 @@
#' Quick thematic map plot
#'
#'
#' Draw a thematic map quickly. This function is a convenient wrapper of the main
#' plotting method of stacking [`tmap-element`]s. Without arguments or with a
#' search term, this functions draws an interactive map.
#'
#'
#' The first argument is a shape object (normally specified by [tm_shape()]).
#' The next arguments, from `fill` to `raster`, are the aesthetics from the main
#' layers. The remaining arguments are related to the map layout. Any argument
#' from any main layer function, such as [tm_polygons()], can be specified (see `...`).
#' It is also possible to stack [`tmap-element`]s on a `qtm` plot. See examples.
#'
#' By default, a scale bar is shown. This option can be set with [tmap_options()]
#'
#' By default, a scale bar is shown. This option can be set with [tmap_options()]
#' (argument `qtm.scalebar`). A minimap is shown by default when `qtm` is called
#' without arguments of with a search term. This option can be set with [tmap_options()]
#' (argument `qtm.minimap`).
#'
#'
#' @param shp One of:
#' * shape object, which is an object from a class defined by the [`sf`][`sf::sf`]
#' or [`stars`][stars::st_as_stars()] package. Objects from the packages `sp`
Expand All @@ -32,7 +32,7 @@
#' @param scale numeric value that serves as the global scale parameter. All font
#' sizes, symbol sizes, border widths, and line widths are controlled by this value.
#' The parameters `symbols.size`, `text.size`, and `lines.lwd` can be scaled
#' separately with respectively `symbols.scale`, `text.scale`, and
#' separately with respectively `symbols.scale`, `text.scale`, and
#' `lines.scale`. See also `...`.
#' @param title main title. For legend titles, use `X.style`, where X is the
#' layer name (see `...`).
Expand Down Expand Up @@ -66,7 +66,7 @@
#' @references Tennekes, M., 2018, {tmap}: Thematic Maps in {R},
#' Journal of Statistical Software, 84(6), 1-39, \doi{10.18637/jss.v084.i06}
#' @export
qtm <- function(shp,
qtm = function(shp,
fill = tm_const(),
col = tm_const(),
size = tm_const(),
Expand All @@ -91,31 +91,31 @@ 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])

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

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") |>
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

o = tmap_options_mode()
show.warnings = o$show.warnings

if (missing(shp) || is.character(shp)) {
viewargs = args[intersect(names(args), names(formals(tm_view)))]
if (!missing(shp)) viewargs$bbox = shp
Expand All @@ -124,24 +124,24 @@ qtm <- function(shp,
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), funs_v4$tm_raster)
args_rst = args[nms_rst]

if (!any(c("col", "raster") %in% called)) {
args_rst$col = tm_vars()
}

nms_rst_v3 = names(args)[substr(names(args), 1, 7) == "raster."]
args_rst_v3 = args[nms_rst_v3]
args_rst_v3 = args[nms_rst_v3]
names(args_rst_v3) = substr(names(args_rst_v3), 8, nchar(names(args_rst_v3)))

g = g + do.call(tm_raster, c(args_rst, args_rst_v3))
} else {
for (f in c("tm_polygons", "tm_lines", "tm_symbols")) {
Expand All @@ -157,7 +157,7 @@ qtm <- function(shp,
if (f == "tm_lines") {
if (!"col" %in% called) args_f$col = NULL
}

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
Expand All @@ -174,30 +174,33 @@ qtm <- function(shp,
args[substr(names(args), 1, 3) %in% c("col", "siz")] = NULL
text_ = substr(names(args), 1, 5) == "text_"
names(args)[text_] = substr(names(args)[text_], 6, nchar(names(args)[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]
names(args_other) = sub("^[^.]+[.]", "", names(args_other))
g = g + do.call(tm_text, c(args_f, args_other))
}

}

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))
}



if (o$qtm.scalebar) g = g + tm_scalebar()
if (o$qtm.minimap) g = g + tm_minimap()
if (o$qtm.mouse.coordinates) g = g + tm_mouse_coordinates()

assign("last_map_new", match.call(), envir = .TMAP)
attr(g, "qtm_shortcut") = FALSE
g
Expand Down
Loading

0 comments on commit f84c89e

Please sign in to comment.