updated tm_labels, added Africa example

NAMESPACE

@@ -120,6 +120,8 @@ S3method(tmapSubsetShp,stars)
 export(get_fact_levels_na)
 export(make_by_vars)
 export(marker_icon)
+export(opt_tm_labels)
+export(opt_tm_text)
 export(providers)
 export(qtm)
 export(renderTmap)

R/misc_other.R

@@ -358,35 +358,87 @@ native_to_npc_to_native <- function(x, scale) {
  (x) / (scale[2] - scale[1])
 }
 
-.rectGrob2pathGrob <- function(rg, angles) {
- x <- convertX(rg$x, "inch", valueOnly=TRUE)
- y <- convertY(rg$y, "inch", valueOnly=TRUE)
- w <- convertWidth(rg$width, "inch", valueOnly=TRUE)
- h <- convertHeight(rg$height, "inch", valueOnly=TRUE)
+.rectGrob2pathGrob <- function(rg, angles, bbx) {
+ x = as.numeric(rg$x)
+ y = as.numeric(rg$y)
+ w = as.numeric(rg$width)
+ h = as.numeric(rg$height)
+
+
+ ####################################
+ ### borrowed from pointLabel2
+ ####################################
+
+
+ asp = tmaptools::get_asp_ratio(bbx)# * 1.25
+
+ #xyAspect <- diff(boundary[c(1,2)]) / diff(boundary[c(3,4)])
+
+ toUnityCoords <- function(xy) {
+ if (asp > 1) {
+ list(x = (xy$x - bbx[1])/(bbx[3] - bbx[1]) * asp, 
+ y = (xy$y - bbx[2])/(bbx[4] - bbx[2])) 
+ } else {
+ list(x = (xy$x - bbx[1])/(bbx[3] - bbx[1]), 
+ y = (xy$y - bbx[2])/(bbx[4] - bbx[2])/asp) 
+ }
+
+
+ }
+ toUserCoords <- function(xy) {
+ if (asp > 1) {
+ list(x = bbx[1] + xy$x/asp * (bbx[3] - bbx[1]),
+ y = bbx[2] + xy$y * (bbx[4] - bbx[2]))
+ } else {
+ list(x = bbx[1] + xy$x * (bbx[3] - bbx[1]),
+ y = bbx[2] + xy$y * asp * (bbx[4] - bbx[2]))
+ }
+
+ }
+ xy <- xy.coords(x, y, recycle = TRUE)
+ z <- toUnityCoords(xy)
+ x2 <- z$x
+ y2 <- z$y
+
+ # CHANGED: width and height are specified by user
+ if (asp > 1) {
+ w2 <- ((w) / (bbx[3] - bbx[1])) * asp
+ h2 <- ((h) / (bbx[4] - bbx[2]))
+ } else {
+ w2 <- ((w) / (bbx[3] - bbx[1]))
+ h2 <- ((h) / (bbx[4] - bbx[2])) / asp
+ }
 
- a <- atan2(h, w)
+
+ ####################################
+ ####################################
+ ####################################
+
+
+ xs = c(x2 - w2/2, x2 + w2 / 2, x2 + w2 / 2, x2 - w2 / 2, x2 - w2/2)
+ ys = c(y2 - h2/2, y2 - h2 / 2, y2 + h2 / 2, y2 + h2 / 2, y2 - h2/2)
+
+ a <- atan2(h2, w2)
+ #as <- as.vector(vapply(a, function(a)c(a,pi-a, pi+a,-a), numeric(4)))
  as <- as.vector(vapply(a, function(a)c(a,pi-a, pi+a,-a), numeric(4)))
 
  as2 <- as + rep(angles * pi / 180, each=4)
 
- dst <- rep(sqrt((w/2)^2+(h/2)^2), each=4)
-
- xs <- rep(x, each=4) + cos(as2) * dst
- ys <- rep(y, each=4) + sin(as2) * dst
+ dst <- rep(sqrt((w2/2)^2+(h2/2)^2), each=4)
 
- xs2 <- convertX(unit(xs, "inch"), "npc")
- ys2 <- convertY(unit(ys, "inch"), "npc")
+ xs2 <- rep(x2, each=4) + cos(as2) * dst
+ ys2 <- rep(y2, each=4) + sin(as2) * dst
 
  id <- rep(1:length(x), each=4)
 
- w2 <- w + (h-w) * abs(sin(angles*pi/180))
- h2 <- h + (w-h) * abs(sin(angles*pi/180))
+ #w2 <- w + (h-w) * abs(cos(angles*pi/180))
+ #h2 <- h + (w-h) * abs(sin(angles*pi/180))
 
- w3 <- convertWidth(unit(w2, "inch"), "npc")
- h3 <- convertHeight(unit(h2, "inch"), "npc")
+ z2 <- xy.coords(xs2, ys2, recycle = TRUE)
+ xy2 <- toUserCoords(z2)
 
- list(poly=polygonGrob(xs2, ys2, id=id, gp=rg$gp),
-  rect=rectGrob(rg$x, rg$y, width = w3, height=h3))
+ list(poly=polygonGrob(unit(xy2$x, "native"), unit(xy2$y, "native"), id=id, gp=rg$gp))
+ #list(poly=rectGrob(unit(x, "native"), unit(y, "native"), width = unit(w, "native"), height=unit(h, "native"), gp = rg$gp))
 }
 
 .get_direction_angle <- function(co) {

R/tm_layers_text.R

@@ -1,3 +1,54 @@
+#' @rdname tm_text
+#' @name opt_tm_text
+#' @export
+opt_tm_text = function(points.only = "ifany",
+ just = "center",
+ along.lines = FALSE,
+ bg.padding = 0.4,
+ clustering = FALSE, 
+ point.label = FALSE,
+ point.label.gap = 0,
+ point.label.method = "SANN",
+ remove.overlap = FALSE) {
+ list(trans.args = list(points.only = points.only,
+ along.lines = along.lines),
+ mapping.args = list(just = just,
+ along.lines = along.lines,
+ bg.padding = bg.padding,
+ clustering = clustering,
+ point.label = point.label,
+ point.label.gap = point.label.gap,
+ point.label.method = point.label.method,
+ remove.overlap = remove.overlap))
+}
+
+
+#' @rdname tm_text
+#' @name opt_tm_labels
+#' @export
+opt_tm_labels = function(points.only = "ifany",
+ just = "center",
+ along.lines = TRUE,
+ bg.padding = 0.4,
+ clustering = TRUE, 
+ point.label = TRUE,
+ point.label.gap = 0.4,
+ point.label.method = "SANN",
+ remove.overlap = FALSE) {
+ list(trans.args = list(points.only = points.only,
+ along.lines = along.lines),
+ mapping.args = list(just = just,
+ along.lines = along.lines,
+ bg.padding = bg.padding,
+ clustering = clustering,
+ point.label = point.label,
+ point.label.gap = point.label.gap,
+ point.label.method = point.label.method,
+ remove.overlap = remove.overlap))
+}
+
+
+
 #' Map layer: text
 #' 
 #' Map layer that draws symbols Supported visual variables are: `text`
@@ -51,6 +102,7 @@
 #' groups 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 options options passed on to the corresponding `opt_<layer_function>` function 
 #' @param bgcol,bgcol.scale,bgcol.legend,bgcol.chart,bgcol.free Visual variable that determines
 #' the background color. See Details.
 #' @param bgcol_alpha,bgcol_alpha.scale,bgcol_alpha.legend,bgcol_alpha.chart,bgcol_alpha.free Visual variable that determines
@@ -129,23 +181,12 @@ tm_text = function(text = tm_const(),
  zindex = NA,
  group = NA,
  group.control = "check",
- points.only = "ifany",
- just = "center",
- along.lines = FALSE,
- bg.padding = 0.4,
- clustering = FALSE, 
- point.label = FALSE,
- point.label.gap = 0,
- point.label.method = "SANN",
- remove.overlap = FALSE,
+ options = opt_tm_text(),
  ...) {
 
  #if (FALSE) {
  args = list(...)
 
- trans.args = list(points.only = points.only, along.lines = along.lines)
- mapping.args = list(clustering = clustering, point.label = point.label, remove.overlap = remove.overlap, point.label.gap = point.label.gap, point.label.method = point.label.method, just = just, bg.padding = bg.padding)
-
  # dput(names(formals("tm_text")))
  v3 = c("root", "clustering", "size.lim", "sizes.legend", 
  "sizes.legend.labels", "sizes.legend.text", "n", "style", "style.args", 
@@ -249,7 +290,7 @@ tm_text = function(text = tm_const(),
  layer = "text",
  trans.fun = tmapTransCentroid,
  trans.aes = list(),
- trans.args = trans.args,
+ trans.args = options$trans.args,
  trans.isglobal = FALSE,
  mapping.aes = list(
  text = tmapScale(aes = "text",
@@ -337,7 +378,7 @@ tm_text = function(text = tm_const(),
  tpar = tmapTpar(),
  plot.order = plot.order,
  mapping.fun = "Text",
- mapping.args = mapping.args,
+ mapping.args = options$mapping.args,
  zindex = zindex,
  group = group,
  group.control = group.control,
@@ -408,12 +449,7 @@ tm_labels = function(text = tm_const(),
  zindex = NA,
  group = NA,
  group.control = "check",
- points.only = "ifany",
- along.lines = TRUE,
- clustering = FALSE, 
- point.label = TRUE,
- point.label.gap = 0.3,
- remove.overlap = FALSE,
+ options = opt_tm_labels(),
  ...) {
  args = c(as.list(environment()), list(...))
  tm = do.call(tm_text, args)

R/tm_scale_.R

@@ -32,10 +32,19 @@ tm_scale = function(...) {
  structure(c(list(FUN = "tmapScaleAuto"), list(...)), class = c("tm_scale_auto", "tm_scale", "list"))
 }
 
+#' Scales: as is
+#' 
+#' 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_asis()` is used to take data values as they are and use them as such for the visual variable.
+#' 
+#' @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.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 ... Arguments caught (and not used) from the automatic function [tm_scale()]
 #' @export
-#' @rdname tm_scale
-tm_scale_asis = function(...) {
- structure(c(list(FUN = "tmapScaleAsIs"), list(...)), class = c("tm_scale_asis", "tm_scale", "list"))
+tm_scale_asis = function(values.scale = NA, value.neutral = NA, ...) {
+ structure(c(list(FUN = "tmapScaleAsIs"), c(list(values.scale = values.scale, value.neutral = value.neutral), list(...))), class = c("tm_scale_asis", "tm_scale", "list"))
 }
 
 #' @export

R/tmapGrid_layers.R

@@ -332,11 +332,17 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
  args = list(...)
 
  rc_text = frc(facet_row, facet_col)
+
+ if (("prop_angle" %in% names(shpTM))) {
+ args$point.label = FALSE
+ }
 
  res = select_sf(shpTM, dt)
  shp = res$shp
  dt = res$dt
 
+
+
  # specials non-vv (later on lost after gp_to_gpar)
  shadow = gp$shadow
 
@@ -407,10 +413,12 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 
  if (with_bg || args$remove.overlap) {
  tGH = vapply(grobTextList, function(grb) {
+ grb$rot = 0
  convertHeight(grobHeight(grb), "inch", valueOnly = TRUE)
  }, FUN.VALUE = numeric(1), USE.NAMES = FALSE) * yIn
 
  tGW = vapply(grobTextList, function(grb) {
+ grb$rot = 0
  convertWidth(grobWidth(grb), "inch", valueOnly = TRUE)
  }, FUN.VALUE = numeric(1), USE.NAMES = FALSE) * xIn
 
@@ -426,10 +434,15 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 
  tGH = unit(tGH + args$bg.padding * yIn * lineIn, "native")
  tGW = unit(tGW + args$bg.padding * xIn * lineIn, "native")
-
- grobTextBGList = mapply(function(x, y, w, h, b, a) {
- rectGrob(x=x, y=y, width=w, height=h, gp=gpar(fill=b, alpha = a, col=NA))
- }, tGX, tGY, tGW, tGH, bgcol, bgcol_alpha, SIMPLIFY = FALSE, USE.NAMES = FALSE)
+
+ grobTextBGList = mapply(function(x, y, w, h, b, a, rot) {
+ rect = rectGrob(x=x, y=y, width=w, height=h, gp=gpar(fill=b, alpha = a, col=NA))
+ if (rot != 0) {
+ .rectGrob2pathGrob(rect, rot, bbx)$poly
+ } else {
+ rect
+ }
+ }, tGX, tGY, tGW, tGH, bgcol, bgcol_alpha, angle, SIMPLIFY = FALSE, USE.NAMES = FALSE)
  } else {
  grobTextBGList = NULL
  }

R/tmapScaleRGB.R

@@ -46,36 +46,3 @@ tmapScaleRGB = function(x1, x2, x3, scale, legend, chart, o, aes, layer, layer_a
  list(vals = values, ids = ids, legend = legend, chart = chart, bypass_ord = bypass_ord)
  }
 }
-
-
-tmapScaleAsIs = function(x1, scale, legend, chart, o, aes, layer, layer_args, sortRev, bypass_ord, submit_legend = TRUE) {
- legend = list(title = NA, 
- nitems = 0,
- labels = NA, 
- dvalues = NA, 
- vvalues = NA,
- vneutral = NA,
- na.show = NA,
- scale = "AsIs",
- show = FALSE)
-
- x1h = head(x1, 100)
- check_values(layer, aes, x1h)
-
-
- sfun = paste0("tmapValuesScale_", aes)
- cfun = paste0("tmapValuesColorize_", aes)
-
- x2 = do.call(sfun, list(x = x1, scale = o$scale))
- values = do.call(cfun, list(x = x2, pc = o$pc))
-
- if (submit_legend) {
- if (bypass_ord) {
- format_aes_results(values, legend = legend, chart = chart)
- } else {
- format_aes_results(values, ord = 1L, legend = legend, chart = chart) 
- }
- } else {
- list(vals = values, ids = 1L, legend = legend, chart = chart, bypass_ord = bypass_ord)
- }
-}

R/tmapScale_defaults.R

@@ -69,7 +69,7 @@ tmapValuesCheck_area = function(x) {
 }
 
 tmapValuesCheck_text = function(x) {
- is.character(x)
+ is.character(x) || is.factor(x)
 }
 
 tmapValuesCheck_fontface = function(x) {

examples/tm_symbols.R

@@ -1,15 +1,21 @@
-# load Africa country data
-data(World, metro)
+metroAfrica = sf::st_intersection(metro, World[World$continent == "Africa", ])
 Africa = World[World$continent == "Africa", ]
-metro_A = sf::st_intersection(metro, Africa)
-
-tm_shape(metro_A) +
- tm_symbols()
 
-tm_shape(Africa) + 
- tm_polygons() +
- tm_shape(metro_A) +
- tm_symbols(fill = "pop1950", size = "pop2030", size.scale = tm_scale(values.scale = 2))
+tm_shape(land) +
+ tm_raster("cover_cls", 
+ col.scale = tm_scale(values = cols4all::c4a("brewer.pastel1")[c(3,7,7,2,6,1,2,2)]),
+ col.legend = tm_legend_hide()) +
+ tm_shape(rivers) +
+ tm_lines(lwd = "strokelwd", lwd.scale = tm_scale_asis(values.scale = .3), col = cols4all::c4a("brewer.pastel1")[2]) +
+ tm_shape(Africa, is.main = TRUE) + 
+ tm_borders() +
+ tm_shape(metroAfrica) +
+ tm_symbols(fill = "red", shape = "pop2020", size = "pop2020", 
+ size.scale = tm_scale_intervals(breaks = c(1, 2, 5, 10, 15, 20, 25) * 1e6, values.range = c(0.2,2)),
+ size.legend = tm_legend("Population in 2020"),
+ shape.scale = tm_scale_intervals(breaks = c(1, 2, 5, 10, 15, 20, 25) * 1e6, values = c(21, 23, 22, 21, 23, 22)),
+ shape.legend = tm_legend_combine("size")) +
+ tm_labels("name", options = opt_tm_labels(remove.overlap = FALSE))
 
 
 ##### tmap v3