angle implemented

r-tmap · Mar 14, 2024 · 354284d · 354284d
1 parent bd12c21
commit 354284d
Show file tree

Hide file tree

Showing 6 changed files with 76 additions and 16 deletions.
diff --git a/R/tm_layers_text.R b/R/tm_layers_text.R
@@ -109,6 +109,11 @@ tm_text = function(text = tm_const(),
 				   ymod.legend = tm_legend_hide(),
 				   ymod.chart = tm_chart_none(),
 				   ymod.free = NA,
+				   angle = 0,
+				   angle.scale = tm_scale(),
+				   angle.legend = tm_legend_hide(),
+				   angle.chart = tm_chart_none(),
+				   angle.free = NA,
 				   shadow = FALSE,
 				   plot.order = tm_plot_order("AREA", reverse = FALSE, na.order = "bottom"),
 				   trans.args = list(points.only = "ifany"),
@@ -274,6 +279,12 @@ tm_text = function(text = tm_const(),
 						   					  legend = bgcol_alpha.legend,
 						   					  chart = bgcol_alpha.chart,
 						   					  free = bgcol_alpha.free),
+						   angle = tmapScale(aes = "angle",
+						   						value = angle,
+						   						scale = angle.scale,
+						   						legend = angle.legend,
+						   						chart = angle.chart,
+						   						free = angle.free),
 						   fontface = tmapScale(aes = "fontface",
 						   				value = fontface,
 						   				scale = fontface.scale,
@@ -298,6 +309,7 @@ tm_text = function(text = tm_const(),
 						lineend = NA,
 						bgcol = "__bgcol",
 						bgcol_alpha = "__bgcol_alpha",
+						angle = "__angle",
 						shadow = shadow),
 		tpar = tmapTpar(),
 		plot.order = plot.order,

diff --git a/R/tmapGridComp_leg_portrait.R b/R/tmapGridComp_leg_portrait.R
@@ -556,12 +556,17 @@ tmapGridLegPlot.tm_legend_standard_portrait = function(comp, o, fH, fW) {
 		bgcols = rep(gp$bgcol, length.out = nlev)
 		bgcols_alpha = rep(gp$bgcol_alpha, length.out = nlev)
 
+		# in case size is a continuous scale
+		if (is.character(gp$cex)) gp$cex = vapply(cont_split(gp$cex), FUN = function(x) {
+			as.numeric(x[round(length(x)/2)])
+		}, FUN.VALUE = numeric(1))
+
+
 		gpars = gp_to_gpar(gp, split_to_n = nlev, o = o, type = comp$type)
 
 		# scale down (due to facet use)
 		gpars = lapply(gpars, rescale_gp, scale = o$scale_down)
 
-		#		sizes = 
 
 
 		grItems = mapply(function(id, gpari, txt, bgcol, bgcol_alpha, size) {

diff --git a/R/tmapGrid_layers.R b/R/tmapGrid_layers.R
@@ -351,6 +351,7 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 	bgcol = gp$bgcol
 	bgcol_alpha = gp$bgcol_alpha
 
+	angle = gp$angle
 
 	gp = gp_to_gpar(gp, sel = "col", o = o, type = "text")
 
@@ -365,9 +366,9 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 		n = nrow(dt)
 		gps = split_gp(gp, n)
 
-		grobTextList = mapply(function(txt, x , y, gp) {
-			grid::textGrob(x = grid::unit(x, "native"), y = grid::unit(y, "native"), label = txt, gp = gp) #, name = paste0("text_", id))
-		}, dt$text, coords[,1], coords[, 2], gps, SIMPLIFY = FALSE, USE.NAMES = FALSE)
+		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))
+		}, dt$text, coords[,1], coords[, 2], gps, angle, SIMPLIFY = FALSE, USE.NAMES = FALSE)
 
 
 		if (with_bg) {
@@ -403,9 +404,10 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 		if (with_shadow) {
 			gp_sh = gp
 			gp_sh$col = ifelse(is_light(gp$col), "#000000", "#FFFFFF")
-			grobTextShList = mapply(function(x, y, txt) {
-				grid::textGrob(x = grid::unit(x, "native") + grid::unit(0.05, "lines"), y = grid::unit(y, "native") - grid::unit(0.05, "lines"), label = txt, gp = gp_sh)
-			}, coords[,1], coords[,2], dt$text, SIMPLIFY = FALSE, USE.NAMES = FALSE)
+			gps_sh = split_gp(gp_sh, n)
+			grobTextShList = mapply(function(x, y, txt, g, a) {
+				grid::textGrob(x = grid::unit(x, "native") + grid::unit(0.05, "lines"), y = grid::unit(y, "native") - grid::unit(0.05, "lines"), label = txt, gp = g, rot = a)
+			}, coords[,1], coords[,2], dt$text, gps_sh, angle, SIMPLIFY = FALSE, USE.NAMES = FALSE)
 		} else {
 			grobTextShList = NULL
 		}
@@ -416,7 +418,7 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id
 		grb = grid::grobTree(do.call(grid::gList, do.call(c, do.call(mapply, c(list(FUN = list, SIMPLIFY = FALSE, USE.NAMES = FALSE), grobTextAll2)))))
 
 	} else {
-		grobText = grid::textGrob(x = grid::unit(coords[,1], "native"), y = grid::unit(coords[,2], "native"), label = dt$text, gp = gp, name = paste0("text_", id))
+		grobText = grid::textGrob(x = grid::unit(coords[,1], "native"), y = grid::unit(coords[,2], "native"), label = dt$text, gp = gp, name = paste0("text_", id), rot = angle)
 		grb = grid::grobTree(gList(grobText))
 	}
 

diff --git a/R/tmapScale_defaults.R b/R/tmapScale_defaults.R
@@ -45,6 +45,11 @@ tmapValuesCheck_xmod = tmapValuesCheck_ymod = function(x) {
 	TRUE
 }
 
+tmapValuesCheck_angle = tmapValuesCheck_ymod = function(x) {
+	# to do
+	is.numeric(x)
+}
+
 tmapValuesCheck_col_alpha= function(x) {
 	tmapValuesCheck_size(x)
 }
@@ -120,6 +125,9 @@ tmapValuesIsDiv_xmod = tmapValuesIsDiv_ymod = function(x) {
 	tmapValuesIsDiv_size(x)
 }
 
+tmapValuesIsDiv_angle = function(x) {
+	FALSE
+}
 
 tmapValuesIsDiv_shape = function(x) {
 	FALSE
@@ -190,6 +198,9 @@ tmapValuesRange_xmod = tmapValuesRange_ymod = function(x, n, isdiv) {
 	tmapValuesRange_size(x, n, isdiv)
 }
 
+tmapValuesRange_angle = function(x, n, isdiv) {
+	c(0, 1)
+}
 
 tmapValuesRange_text = function(x, n, isdiv) {
 	c(0, 1)
@@ -360,6 +371,10 @@ tmapValuesVV_xmod = tmapValuesVV_ymod = function(...) {
 	do.call(tmapValuesVV_size, args = list(...))
 }
 
+tmapValuesVV_angle = function(...) {
+	do.call(tmapValuesVV_size, args = list(...))
+}
+
 tmapValuesVV_text = function(x, value.na, isdiv, n, dvalues, are_breaks, midpoint, range, scale, rep, o) {
 	list(vvalues = rep(x, length.out = n), value.neutral = x[1], value.na = value.na)
 }
@@ -375,6 +390,7 @@ tmapValuesSubmit_bgcol = function(x, args) x
 tmapValuesSubmit_size = function(x, args) x
 tmapValuesSubmit_xmod = function(x, args) x
 tmapValuesSubmit_ymod = function(x, args) x
+tmapValuesSubmit_angle = function(x, args) x
 tmapValuesSubmit_lwd = function(x, args) x
 tmapValuesSubmit_lty = function(x, args) x
 tmapValuesSubmit_shape = function(x, args) {
@@ -423,6 +439,7 @@ tmapValuesScale_bgcol_alpha = function(x, scale) x
 tmapValuesScale_text = function(x, scale) x
 tmapValuesScale_fontface = function(x, scale) x
 tmapValuesScale_xmod = tmapValuesScale_ymod = function(x, scale) x
+tmapValuesScale_angle = function(x, scale) x
 
 tmapValuesColorize_col = function(x, pc) do.call(process_color, c(list(col = x), pc))
 tmapValuesColorize_fill = function(x, pc) do.call(process_color, c(list(col = x), pc))
@@ -437,7 +454,7 @@ tmapValuesColorize_bgcol_alpha = function(x, pc) x
 tmapValuesColorize_text = function(x, pc) x
 tmapValuesColorize_fontface = function(x, pc) x
 tmapValuesColorize_xmod = tmapValuesColorize_ymod = function(x, pc) x
-
+tmapValuesColorize_angle = function(x, pc) x
 
 
 tmap_seq = function(from = 0, to = 1, power = c("lin", "sqrt", "sqrt_perceptual", "quadratic")) {
@@ -540,6 +557,10 @@ tmapValuesCVV_ymod = function(x, value.na, n, range, scale, rep, o) {
 	tmapValuesVV_ymod(x = x, value.na = value.na, isdiv = FALSE, n = n, dvalues = NA, are_breaks = FALSE, midpoint = NA, range = range, scale = scale, rep = rep)
 }
 
+tmapValuesCVV_angle = function(x, value.na, n, range, scale, rep, o) {
+	tmapValuesVV_angle(x = x, value.na = value.na, isdiv = FALSE, n = n, dvalues = NA, are_breaks = FALSE, midpoint = NA, range = range, scale = scale, rep = rep)
+}
+
 tmapValuesCVV_shape = function(x, value.na, n, range, scale, rep, o) {
 	tmapValuesVV_shape(x = x, value.na = value.na, isdiv = FALSE, n = n, dvalues = NA, are_breaks = FALSE, midpoint = NA, range = range, scale = scale, rep = rep)
 }

diff --git a/R/tmap_options.R b/R/tmap_options.R
@@ -63,7 +63,8 @@
 						 size.text = 1,
 						 fill_alpha = 1,
 						 col_alpha = 1,
-						 bgcol_alpha = 1),
+						 bgcol_alpha = 1,
+						 angle = 0),
 		value.na = list(
 			fill = "grey75",
 			col = "grey75",
@@ -76,7 +77,8 @@
 			fill_alpha = 1,
 			col_alpha = 1,
 			bgcol_alpha = 1,
-			col_alpha.raster = 0
+			col_alpha.raster = 0,
+			angle = 0
 		),
 		value.null = list(
 			fill = "grey95",
@@ -90,7 +92,8 @@
 			fill_alpha = 1,
 			col_alpha = 1,
 			bgcol_alpha = 1,
-			size = 0.2
+			size = 0.2,
+			angle = 0
 		),
 		value.blank = list(
 			fill = "#00000000",
@@ -102,7 +105,8 @@
 			fontface = "plain",
 			fill_alpha = 0,
 			col_alpha = 0,
-			bgcol_alpha = 0
+			bgcol_alpha = 0,
+			angle = 0
 		),
 		values.var = list(fill = list(seq = "hcl.blues3", div = "pu_gn_div",
 									  unord = "tol.muted", ord = "hcl.blues3", cyc = "tol.rainbow_pu_rd", biv = "pu_gn_bivs"),
@@ -122,18 +126,20 @@
 						  shape = 21:25,
 						  area = c(0, 1),
 						  xmod = c(0, 1),
-						  ymod = c(0, 1)),
+						  ymod = c(0, 1),
+						  angle = c(0, 360)),
 		values.range = list(fill = NA, col = NA, size = c(0, 1), lwd = c(0.1, 1),
 							lty = NA, text = NA, fontface = NA, fill_alpha = NA,
-							col_alpha = NA, shape = NA), # NA = automatic, NULL is not applicable
+							col_alpha = NA, shape = NA, angle = NA), # NA = automatic, NULL is not applicable
 		value.neutral = list(size = 0.75,
 							 lwd = 2,
 							 lty = "solid",
 							 fill_alpha = 1,
 							 col_alpha = 1,
 							 bgcol_alpha = 1,
 							 text = "Abc",
-							 fontface = "plain"),
+							 fontface = "plain",
+							 angle = 0),
 		values.scale = list(
 			1,
 			lwd.lines = 1,
@@ -156,6 +162,7 @@
 						  area = list(fact = "categorical", num = "continuous"),
 						  xmod = list(fact = "asis", num = "asis"),
 						  ymod = list(fact = "asis", num = "asis"),
+						  angle = list(fact = "asis", num = "asis"),
 						  text = list(fact = "asis", num = "asis"),
 						  fontface = list(fact = "categorical", num = "categorical")),
 

diff --git a/examples/tm_text.R b/examples/tm_text.R
@@ -15,6 +15,9 @@ tm_shape(World) +
     bgcol_alpha = "pop_est",
     bgcol_alpha.scale = tm_scale_intervals(style = "kmeans"))
 
+tm_shape(metro) +
+	tm_text(text = "name", size = "pop2020", size.legend = tm_legend_hide())
+
 ## xymod
 metro$initial = substr(metro$name,1,1)
 metro$az = (match(metro$initial, LETTERS)-1) /25
@@ -23,3 +26,13 @@ tm_shape(metro) +
 	tm_dots("red") +
 	tm_text("initial", ymod = "az")
 
+# angle
+tm_shape(World) +
+	tm_polygons() +
+tm_shape(metro) +
+	tm_text(text = "name", size = "pop2020", angle = -30, shadow = TRUE)
+
+metro$upside_down = ifelse(sf::st_coordinates(metro)[,2] < 0, 180, 0)
+tm_shape(metro) +
+	tm_text(text = "name", size = "pop2020", angle = "upside_down", size.legend = tm_legend_hide())
+