tm_rgb bug fixed, tm_rgba added

NAMESPACE

@@ -131,7 +131,6 @@ export(opt_tm_lines)
 export(opt_tm_markers)
 export(opt_tm_polygons)
 export(opt_tm_raster)
-export(opt_tm_rgb)
 export(opt_tm_sf)
 export(opt_tm_squares)
 export(opt_tm_symbols)
@@ -221,6 +220,7 @@ export(tm_scale_intervals)
 export(tm_scale_ordinal)
 export(tm_scale_rank)
 export(tm_scale_rgb)
+export(tm_scale_rgba)
 export(tm_scalebar)
 export(tm_sf)
 export(tm_shape)

R/tm_layers_rgb.R

@@ -1,16 +1,19 @@
-#' @rdname tm_raster
+#' @rdname tm_rgb
 #' @name opt_tm_rgb
-#' @export
+#' @param interpolate Should the raster image be interpolated? Currently only applicable in view mode (passed on to [`grid`][grid::rasterGrob()])
 opt_tm_rgb = function(interpolate = FALSE) {
 	list(trans.args = list(),
 		 mapping.args = list(interpolate = interpolate))
 }
 
-#' Map layer: RGB
+#' Map layer: rgb images
+#' 
+#' Map layer that an rgb image.. The used (multivariate) visual variable is `col`, which should be specified with 3 or 4 variables for `tm_rgb` and `tm_rgba` respectively. The first three correspond to the red, green, and blue channels. The optional fourth is the alpha transparency channel.
 #' 
 #' @param col,col.scale,col.legend,col.chart,col.free Visual variable that determines
