From 1da634325d787a4bfa7dd2b2a03ce4d667880b99 Mon Sep 17 00:00:00 2001 From: mtennekes Date: Thu, 11 Jan 2024 15:43:01 +0100 Subject: [PATCH] scalebar improved #809 --- R/process_meta.R | 8 ++++---- R/step1_rearrange.R | 2 ++ R/step2_helper_data.R | 4 +--- R/step4_plot.R | 12 ++++++++++-- R/tmapGridComp.R | 45 ++++++++++++++++++++++++++++++------------- R/tmapGridLegend.R | 38 +++++++++++++++++++++++++++--------- R/tmap_options.R | 8 ++++++-- 7 files changed, 84 insertions(+), 33 deletions(-) diff --git a/R/process_meta.R b/R/process_meta.R index 3cf2528a3..48ccc2d4a 100644 --- a/R/process_meta.R +++ b/R/process_meta.R @@ -67,10 +67,10 @@ preprocess_meta = function(o, cdt) { per_col = any(is.na(cdt$by1__) & !is.na(cdt$by2__) & cdt$class == "autoout"), per_facet = any(!is.na(cdt$by1__) & !is.na(cdt$by2__) & cdt$class == "autoout")) } - legend.present.fix = c(any(cdt$class == "out" & cdt$cell.v == "bottom"), - any(cdt$class == "out" & cdt$cell.h == "left"), - any(cdt$class == "out" & cdt$cell.v == "top"), - any(cdt$class == "out" & cdt$cell.h == "right")) + legend.present.fix = c(any(cdt$class == "out" & identical(cdt$cell.v, "bottom")), + any(cdt$class == "out" & identical(cdt$cell.h, "left")), + any(cdt$class == "out" & identical(cdt$cell.v, "top")), + any(cdt$class == "out" & identical(cdt$cell.h, "right"))) } diff --git a/R/step1_rearrange.R b/R/step1_rearrange.R index 57cac8609..53deea440 100644 --- a/R/step1_rearrange.R +++ b/R/step1_rearrange.R @@ -239,6 +239,8 @@ impute_comp = function(a, o) { # special case: position, in case c("left", "top") is used if (is.character(a$position)) a$position = str2pos(a$position) if (is.numeric(a$position)) a$position = num2pos(a$position) + if (inherits(a$position, "tm_pos")) a$position = complete_options(a$position, o$component.position[[a$position$type]]) + a = complete_options(a, ot) diff --git a/R/step2_helper_data.R b/R/step2_helper_data.R index c6d462856..31ecf3938 100644 --- a/R/step2_helper_data.R +++ b/R/step2_helper_data.R @@ -17,8 +17,7 @@ update_l = function(o, l, v, mfun) { if ("position" %in% names(l) && is.character(l$position)) l$position = str2pos(l$position) if ("position" %in% names(l) && is.numeric(l$position)) l$position = num2pos(l$position) - - + if ("position" %in% names(l) && inherits(l$position, "tm_pos")) l$position = complete_options(l$position, o$component.position[[l$position$type]]) l = complete_options(l, oleg) l$call = call @@ -205,7 +204,6 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order) l = update_l(o = o, l = l, v = v, mfun = mfun) - if (length(s) == 0) stop("mapping not implemented for aesthetic ", nm, call. = FALSE) f = s$FUN s$FUN = NULL diff --git a/R/step4_plot.R b/R/step4_plot.R index f74a89e76..20349616e 100644 --- a/R/step4_plot.R +++ b/R/step4_plot.R @@ -699,9 +699,17 @@ step4_plot = function(tm, vp, return.asp, show) { legs_out = copy(cdt[!is_in]) legs_out[, page:=as.integer(NA)] - legs_out[, bbox:=list()] - legs_out[, units:=list()] + # legs_out[, bbox:=list()] + # legs_out[, units:=list()] + + # ad-hoc method: take first bbox and units + bbox_nb = d$bbox[1] + attr(bbox_nb, "borrow") = list(col = d$col[1], row = d$row[1]) + legs_out[, bbox:=bbox_nb] + legs_out[, units:=d$units[1]] + + cdt = data.table::rbindlist(c(list(legs_out), legs_in)) cdt$comp = mapply(function(cmp, bbx, u) { diff --git a/R/tmapGridComp.R b/R/tmapGridComp.R index 9677c7712..5bab0db6c 100644 --- a/R/tmapGridComp.R +++ b/R/tmapGridComp.R @@ -388,6 +388,9 @@ tmapGridCompWidth.tm_scalebar = function(comp, o) { #textP = comp$padding[c(3,1)] * textS * o$lin marW = comp$margins[c(2,4)] * textS * o$lin + + + ws = c(marW[1], 0, marW[2]) sides = switch(comp$position$align.h, left = "second", right = "first", "both") @@ -396,7 +399,7 @@ tmapGridCompWidth.tm_scalebar = function(comp, o) { comp$Win = sum(ws) comp$wsu = wsu - + # in case breaks are used: adjust the legend width later (in tmapGridLegend) comp$WnativeID = 3 if (!is.null(comp$breaks)) { @@ -421,11 +424,17 @@ tmapGridLegPlot.tm_scalebar = function(comp, o, fH, fW) { widths = wsu, heights = hsu)) + #fW_fact = 1 unit = comp$units$unit unit.size = 1/comp$units$to - xrange = comp$bbox[3] - comp$bbox[1] - crop_factor = as.numeric(wsu[3]) / fW + #xrange = (comp$bbox[3] - comp$bbox[1]) * fW_fact + + xrange = fW * comp$cpi + + W = as.numeric(wsu[3]) + + crop_factor = W / fW just = 0 if (is.na(unit.size)) { @@ -437,18 +446,28 @@ tmapGridLegPlot.tm_scalebar = function(comp, o, fH, fW) { xrange2 = xrange/unit.size # to find the label width of first and last item, only used as proxy - tcks = pretty(c(0, xrange2*crop_factor), 4) - tcksL = format(tcks, trim=TRUE) - rngL = c(tcksL[1], paste(unit, tail(tcksL, 1), unit)) - rngW = ((text_width_inch(rngL) / 2) + o$lin * 0.5) * comp$text.size - - # available width for scale bar - sbW = as.numeric(wsu[3]) - sum(rngW) - - crop_factor2 = sbW / fW + if (is.null(comp$breaks)) { - ticks2 = pretty(c(0, xrange2*crop_factor2), round(comp$width * 8)) + + # determine resolution + for (i in 10:1) { + tcks = pretty(c(0, xrange2*crop_factor), i) + + tcks3 = (tcks / xrange2) * fW + + tcksL = format(tcks, trim=TRUE) + + labW = text_width_inch(tcksL) * comp$text.size + + tickW = tcks3[-1] - head(tcks3, -1) + + if (all(tickW > labW[-1])) { + sbW = W - labW + break + } + } + ticks2 = tcks } else { ticks2 = comp$breaks } diff --git a/R/tmapGridLegend.R b/R/tmapGridLegend.R index fb3197f54..71e2a6b90 100644 --- a/R/tmapGridLegend.R +++ b/R/tmapGridLegend.R @@ -24,6 +24,7 @@ process_comp_box = function(comp, sc, o) { tmapGridCompCorner = function(comp, o, stack, pos.h, pos.v, maxH, maxW, offsetIn.h, offsetIn.v, marginIn, are_nums, fH, fW) { + n = length(comp) # if (stack == "vertical") { # maxH = totH - marginInTot @@ -35,7 +36,7 @@ tmapGridCompCorner = function(comp, o, stack, pos.h, pos.v, maxH, maxW, offsetIn legWin = vapply(comp, "[[", FUN.VALUE = numeric(1), "Win") # vapply(comp, leg_standard$fun_width, FUN.VALUE = numeric(1), o = o) legHin = vapply(comp, "[[", FUN.VALUE = numeric(1), "Hin")#vapply(comp, leg_standard$fun_height, FUN.VALUE = numeric(1), o = o) - + group.just = c(pos.h, pos.v) group.frame = comp[[1]]$group.frame @@ -283,33 +284,52 @@ tmapGridLegend = function(comp, o, facet_row = NULL, facet_col = NULL, facet_pag ######### # 5 is rect category consisting of "center"s or numbers - ## update scale_bar width + ## update scale_bar width: identified by the WnativeID = 3 item (null for other components) comp = mapply(function(cmp, bb) { bbw = bb[3] - bb[1] if (!is.null(cmp$WnativeID)) { + bbox_nb = attr(bbox, "borrow") + if (is.null(bbox_nb)) { + bb_facet = sum(colsIn) + } else { + bb_facet = sum(g$colsIn[g$cols_facet_ids[bbox_nb$col]]) + } + oldIn = as.numeric(cmp$wsu[cmp$WnativeID]) + if (is.null(cmp$WnativeRange)) { - newIn = min(totW, cmp$width * sum(colsIn)) - - #cmp$WnativeRange = bbw * cmp$units$to - #newIn = totW - cmp$Win + oldIn + newIn = min(totW, bb_facet * cmp$width) } else { - bbw2 = bbw / sum(colsIn) * totW - newIn = (min(1, ((cmp$WnativeRange / bbw2) / cmp$units$to)) * totW) + (o$lin * cmp$text.size * 3.5) + newIn = totW } + #if (is.null(cmp$WnativeRange)) { + # no specified scare bar width range + # newIn = min(totW, cmp$width * sum(colsIn)) + #} else { + #bbw2 = bbw / sum(colsIn) * totW + # newIn = min(totW, sum(colsIn)) + #newIn = (min(1, ((cmp$WnativeRange / bbw2) / cmp$units$to)) * totW) + (o$lin * cmp$text.size * 3.5) + #} cmp$wsu[cmp$WnativeID] = unit(newIn, "inch") cmp$Win = cmp$Win + (newIn - oldIn) + + + # get cpi: coordinates per inch + + + cmp$cpi = unname(bbw / bb_facet) } cmp }, comp, bbox, SIMPLIFY = FALSE) + qH = rep(totH, 5) qW = rep(totW, 5) legWin = vapply(comp, "[[", FUN.VALUE = numeric(1), "Win") # vapply(comp, leg_standard$fun_width, FUN.VALUE = numeric(1), o = o) legHin = vapply(comp, "[[", FUN.VALUE = numeric(1), "Hin")#vapply(comp, leg_standard$fun_height, FUN.VALUE = numeric(1), o = o) - + # get total value (width or height) getH = function(s, lH) { if (!length(s)) return(NULL) diff --git a/R/tmap_options.R b/R/tmap_options.R index 9209e9a06..c3310d0f3 100644 --- a/R/tmap_options.R +++ b/R/tmap_options.R @@ -235,6 +235,11 @@ text.fontfamily = "", + component.position = list('in' = list(pos.h = "left", pos.v = "top", + align.h = "left", align.v = "top", just.h = "left", just.v = "top"), + out = list(cell.h = "right", cell.v = "center", + pos.h = "left", pos.v = "top", + align.h = "left", align.v = "top", just.h = "left", just.v = "top")), # legend legend.show = TRUE, @@ -377,13 +382,12 @@ scalebar.show = FALSE, scalebar.breaks=NULL, - scalebar.width=.3, + scalebar.width=0.3, scalebar.text.size = .5, scalebar.text.color=NA, scalebar.color.dark="black", scalebar.color.light="white", scalebar.lwd=1, - scalebar.position=NA, scalebar.bg.color=NA, scalebar.bg.alpha=NA, scalebar.size = NULL,