From ca86e1d2a51a8bfbf71edf1833805ca739f2d3c1 Mon Sep 17 00:00:00 2001 From: mtennekes Date: Sun, 21 Jul 2024 17:54:09 +0200 Subject: [PATCH] fixed #819 --- NAMESPACE | 1 + R/step1_helper_facets.R | 27 ++++++++++++++++++++++++--- R/step2_helper_data.R | 15 --------------- R/tm_layers_rgb.R | 6 +++--- R/tm_scale_.R | 13 +++++++++++-- R/tmapScale_.R | 3 ++- examples/tm_rgb.R | 28 ++++++++++++++-------------- man/tm_rgb.Rd | 37 +++++++++++++++++++++++++++++++++++-- man/tm_shape_vars.Rd | 8 +++++++- 9 files changed, 97 insertions(+), 41 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index 8b647632..0d44f360 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -185,6 +185,7 @@ 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) diff --git a/R/step1_helper_facets.R b/R/step1_helper_facets.R index a13f354f..5121b93e 100644 --- a/R/step1_helper_facets.R +++ b/R/step1_helper_facets.R @@ -83,8 +83,15 @@ step1_rearrange_facets = function(tmo, o) { precheck_aes = function(a, layer, shpvars, args) { within(a, { - if (inherits(value, "tmapDimVars")) { - if (!(value$x %in% smeta$dims)) stop("Unknown dimension in tm_dim_vars", call. = FALSE) + if (inherits(value, "tmapDimVars") || (inherits(value, "tmapMVShpVars") && length(shpvars) == 1L && value$n >= 1)) { + if (inherits(value, "tmapDimVars")) { + if (!(value$x %in% smeta$dims)) stop("Unknown dimension in tm_dim_vars", call. = FALSE) + } 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] + }) + } + 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) @@ -110,7 +117,21 @@ step1_rearrange_facets = function(tmo, o) { if (!is.list(value_orig)) value = list(value_orig) names(value) = sapply(value, "[", 1) } else if (inherits(value, "tmapShpVars")) { - value = as.list(shpvars) + if (is.na(value$n)) { + value = as.list(shpvars) + } else { + 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]) + } + } else if (inherits(value, "tmapMVShpVars")) { + if (is.na(value$n)) { + value = list(shpvars) + } else { + 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]) + } } else { value_orig = value #value = lapply(value_orig, make.names) diff --git a/R/step2_helper_data.R b/R/step2_helper_data.R index 2097df80..7d9e60b6 100644 --- a/R/step2_helper_data.R +++ b/R/step2_helper_data.R @@ -159,21 +159,6 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order) aes$data_vars = FALSE } - # - # List of 10 - # $ scale :List of 1 - # ..- attr(*, "class")= chr [1:3] "tm_scale_auto" "tm_scale" "list" - # $ legend :List of 65 - # ..- attr(*, "class")= chr [1:2] "tm_legend_standard_portrait" "list" - # $ chart :List of 36 - # ..- attr(*, "class")= chr [1:4] "tm_chart_none" "tm_chart" "tm_component" "list" - # $ o :List of 343 - # $ aes : chr "fill" - # $ layer : chr "polygons" - # $ layer_args : list() - # $ sortRev : logi NA - # $ bypass_ord : logi FALSE - # $ submit_legend: logi TRUE 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) diff --git a/R/tm_layers_rgb.R b/R/tm_layers_rgb.R index d619ddde..82919b3c 100644 --- a/R/tm_layers_rgb.R +++ b/R/tm_layers_rgb.R @@ -13,9 +13,9 @@ opt_tm_rgb = function(interpolate = FALSE) { #' @param col,col.scale,col.legend,col.chart,col.free Visual variable that determines #' the col color. `col` is a multivariate variable, with 3 (`tm_rgb`) or 4 (`tm_rgba`) numeric data variables. These can be specified via [tm_mv()] or [tm_mv_dim()] #' @param options options passed on to the corresponding `opt_` function - +#' @example ./examples/tm_rgb.R #' @export -tm_rgb = function(col = tm_mv(1:3), +tm_rgb = function(col = tm_mv_shape_vars(3), col.scale = tm_scale_rgb(), col.legend = tm_legend(), col.chart = tm_chart_none(), @@ -26,7 +26,7 @@ tm_rgb = function(col = tm_mv(1:3), #' @rdname tm_rgb #' @export -tm_rgba = function(col = tm_mv(1:4), +tm_rgba = function(col = tm_mv_shape_vars(4), col.scale = tm_scale_rgba(), col.legend = tm_legend(), col.chart = tm_chart_none(), diff --git a/R/tm_scale_.R b/R/tm_scale_.R index 657ec834..2f8d5b72 100644 --- a/R/tm_scale_.R +++ b/R/tm_scale_.R @@ -11,9 +11,18 @@ tm_const = function() { #' #' tmap function to specify all variables in the shape object #' +#' @param n the first `n` shape variables are used +#' @rdname tm_shape_vars #' @export -tm_shape_vars = function() { - structure(list(), class = c("tm_shape_vars", "list")) +tm_shape_vars = function(n = NA) { + structure(list(n = n), class = c("tm_shape_vars", "list")) +} + +#' @rdname tm_shape_vars +#' @name tm_mv_shape_vars +#' @export +tm_mv_shape_vars = function(n = NA) { + structure(list(n = n), class = c("tm_mv_shape_vars", "list")) } #' Scales: automatic scale diff --git a/R/tmapScale_.R b/R/tmapScale_.R index eaa75271..b682e742 100644 --- a/R/tmapScale_.R +++ b/R/tmapScale_.R @@ -21,7 +21,8 @@ tm_mv_dim = function(x, values) { tmapVars = function(x) { if (inherits(x, "tmapOption")) return(x) - if (inherits(x, "tm_shape_vars")) return(structure(list(), class = "tmapShpVars")) + if (inherits(x, "tm_shape_vars")) return(structure(list(n = x$n), class = "tmapShpVars")) + if (inherits(x, "tm_mv_shape_vars")) return(structure(list(n = x$n), class = "tmapMVShpVars")) if (inherits(x, "tmapDimVars")) return(x) cls = if (inherits(x, "AsIs")) "tmapAsIs" else if (inherits(x, "tmapUsrCls")) "tmapUsrCls" else "tmapVars" diff --git a/examples/tm_rgb.R b/examples/tm_rgb.R index 29fad091..7a380d72 100644 --- a/examples/tm_rgb.R +++ b/examples/tm_rgb.R @@ -1,31 +1,31 @@ +require(stars) file = system.file("tif/L7_ETMs.tif", package = "stars") L7 = stars::read_stars(file) -# not working yet #819 tm_shape(L7) + tm_rgb() +\dontrun{ +# the previous example was a shortcut of this call tm_shape(L7) + tm_rgb(col = tm_mv_dim("band", 1:3)) -tm_shape(L7) + - tm_rgba(col = tm_mv_dim("band", 1:4)) - -library(stars) +# alternative format: using a stars dimension instead of attributes L7_alt = split(L7, "band") - -# not working yet #819 tm_shape(L7_alt) + tm_rgb() tm_shape(L7_alt) + tm_rgb(col = tm_mv("X1", "X2", "X3")) -tm_shape(L7_alt) + - tm_rgb(col = tm_mv(1:3)) - -L7_terra = terra::rast(file) - -tm_shape(L7_terra) + - tm_rgb(col = do.call(tm_mv, as.list(names(L7_terra)[1:3]))) +if (requireNamespace("terra")) { + L7_terra = terra::rast(file) + + tm_shape(L7_terra) + + tm_rgb() + + tm_shape(L7_terra) + + tm_rgb(tm_mv(names(L7_terra)[1:3])) +} +} diff --git a/man/tm_rgb.Rd b/man/tm_rgb.Rd index b61045c6..1f7aaeb6 100644 --- a/man/tm_rgb.Rd +++ b/man/tm_rgb.Rd @@ -9,7 +9,7 @@ opt_tm_rgb(interpolate = FALSE) tm_rgb( - col = tm_mv(1:3), + col = tm_mv_shape_vars(3), col.scale = tm_scale_rgb(), col.legend = tm_legend(), col.chart = tm_chart_none(), @@ -18,7 +18,7 @@ tm_rgb( ) tm_rgba( - col = tm_mv(1:4), + col = tm_mv_shape_vars(4), col.scale = tm_scale_rgba(), col.legend = tm_legend(), col.chart = tm_chart_none(), @@ -37,3 +37,36 @@ the col color. \code{col} is a multivariate variable, with 3 (\code{tm_rgb}) or \description{ Map layer that an rgb image.. The used (multivariate) visual variable is \code{col}, which should be specified with 3 or 4 variables for \code{tm_rgb} and \code{tm_rgba} respectively. The first three correspond to the red, green, and blue channels. The optional fourth is the alpha transparency channel. } +\examples{ +require(stars) +file = system.file("tif/L7_ETMs.tif", package = "stars") + +L7 = stars::read_stars(file) + +tm_shape(L7) + + tm_rgb() + +\dontrun{ +# the previous example was a shortcut of this call +tm_shape(L7) + + tm_rgb(col = tm_mv_dim("band", 1:3)) + +# alternative format: using a stars dimension instead of attributes +L7_alt = split(L7, "band") +tm_shape(L7_alt) + + tm_rgb() + +tm_shape(L7_alt) + + tm_rgb(col = tm_mv("X1", "X2", "X3")) + +if (requireNamespace("terra")) { + L7_terra = terra::rast(file) + + tm_shape(L7_terra) + + tm_rgb() + + tm_shape(L7_terra) + + tm_rgb(tm_mv(names(L7_terra)[1:3])) +} +} +} diff --git a/man/tm_shape_vars.Rd b/man/tm_shape_vars.Rd index 48d6cd54..c0d08f8a 100644 --- a/man/tm_shape_vars.Rd +++ b/man/tm_shape_vars.Rd @@ -2,9 +2,15 @@ % Please edit documentation in R/tm_scale_.R \name{tm_shape_vars} \alias{tm_shape_vars} +\alias{tm_mv_shape_vars} \title{tmap function to specify all variables in the shape object} \usage{ -tm_shape_vars() +tm_shape_vars(n = NA) + +tm_mv_shape_vars(n = NA) +} +\arguments{ +\item{n}{the first \code{n} shape variables are used} } \description{ tmap function to specify all variables in the shape object