Merged upstream/master into note

R/misc_other.R

@@ -245,6 +245,65 @@ get_midpoint <- function (coords) {
 
 }
 
+# copied from tmap3, may need updating
+process_just <- function(just, interactive) {
+	show.messages <- get("tmapOptions", envir = .TMAP)$show.messages
+	show.warnings <- get("tmapOptions", envir = .TMAP)$show.warnings
+
+	n <- length(just)
+	isnum <- is_num_string(just)
+
+	if (!all(isnum | (just %in% c("left", "right", "top", "bottom", "center", "centre"))) && show.warnings) {
+		warning("wrong specification of argument just", call. = FALSE)
+	}
+
+	just[just == "centre"] <- "center"
+
+	if (interactive) {
+		just <- just[1]
+		if (n > 1 && show.messages) message("In interactive mode, the just argument should be one element")	
+
+		if (isnum[1]) {
+			justnum <- as.numeric(just)
+			just <- ifelse(justnum < .25, "left",
+						   ifelse(justnum > .75, "right", "center"))
+			if (show.messages) message("In interactive mode, just cannot be a numeric value. Therefore, ", justnum, " has been cenverted to \"", just, "\".")
+		}
+	} else {
+		if (n > 2 && show.warnings) warning("The just argument should be a single value or a vector of 2 values.", call. = FALSE)
+		if (n == 1) {
+			if (just %in% c("top", "bottom")) {
+				just <- c("center", just)
+				isnum <- c(FALSE, isnum)
+			} else {
+				just <- c(just, "center")
+				isnum <- c(isnum, FALSE)
+			}
+		}
+
+		x <- ifelse(isnum[1], as.numeric(just[1]),
+					ifelse(just[1] == "left", 0,
+						   ifelse(just[1] == "right", 1,
+						   	   ifelse(just[1] == "center", .5, NA))))
+		if (is.na(x)) {
+			if (show.warnings) warning("wrong specification of argument just", call. = FALSE)
+			x <- .5
+		}
+
+		y <- ifelse(isnum[2], as.numeric(just[2]),
+					ifelse(just[2] == "bottom", 0,
+						   ifelse(just[2] == "top", 1,
+						   	   ifelse(just[2] == "center", .5, NA))))
+		if (is.na(y)) {
+			if (show.warnings) warning("wrong specification of argument just", call. = FALSE)
+			y <- .5
+		}
+		just <- c(x, y)
+	}
+	just
+}
+
+
 
 
 
