Merge pull request #893 from r-tmap/doc

use `=` instead of `<-` + prefix `sf::` in code

DESCRIPTION

@@ -21,8 +21,7 @@ License: GPL-3
 URL: https://github.com/r-tmap/tmap, https://r-tmap.github.io/tmap/
 BugReports: https://github.com/r-tmap/tmap/issues
 Depends:
-    methods,
-    R (>= 3.5.0)
+    R (>= 3.6.0)
 Imports:
     classInt (>= 0.4-3),
     cols4all (>= 0.7-1),
@@ -35,13 +34,13 @@ Imports:
     leaflegend,
     leaflet (>= 2.0.2),
     leafsync,
+    methods,
     rlang,
     sf (>= 0.9-3),
     stars (>= 0.4-2),
     stats,
     tmaptools (>= 3.1),
     units (>= 0.6-1),
-    utils,
     widgetframe
 Suggests:
     av,

NAMESPACE

@@ -1,18 +1,8 @@
 # Generated by roxygen2: do not edit by hand
 
-
-if(getRversion() >= "3.6.0") {
-  S3method(knitr::knit_print, tmap)
-} else {
-  export(knit_print.tmap)
-}
-
-if(getRversion() >= "3.6.0") {
-  S3method(knitr::knit_print, tmap_arrange)
-} else {
-  export(knit_print.tmap_arrange)
-}
 S3method("+",tmap)
+S3method(knitr::knit_print,tmap)
+S3method(knitr::knit_print,tmap_arrange)
 S3method(print,tm_element)
 S3method(print,tm_shape)
 S3method(print,tmap)
@@ -304,4 +294,3 @@ importFrom(htmlwidgets,saveWidget)
 importFrom(leaflet,providers)
 importFrom(rlang,expr)
 importFrom(rlang,missing_arg)
-importFrom(utils,browseURL)

NEWS.md

@@ -2,6 +2,10 @@
 
 * For consistency with ggplot2, `tm_polygons()` now recognizes the `fill` argument instead of `col`.
 
+* tmap now requires R 3.6 and above.
+
+* In view mode, `hover` is now independent from `id` (#851).
+
 # tmap 3.3-4
 - (!) last version of tmap 3.x. Next CRAN version will be tmap 4.x (release planned at the end of 2023)
 - fixed bug (some stars appeared upside down in plot mode)

R/misc_other.R

@@ -18,7 +18,7 @@ select_sf = function(shpTM, dt) {
 	}
 	sid = match(d$tid, stid)
 
-	shpSel = shp[sid] #st_cast(shp[match(tid, tmapID)], "MULTIPOLYGON")
+	shpSel = shp[sid] #sf::st_cast(shp[match(tid, tmapID)], "MULTIPOLYGON")
 
 	# assign prop_ vectors to data dt (to be used in plotting) e.g. prop_angle is determined in tmapTransCentroid when along.lines = TRUE
 	prop_vars = names(shpTM)[substr(names(shpTM), 1, 5) == "prop_"]
@@ -232,32 +232,32 @@ without_units = function(x) {
 }
 
 
-get_midpoint <- function (coords) {
-	dist <- sqrt((diff(coords[, 1])^2 + (diff(coords[, 2]))^2))
-	dist_mid <- sum(dist)/2
-	dist_cum <- c(0, cumsum(dist))
-	end_index <- which(dist_cum > dist_mid)[1]
-	start_index <- end_index - 1
-	start <- coords[start_index, ]
-	end <- coords[end_index, ]
-	dist_remaining <- dist_mid - dist_cum[start_index]
+get_midpoint = function (coords) {
+	dist = sqrt((diff(coords[, 1])^2 + (diff(coords[, 2]))^2))
+	dist_mid = sum(dist)/2
+	dist_cum = c(0, cumsum(dist))
+	end_index = which(dist_cum > dist_mid)[1]
+	start_index = end_index - 1
+	start = coords[start_index, ]
+	end = coords[end_index, ]
+	dist_remaining = dist_mid - dist_cum[start_index]
 	start + (end - start) * (dist_remaining/dist[start_index])
 
 }
 
 # 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
+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)
+	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"
+	just[just == "centre"] = "center"
 
 	if (interactive) {
 		just <- just[1]
@@ -273,15 +273,15 @@ process_just <- function(just, interactive) {
 		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)
+				just = c("center", just)
+				isnum = c(FALSE, isnum)
 			} else {
-				just <- c(just, "center")
-				isnum <- c(isnum, FALSE)
+				just = c(just, "center")
+				isnum = c(isnum, FALSE)
 			}
 		}
 
