tm_vars tm_scale_rgb (big update!)

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: tmap
 Title: Thematic Maps
-Version: 3.99.9001
+Version: 3.99.9002
 Authors@R: c(
  person("Martijn", "Tennekes", , "mtennekes@gmail.com", role = c("aut", "cre")),
  person("Jakub", "Nowosad", , "nowosad.jakub@gmail.com", role = "ctb"),

NAMESPACE

@@ -187,9 +187,6 @@ export(tm_logo)
 export(tm_markers)
 export(tm_minimap)
 export(tm_mouse_coordinates)
-export(tm_mv)
-export(tm_mv_dim)
-export(tm_mv_shape_vars)
 export(tm_options)
 export(tm_place_legends_bottom)
 export(tm_place_legends_inside)
@@ -229,7 +226,6 @@ export(tm_scale_rgba)
 export(tm_scalebar)
 export(tm_sf)
 export(tm_shape)
-export(tm_shape_vars)
 export(tm_squares)
 export(tm_style)
 export(tm_symbols)
@@ -238,6 +234,7 @@ export(tm_tiles)
 export(tm_title)
 export(tm_title_in)
 export(tm_title_out)
+export(tm_vars)
 export(tm_view)
 export(tm_xlab)
 export(tm_ylab)

R/messages_v4_v3.R

@@ -247,6 +247,12 @@ v3_opt = function(olds, news, layer_fun) {
  message("[v3->v4] ", layer_fun, "(): migrate the layer options ", x, " to 'options = opt_", layer_fun, "(<HERE>)'")
 }
 
+
+v3_tm_rgb = function(r, g, b) {
+ message("[v3->v4] ", "tm_rgb", "(): instead of using r = ", r, ", g = ", g, ", and b = ", b, ", please use col = tm_vars(c(", r, ", ", g, ", ", b, "), multivariate = TRUE)")
+}
+
+
 # v3_multiple = function(layer_fun, vv) {
 # if (!message_thrown("multiple_args")) {
 # message("[v3->v4] ", layer_fun, "(): use '", vv, ".scale = list(<scale1>, <scale2>, ...)' to specify small multiples")

R/process_meta.R

@@ -87,7 +87,6 @@ preprocess_meta = function(o, cdt) {
  set_to_stack_message = FALSE
  }
 
-
  })
 }
 
