fixed #934

R/step1_rearrange.R

@@ -238,7 +238,7 @@ step1_rearrange = function(tmel) {
 
  if (dev) timing_add(s2 = "prep shape")
 
- if (!is.null(tms$unit)) o$unit = tms$unit
+ if (any_data_layer && !is.null(tms$unit)) o$unit = tms$unit
 
  list(tmo = tmo, aux = aux, cmp = cmp, prx = prx, o = o)
 }

R/tmapGridSymbols.R

@@ -39,20 +39,9 @@ tmapGridSymbols = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page,
  coords = sf::st_coordinates(shp)
 
  # in case shp is a multipoint (point.per == "segment"), expand gp:
- if (ncol(coords) == 3L) {
- ndt = nrow(dt)
- gp = lapply(gp, function(gpi) {
- if (is.list(gpi)) {
- unlist(gpi)
- } else if (length(gpi) == ndt) {
- gpi[coords[,3L]]
- } else {
- gpi
- }
- })
- coords = coords[, 1:2, drop=FALSE]
- }
-
+ cp = expand_coords_gp(coords, gp, ndt = nrow(dt))
+ coords = cp$coords
+ gp = cp$gp
 
  if (diffAlpha) {
  gp1 = gp_to_gpar(gp, sel = "fill", o = o, type = "symbols")

R/tmapGridText.R

@@ -3,100 +3,95 @@
 #' @rdname tmap_internal
 tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id, pane, group, o, ...) {
  args = list(...)
- 
+
  rc_text = frc(facet_row, facet_col)
- 
+
  if (("prop_angle" %in% names(shpTM))) {
  args$point.label = FALSE
  }
- 
+
  res = select_sf(shpTM, dt[!is.na(dt$size), ])
- 
+
  shp = res$shp
  dt = res$dt
- 
- 
- 
+
+
+
  # specials non-vv (later on lost after gp_to_gpar)
  shadow = args$shadow
- 
- 
+
+
  gp = impute_gp(gp, dt)
  gp = rescale_gp(gp, o$scale_down)
- 
+
  coords = sf::st_coordinates(shp)
- 
+
  # in case shp is a multipoint (point.per == "segment"), expand gp:
- if (ncol(coords) == 3L) {
- ndt = nrow(dt)
- gp = lapply(gp, function(gpi) {
- if (is.list(gpi)) {
- unlist(gpi)
- } else if (length(gpi) == ndt) {
- gpi[coords[,3L]]
- } else {
- gpi
- }
- })
- coords = coords[,1:2]
- n = nrow(coords)
- text = dt$text[match(shpTM$tmapID_expanded, shpTM$tmapID)]
+ cp = expand_coords_gp(coords, gp, ndt = nrow(dt))
+ coords = cp$coords
+ gp = cp$gp
+
+ n = nrow(coords)
+
+ if (cp$expanded) {
+ shpTM_match = match(shpTM$tmapID_expanded, shpTM$tmapID)
+ text = dt$text[shpTM_match]
  } else {
- n = nrow(dt)
  text = dt$text
  }
-
-
+
+
+
  g = get("g", .TMAP_GRID)
- 
- 
+
+
  # calculate native per line
  wIn = g$colsIn[g$cols_facet_ids[facet_col]]
  hIn = g$rowsIn[g$rows_facet_ids[facet_row]]
- 
+
  wNative = bbx[3] - bbx[1]
  hNative = bbx[4] - bbx[2]
- 
+
  xIn = wNative / wIn
  yIn = hNative / hIn
- 
+
  lineIn = convertHeight(unit(1, "lines"), "inch", valueOnly = TRUE)
 
- 
- 
+
+
  just = process_just(args$just, interactive = FALSE)
  if (args$point.label) {
  if (!all(just == 0.5)) {
  just = c(0.5, 0.5)
  if (get("tmapOptions", envir = .TMAP)$show.messages) message("Point labeling is enabled. Therefore, just will be ignored.")
- 
+
  }
  }
- 
- 
+
+
  # apply xmod and ymod
  coords[,1] = coords[,1] + xIn * lineIn * gp$cex * gp$xmod
  coords[,2] = coords[,2] + yIn * lineIn * gp$cex * gp$ymod
 
- 
+
  # specials vv (later on lost after gp_to_gpar)
  bgcol = gp$bgcol
  bgcol_alpha = gp$bgcol_alpha
- 
+
  angle = gp$angle
- 
+
  gp = gp_to_gpar(gp, sel = "col", o = o, type = "text")
- 
+
  with_bg = any(bgcol_alpha != 0)
  with_shadow = (!identical(args$shadow, FALSE))
- 
- 
+
+
  if (with_bg || with_shadow || args$remove.overlap || args$point.label) {
  # grobs are processed seperately because of the order: backgrond1, shadow1, text1, background2, shadow2, text2, etc.
- # becaues it is less efficient when there is no background/shadow (majority of use cases), this is a seperate routine
- 
+ # becaues it is less efficient when there is no background/shadow (majority of use cases), this is a separate routine
+
  gps = split_gp(gp, n)
- 
+
  grobTextList = mapply(function(txt, x , y, gp, a) {
  grid::textGrob(x = grid::unit(x, "native"), y = grid::unit(y, "native"), label = txt, gp = gp, rot = a, just = just) #, name = paste0("text_", id))
  }, text, coords[,1], coords[,2], gps, angle, SIMPLIFY = FALSE, USE.NAMES = FALSE)
@@ -111,31 +106,31 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
  } else {
  grobTextShList = NULL
  }
- 
+
  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
- 
+
  justx <- .5 - just[1]
  justy <- .5 - just[2]
- 
+
  #tGX <- grobText$x + unit(tGW * justx, "native")
  #tGY <- grobText$y + unit(tGH * justy, "native")
- 
- 
+
+
  tGX = unit(coords[,1] + justx * tGW, "native")
  tGY = unit(coords[,2] + justy * tGH, "native")
- 
+
  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, rot) {
  rect = rectGrob(x=x, y=y, width=w, height=h, gp=gpar(fill=b, alpha = a, col=NA))
  if (rot != 0) {
@@ -147,12 +142,12 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
  } else {
  grobTextBGList = NULL
  }
- 
+
  #if (args$auto.placement || args$remove.overlap) {
  # grobs to sf
  s = do.call(c,lapply(grobTextBGList, .grob2Poly))
  #}
- 
+
  if (args$point.label) {
  get_rect_coords = function(polygon) {
  co = sf::st_coordinates(polygon)
@@ -163,28 +158,28 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
  width = xr[2] - xr[1],
  height = yr[2] - yr[1])
  }
- 
+
  rect = do.call(rbind, lapply(s, get_rect_coords))
- 
+
  res = pointLabel2(x = rect[,1], y = rect[,2], width = rect[,3], height = rect[,4], bbx = bbx, gap = yIn * lineIn * args$point.label.gap, method = args$point.label.method)
- 
+
  sx = res$x - rect[,1]
  sy = res$y - rect[,2]
- 
+
  grobTextList = mapply(function(grb, sxi, syi) {
  grb$x = grb$x + grid::unit(sxi, "native")
  grb$y = grb$y + grid::unit(syi, "native")
  grb
  }, grobTextList, sx, sy, SIMPLIFY = FALSE)
- 
- 
+
+
  grobTextBGList = mapply(function(grb, sxi, syi) {
  grb$x = grb$x + grid::unit(sxi, "native")
  grb$y = grb$y + grid::unit(syi, "native")
  grb
  }, grobTextBGList, sx, sy, SIMPLIFY = FALSE)
- 
- 
+
+
  if (with_shadow) {
  grobTextShList = mapply(function(grb, sxi, syi) {
  grb$x = grb$x + grid::unit(sxi, "native")
@@ -193,7 +188,7 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
  }, grobTextShList, sx, sy, SIMPLIFY = FALSE)
  }
  }
- 
+
  if (args$remove.overlap) {
  im = sf::st_intersects(s, sparse = FALSE)
  sel = rep(TRUE, length(s))
@@ -208,35 +203,35 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
  } else {
  sel = TRUE
  }
- 
+
  if (!with_bg && args$remove.overlap) {
  grobTextBGList = NULL
  }
-
 
-
+
+
  grobTextAll = list(grobTextBGList[sel], grobTextShList[sel], grobTextList[sel])
  grobTextAll2 = grobTextAll[!vapply(grobTextAll, is.null, FUN.VALUE = logical(1))]
- 
+
  grb = grid::grobTree(do.call(grid::gList, do.call(c, do.call(mapply, c(list(FUN = list, SIMPLIFY = FALSE, USE.NAMES = FALSE), grobTextAll2)))))
- 
+
  } else {
  grobText = grid::textGrob(x = grid::unit(coords[,1], "native"), y = grid::unit(coords[,2], "native"), label = text, gp = gp, name = paste0("text_", id), rot = angle)
  grb = grid::grobTree(gList(grobText))
  }
- 
- 
+
+
  gts = get("gts", .TMAP_GRID)
  gt = gts[[facet_page]]
- 
+
  gt_name = paste0("gt_facet_", rc_text)
- 
+
  gt = grid::addGrob(gt, grb, gPath = grid::gPath(gt_name))
- 
- 
- 
+
+
+
  gts[[facet_page]] = gt
  assign("gts", gts, envir = .TMAP_GRID)
- NULL 
+ NULL
 }