Skip to content

Commit

Permalink
done #788
Browse files Browse the repository at this point in the history
  • Loading branch information
mtennekes committed Sep 24, 2023
1 parent b9c43e0 commit b0a8448
Show file tree
Hide file tree
Showing 11 changed files with 373 additions and 4 deletions.
1 change: 1 addition & 0 deletions NAMESPACE
Original file line number Diff line number Diff line change
Expand Up @@ -155,6 +155,7 @@ export(tm_scale_continuous_log1p)
export(tm_scale_discrete)
export(tm_scale_intervals)
export(tm_scale_ordinal)
export(tm_scale_rank)
export(tm_scale_rgb)
export(tm_scalebar)
export(tm_sf)
Expand Down
2 changes: 2 additions & 0 deletions R/tm_layers_lines.R
Original file line number Diff line number Diff line change
Expand Up @@ -115,6 +115,8 @@ tm_lines = function(col = tm_const(),
"continuous"
} else if (style == "log10") {
"continuous_log"
} else if (style == "order") {
"rank"
} else {
stop("unknown style")
}
Expand Down
2 changes: 2 additions & 0 deletions R/tm_layers_polygons.R
Original file line number Diff line number Diff line change
Expand Up @@ -164,6 +164,8 @@ tm_polygons = function(fill = tm_const(),
"continuous"
} else if (style == "log10") {
"continuous_log"
} else if (style == "order") {
"rank"
} else {
stop("unknown style")
}
Expand Down
85 changes: 84 additions & 1 deletion R/tm_layers_raster.R
Original file line number Diff line number Diff line change
Expand Up @@ -42,6 +42,7 @@
#' can be switched on and off. Options: `"radio"` for radio buttons (meaning only
#' one group can be shown), `"check"` for check boxes (so multiple groups can be
#' shown), and `"none"` for no control (the group cannot be (de)selected).
#' @param ... to catch deprecated arguments from version < 4.0
#' @example ./examples/tm_raster.R
#' @export
tm_raster = function(col = tm_shape_vars(),
Expand All @@ -56,7 +57,89 @@ tm_raster = function(col = tm_shape_vars(),
mapping.args = list(),
zindex = NA,
group = NA,
group.control = "check") {
group.control = "check",
...) {


args = list(...)
args_called = as.list(match.call()[-1]) #lapply(as.list(match.call()[-1]), eval, envir = parent.frame())

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

if (any(v3 %in% names(args))) {
message("Deprecated tmap v3 code detected. Code translated to v4")
if (!("style" %in% names(args))) {
if (!"breaks" %in% names(args)) {
style = "pretty"
} else {
style = "fixed"
}
} else {
style = args$style
}

imp = function(name, value) {
if (name %in% names(args)) args[[name]] else value
}

col.scale.args = list(n = imp("n", 5),
style = style,
style.args = imp("style.args", list()),
breaks = imp("breaks", NULL),
interval.closure = imp("interval.closure", "left"),
drop.levels = imp("drop.levels", FALSE),
midpoint = imp("midpoint", NULL),
as.count = imp("as.count", NA),
values = imp("palette", NA),
values.repeat = !imp("stretch.palette", TRUE),
values.range = imp("contrast", NA),
values.scale = 1,
value.na = imp("colorNA", NA),
value.null = imp("colorNULL", NA),
value.neutral = NA,
labels = imp("labels", NULL),
label.na = imp("textNA", NA),
label.null = NA,
label.format = imp("legend.format", list()))
col.scale.args$fun_pref = if (style == "cat") {
"categorical"
} else if (style %in% c("fixed", "sd", "equal", "pretty", "quantile", "kmeans", "hclust", "bclust", "fisher", "jenks", "dpih", "headtails")) {
"intervals"
} else if (style == "cont") {
"continuous"
} else if (style == "log10") {
"continuous_log"
} else if (style == "order") {
"rank"
} else {
stop("unknown style")
}

col.scale = do.call("tm_scale", args = col.scale.args)

if ("alpha" %in% names(args)) {
col_alpha = args$alpha
}

col.legend.args = alist(title = imp("title", NA),
show = imp("legend.show", NULL),
na.show = imp("na.show", NA),
format = imp("legend.format", list()),
orientation = ifelse(imp("legend.is.portrait", TRUE), "portrait", "landscape"),
reverse = imp("legend.reverse", FALSE))

col.legend = do.call("tm_legend", col.legend.args)
}





tm_element_list(tm_element(
layer = "raster",
Expand Down
2 changes: 2 additions & 0 deletions R/tm_layers_symbols.R
Original file line number Diff line number Diff line change
Expand Up @@ -272,6 +272,8 @@ v3_symbols = function(args, args_called) {
"continuous"
} else if (style == "log10") {
"continuous_log"
} else if (style == "order") {
"rank"
} else {
stop("unknown style")
}
Expand Down
37 changes: 37 additions & 0 deletions R/tm_scale_.R
Original file line number Diff line number Diff line change
Expand Up @@ -236,6 +236,43 @@ tm_scale_continuous = function(n = NULL,
}


#' Scales: rank scale
#'
#' Scales in tmap are configured by the family of functions with prefix `tm_scale`.
#' Such function should be used for the input of the `.scale` arguments in the layer
#' functions (e.g. `fill.scale` in [tm_polygons()]).
#' The function `tm_scale_rank()` is used to rank numeric data.
#'
#' @param n Preferred number of tick labels. Only used if `ticks` is not specified
#' @param ticks Tick values. If not specified, it is determined automatically with `n`
#' @param values (generic scale argument) The visual values. For colors (e.g. `fill` or `col` for [tm_polygons()]) this is a palette name from the `cols4all` package (see [cols4all::c4a()]) or vector of colors, for size (e.g. `size` for [tm_symbols()]) these are a set of sizes (if two values are specified they are interpret as range), for symbol shapes (e.g. `shape` for [tm_symbols()]) these are a set of symbols, etc. The tmap option `values.var` contains the default values per visual variable and in some cases also per data type.
#' @param values.repeat (generic scale argument) Should the values be repeated in case there are more categories?
#' @param values.range (generic scale argument) Range of the values, especially useful for color palettes. Vector of two numbers (both between 0 and 1) where the first determines the minimum and the second the maximum. Full range, which means that all values are used, is encoded as `c(0, 1)`. For instance, when a gray scale is used for color (from black to white), `c(0,1)` means that all colors are used, `0.25, 0.75` means that only colors from dark gray to light gray are used (more precisely `"grey25"` to `"grey75"`), and `0, 0.5` means that only colors are used from black to middle gray (`"grey50"`). When only one number is specified, this is interpreted as the second number (where the first is set to 0). Default values can be set via the tmap option `values.range`.
#' @param values.scale (generic scale argument) Scaling of the values. Only useful for size-related visual variables, such as `size` of [tm_symbols()] and `lwd` of [tm_lines()].
#' @param value.na (generic scale argument) Value used for missing values. See tmap option `"value.na"` for defaults per visual variable.
#' @param value.null (generic scale argument) Value used for NULL values. See tmap option `"value.null"` for defaults per visual variable. Null data values occur when out-of-scope features are shown (e.g. for a map of Europe showing a data variable per country, the null values are applied to countries outside Europe).
#' @param value.neutral (generic scale argument) Value that can be considered neutral. This is used for legends of other visual variables of the same map layer. E.g. when both `fill` and `size` are used for [tm_symbols()] (using filled circles), the size legend items are filled with the `value.neutral` color from the `fill.scale` scale, and fill legend items are bubbles of size `value.neutral` from the `size.scale` scale.
#' @param labels (generic scale argument) Labels
#' @param label.na (generic scale argument) Label for missing values
#' @param label.null (generic scale argument) Label for null (out-of-scope) values
#' @param label.format (generic scale argument) Label formatting (similar to `legend.format` in tmap3)
#' @export
tm_scale_rank = function(n = NULL,
ticks = NULL,
values = NA,
values.repeat = FALSE,
values.range = NA,
values.scale = NA,
value.na = NA,
value.null = NA,
value.neutral = NA,
labels = NULL,
label.na = NA,
label.null = NA,
label.format = list()) {
structure(c(list(FUN = "tmapScaleRank"), as.list(environment())), class = c("tm_scale_rank", "tm_scale", "list"))
}


#' #' @export
#' tm_scale_rank = function(...) {
Expand Down
183 changes: 183 additions & 0 deletions R/tmapScaleRank.R
Original file line number Diff line number Diff line change
@@ -0,0 +1,183 @@

tmapScaleRank = function(x1, scale, legend, o, aes, layer, layer_args, sortRev, bypass_ord, submit_legend = TRUE) {
# update misc argument from tmap option scale.misc.args
scale = update_scale_args("rank", scale, aes, o)

cls = data_class(x1)
maincls = class(scale)[1]

if (cls[1] != "num") {
if (!is.factor(x1)) x1 = as.factor(x1)
x1 = as.integer(x1)
warning(maincls, " is supposed to be applied to numerical data", call. = FALSE)
}

x1 = rank(without_units(x1))

if (aes %in% c("lty", "shape", "pattern")) stop("tm_scale_rank cannot be used for layer ", layer, ", aesthetic ", aes, call. = FALSE)

scale = get_scale_defaults(scale, o, aes, layer, cls)

show.messages <- o$show.messages
show.warnings <- o$show.warnings

with(scale, {
if (all(is.na(x1))) return(tmapScale_returnNA(n = length(x1), legend = legend, value.na = value.na, label.na = label.na, label.show = label.show, na.show = legend$na.show, sortRev = sortRev, bypass_ord = bypass_ord))


ticks.specified = !is.null(ticks)

if (ticks.specified) {
n = length(ticks) - 1
}

limits = range(x1)
breaks = cont_breaks(limits, n=101)

if (is.null(labels)) {
ncont = n
} else {
if (ticks.specified && length(labels) != n+1) {
if (show.warnings) warning("The length of legend labels is ", length(labels), ", which differs from the length of the breaks (", (n+1), "). Therefore, legend labels will be ignored", call.=FALSE)
labels = NULL
} else {
ncont = length(labels)
}
}
q = num2breaks(x = x1, n = 101, style = "fixed", breaks=breaks, approx=TRUE, interval.closure = "left", var=paste(layer, aes, sep = "-"), args = list())

breaks = q$brks
nbrks = length(breaks)
n2 = nbrks - 1

int.closure <- attr(q, "intervalClosure")

# update range if NA (automatic)
if (is.na(values.range[1])) {
fun_range = paste0("tmapValuesRange_", aes)
values.range = do.call(fun_range, args = list(x = values, n = n, isdiv = FALSE))
}
if (length(values.range) == 1 && !is.na(values.range[1])) values.range = c(0, values.range)


fun_check = paste0("tmapValuesCheck_", aes)

are_valid = do.call(fun_check, args = list(x = values))
if (!are_valid) stop("Incorrect values for layer ", layer, ", aesthetic ", aes, "; values should conform aes ", aes, call. = FALSE)

fun_isdiv = paste0("tmapValuesIsDiv_", aes)


fun_getVV = paste0("tmapValuesVV_", aes)
VV = do.call(fun_getVV, list(x = values, value.na = value.na, isdiv = FALSE, n = n2, dvalues = breaks, range = values.range, scale = values.scale * o$scale, are_breaks = TRUE, rep = values.repeat, o = o))

vvalues = VV$vvalues
value.na = VV$value.na

sfun = paste0("tmapValuesScale_", aes)
cfun = paste0("tmapValuesColorize_", aes)
if (is.na(value.neutral)) value.neutral = VV$value.neutral else value.neutral = do.call(sfun, list(x = do.call(cfun, list(x = value.neutral, pc = o$pc)), scale = values.scale))


ids = classInt::findCols(q)
vals = vvalues[ids]
isna = is.na(vals)
anyNA = any(isna)

na.show = update_na.show(label.show, legend$na.show, anyNA)

if (is.null(sortRev)) {
ids = NULL
} else if (is.na(sortRev)) {
ids[] = 1L
} else if (sortRev) {
ids = (as.integer(n2) + 1L) - ids
}

if (anyNA) {
vals[isna] = value.na
if (!is.null(sortRev)) ids[isna] = 0L
}

if (ticks.specified) {
b = ticks
} else {
b = prettyTicks(seq(limits[1], limits[2], length.out = n))
if (!(aes %in% c("col", "fill"))) b = b[b!=0]
}
sel = if (length(b) == 2) TRUE else (b>=limits[1] & b<=limits[2])
b = b[sel]

nbrks_cont <- length(b)
id = as.integer(cut(b, breaks=breaks, include.lowest = TRUE))

id_step = id[-1] - head(id, -1)
id_step = c(id_step[1], id_step, id_step[length(id_step)])
id_lst = mapply(function(i, s1, s2){
#res = round(seq(i-floor(id_step/2), i+ceiling(id_step/2), length.out=11))[1:10]
res1 = round(seq(i-floor(s1/2), i, length.out=6))
res2 = round(seq(i, i+ceiling(s2/2), length.out=6))[2:5]
res = c(res1, res2)
res[res<1 | res>101] = NA
res
}, id, head(id_step, -1), id_step[-1], SIMPLIFY = FALSE)
vvalues = lapply(id_lst, function(i) {
if (legend$reverse) rev(vvalues[i]) else vvalues[i]
})

if (legend$reverse) vvalues = rev(vvalues)

if (na.show) vvalues = c(vvalues, value.na)

# temporarily stack gradient values
vvalues = cont_collapse(vvalues)

# create legend values
values = b

# create legend labels for continuous cases
if (is.null(labels)) {
labels = do.call("fancy_breaks", c(list(vec=b, as.count = FALSE, intervals=FALSE, interval.closure=int.closure), label.format))
} else {
labels = rep(labels, length.out=nbrks_cont)
attr(labels, "align") <- label.format$text.align
}

if (legend$reverse) {
labels.align = attr(labels, "align")
labels = rev(labels)
attr(labels, "align") = labels.align
}
if (na.show) {
labels.align = attr(labels, "align")
labels = c(labels, label.na)
attr(labels, "align") = labels.align
}



legend = within(legend, {
nitems = length(labels)
labels = labels
dvalues = values
vvalues = vvalues
vneutral = value.neutral
na.show = get("na.show", envir = parent.env(environment()))
scale = "rank"
tr = trans_identity
limits = limits
})
# NOTE: tr and limits are included in the output to facilitate the transformation of the leaflet continuous legend ticks (https://github.com/rstudio/leaflet/issues/665)

if (submit_legend) {
if (bypass_ord) {
format_aes_results(vals, legend = legend)
} else {
format_aes_results(vals, ids, legend)
}
} else {
list(vals = vals, ids = ids, legend = legend, bypass_ord = bypass_ord)
}

})
}
2 changes: 1 addition & 1 deletion R/tmapScale_.R
Original file line number Diff line number Diff line change
Expand Up @@ -150,7 +150,7 @@ tmapScaleAuto = function(x1, scale, legend, o, aes, layer, layer_args, sortRev,
sc_pref = scale$fun_pref

if (!is.null(sc_pref)) {
if (sc_pref %in% c("categorical", "continuous", "continuous_log")) {
if (sc_pref %in% c("categorical", "continuous", "continuous_log", "rank")) {
sc = sc_pref
} else {
sc = sc_opt
Expand Down
3 changes: 2 additions & 1 deletion R/tmap_options.R
Original file line number Diff line number Diff line change
Expand Up @@ -140,7 +140,8 @@
scale.misc.args = list(continuous = list(n = c(fill = 5, col = 5, 5),
outliers.trunc = c(FALSE, FALSE),
trans = "identity",
limits = list(fill = NA, col = NA, 0))), # NA means take data range, 0 means include 0
limits = list(fill = NA, col = NA, 0)),
rank = list(n = 5)), # NA means take data range, 0 means include 0



Expand Down
5 changes: 4 additions & 1 deletion man/tm_raster.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

Loading

0 comments on commit b0a8448

Please sign in to comment.