disabled #972, migrated examples to new vignette (topo_africa) to red…

…uce example running time.

R/messages.R

@@ -117,6 +117,12 @@ message_webgl_checks = function(checks, checkif) {
 
 }
 
+message_webgl_crs_simple = function() {
+	cli::cli_inform("{.field [view mode]} WegGL does not work (yet) with projected map projections, so it has been disabled.")
+
+}
+
+
 message_qtm_empty = function() {
 	cli::cli_inform(
 		"{.field [qtm()]} nothing to show. Either specify {.arg shp} or {.arg basemap}. Alternatively, switch to view mode with {.code tmap_mode(\"view\")}"

R/tm_layers_text.R

@@ -25,6 +25,7 @@
 #' @param options options passed on to the corresponding `opt_<layer_function>` function
 #' @param ... to catch deprecated arguments from version < 4.0
 #' @example ./examples/tm_text.R
+#' @seealso \href{https://r-tmap.github.io/tmap/articles/examples_topo_Africa}{Topographic map}
 #' @export
 tm_text = function(text = tm_const(),
 				   text.scale = tm_scale(),

R/tm_layout.R

@@ -27,7 +27,8 @@ tm_layout = function(
 #' View mode options. These options are specific to the view mode.
 #'
 #' @param use_browser If `TRUE` it opens an external browser, and `FALSE` (default) it opens the internal IDEs (e.g. RStudio) browser.
-#' @param use_WebGL use webGL for points, lines, and polygons. This is much faster than the standard leaflet layer functions, but the number of visual variables are limited; only fill, size, and color (for lines) are supported. By default `TRUE` if no other visual variables are used.
+#' @param use_WebGL use webGL for points, lines, and polygons. For large spatial objects, this is much faster than the standard leaflet layer functions. However, it can not always be used for two reasons. First, the number of visual variables are limited; only fill, size, and color (for lines) are supported. Second, projected CRS's are not supported. Furthermore, it has the drawback that polygon borders are not as sharp. By default only `TRUE` for large spatial objects (500 or more features) when the mentioned criteria are met.
+#'  By default `TRUE` if no other visual variables are used.
 #' @param control.position `r .doc_opt("control.position")`
 #' @param control.bases base layers
 #' @param control.overlays overlay layers

R/tmapLeaflet_layers.R

@@ -21,61 +21,67 @@ submit_labels = function(labels, cls, pane, group) {
 	labels
 }
 
-impute_webgl = function(use_WebGL, dt, supported, checkif = NULL, type, hover, popup) {
+impute_webgl = function(use_WebGL, dt, supported, checkif = NULL, type, hover, popup, crs_class) {
 	if (!identical(use_WebGL, FALSE)) {
-		vary = vapply(dt, function(x) {
-			any(is.na(x)) || any(x!=x[1])
-		}, FUN.VALUE = logical(1))
-
-		vary = vary[setdiff(names(vary), c(supported, "tmapID__", "ord__"))]
+		if (crs_class == "L.CRS.Simple") {
+			message_webgl_crs_simple()
+			use_WebGL = FALSE
+		} else {
 
-		if (!is.null(checkif)) {
-			checks = vapply(seq_along(checkif), function(i) {
-				if (!(checkif[i] %in% names(dt))) {
-					TRUE
-				} else {
-					dt[[names(checkif)[i]]][1] %in% checkif[[i]]
-				}
+			vary = vapply(dt, function(x) {
+				any(is.na(x)) || any(x!=x[1])
 			}, FUN.VALUE = logical(1))
-		} else {
-			checks = TRUE
-		}
 
-		if (any(vary)) {
-			if (is.na(use_WebGL)) {
-				use_WebGL = FALSE
-			} else {
-				message_webgl_vars(supported, vary)
-			}
-		} else if (!all(checks)) {
-			if (is.na(use_WebGL)) {
-				use_WebGL = FALSE
-			} else {
-				checkif = lapply(checkif, function(x) {
-					if (is.character(x)) paste0("\"", x, "\"") else x
-				})
+			vary = vary[setdiff(names(vary), c(supported, "tmapID__", "ord__"))]
 
-				checkif = lapply(checkif, function(x) {
-					if (length(x) == 1) {
-						x
+			if (!is.null(checkif)) {
+				checks = vapply(seq_along(checkif), function(i) {
+					if (!(checkif[i] %in% names(dt))) {
+						TRUE
 					} else {
-						k = length(x)
-						paste(paste(head(x, -1), collapse = ", "), tail(x, 1), sep = " or ")
+						dt[[names(checkif)[i]]][1] %in% checkif[[i]]
 					}
-				})
+				}, FUN.VALUE = logical(1))
+			} else {
+				checks = TRUE
+			}
 
-				message_webgl_checks(checks, checkif)
+			if (any(vary)) {
+				if (is.na(use_WebGL)) {
+					use_WebGL = FALSE
+				} else {
+					message_webgl_vars(supported, vary)
+				}
+			} else if (!all(checks)) {
+				if (is.na(use_WebGL)) {
+					use_WebGL = FALSE
+				} else {
+					checkif = lapply(checkif, function(x) {
+						if (is.character(x)) paste0("\"", x, "\"") else x
+					})
 
+					checkif = lapply(checkif, function(x) {
+						if (length(x) == 1) {
+							x
+						} else {
+							k = length(x)
+							paste(paste(head(x, -1), collapse = ", "), tail(x, 1), sep = " or ")
+						}
+					})
+
+					message_webgl_checks(checks, checkif)
+
+				}
+			} else if (type != "symbols" && hover) {
+				if (!is.na(use_WebGL)) {
+					message_webgl_hover(type)
+				} else {
+					use_WebGL = FALSE
+				}
+			} else if ((is.na(use_WebGL))) {
+				n = nrow(dt)
+				use_WebGL = (n >= 500)
 			}
-		} else if (type != "symbols" && hover) {
-			if (!is.na(use_WebGL)) {
-				message_webgl_hover(type)
-			} else {
-				use_WebGL = FALSE
-			}
-		} else if ((is.na(use_WebGL))) {
-			n = nrow(dt)
-			use_WebGL = (n >= 500)
 		}
 	}
 	use_WebGL
@@ -145,7 +151,7 @@ tmapLeafletPolygons = function(shpTM, dt, pdt, popup.format, hdt, idt, gp, bbx,
 		submit_labels("polygons", pane, group)
 
 
-	o$use_WebGL = impute_webgl(o$use_WebGL, dt, supported = c("fill", "col"), checkif = list(lty = "solid"), type = "polygons", hover = !is.null(hdt), popup = !is.null(pdt))
+	o$use_WebGL = impute_webgl(o$use_WebGL, dt, supported = c("fill", "col"), checkif = list(lty = "solid"), type = "polygons", hover = !is.null(hdt), popup = !is.null(pdt), crs_class = o$crs_leaflet$crsClass)
 
 	if (o$use_WebGL) {
 		shp2 = sf::st_sf(id = seq_along(shp), geom = shp)
@@ -232,7 +238,7 @@ tmapLeafletLines = function(shpTM, dt, pdt, popup.format, hdt, idt, gp, bbx, fac
 	idt = (if (is.null(idt))dt$tmapID__ else idt) |>
 		submit_labels("lines", pane, group)
 
-	o$use_WebGL = impute_webgl(o$use_WebGL, dt, supported = "col", checkif = list(lty = "solid"), type = "lines", hover = !is.null(hdt), popup = !is.null(pdt))
+	o$use_WebGL = impute_webgl(o$use_WebGL, dt, supported = "col", checkif = list(lty = "solid"), type = "lines", hover = !is.null(hdt), popup = !is.null(pdt), crs_class = o$crs_leaflet$crsClass)
 
 	if (o$use_WebGL) {
 		shp2 = sf::st_sf(id = seq_along(shp), geom = shp)
@@ -316,7 +322,7 @@ tmapLeafletSymbols = function(shpTM, dt, pdt, popup.format, hdt, idt, gp, bbx, f
 
 	opt = leaflet::pathOptions(interactive = interactive, pane = pane)
 
-	o$use_WebGL = impute_webgl(o$use_WebGL, dt, supported = c("fill", "size"), checkif = list(shape = c(1,16,19,20,21)), type = "symbols", hover = !is.null(hdt), popup = !is.null(pdt))
+	o$use_WebGL = impute_webgl(o$use_WebGL, dt, supported = c("fill", "size"), checkif = list(shape = c(1,16,19,20,21)), type = "symbols", hover = !is.null(hdt), popup = !is.null(pdt), crs_class = o$crs_leaflet$crsClass)
 
 	use_circleMarkers = o$use_circle_markers && all(gp$shape %in% c(1, 16, 19, 20, 21))
 

_pkgdown.yml

@@ -165,6 +165,8 @@ navbar:
           href: articles/examples_bubble
         - text: Raster map
           href: articles/examples_raster
+        - text: Topographic map (Africa)
+          href: articles/examples_topo_Africa
         - text: Terrain map
           href: articles/examples_terrain
         - text: Gridmap

examples/tm_chart.R

@@ -1,61 +1,4 @@
-## numerical variable
-
-tm_shape(World) + 
-  tm_polygons("HPI", 
-    fill.scale = tm_scale_intervals(), 
-    fill.chart = tm_chart_histogram())
-
-tm_shape(World) + 
-	tm_polygons("HPI", 
-				fill.scale = tm_scale_continuous(), 
-				fill.chart = tm_chart_histogram(
-					position = tm_pos_out("center", "bottom"),
-					width = 30)
-				)
-
-tm_shape(World) + 
-	tm_polygons("HPI", 
-				fill.scale = tm_scale_intervals(), 
-				fill.chart = tm_chart_donut())
-
-tm_shape(World) + 
-	tm_polygons("HPI", 
-				fill.scale = tm_scale_intervals(), 
-				fill.chart = tm_chart_box())
-
-tm_shape(World) + 
-	tm_polygons("HPI", 
-				fill.scale = tm_scale_intervals(), 
-				fill.chart = tm_chart_violin())
-
-# with additional ggplot2 code
-require(ggplot2)
-tm_shape(World) + 
-	tm_polygons("HPI", 
-				fill.scale = tm_scale_intervals(), 
-				fill.chart = tm_chart_bar(
-					extra.ggplot2 = theme(
-						panel.grid.major.y = element_line(colour = "red")
-					))
-				)
-
-tm_shape(land) +
-	tm_raster("trees",
-			  col.chart = tm_chart_histogram())
-
-## categorical variable
-tm_shape(World) + 
-	tm_polygons("economy", 
-				fill.scale = tm_scale_categorical(), 
-				fill.chart = tm_chart_bar())
-
-tm_shape(World) + 
-	tm_polygons("economy", 
-				fill.scale = tm_scale_categorical(), 
-				fill.chart = tm_chart_donut())
-
 tm_shape(World) +
-	tm_polygons(tm_vars(c("HPI", "well_being"), multivariate = TRUE),
-				fill.chart = tm_chart_heatmap())
-
-
+  tm_polygons("HPI",
+    fill.scale = tm_scale_intervals(),
+    fill.chart = tm_chart_histogram())

examples/tm_raster.R

@@ -1,3 +1,4 @@
+\dontrun{
 # load land data
 data(land, World)
 
@@ -8,3 +9,4 @@ tm_shape(land) +
 	tm_raster("elevation", col.scale = tm_scale_continuous(values = terrain.colors(9))) +
 	tm_shape(World) +
 	tm_borders()
+}

examples/tm_text.R

@@ -14,45 +14,3 @@ tm_shape(metro) +
 			col.legend = tm_legend_hide()) +
 	tm_title_out("Which Hemisphere?", position = tm_pos_out("center", "top", pos.v = "bottom"))
 
-
-metroAfrica = sf::st_intersection(metro, World[World$continent == "Africa", ])
-Africa = World[World$continent == "Africa", ]
-
-tm_shape(land) +
-	tm_raster("cover_cls",
-			  col.scale = tm_scale(
-			  	  values = cols4all::c4a("brewer.pastel1")[c(3,7,7,2,6,1,2,2)]
-			  ),
-			  col.legend = tm_legend_hide()) +
-tm_shape(World_rivers) +
-	tm_lines(lwd = "strokelwd", lwd.scale = tm_scale_asis(values.scale = .3),
-			 col = cols4all::c4a("brewer.pastel1")[2]) +
-    tm_shape(Africa, is.main = TRUE) +
-	tm_borders() +
-    tm_shape(metroAfrica) +
-	tm_symbols(fill = "red", shape = "pop2020", size = "pop2020",
-			   size.scale = tm_scale_intervals(
-			   	    breaks = c(1, 2, 5, 10, 15, 20, 25) * 1e6,
-			   	    values.range = c(0.2,2)
-			   ),
-			   size.legend = tm_legend("Population in 2020"),
-			   shape.scale = tm_scale_intervals(
-			   	   breaks = c(1, 2, 5, 10, 15, 20, 25) * 1e6,
-			   	   values = c(21, 23, 22, 21, 23, 22)
-			   ),
-			   shape.legend = tm_legend_combine("size")) +
-	tm_labels("name")
-
-tm_shape(metroAfrica) +
-	tm_markers(text = "name",
-			   dots_fill = "red",
-			   dots_size = 0.3)
-
-tm_shape(metroAfrica) +
-	tm_markers(text = "name",
-			   dots_shape = marker_icon(),
-			   dots_col = NA,
-			   dots_fill = "red",
-			   dots_size = 2,
-			   ymod = -0.25,
-			   options = opt_tm_markers(point.label = FALSE, remove_overlap = TRUE))

examples/tmapOutput.R

@@ -3,7 +3,7 @@ if (interactive() && require("shiny")) {
 	data(World)
 	world_vars <- setdiff(names(World), c("iso_a3", "name", "sovereignt", "geometry"))
 
-	tmap_mode("plot")
+	current.mode <- tmap_mode("plot")
 
 	shinyApp(
 		ui = fluidPage(
@@ -40,4 +40,6 @@ if (interactive() && require("shiny")) {
 			})
 		},options = list(launch.browser=TRUE)
 	)
+
+	tmap_mode(current.mode)
 }

examples/tmap_mode.R

@@ -1,4 +1,4 @@
-tmap_mode()
+current.mode = tmap_mode()
 
 tmap_mode("plot")
 
@@ -11,3 +11,5 @@ tm_shape(World) + tm_polygons("HPI")
 ttm()
 
 tm_shape(World) + tm_polygons("HPI")
+
+tmap_mode(current.mode)