-		x <- ifelse(isnum[1], as.numeric(just[1]),
+		x = ifelse(isnum[1], as.numeric(just[1]),
 					ifelse(just[1] == "left", 0,
 						   ifelse(just[1] == "right", 1,
 						   	   ifelse(just[1] == "center", .5, NA))))
@@ -310,30 +310,30 @@ process_just <- function(just, interactive) {
 
 ################!!!!! Functions below needed for Advanced text options !!!!####################
 
-.grob2Poly <- function(g) {
-	x <- convertX(g$x, unitTo = "native", valueOnly = TRUE)
-	y <- convertY(g$y, unitTo = "native", valueOnly = TRUE)
+.grob2Poly = function(g) {
+	x = convertX(g$x, unitTo = "native", valueOnly = TRUE)
+	y = convertY(g$y, unitTo = "native", valueOnly = TRUE)
 	if (inherits(g, "rect")) {
-		w <- convertWidth(g$width, unitTo = "native", valueOnly = TRUE)
-		h <- convertHeight(g$height, unitTo = "native", valueOnly = TRUE)
-		x1 <- x - .5*w
-		x2 <- x + .5*w
-		y1 <- y - .5*h
-		y2 <- y + .5*h
-		polys <- mapply(function(X1, X2, Y1, Y2) {
-			st_polygon(list(cbind(c(X1, X2, X2, X1, X1),
+		w = convertWidth(g$width, unitTo = "native", valueOnly = TRUE)
+		h = convertHeight(g$height, unitTo = "native", valueOnly = TRUE)
+		x1 = x - .5*w
+		x2 = x + .5*w
+		y1 = y - .5*h
+		y2 = y + .5*h
+		polys = mapply(function(X1, X2, Y1, Y2) {
+			sf::st_polygon(list(cbind(c(X1, X2, X2, X1, X1),
 								  c(Y2, Y2, Y1, Y1, Y2))))
-		}, x1, x2, y1, y2, SIMPLIFY=FALSE)
-		st_union(st_sfc(polys))
+		}, x1, x2, y1, y2, SIMPLIFY = FALSE)
+		sf::st_union(sf::st_sfc(polys))
 	} else if (inherits(g, "polygon")) {
-		xs <- split(x, g$id)
-		ys <- split(y, g$id)
+		xs = split(x, g$id)
+		ys = split(y, g$id)
 
-		polys <- mapply(function(xi, yi) {
-			co <- cbind(xi, yi)
-			st_polygon(list(rbind(co, co[1,])))
+		polys = mapply(function(xi, yi) {
+			co = cbind(xi, yi)
+			sf::st_polygon(list(rbind(co, co[1,])))
 		}, xs, ys, SIMPLIFY = FALSE)
-		st_union(st_sfc(polys))
+		sf::st_union(sf::st_sfc(polys))
 	} # else return(NULL)
 
 }
@@ -344,9 +344,9 @@ polylineGrob2sfLines <- function(gL) {
 	} else {
 		ids = gL$id
 	}
-	coords <- mapply(cbind, split(as.numeric(gL$x), ids), split(as.numeric(gL$y), ids), SIMPLIFY = FALSE)
+	coords = mapply(cbind, split(as.numeric(gL$x), ids), split(as.numeric(gL$y), ids), SIMPLIFY = FALSE)
 
-	st_sf(geometry = st_sfc(st_multilinestring(coords)))
+	sf::st_sf(geometry = sf::st_sfc(sf::st_multilinestring(coords)))
 }
 
 npc_to_native <- function(x, scale) {

R/misc_stars.R

@@ -110,7 +110,7 @@ get_downsample = function(dims, px = round(dev.size("px") * (graphics::par("fin"
 
 
 # st_is_merc = function(x) {
-# 	crs = st_crs(x)
+# 	crs = sf::st_crs(x)
 # 	if (is.na(crs)) { 
 # 		NA
 # 	} else {
@@ -119,7 +119,7 @@ get_downsample = function(dims, px = round(dev.size("px") * (graphics::par("fin"
 # }
 
 get_xy_dim = function(x) {
-	d = st_dimensions(x)
+	d = stars::st_dimensions(x)
 	dxy = attr(d, "raster")$dimensions
 	dim(x)[dxy]
 }
@@ -144,10 +144,10 @@ transwarp = function(x, crs, raster.warp) {
 
 has_rotate_or_shear = function (x) 
 {
-	dimensions = st_dimensions(x)
+	dimensions = stars::st_dimensions(x)
 	if (has_raster(x)) {
 		r = attr(dimensions, "raster")
-		!any(is.na(r$affine)) && any(r$affine != 0)
+		!anyNA(r$affine) && any(r$affine != 0)
 	}
 	else FALSE
 }

R/misc_text.R

@@ -58,9 +58,9 @@ text_height_npc = function(txt, to_width = FALSE) {
 
 text_height_inch = function(txt, to_width = FALSE) {
 	if (to_width) {
-		convertWidth(convertHeight(stringHeight(txt), "inch"), "inch", TRUE)
+		grid::convertWidth(grid::convertHeight(stringHeight(txt), "inch"), "inch", TRUE)
 	} else {
-		convertHeight(stringHeight(txt), "inch", TRUE)
+		grid::convertHeight(stringHeight(txt), "inch", TRUE)
 	}
 }
 
@@ -74,31 +74,31 @@ split_legend_labels = function(txt, brks) {
 
 is.ena = function(x) {
 	if (is.expression(x)) {
-		rep(FALSE, length(x))
+		rep_len(FALSE, length(x))
 	} else is.na(x)
 }
 
 
-nonempty_text <- function(txt) {
+nonempty_text = function(txt) {
 	if (is.character(txt)) {
-		txt!=""
-	} else rep(TRUE, length(txt))
+		nzchar(txt)
+	} else rep_len(TRUE, length(txt))
 }
 
-number_text_lines <- function(txt) {
+number_text_lines = function(txt) {
 	if (is.character(txt)) {
 		length(strsplit(txt, "\n")[[1]])
 	} else 1
 }
 
-expr_to_char <- function(txt) {
+expr_to_char = function(txt) {
 	if (is.character(txt)) {
 		txt
 	} else {
 		as.character(txt)
 	}
 }
 
-is_num_string <- function(x) {
+is_num_string = function(x) {
 	suppressWarnings(!is.na(as.numeric(x)))
 }

R/print.R

@@ -34,12 +34,7 @@ print.tmap = function(x, return.asp = FALSE, show = TRUE, vp = NULL, knit = FALS
 }
 
 #' @rdname print.tmap
-#' @rawNamespace
-#' if(getRversion() >= "3.6.0") {
-#'   S3method(knitr::knit_print, tmap)
-#' } else {
-#'   export(knit_print.tmap)
-#' }
+#' @exportS3Method knitr::knit_print
 knit_print.tmap <- function(x, ..., options=NULL) {
 	print.tmap(x, knit=TRUE, options=options, ...)
 }

R/process_legend_format.R

@@ -1,21 +1,21 @@
-process_label_format <- function(lf, mlf) {
+process_label_format = function(lf, mlf) {
 
 
-	to_be_assigned <- setdiff(names(mlf), names(lf))
-	big.num.abbr.set <- "big.num.abbr" %in% names(lf)
-	lf[to_be_assigned] <- mlf[to_be_assigned]
-	attr(lf, "big.num.abbr.set") <- big.num.abbr.set
+	to_be_assigned = setdiff(names(mlf), names(lf))
+	big.num.abbr.set = "big.num.abbr" %in% names(lf)
+	lf[to_be_assigned] = mlf[to_be_assigned]
+	attr(lf, "big.num.abbr.set") = big.num.abbr.set
 	lf
 }
 
-# process_popup_format <- function(gpf, gtlf, vars, show.warnings) {
+# process_popup_format = function(gpf, gtlf, vars, show.warnings) {
 # 	# check if g$legend.format is list of lists or functions
-# 	islist <- is.list(gpf) && length(gpf)>0 && is.list(gpf[[1]])
+# 	islist = is.list(gpf) && length(gpf)>0 && is.list(gpf[[1]])
 # 	
 # 	if (!islist) {
 # 		process_legend_format(gpf, gtlf, nx=1)
 # 	} else {
-# 		nms <- names(gpf)
+# 		nms = names(gpf)
 # 		if (is.na(vars[1])) {
 # 			if (show.warnings) warning("popup.vars not specified whereas popup.format is a list", call. = FALSE)
 # 			return(process_legend_format(gpf[[1]], gtlf, nx=1))

R/process_meta.R

@@ -255,7 +255,7 @@ process_meta = function(o, d, cdt, aux) {
 
 				if (grid.labels.show[2]) {
 					gridy = pretty30(bbx[c(2,4)], n = 5, longlat = !is.na(o$grid.crs) && sf::st_is_longlat(proj))
-					ybbstringWin <- max(
+					ybbstringWin = max(
 						convertWidth(
 							stringWidth(do.call("fancy_breaks", c(
 								list(vec=gridy, intervals=FALSE), grid.labels.format))), "inch", valueOnly = TRUE)

R/qtm.R

@@ -88,8 +88,8 @@ qtm <- function(shp,
 				zindex = NA,
 				group = NA,
 				group.control = "check",
-				style=NULL,
-				format=NULL,
+				style = NULL,
+				format = NULL,
 				...) {
 
 	args <- c(as.list(environment()), list(...))
@@ -117,11 +117,11 @@ qtm <- function(shp,
 	show.warnings = tmapOptions$show.warnings
 
 	if (missing(shp) || is.character(shp)) {
-		viewargs <- args[intersect(names(args), names(formals(tm_view)))]
-		if (!missing(shp)) viewargs$bbox <- shp
-		g <- c(tm_basemap(basemaps), tm_tiles(overlays), do.call("tm_view", viewargs))
-		attr(g, "qtm_shortcut") <- TRUE
-		class(g) <- "tmap"
+		viewargs = args[intersect(names(args), names(formals(tm_view)))]
+		if (!missing(shp)) viewargs$bbox = shp
+		g = c(tm_basemap(basemaps), tm_tiles(overlays), do.call("tm_view", viewargs))
+		attr(g, "qtm_shortcut") = TRUE
+		class(g) = "tmap"
 		return(g)
 	}
 
@@ -199,6 +199,6 @@ qtm <- function(shp,
 
 
 	assign("last_map_new", match.call(), envir = .TMAP)
-	attr(g, "qtm_shortcut") <- FALSE
+	attr(g, "qtm_shortcut") = FALSE
 	g
 }

R/step1_helper_facets.R

@@ -188,18 +188,22 @@ step1_rearrange_facets = function(tmo, o) {
 					rlang::arg_match(popup.vars, values = smeta$vars, multiple = TRUE)
 				}
 				if (length(popup.vars)) add_used_vars(popup.vars)
-
+
+        if (length(hover) > 1) {
+          stop("hover should have length <= 1", call. = FALSE)
+        }
 
 				if (is.na(hover)) {
 					hover = id
 				} else if (is.logical(hover)) {
 					hover = ifelse(hover, id, "")
 				}
 
-				if (hover != "" && !hover %in% smeta$vars) rlang::arg_match0(hover, smeta$vars, "hover label", error_call = NULL)
+				if (hover != "" && !hover %in% smeta$vars) rlang::arg_match0(hover, smeta$vars, arg_nm = "hover", error_call = NULL)
 				if (hover != "") add_used_vars(hover)
 				if (id != "" && !id %in% smeta$vars) rlang::arg_match0(id, smeta$vars, arg_nm = "id", error_call = NULL)
 				if (id != "") add_used_vars(id)
+
 			})
 		})