From 19da021af9b2acc25d240f58fbce617d72cbdd9e Mon Sep 17 00:00:00 2001 From: mtennekes Date: Wed, 8 May 2024 17:56:43 +0200 Subject: [PATCH] improved no-layer case #805 --- R/messages.R | 8 ++++++++ R/step2_data.R | 2 +- R/step3_trans.R | 5 +++-- R/step4_plot.R | 43 +++++++++++++++++++++++++++++++++---------- 4 files changed, 45 insertions(+), 13 deletions(-) diff --git a/R/messages.R b/R/messages.R index 490e8eec..c75afa95 100644 --- a/R/messages.R +++ b/R/messages.R @@ -37,4 +37,12 @@ message_c4a = function(old_palette_name, info) { message(paste0("[cols4all] color palettes: use palettes from the R package cols4all. Run 'cols4all::c4a_gui()' to explore them. The old palette name \"", old_palette_name, "\" is named \"", new2, "\" (in long format \"", new1, "\")")) message_reg(mess) } +} + +message_nothing_to_show = function(any_groups) { + if (any_groups) { + message("[nothing to show] no data layers defined after tm_shape") + } else { + message("[nothing to show] no layers defined") + } } \ No newline at end of file diff --git a/R/step2_data.R b/R/step2_data.R index 9b2af815..a2695511 100644 --- a/R/step2_data.R +++ b/R/step2_data.R @@ -120,7 +120,7 @@ step2_data = function(tm) { gp = gp, tp = tp) }) - names(lrs) = layernames + if (length(lrs)) names(lrs) = layernames shpDT = data.table(shpTM = list(tmg$tms$shpTM)) if (dev) timing_add(s2 = "group") diff --git a/R/step3_trans.R b/R/step3_trans.R index a367204a..2b14ced9 100644 --- a/R/step3_trans.R +++ b/R/step3_trans.R @@ -62,8 +62,9 @@ step3_trans = function(tm) { al[c("trans_dt", "trans_args", "trans_isglobal", "tp")] = NULL al }) - - + if (!length(adi$layers)) { + adi$bbx = tmaptools::bb(shpDT$shpTM[[1]]$shp) + } adi$shpDT = NULL adi diff --git a/R/step4_plot.R b/R/step4_plot.R index 30647046..647143bb 100644 --- a/R/step4_plot.R +++ b/R/step4_plot.R @@ -213,7 +213,15 @@ step4_plot = function(tm, vp, return.asp, show, knit, args) { aux = tm$aux cmp = tm$cmp + if ("bbx" %in% names(tmx[[o$main]])) { + bbm = tmx[[o$main]]$bbx + } else { + bbm = NULL + } + # remove empty data layers + any_groups = (length(tmx) > 0L) + tmx = lapply(tmx, function(tmxi) { tmxi$layers = lapply(tmxi$layers, function(tml) { empt = vapply(tml$shpDT$shpTM, function(sdt) { @@ -224,7 +232,7 @@ step4_plot = function(tm, vp, return.asp, show, knit, args) { empt = vapply(tmxi$layers, is.null, logical(1)) if (all(empt)) { - NULL + NULL } else { tmxi$layers = tmxi$layers[!empt] tmxi @@ -342,19 +350,34 @@ step4_plot = function(tm, vp, return.asp, show, knit, args) { if (o$legend.only) { d = NULL } else if (any_data_layer) { - tmain = tmx[[o$main]][[1]] - # create table with meta data for the facets (row, col id, bbox, asp) d = data.table::data.table(do.call(expand.grid, lapply(structure(o$nby, names = c("by1", "by2", "by3")), seq_len))) d[, i := seq_len(nrow(d))] grps = c("by1", "by2", "by3")[o$free.coords] - d[, bbox:=do.call(get_bbox, as.list(.SD)), by = grps, .SDcols = c("by1", "by2", "by3")] - } else { - bbo = o$bbox - if (!is.null(bbo)) { - bbm = tmaptools::bb(bbo) + + grp_ids = as.integer(substr(names(tmx), 6, nchar(names(tmx)))) + if (o$main %in% grp_ids) { + tmain = tmx[[which(grp_ids == o$main)]][[1]] + d[, bbox:=do.call(get_bbox, as.list(.SD)), by = grps, .SDcols = c("by1", "by2", "by3")] } else { - bbm = sf::st_bbox() + if (is.null(bbm)) { + bbo = o$bbox + if (!is.null(bbo)) { + bbm = tmaptools::bb(bbo) + } else { + bbm = sf::st_bbox() + } + } + d[, bbox:=rep(list(bbm),nrow(d))] + } + } else { + if (is.null(bbm)) { + bbo = o$bbox + if (!is.null(bbo)) { + bbm = tmaptools::bb(bbo) + } else { + bbm = sf::st_bbox() + } } d = data.table::data.table(by1 = 1L, by2 = 1L, by3 = 1L, i = 1, bbox = list(bbm)) } @@ -570,7 +593,7 @@ step4_plot = function(tm, vp, return.asp, show, knit, args) { aux_lid = vapply(aux, function(a) a$lid, FUN.VALUE = numeric(1)) if (!any_data_layer && !length(aux_lid)) { - message("Nothing to show") + message_nothing_to_show(any_groups) return(invisible(NULL)) }