@@ -141,7 +140,6 @@ process_meta = function(o, d, cdt, aux) {
  o$credits.defined = (!is.na(cid))
 
  bbx = d$bbox[[1]]
-
  within(o, {
  # sasp shape aspect ratio (NA if free coordinates)
  diff_asp = any(d$asp != d$asp[1])
@@ -164,6 +162,7 @@ process_meta = function(o, d, cdt, aux) {
 
 
  if (gs == "Grid") {
+
  bufferH = lineH / 2
  bufferW = lineW / 2
 
@@ -397,7 +396,7 @@ process_meta = function(o, d, cdt, aux) {
 
 
  stacks = o$legend.stack
- 
+
  cdt2[is.na(by1__) & is.na(by2__) & class == "autoout", ':='(cell.h = legend.position.all$cell.h, cell.v = legend.position.all$cell.v)]
  cdt2[!is.na(by1__) & is.na(by2__) & class == "autoout", ':='(cell.h = legend.position.sides$cell.h, cell.v = "by")]
  cdt2[is.na(by1__) & !is.na(by2__) & class == "autoout", ':='(cell.h = "by", cell.v = legend.position.sides$cell.v)]

R/qtm.R

@@ -135,7 +135,7 @@ qtm <- function(shp,
  args_rst = args[nms_rst]
 
  if (!any(c("col", "raster") %in% called)) {
- args_rst$col = tm_shape_vars()
+ args_rst$col = tm_vars()
  }
 
  nms_rst_v3 = names(args)[substr(names(args), 1, 7) == "raster."]

R/step1_helper_facets.R

@@ -81,86 +81,106 @@ step1_rearrange_facets = function(tmo, o) {
  assign("c2d_vars", character(0), envir = .TMAP)
 
  precheck_aes = function(a, layer, shpvars, args) {
- within(a, {
+ b = within(a, {
+ if (inherits(value, "tmapAsIs")) {
+ if (inherits(scale, "tm_scale_auto")) {
+ class(scale) = c("tm_scale_asis", "tm_scale", "list")
+ scale$FUN = tmapScaleAsIs
+ }
+ }
 
- if (inherits(value, "tmapDimVars") || (inherits(value, "tmapMVShpVars") && length(shpvars) == 1L)) {
- if (inherits(value, "tmapDimVars")) {
- if (!(value$x %in% smeta$dims)) stop("Unknown dimension in tm_dim_vars", call. = FALSE)
+ # check if dimension is or should be used
+ if (inherits(value, "tmapVars") && (length(smeta$dims) != 0) && (!is.null(value$dimvalues) || (!is.na(value$x[1]) && length(value$x) == 1L) || (value$multivariate && length(shpvars) == 1L))) {
+ if (is.na(value$x)) {
+ value$x = smeta$dims[1]
  } else {
- value = list(x = smeta$dims[1], values = {
- if (is.na(value$n)) smeta$dims_vals[[1]] else smeta$dims_vals[[1]][1L:value$n]
- })
+ if (length(value$x) > 1L) {
+ warning("dimvalues specified while more than one dimension name is specified. Only the first will be used", call. = FALSE) 
+ value$x = value$x[1]
+ }
+ if (!(value$x %in% smeta$dims)) {
+ stop("dimvalues specified, but dimension \"" , x, "\" not found. Available dimension name(s): ", paste(smeta$dims,collapse = ", "), call. = FALSE)
+ }
  }
-
+ if (is.null(value$dimvalues)) {
+ if (!is.na(value$n)) {
+ value$dimvalues = smeta$dims_vals[[value$x]][1L:value$n]
+ } else {
+ if (!all(value$dimvalues) %in% smeta$dims_vals[[value$x]]) stop("Incorrect dimvalues", call. = FALSE)
+ }
+ }
+
  split_stars_dim = value$x
- if (!all(value$values %in% smeta$dims_vals[[split_stars_dim]])) stop("Unknown values in tm_dim_vars", call. = FALSE)
-
- update_grp_vars(lev = value$x)
- add_used_vars(value$values)
+ add_used_vars(value$dimvalues) 
 
  # redefine value for step 2
- value = structure(list(as.character(value$values)), names = value$x, class = "tmapVars")
-
+ if (value$multivariate) {
+ update_grp_vars(lev = value$x)
+ value = structure(list(as.character(value$dimvalues)), names = paste(as.character(value$dimvalues), collapse = "_"), class = "tmapVars")
+ } else {
+ update_grp_vars(lev = value$dimvalues)
+ value = structure(as.list(as.character(value$dimvalues)), names = as.character(value$dimvalues), class = "tmapVars")
+ }
 
  data_vars = TRUE
  geo_vars = FALSE
-  
+
  } else {
  split_stars_dim = ""
- value_orig = value # just for the case of L156
- if (length(value) && is.na(value[[1]][1]) && !inherits(value, c("tmapMVShpVars", "tmapShpVars"))) {
+
+ #value_orig = value # just for the case of L156
+ if (length(value) && is.na(value[[1]][1]) && !inherits(value, c("tmapOption", "tmapVars", "tmapAsIs", "tmapSpecial"))) {
  # NA -> value.blank
- value = tmapVars(getAesOption("value.blank", o, aes = aes, layer = layer))
+ value = tmapVV(getAesOption("value.blank", o, aes = aes, layer = layer))
  }
 
  if (inherits(value, "tmapOption")) {
- value_orig = tmapVars(getAesOption(value[[1]], o, aes = aes, layer = layer))
+ #value_orig = tmapVV(getAesOption(value[[1]], o, aes = aes, layer = layer))
+ value = tmapVV(getAesOption(value[[1]], o, aes = aes, layer = layer))
+ data_vars = FALSE
+ geo_vars = FALSE
  #if (!is.list(value_orig)) value = list(value_orig)
- value = value_orig
- names(value) = sapply(value, "[", 1)
- } else if (inherits(value, "tmapShpVars")) {
- if (!is.na(value$ids[1])) {
- if (!all(value$ids %in% 1L:length(shpvars))) stop("tm_shape_vars defined for ids = ", paste(value$ids, collapse = ", "), " while there are only ", length(shpvars), " variables", call. = FALSE)
- value = as.list(shpvars[value$ids])
+ #value = value_orig
+ #names(value) = sapply(value, "[", 1)
+ } else if (inherits(value, "tmapVars")) {
+ if (!is.na(value$x[1])) {
+ if (is.character(value$x)) {
+ if (!all(value$x %in% shpvars)) stop("not all variables specified in tm_vars are found", call. = FALSE)
+ vars = value$x
+ } else {
+ if (!all(value$x %in% 1L:length(shpvars))) stop("tm_vars defined for x = ", paste(value$ids, collapse = ", "), " while there are only ", length(shpvars), " variables", call. = FALSE)
+ vars = shpvars[value$x]
+ }
  } else if (!is.na(value$n)) {
- if (length(shpvars) < value$n) stop("tm_shape_vars defined for n = ", value$n, " while there are only ", length(shpvars), " variables", call. = FALSE)
- value = as.list(shpvars[1L:value$n])
+ if (length(shpvars) < value$n) stop("tm_vars defined for n = ", value$n, " while there are only ", length(shpvars), " variables", call. = FALSE)
+ vars = shpvars[1L:value$n]
  } else {
- value = as.list(shpvars)
+ vars = shpvars
  }
- } else if (inherits(value, "tmapMVShpVars")) {
- if (!is.na(value$ids[1])) {
- if (!all(value$ids %in% 1L:length(shpvars))) stop("tm_shape_vars defined for ids = ", paste(value$ids, collapse = ", "), " while there are only ", length(shpvars), " variables", call. = FALSE)
- value = list(shpvars[value$ids])
- } else if (!is.na(value$n)) {
- if (length(shpvars) < value$n) stop("tm_shape_vars specified with n = ", value$n, " but there are only ", length(shpvars), " variables available", call. = FALSE)
- value = list(shpvars[1L:value$n])
+ names(vars) = vars
+ if (value$multivariate) {
+ value = structure(list(unname(vars)), names = paste(vars, collapse = "_"), class = "tmapStandard")
  } else {
- value = list(shpvars)
+ value = structure(as.list(vars), class = "tmapStandard")
  }
- } else {
- value_orig = value
- #value = lapply(value_orig, make.names)
- names(value) = value_orig
 
- if (inherits(value_orig, "tmapAsIs")) {
- if (inherits(scale, "tm_scale_auto")) {
- class(scale) = c("tm_scale_asis", "tm_scale", "list")
- scale$FUN = tmapScaleAsIs
- }
+ data_vars = TRUE
+ geo_vars = FALSE
+ } else {
+ if (inherits(value, "tmapStandard")) {
+ uvalue = unlist(value)
+ data_vars = all(uvalue %in% shpvars)
+ geo_vars = all(uvalue %in% c("AREA", "LENGTH", "MAP_COLORS")) && !data_vars
+ if (data_vars) vars = uvalue
+ } else {
+ data_vars = FALSE
+ geo_vars = FALSE
+ vars = character(0)
  }
  }
  nvars = length(value) #m
  nvari = vapply(value, length, integer(1))
- if (inherits(value_orig, c("tmapSpecial", "tmapAsIs"))) {
- data_vars = FALSE
- geo_vars = FALSE
- } else {
- vars = unlist(value)
- data_vars = all(vars %in% shpvars)
- geo_vars = all(vars %in% c("AREA", "LENGTH", "MAP_COLORS")) && !data_vars
- }
-
+
  convert2density = "convert2density" %in% names(scale) && scale$convert2density 
 
  nflvar = nvars
@@ -176,9 +196,7 @@ step1_rearrange_facets = function(tmo, o) {
  # if (aes == "shape") browser()
  mfun = paste0("tmapValuesSubmit_", aes)
  if (exists(mfun)) {
- value = do.call(mfun, list(x = value_orig, args = args))
- } else {
- value = value_orig
+ value = do.call(mfun, list(x = value, args = args))
  }
  nvars = length(value)
  nflvar = nvars
@@ -190,6 +208,7 @@ step1_rearrange_facets = function(tmo, o) {
  }
  }
  })
+ b
  }
 
 
@@ -243,7 +262,7 @@ step1_rearrange_facets = function(tmo, o) {
 
  # split stars if needed (dimension -> attributes)
  split_stars_dim = get_split_stars_dim(tmg$tmls)
- shp = tmapSplitShp(shp, split_stars_dim)
+ shp = tmapSplitShp(shp, split_stars_dim, smeta)
  if (split_stars_dim != "") {
  smeta = tmapGetShapeMeta1(shp, o)
  if (dev) timing_add(s3 = "get_shape_meta1_2")
@@ -409,7 +428,6 @@ step1_rearrange_facets = function(tmo, o) {
  } 
  }
  }
-
 
  if (is.na(free.coords)) {
  if (type %in% c("wrapstack", "wrap", "stack", "page")) {
@@ -443,6 +461,7 @@ step1_rearrange_facets = function(tmo, o) {
  })
 
  tmf = get_tmf(lapply(tmo, function(tmoi) tmoi$tmf))
+
  tmo$tmf_global = tmf
  tmo
 }

R/step2_helper_data.R

@@ -112,9 +112,9 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
 
  if (inherits(val, "tmapUsrCls")) {
  temp = local({
- # not data driven variable: visual variable to support tm_mv of other visual variable (e.g. fill of donut maps)
- k = length(aes$value[[1]])
- vls = unname(aes$value[[1]])
+ # not data driven variable: visual variable to support tm_vars(multivariate = TRUE) of other visual variable (e.g. fill of donut maps)
+ k = length(aes$value[[1]]$x)
+ vls = unname(aes$value[[1]]$x)
  dtl = data.table::data.table(tmapID__ = 1L:k, sel = TRUE, value = factor(vls, levels = vls))
 
 
@@ -142,7 +142,6 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
  submit_legend = TRUE)
  dtl[, c(varname, legname, crtname) := do.call(f, c(unname(.SD), arglist)), .SDcols = "value"]
 
-
  list(val = paste(dtl[[varname]], collapse = "__"),
  legnr = dtl$legnr_1[1],
  ctrnr = dtl$crtnr_1[1])
@@ -161,8 +160,8 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
 
  if (!aes$data_vars && !aes$geo_vars) {
  #cat("step2_grp_lyr_aes_const", unm," \n")
- # constant values (take first value (of possible tm_mv per facet)
- if (any(nvari) > 1) warning("Aesthetic values considered as direct visual variables, which cannot be used with tm_mv", call. = FALSE)
+ # constant values (take first value (of possible multivariate per facet)
+ if (any(nvari) > 1) warning("Aesthetic values considered as direct visual variables, which cannot be used with multivariate variables", call. = FALSE)
  val1 = sapply(vars, "[[", 1, USE.NAMES = FALSE)
  check_fun = paste0("tmapValuesCheck_", nm)
  check = do.call(check_fun, list(x = val1))
@@ -304,9 +303,8 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
  names(val) = val_name
  vars = vars[1] # only needed for update_fl?
  }
-
  if (length(v)) update_fl(k = v, lev = vars)
- 
+
  apply_scale = function(s, l, crt, v, varname, ordname, legname, crtname, sortRev, bypass_ord) {
  l = update_l(o = o, l = l, v = v, mfun = mfun, unm = unm, active = TRUE)
  crt = update_crt(o = o, crt = crt, v = v, mfun = mfun, unm = unm, active = TRUE)
@@ -340,6 +338,19 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
  if (all(is.ena(l$title))) l$title = paste0(names(v), attr(cls, "units"), unit)
  }
 
+ if (f != "tmapScaleAuto") {
+ # number of variables needed
+ fnames = names(formals(f))
+ fnvar = which(fnames == "scale") - 1L
+ if (fnames[1] != "...") {
+ if (fnvar > length(v)) {
+ stop("Too few variables defined")
+ } else if (fnvar < length(v)) {
+ warning("Too many variables defined")
+ v = v[1L:fnvar]
+ }
+ }
+ }
 
 
  #aesname = aes$aes
@@ -416,7 +427,6 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
  ordnames = paste(unm__ord, 1L:nvars, sep = "_")
  legnames = paste("legnr", 1L:nvars, sep = "_")
  crtnames = paste("crtnr", 1L:nvars, sep = "_")
-
  for (i in 1L:nvars) {
  dtl = apply_scale(scale[[i]], legend[[i]], crt[[i]], val[[i]], varnames[[i]], ordnames[[i]], legnames[[i]], crtnames[[i]], sortRev = sortRev, bypass_ord = bypass_ord)
  }
@@ -434,6 +444,7 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
  #sel = !vapply(dtl_leg$legend, is.null, logical(1))
  dtl_leg = dtl_leg[legnr != 0, c(grp_bv_fr, "legnr"), with = FALSE]
  dtl_crt = dtl_crt[crtnr != 0, c(grp_bv_fr, "crtnr"), with = FALSE]
+
  } else {
  #cat("step2_grp_lyr_aes_var_one_aes_column\n")
 

R/step2_helper_facets.R

@@ -70,7 +70,6 @@ get_tmf = function(tmfs) {
  if (tmf$type == "wrapstack") {
  tmf$type = if (tmf$n > 3) "wrap" else "stack"
  }
-
  tmf
 }
 

R/tm_layers_raster.R

@@ -55,7 +55,7 @@ opt_tm_raster = function(interpolate = FALSE) {
 #' @param ... to catch deprecated arguments from version < 4.0
 #' @example ./examples/tm_raster.R 
 #' @export
-tm_raster = function(col = tm_shape_vars(),
+tm_raster = function(col = tm_vars(),
  col.scale = tm_scale(value.na = "#00000000"),
  col.legend = tm_legend(),
  col.chart = tm_chart_none(),