tm_inset #1048

r-tmap · Feb 27, 2025 · c9d2d30 · c9d2d30
1 parent aaa277f
commit c9d2d30
Show file tree

Hide file tree

Showing 13 changed files with 165 additions and 213 deletions.
diff --git a/NAMESPACE b/NAMESPACE
@@ -23,9 +23,9 @@ S3method(tmapGetShapeMeta2,sfc)
 S3method(tmapGetShapeMeta2,stars)
 S3method(tmapGridCompHeight,tm_chart)
 S3method(tmapGridCompHeight,tm_compass)
-S3method(tmapGridCompHeight,tm_component_general)
 S3method(tmapGridCompHeight,tm_credits)
-S3method(tmapGridCompHeight,tm_inset)
+S3method(tmapGridCompHeight,tm_inset_grob)
+S3method(tmapGridCompHeight,tm_inset_map)
 S3method(tmapGridCompHeight,tm_legend_standard_landscape)
 S3method(tmapGridCompHeight,tm_legend_standard_portrait)
 S3method(tmapGridCompHeight,tm_logo)
@@ -37,9 +37,10 @@ S3method(tmapGridCompPrepare,tm_chart)
 S3method(tmapGridCompPrepare,tm_chart_bar)
 S3method(tmapGridCompPrepare,tm_chart_histogram)
 S3method(tmapGridCompPrepare,tm_compass)
-S3method(tmapGridCompPrepare,tm_component_general)
 S3method(tmapGridCompPrepare,tm_credits)
-S3method(tmapGridCompPrepare,tm_inset)
+S3method(tmapGridCompPrepare,tm_inset_gg)
+S3method(tmapGridCompPrepare,tm_inset_grob)
+S3method(tmapGridCompPrepare,tm_inset_map)
 S3method(tmapGridCompPrepare,tm_legend_standard_landscape)
 S3method(tmapGridCompPrepare,tm_legend_standard_portrait)
 S3method(tmapGridCompPrepare,tm_logo)
@@ -49,9 +50,9 @@ S3method(tmapGridCompPrepare,tm_scalebar)
 S3method(tmapGridCompPrepare,tm_title)
 S3method(tmapGridCompWidth,tm_chart)
 S3method(tmapGridCompWidth,tm_compass)
-S3method(tmapGridCompWidth,tm_component_general)
 S3method(tmapGridCompWidth,tm_credits)
-S3method(tmapGridCompWidth,tm_inset)
+S3method(tmapGridCompWidth,tm_inset_grob)
+S3method(tmapGridCompWidth,tm_inset_map)
 S3method(tmapGridCompWidth,tm_legend_standard_landscape)
 S3method(tmapGridCompWidth,tm_legend_standard_portrait)
 S3method(tmapGridCompWidth,tm_logo)
@@ -66,9 +67,9 @@ S3method(tmapGridLegPlot,tm_chart_heatmap)
 S3method(tmapGridLegPlot,tm_chart_histogram)
 S3method(tmapGridLegPlot,tm_chart_violin)
 S3method(tmapGridLegPlot,tm_compass)
-S3method(tmapGridLegPlot,tm_component_general)
 S3method(tmapGridLegPlot,tm_credits)
-S3method(tmapGridLegPlot,tm_inset)
+S3method(tmapGridLegPlot,tm_inset_grob)
+S3method(tmapGridLegPlot,tm_inset_map)
 S3method(tmapGridLegPlot,tm_legend_standard_landscape)
 S3method(tmapGridLegPlot,tm_legend_standard_portrait)
 S3method(tmapGridLegPlot,tm_logo)
@@ -189,7 +190,6 @@ export(tm_chart_none)
 export(tm_chart_violin)
 export(tm_check_fix)
 export(tm_compass)
-export(tm_component)
 export(tm_const)
 export(tm_credits)
 export(tm_crs)