@@ -375,3 +434,4 @@ native_to_npc_to_native <- function(x, scale) {
 
 
 
+

R/step2_helper_data.R

@@ -97,11 +97,13 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
 			# constant values (take first value (of possible tm_mv per facet)
 			if (any(nvari) > 1) warning("Aesthetic values considered as direct visual variables, which cannot be used with tm_mv", call. = FALSE)
 			val1 = sapply(vars, "[[", 1, USE.NAMES = FALSE)
-
 			check_fun = paste0("tmapValuesCheck_", unm)
-			if (!do.call(check_fun, list(x = val1))) {
+			check = do.call(check_fun, list(x = val1))
+			if (!check) {
 				# to do: add "layer" name e.g. tm_fill is still "polygons" and not "fill"
-				stop("Visual values used for the variable, \"", unm, "\" of layer function \"tm_", layer[1], "\" are incorrect.", call. = FALSE)
+				info = attr(check, "info")
+
+				stop("Visual values used for the variable, \"", unm, "\" of layer function \"tm_", layer[1], "\" are incorrect.", info, call. = FALSE)
 			}
 
 			val1 = do.call(sfun, list(x = val1, scale = o$scale))

R/tm_layers_text.R

@@ -60,10 +60,13 @@
 #'   the text. See details.
 #' @param angle,angle.scale,angle.legend,angle.chart,angle.free Rotation angle
 #' @param points.only should only point geometries of the shape object (defined in [tm_shape()]) be plotted? By default `"ifany"`, which means `TRUE` in case a geometry collection is specified.
+#' @param just justification of the text relative to the point coordinates. Either one of the following values: \code{"left"} , \code{"right"}, \code{"center"}, \code{"bottom"}, and \code{"top"}, or a vector of two values where first value specifies horizontal and the second value vertical justification. Besides the mentioned values, also numeric values between 0 and 1 can be used. 0 means left justification for the first value and bottom justification for the second value. Note that in view mode, only one value is used.
 #' @param along.lines logical that determines whether labels are rotated along the spatial lines. Only applicable if a spatial lines shape is used.
+#' @param bg.padding The padding of the background in terms of line heights.
 #' @param clustering value that determines whether the text labels are clustered in \code{"view"} mode. One of: \code{TRUE}, \code{FALSE}, or the output of \code{\link[leaflet:markerClusterOptions]{markerClusterOptions}}.
 #' @param point.label logical that determines whether the labels are placed automatically.
 #' @param point.label.gap numeric that determines the gap between the point and label
+#' @param point.label.method the optimization method, either `"SANN"` for simulated annealing (the default) or `"GA"` for a genetic algorithm.
 #' @param remove.overlap logical that determines whether the overlapping labels are removed
 #' @param ... to catch deprecated arguments from version < 4.0
 #' @example ./examples/tm_text.R 
@@ -127,18 +130,21 @@ tm_text = function(text = tm_const(),
 				   group = NA,
 				   group.control = "check",
 				   points.only = "ifany",
+				   just = "center",
 				   along.lines = FALSE,
+				   bg.padding = 0.4,
 				   clustering = FALSE, 
 				   point.label = FALSE,
 				   point.label.gap = 0,
+				   point.label.method = "SANN",
 				   remove.overlap = FALSE,
 				   ...) {
 
 	#if (FALSE) {
 	args = list(...)
 
 	trans.args = list(points.only = points.only, along.lines = along.lines)
-	mapping.args = list(clustering = clustering, point.label = point.label, remove.overlap = remove.overlap, point.label.gap = point.label.gap)
+	mapping.args = list(clustering = clustering, point.label = point.label, remove.overlap = remove.overlap, point.label.gap = point.label.gap, point.label.method = point.label.method, just = just, bg.padding = bg.padding)
 
 	# dput(names(formals("tm_text")))
 	v3 = c("root", "clustering", "size.lim", "sizes.legend", 
@@ -148,7 +154,7 @@ tm_text = function(text = tm_const(),
 		   "contrast", "colorNA", "textNA", "showNA", "colorNULL", "fontface", 
 		   "fontfamily", "alpha", "case", "bg.alpha", 
 		   "size.lowerbound", "print.tiny", "scale", "auto.placement", 
-		   "along.lines", "overwrite.lines", "just", "xmod", "ymod", "title.size", 
+		   "along.lines", "overwrite.lines", "xmod", "ymod", "title.size", 
 		   "title.col", "legend.size.show", "legend.col.show", "legend.format", 
 		   "legend.size.is.portrait", "legend.col.is.portrait", "legend.size.reverse", 
 		   "legend.col.reverse", "legend.hist", "legend.hist.title", "legend.size.z", 
@@ -242,18 +248,7 @@ tm_text = function(text = tm_const(),
 	tm_element_list(tm_element(
 		layer = "text",
 		trans.fun = tmapTransCentroid,
-		trans.aes = list(xmod = tmapScale(aes = "xmod",
-											  value = xmod,
-											  scale = xmod.scale,
-											  legend = xmod.legend,
-											  chart = xmod.chart,
-											  free = xmod.free),
-						 ymod = tmapScale(aes = "ymod",
-						 				 value = ymod,
-						 				 scale = ymod.scale,
-						 				 legend = ymod.legend,
-						 				 chart = ymod.chart,
-						 				 free = ymod.free)),
+		trans.aes = list(),
 		trans.args = trans.args,
 		trans.isglobal = FALSE,
 		mapping.aes = list(
@@ -304,7 +299,19 @@ tm_text = function(text = tm_const(),
 						   				scale = fontface.scale,
 						   				legend = fontface.legend,
 						   				chart = fontface.chart,
-						   				free = fontface.free)),
+						   				free = fontface.free),
+						   xmod = tmapScale(aes = "xmod",
+						   				 value = xmod,
+						   				 scale = xmod.scale,
+						   				 legend = xmod.legend,
+						   				 chart = xmod.chart,
+						   				 free = xmod.free),
+						   ymod = tmapScale(aes = "ymod",
+						   				 value = ymod,
+						   				 scale = ymod.scale,
+						   				 legend = ymod.legend,
+						   				 chart = ymod.chart,
+						   				 free = ymod.free)),
 
 		gpar = tmapGpar(fill = NA,
 						col = "__col",
@@ -323,6 +330,8 @@ tm_text = function(text = tm_const(),
 						lineend = NA,
 						bgcol = "__bgcol",
 						bgcol_alpha = "__bgcol_alpha",
+						xmod = "__xmod",
+						ymod = "__ymod",
 						angle = "__angle",
 						shadow = shadow),
 		tpar = tmapTpar(),
@@ -400,7 +409,7 @@ tm_labels = function(text = tm_const(),
 					group = NA,
 					group.control = "check",
 					points.only = "ifany",
-					along.lines = FALSE,
+					along.lines = TRUE,
 					clustering = FALSE, 
 					point.label = TRUE,
 					point.label.gap = 0.3,
@@ -411,3 +420,4 @@ tm_labels = function(text = tm_const(),
 	tm[[1]]$layer = c("labels", "text")
 	tm
 }
+

R/tmapGrid_layers.R

@@ -350,22 +350,36 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 
 
 	# calculate native per line
-		wIn = g$colsIn[g$cols_facet_ids[facet_col]]
-		hIn = g$rowsIn[g$rows_facet_ids[facet_row]]
-		
-		wNative = bbx[3] - bbx[1]
-		hNative = bbx[4] - bbx[2]
-		
-		xIn = wNative / wIn
-		yIn = hNative / hIn
-		
-		
-		lineIn = convertHeight(unit(1, "lines"), "inch", valueOnly = TRUE)
-		#xnpl = (wNative / wIn) / lineIn
-		#ynpl = (hNative / hIn) / lineIn
+	wIn = g$colsIn[g$cols_facet_ids[facet_col]]
+	hIn = g$rowsIn[g$rows_facet_ids[facet_row]]
+
+	wNative = bbx[3] - bbx[1]
+	hNative = bbx[4] - bbx[2]
+
+	xIn = wNative / wIn
+	yIn = hNative / hIn
+
+
+	lineIn = convertHeight(unit(1, "lines"), "inch", valueOnly = TRUE)
+	#xnpl = (wNative / wIn) / lineIn
+	#ynpl = (hNative / hIn) / lineIn
 	#}
 
 
+	just = process_just(args$just, interactive = FALSE)
+	if (args$point.label) {
+		if (!all(just == 0.5)) {
+			just = c(0.5, 0.5)
+			if (get("tmapOptions", envir = .TMAP)$show.messages) message("Point labeling is enabled. Therefore, just will be ignored.")
+
+		}
+	}
+
+
+	# apply xmod and ymod
+	coords[,1] = coords[,1] + xIn * lineIn * gp$cex * gp$xmod
+	coords[,2] = coords[,2] + yIn * lineIn * gp$cex * gp$ymod
+
 	# specials vv (later on lost after gp_to_gpar)
 	bgcol = gp$bgcol
 	bgcol_alpha = gp$bgcol_alpha
@@ -386,10 +400,11 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 		gps = split_gp(gp, n)
 
 		grobTextList = mapply(function(txt, x , y, gp, a) {
-			grid::textGrob(x = grid::unit(x, "native"), y = grid::unit(y, "native"), label = txt, gp = gp, rot = a) #, name = paste0("text_", id))
+			grid::textGrob(x = grid::unit(x, "native"), y = grid::unit(y, "native"), label = txt, gp = gp, rot = a, just = just) #, name = paste0("text_", id))
 		}, dt$text, coords[,1], coords[, 2], gps, angle, SIMPLIFY = FALSE, USE.NAMES = FALSE)
 
 
+
 		if (with_bg || args$remove.overlap) {
 			tGH = vapply(grobTextList, function(grb) {
 				convertHeight(grobHeight(grb), "inch", valueOnly = TRUE)
@@ -399,11 +414,18 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 				convertWidth(grobWidth(grb), "inch", valueOnly = TRUE)
 			}, FUN.VALUE = numeric(1), USE.NAMES = FALSE) * xIn
 
-			tGX = unit(coords[,1], "native")
-			tGY = unit(coords[,2], "native")
+			justx <- .5 - just[1]
+			justy <- .5 - just[2]
 
-			tGH = unit(tGH , "native")
-			tGW = unit(tGW, "native")
+			#tGX <- grobText$x + unit(tGW * justx, "native")
+			#tGY <- grobText$y + unit(tGH * justy, "native")
+
+
+			tGX = unit(coords[,1] + justx * tGW, "native")
+			tGY = unit(coords[,2] + justy * tGH, "native")
+
+			tGH = unit(tGH + args$bg.padding * yIn * lineIn, "native")
+			tGW = unit(tGW + args$bg.padding * xIn * lineIn, "native")
 
 			grobTextBGList = mapply(function(x, y, w, h, b, a) {
 				rectGrob(x=x, y=y, width=w, height=h, gp=gpar(fill=b, alpha = a, col=NA))
@@ -430,7 +452,7 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 
 			rect = do.call(rbind, lapply(s, get_rect_coords))
 
-			res = pointLabel2(x = rect[,1], y = rect[,2], width = rect[,3], height = rect[,4], bbx = bbx, gap = yIn * lineIn * args$point.label.gap, method = "SANN")
+			res = pointLabel2(x = rect[,1], y = rect[,2], width = rect[,3], height = rect[,4], bbx = bbx, gap = yIn * lineIn * args$point.label.gap, method = args$point.label.method)
 
 			sx = res$x - rect[,1]
 			sy = res$y - rect[,2]
@@ -506,3 +528,4 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 	assign("gts", gts, envir = .TMAP_GRID)
 	NULL	
 }
+

R/tmapScaleRGB.R

@@ -59,6 +59,10 @@ tmapScaleAsIs = function(x1, scale, legend, chart, o, aes, layer, layer_args, so
 				  scale = "AsIs",
 				  show = FALSE)
 
+	x1h = head(x1, 100)
+	check_values(layer, aes, x1h)
+
+
 	sfun = paste0("tmapValuesScale_", aes)
 	cfun = paste0("tmapValuesColorize_", aes)
 

R/tmapScale_defaults.R

@@ -42,10 +42,12 @@ tmapValuesCheck_lty = function(x) {
 
 tmapValuesCheck_xmod = tmapValuesCheck_ymod = function(x) {
 	# to do
-	TRUE
+	res = all(x >= -50 & x <= 50)
+	if (!res) attr(res, "info") = " Values found that are outside the [-50,50] range. Note that the default scale for xmod and ymod is tm_scale_asis."
+	res
 }
 
-tmapValuesCheck_angle = tmapValuesCheck_ymod = function(x) {
+tmapValuesCheck_angle = function(x) {
 	# to do
 	is.numeric(x)
 }

R/tmapScale_misc.R

@@ -2,7 +2,10 @@ check_values = function(layer, aes, values) {
 	fun_check = paste0("tmapValuesCheck_", aes)
 
 	are_valid = do.call(fun_check, args = list(x = values))
-	if (!are_valid) stop("Incorrect values for layer ", layer, ", aesthetic ", aes, "; values should conform visual variable \"", aes, "\"", call. = FALSE)
+	if (!are_valid) {
+		info = attr(are_valid, "info")
+		stop("Incorrect values for layer ", layer, ", aesthetic ", aes, "; values should conform visual variable \"", aes, "\".", info, call. = FALSE)
+	}
 }
 
 get_scale_defaults = function(scale, o, aes, layer, cls, ct = NULL) {

examples/tm_text.R

@@ -45,7 +45,7 @@ tm_shape(DE) +
 	tm_polygons() +
 tm_shape(rivers_DE) +
 	tm_lines(lwd = "strokelwd", lwd.scale = tm_scale_asis()) + 
-	tm_text("name", along.lines = TRUE)
+	tm_labels("name")
 
 metroAfrica = sf::st_intersection(metro, World[World$continent == "Africa", ])
 
@@ -63,3 +63,38 @@ tm_shape(metroAfrica) +
 tm_shape(metroAfrica) +
 	tm_labels("name", bgcol = "yellow") +
 	tm_dots("red")
+
+##### v3 examples
+
+current.mode <- tmap_mode("plot")
+
+data(World, metro)
+
+tm_shape(World) +
+	tm_text("name", size="AREA")
+
+
+tm_shape(World) +
+	tm_text("name", size="pop_est", col="continent", palette="Dark2",
+			title.size = "Population", title.col="Continent") +
+	tm_legend(outside = TRUE)
+
+tmap_mode("view")
+
+\dontrun{
+	require(tmaptools)
+	metro_aus <- crop_shape(metro, bb("Australia"))
+
+	tm_shape(metro_aus) +
+		tm_dots() +
+		tm_text("name", just = "top")
+
+	# alternative
+	tm_shape(metro_aus) +
+		tm_markers(text = "name")
+}
+
+# restore current mode
+tmap_mode(current.mode)
+
+