-#'   the col color.
+#'   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_<layer_function>` function 
+
 #' @export
 tm_rgb = function(col = tm_mv(1:3),
 				  col.scale = tm_scale_rgb(),
@@ -20,3 +23,14 @@ tm_rgb = function(col = tm_mv(1:3),
 				  options = opt_tm_rgb()) {
 	do.call(tm_raster, args = list(col = col, col.scale = col.scale, col.legend = col.legend, col.chart = col.chart, col.free = col.free, options = options))
 }
+
+#' @rdname tm_rgb
+#' @export
+tm_rgba = function(col = tm_mv(1:4),
+				  col.scale = tm_scale_rgba(),
+				  col.legend = tm_legend(),
+				  col.chart = tm_chart_none(),
+				  col.free = NA,
+				  options = opt_tm_rgb()) {
+	do.call(tm_raster, args = list(col = col, col.scale = col.scale, col.legend = col.legend, col.chart = col.chart, col.free = col.free, options = options))
+}

R/tm_scale_.R

@@ -365,12 +365,20 @@ tm_scale_continuous_pseudo_log = function(..., base = exp(1), sigma = 1) {
 #' @param value.na value for missing values
 #' @param maxValue maximum value
 #' @seealso [tm_scale()]
+#' @rdname tm_scale_rgb
 #' @export
 tm_scale_rgb = function(value.na = NA,
 						maxValue = 255) {
 	structure(c(list(FUN = "tmapScaleRGB"), as.list(environment())), class = c("tm_scale_rgb", "tm_scale", "list"))
 }
 
+#' @rdname tm_scale_rgb
+#' @export
+tm_scale_rgba = function(value.na = NA,
+						maxValue = 255) {
+	structure(c(list(FUN = "tmapScaleRGBA"), as.list(environment())), class = c("tm_scale_rgba", "tm_scale", "list"))
+}
+
 # tm_scale_na = function() {
 # 	structure(c(list(FUN = "tmapScaleNA"), as.list(environment())), class = c("tm_scale_na", "tm_scale", "list"))
 # }

R/tmapGrid_misc.R

@@ -272,7 +272,6 @@ hex_to_num = function(h) {
 merge_alpha = function(dt, name) {
 	name_a = paste0(name, "_alpha")
 	f = function(d) {
-
 		d1 = d[1,]
 		col = d1[[name]]
 		alpha = d1[[name_a]]
@@ -281,10 +280,10 @@ merge_alpha = function(dt, name) {
 			a = hex_to_num(substr(col, 8, 9)) * alpha
 			cl = substr(col, 1, 7)
 		} else {
-			a = alpha
+			a = alpha * 255
 			cl = col
 		}
-		ac = paste0(cl, num_to_hex(round(a*255)))
+		ac = paste0(cl, num_to_hex(round(a)))
 		rep(ac, nrow(d))
 	}
 

R/tmapScaleRGB.R

@@ -1,29 +1,35 @@
-tmapScaleRGB = function(x1, x2, x3, scale, legend, chart, o, aes, layer, layer_args, sortRev, bypass_ord, submit_legend = TRUE) {
+tmapScaleRGB_RGBA = function(xlist, scale, legend, chart, o, aes, layer, layer_args, sortRev, bypass_ord, submit_legend = TRUE, called) {
+
+	k = length(xlist)
+	n = length(xlist[[1]])
+
+	cls = vapply(xlist, function(xi) {
+		data_class(xi)[1]
+	}, FUN.VALUE = character(1))
 
-	cls1 = data_class(x1)
-	cls2 = data_class(x2)
-	cls3 = data_class(x3)
+
+	# cls1 = data_class(x1)
+	# cls2 = data_class(x2)
+	# cls3 = data_class(x3)
 
 	if (!(aes %in% c("col", "fill"))) stop("tm_scale_rgb cannot be used for layer ", layer, ", aesthetic ", aes, call. = FALSE)
-	if (cls1[1] != "num" || cls2[1] != "num" || cls3[1] != "num") {
-		stop("tm_scale_rgb requires three numeric variables", call. = FALSE)
+	if (any(cls != "num")) {
+		stop(called, " requires ", {if (called == "tm_scale_rgb") 3 else 4}, " variables", call. = FALSE)
 	}
 
 	#scale = get_scale_defaults(scale, opt, aes, layer, cls)
-	scale$value.na = if (is.na(scale$value.na) || identical(scale$value.na, TRUE)) getAesOption("value.na", o, aes, layer, cls = cls1) else scale$value.na
-
+	scale$value.na = if (is.na(scale$value.na) || identical(scale$value.na, TRUE)) getAesOption("value.na", o, aes, layer, cls = cls[1]) else scale$value.na
 
+	isna = Reduce("|", lapply(xlist, is.na))
 
-	isna = is.na(x1) | is.na(x2) | is.na(x3)
 	if (any(isna)) {
-		values = rep(scale$value.na, length(x1)) 
-		values[!isna] = grDevices::rgb(x1[!isna], x2[!isna], x3[!isna], maxColorValue = scale$maxValue)
-
+		values = rep(scale$value.na, n) 
+		values[!isna] = do.call(grDevices::rgb, c(xlist, list(maxColorValue = scale$maxValue)))
 	} else {
-		values = grDevices::rgb(x1, x2, x3, maxColorValue = scale$maxValue)
+		values = do.call(grDevices::rgb, c(xlist, list(maxColorValue = scale$maxValue)))
 	}
 
-
+	
 	legend = list(title = NA, 
 				  nitems = 0,
 				  labels = NA, 
@@ -32,7 +38,8 @@ tmapScaleRGB = function(x1, x2, x3, scale, legend, chart, o, aes, layer, layer_a
 				  vneutral = "grey50",
 				  na.show = NA,
 				  scale = "RGB",
-				  show = FALSE)
+				  show = FALSE,
+				  active = FALSE)
 
 	chart = list(show = FALSE)
 
@@ -46,3 +53,12 @@ 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)
 	}
 }
+
+
+tmapScaleRGB = function(x1, x2, x3, scale, legend, chart, o, aes, layer, layer_args, sortRev, bypass_ord, submit_legend = TRUE) {
+	tmapScaleRGB_RGBA(xlist = list(x1, x2, x3), scale = scale, legend = legend, chart = chart, o = o, aes = aes, layer = layer, layer_args = layer_args, sortRev = sortRev, bypass_ord = bypass_ord, submit_legend = submit_legend)
+}
+
+tmapScaleRGBA = function(x1, x2, x3, x4, scale, legend, chart, o, aes, layer, layer_args, sortRev, bypass_ord, submit_legend = TRUE) {
+	tmapScaleRGB_RGBA(xlist = list(x1, x2, x3, x4), scale = scale, legend = legend, chart = chart, o = o, aes = aes, layer = layer, layer_args = layer_args, sortRev = sortRev, bypass_ord = bypass_ord, submit_legend = submit_legend)
+}

R/v4-not-implemented.R

@@ -16,12 +16,6 @@ tmap_grob <- function(...) {
 }
 #' @export
 #' @rdname v4-not-yet
-tm_rgba <- function(...) {
-	.Deprecated(new = "tm_rgb()")
-	stop("Not yet implemented in v4")
-}
-#' @export
-#' @rdname v4-not-yet
 tmap_tip <- function(...) {
 	stop("Not yet implemented in v4")
 }