diff --git a/R/misc_options.R b/R/misc_options.R
@@ -115,7 +115,8 @@ getAesValue = function(x, aes) {
 # get options with a prefic
 get_prefix_opt = function(prefix, class, o) {
 	if (missing(prefix)) prefix = substr(class, 4, nchar(class))
-	ot = o[names(o)[substr(names(o), 1, nchar(prefix)) == prefix]]
+	prefixdot = paste0(prefix, ".")
+	ot = o[names(o)[substr(names(o), 1, nchar(prefixdot)) == prefixdot]]
 	names(ot) = substr(names(ot), nchar(prefix)+2, nchar(names(ot)))
 	ot
 }

diff --git a/R/step1_rearrange.R b/R/step1_rearrange.R
@@ -444,20 +444,20 @@ check_v = function(x, var, h_is_num) {
 }
 
 impute_comp = function(a, o) {
-	cls = class(a)[1]
-
-	ot = get_prefix_opt(class = cls, o = o)
-
 	ca = class(a)
 
 	call = names(a)
-
 	a$position = process_position(a$position, o)
-
 	a$padding = process_padding(a$padding)
 
+	ot = get_prefix_opt(class = ca[1], o = o)
 	a = complete_options(a, ot)
 
+	if (length(ca) > 1L) {
+		ot2 = get_prefix_opt(class = ca[2], o = o)
+		a = complete_options(a, ot2)
+	}
+
 	a$call = call
 
 	class(a) = ca

diff --git a/R/step3_trans.R b/R/step3_trans.R
@@ -1,3 +1,12 @@
+crs_reproject_shpTM = function(s, crs, raster.warp) {
+	# crs can be a list per class (due to leaflet EPSG:3857 requirement for raster images)
+	crs2 = sf::st_crs(get_option_class(crs, class = class(s$shp)))
+	if (sf::st_crs(s$shp) != crs2) {
+		s = do.call(tmapReproject, c(s, list(crs = crs2, raster.warp = raster.warp)))
+	}
+	s
+}
+
 step3_trans = function(tm) {
 	ad = tm$tmo
 	o = tm$o
@@ -29,17 +38,10 @@ step3_trans = function(tm) {
 		crs_step4 = o$crs_step4
 		crs_step3 = o$crs_step3
 
-		crs_reproject_shpTM = function(s, crs) {
-			# crs can be a list per class (due to leaflet EPSG:3857 requirement for raster images)
-			crs2 = sf::st_crs(get_option_class(crs, class = class(s$shp)))
-			if (sf::st_crs(s$shp) != crs2) {
-				s = do.call(tmapReproject, c(s, list(crs = crs2, raster.warp = o$raster.warp)))
-			}
-			s
-		}
+
 
 		# step 3.a : reproject crs to main_crs
-		shpDT$shpTM = lapply(shpDT$shpTM, crs_reproject_shpTM, crs = crs_step3)
+		shpDT$shpTM = lapply(shpDT$shpTM, crs_reproject_shpTM, crs = crs_step3, raster.warp = o$raster.warp)
 
 		# step 3.b: apply all global transformation functions
 		for (al in adi$layers) {
@@ -56,7 +58,7 @@ step3_trans = function(tm) {
 			}
 
 			# step 3.c2 : reproject crs to crs (for plotting)
-			al$shpDT$shpTM = lapply(al$shpDT$shpTM, crs_reproject_shpTM, crs = crs_step4)
+			al$shpDT$shpTM = lapply(al$shpDT$shpTM, crs_reproject_shpTM, crs = crs_step4, raster.warp = o$raster.warp)
 
 			al[c("trans_dt", "trans_args", "trans_isglobal", "tp")] = NULL
 			al

diff --git a/R/step4_plot.R b/R/step4_plot.R
@@ -851,7 +851,7 @@ step4_plot = function(tm, vp, return.asp, show, in.shiny, knit, args) {
 		crt_nr_dummy = chart_save(tm_chart_none())
 
 		# inset maps: prepare input for step4
-		inset_ids = if (nrow(cdt) == 0L) integer(0) else which(sapply(cdt$comp, inherits, "tm_inset"))
+		inset_ids = if (nrow(cdt) == 0L) integer(0) else which(sapply(cdt$comp, inherits, "tm_inset_map"))
 		if (length(inset_ids)) {
 			cdt$comp[inset_ids] = lapply(cdt$comp[inset_ids], function(comp) {
 					tmo_i = tm$tmo
@@ -860,11 +860,18 @@ step4_plot = function(tm, vp, return.asp, show, in.shiny, knit, args) {
 					cmp_i = list()
 					prx_i = list()
 
+					if ("crs" %in% names(comp)) {
+						crs_i = comp$crs
+						o_i$crs_step4 = crs_i
+					} else {
+						crs_i = o_i$crs_step4
+					}
 
 					# set legends to inactive
 					tmo_i = lapply(tmo_i, function(tmg) {
 						lapply(tmg, function(tml) {
 							lapply(tml, function(tmi) {
+								tmi$shpDT$shpTM = lapply(tmi$shpDT$shpTM, crs_reproject_shpTM, crs = crs_i, raster.warp = o$raster.warp)
 								tmi$mapping_legend = lapply(tmi$mapping_legend, function(l) {
 									l$legnr = leg_nr_dummy
 									l$crtnr = crt_nr_dummy

diff --git a/R/tm_components.R b/R/tm_components.R
@@ -255,77 +255,3 @@ tm_logo = function(file,
 	args$z = args$z %||% NA_integer_
 	tm_element_list(do.call(tm_element, c(args, list(subclass = c("tm_logo", "tm_component")))))
 }
-
-
-
-#' Map component: general
-#'
-#' Map component that adds an graphical object
-#'
-#' @param x object, e.g. a `grid::grob`.
-#' @param height height of the component in number of text line heights.
-#' @param width width of the component in number of text line heights.
-#' @param dpi dpi of the component (in view mode)
-#' @param margins margins
-#' @param between_margin Margin between
-#' @param stack stack with other map components, either `"vertical"` or `"horizontal"`.
-#' @inheritParams tm_title
-#' @param group.frame group.frame
-#' @param resize_as_group resize_as_group
-#' @param z z
-#' @example ./examples/tm_component.R
-#' @export
-tm_component = function(x,
-						height,
-						width,
-						dpi,
-						margins,
-						between_margin,
-						stack,
-						position,
-						frame,
-						frame.lwd,
-						frame.r,
-						group.frame,
-						resize_as_group,
-						z) {
-	args = lapply(as.list(rlang::call_match()[-1]), eval, envir = parent.frame())
-	args$z = args$z %||% NA_integer_
-	tm_element_list(do.call(tm_element, c(args, list(subclass = c("tm_component_general", "tm_component")))))
-}
-
-#' Map component: inset map
-#'
-#' Map component that adds an inset map
-#'
-#' @param bbox a bounding box
-#' @param height height of the component in number of text line heights.
-#' @param width width of the component in number of text line heights.
-#' @param margins margins
-#' @param between_margin Margin between
-#' @param stack stack with other map components, either `"vertical"` or `"horizontal"`.
-#' @inheritParams tm_title
-#' @param group.frame group.frame
-#' @param resize_as_group resize_as_group
-#' @param z z
-#' @example ./examples/tm_inset.R
-#' @export
-tm_inset = function(bbox,
-					height,
-					width,
-					margins,
-					between_margin,
-					stack,
-					position,
-					frame,
-					frame.lwd,
-					frame.r,
-					group.frame,
-					resize_as_group,
-					z) {
-	args = lapply(as.list(rlang::call_match()[-1]), eval, envir = parent.frame())
-	args$z = args$z %||% NA_integer_
-	tm_element_list(do.call(tm_element, c(args, list(subclass = c("tm_inset", "tm_component")))))
-}
-
-
diff --git a/R/tm_inset.R b/R/tm_inset.R
@@ -0,0 +1,50 @@
+#' Map component: inset maps and other objects
+#'
+#' Map component that adds an inset object, e.g. a mini map
+#'
+#' @param x object to draw. Can be: bounding box, tmap object, ggplot2 object, grob object, image file name.
+#' @param height height of the component in number of text line heights.
+#' @param width width of the component in number of text line heights.
+#' @param margins margins
+#' @param between_margin Margin between
+#' @param stack stack with other map components, either `"vertical"` or `"horizontal"`.
+#' @inheritParams tm_title
+#' @param group.frame group.frame
+#' @param resize_as_group resize_as_group
+#' @param z z
+#' @example ./examples/tm_inset.R
+#' @export
+tm_inset = function(x = NULL,
+					height,
+					width,
+					margins,
+					between_margin,
+					stack,
+					position,
+					frame,
+					frame.lwd,
+					frame.r,
+					group.frame,
+					resize_as_group,
+					z) {
+	args = lapply(as.list(rlang::call_match()[-1]), eval, envir = parent.frame())
+	args$z = args$z %||% NA_integer_
+
+	cls = if (is.null(x) || (inherits(x, "bbox"))) {
+		"map"
+	} else if (inherits(x, "tmap")) {
+		"tmap"
+	} else if (inherits(x, "ggplot")) {
+		"gg"
+	} else if (inherits(x, "grob")) {
+		"grob"
+	} else if (is.character(x)) {
+		"image"
+	} else {
+		stop("Unsupported object")
+	}
+
+	cls2 = paste0("tm_inset_", cls)
+
+	tm_element_list(do.call(tm_element, c(args, list(subclass = c(cls2, "tm_inset", "tm_component")))))
+}
diff --git a/R/tmapGridComp_funs.R b/R/tmapGridComp_funs.R
@@ -815,13 +815,22 @@ tmapGridLegPlot.tm_logo = function(comp, o, fH, fW) {
 
 
 #' @export
-tmapGridCompPrepare.tm_component_general = function(comp, o) {
+tmapGridCompPrepare.tm_inset_grob = function(comp, o) {
 	comp$show = TRUE
 	comp
 }
 
 #' @export
-tmapGridCompHeight.tm_component_general = function(comp, o) {
+tmapGridCompPrepare.tm_inset_gg = function(comp, o) {
+	rlang::check_installed("ggplot2", reason = "for plotting ggplot2 charts")
+	comp$x = ggplot2::ggplotGrob(comp$x)
+	class(comp)[1] = "tm_inset_grob"
+	comp$show = TRUE
+	comp
+}
+
+#' @export
+tmapGridCompHeight.tm_inset_grob = function(comp, o) {
 	marH = comp$margins[c(3,1)] * o$lin
 	hs = c(marH[1], comp$height * o$lin, marH[2])
 
@@ -836,7 +845,7 @@ tmapGridCompHeight.tm_component_general = function(comp, o) {
 }
 
 #' @export
-tmapGridCompWidth.tm_component_general = function(comp, o) {
+tmapGridCompWidth.tm_inset_grob = function(comp, o) {
 	marW = comp$margins[c(2,4)] * o$lin
 
 	ws = c(marW[1], comp$width * o$lin, marW[2])
@@ -851,7 +860,7 @@ tmapGridCompWidth.tm_component_general = function(comp, o) {
 }
 
 #' @export
-tmapGridLegPlot.tm_component_general = function(comp, o, fH, fW) {
+tmapGridLegPlot.tm_inset_grob = function(comp, o, fH, fW) {
 
 	k = length(comp$logo)
 
@@ -876,13 +885,20 @@ tmapGridLegPlot.tm_component_general = function(comp, o, fH, fW) {
 
 
 #' @export
-tmapGridCompPrepare.tm_inset = function(comp, o) {
+tmapGridCompPrepare.tm_inset_map = function(comp, o) {
+	limit_lat = if ("limit_latitude_3857" %in% names(o)) o$limit_latitude_3857 else c(-90, 90)
+
+	if (is.null(comp$x)) {
+		comp$x = sf::st_bbox(c(xmin = -180, xmax = 180, ymin = limit_lat[1], ymax = limit_lat[2]), crs = 4326)
+		comp$crs = tmap_options()$crs_global
+	}
+	comp$bbox = comp$x
 	comp$show = TRUE
 	comp
 }
 
 #' @export
-tmapGridCompHeight.tm_inset = function(comp, o) {
+tmapGridCompHeight.tm_inset_map = function(comp, o) {
 	marH = comp$margins[c(3,1)] * o$lin
 	hs = c(marH[1], comp$height * o$lin, marH[2])
 
@@ -897,7 +913,7 @@ tmapGridCompHeight.tm_inset = function(comp, o) {
 }
 
 #' @export
-tmapGridCompWidth.tm_inset = function(comp, o) {
+tmapGridCompWidth.tm_inset_map = function(comp, o) {
 	marW = comp$margins[c(2,4)] * o$lin
 
 	ws = c(marW[1], comp$width * o$lin, marW[2])
@@ -912,7 +928,7 @@ tmapGridCompWidth.tm_inset = function(comp, o) {
 }
 
 #' @export
-tmapGridLegPlot.tm_inset = function(comp, o, fH, fW) {
+tmapGridLegPlot.tm_inset_map = function(comp, o, fH, fW) {
 
 	k = length(comp$logo)