Merge pull request #853 from olivroy/check-examples

Fix partial matching + silence R cmd check notes + warnings

NAMESPACE

@@ -130,7 +130,7 @@ export(opt_tm_lines)
 export(opt_tm_polygons)
 export(opt_tm_raster)
 export(opt_tm_sf)
-export(opt_tm_sqaures)
+export(opt_tm_squares)
 export(opt_tm_symbols)
 export(opt_tm_text)
 export(providers)

R/misc_other.R

@@ -395,7 +395,7 @@ native_to_npc_to_native <- function(x, scale) {
 		}
 
 	}
-	xy <- xy.coords(x, y, recycle = TRUE)
+	xy <- grDevices::xy.coords(x, y, recycle = TRUE)
 	z <- toUnityCoords(xy)
 	x2 <- z$x
 	y2 <- z$y
@@ -434,10 +434,10 @@ native_to_npc_to_native <- function(x, scale) {
 	#w2 <- w + (h-w) * abs(cos(angles*pi/180))
 	#h2 <- h + (w-h) * abs(sin(angles*pi/180))
 
-	z2 <- xy.coords(xs2, ys2, recycle = TRUE)
+	z2 <- grDevices::xy.coords(xs2, ys2, recycle = TRUE)
 	xy2 <- toUserCoords(z2)
 
-	list(poly=polygonGrob(unit(xy2$x, "native"), unit(xy2$y, "native"), id=id, gp=rg$gp))
+	list(poly=polygonGrob(unit(xy2$x, "native"), grid::unit(xy2$y, "native"), id=id, gp=rg$gp))
 	#list(poly=rectGrob(unit(x, "native"), unit(y, "native"), width = unit(w, "native"), height=unit(h, "native"), gp = rg$gp))
 }
 
@@ -454,7 +454,7 @@ native_to_npc_to_native <- function(x, scale) {
 .editGrob <- function(tg, sel, shiftX, shiftY, angles) {
 	nt <- length(sel)
 	angles <- rep(angles, length.out=nt)
-	if (any(angles!=0)) {
+	if (any(angles != 0)) {
 		if (inherits(tg, "rect")) {
 			tg <- .rectGrob2pathGrob(tg, angles)$poly
 		}

R/misc_pointLabel.R

@@ -1,44 +1,44 @@
 test_rect = function(x, y, width, height, bbx) {
-	library(grid)
-	grid.newpage()
+	# library(grid)
+	grid::grid.newpage()
 
 	asp = tmaptools::get_asp_ratio(bbx)
 
 	if (asp > 1) {
-		pushViewport(viewport(width = unit(1, "snpc"), height = unit(1/asp, "snpc")))	
+		grid::pushViewport(grid::viewport(width = grid::unit(1, "snpc"), height = grid::unit(1/asp, "snpc")))	
 	} else {
-		pushViewport(viewport(width = unit(asp, "snpc"), height = unit(1, "snpc")))	
+		grid::pushViewport(grid::viewport(width = grid::unit(asp, "snpc"), height = grid::unit(1, "snpc")))	
 	}
 
 
-	pushViewport(viewport(xscale = bbx[c(1,3)], yscale = bbx[c(2,4)]))
-	grid.rect()
+	grid::pushViewport(grid::viewport(xscale = bbx[c(1,3)], yscale = bbx[c(2,4)]))
+	grid::grid.rect()
 
 	mapply(function(xi,yi,wi,hi) {
-		grid.rect(x = unit(xi, "native"), y = unit(yi, "native"), width = unit(wi, "native"), height = unit(hi, "native"), gp = gpar(fill = "orange", col = "black"))
+		grid::grid.rect(x = grid::unit(xi, "native"), y = grid::unit(yi, "native"), width = grid::unit(wi, "native"), height = grid::unit(hi, "native"), gp = grid::gpar(fill = "orange", col = "black"))
 	}, x, y, width, height)
-	upViewport(2)
+	grid::upViewport(2)
 }
 
 test_poly = function(xs, ys, bbx) {
-	library(grid)
-	grid.newpage()
+	# library(grid)
+	grid::grid.newpage()
 
 	asp = tmaptools::get_asp_ratio(bbx)
 
 	if (asp > 1) {
-		pushViewport(viewport(width = unit(1, "snpc"), height = unit(1/asp, "snpc")))	
+		grid::pushViewport(grid::viewport(width = grid::unit(1, "snpc"), height = grid::unit(1/asp, "snpc")))	
 	} else {
-		pushViewport(viewport(width = unit(asp, "snpc"), height = unit(1, "snpc")))	
+		grid::pushViewport(grid::viewport(width = grid::unit(asp, "snpc"), height = grid::unit(1, "snpc")))	
 	}
 
-	pushViewport(viewport(xscale = bbx[c(1,3)], yscale = bbx[c(2,4)]))
+	grid::pushViewport(grid::viewport(xscale = bbx[c(1,3)], yscale = bbx[c(2,4)]))
 
-	grid.rect()
+	grid::grid.rect()
 
-	grid.path(x = unit(xs, "native"), y = unit(ys, "native"), gp = gpar(fill = "orange", col = "black"))
+	grid::grid.path(x = grid::unit(xs, "native"), y = grid::unit(ys, "native"), gp = grid::gpar(fill = "orange", col = "black"))
 
-	upViewport(2)
+	grid::upViewport(2)
 }
 
 # function adapted from car::pointLabel
@@ -74,7 +74,7 @@ pointLabel2 <- function (x, y, width, height, bbx,
 
 	}
 
-	z <- xy.coords(x, y, recycle = TRUE)
+	z <- grDevices::xy.coords(x, y, recycle = TRUE)
 	z <- toUnityCoords(z)
 	x <- z$x
 	y <- z$y
@@ -117,7 +117,7 @@ pointLabel2 <- function (x, y, width, height, bbx,
 	rectv <- width + (0+1i) * height
 	rectidx1 <- rectidx2 <- array(0, (length(x)^2 - length(x))/2)
 	k <- 0
-	for (i in 1:length(x)) for (j in seq(len = (i - 1))) {
+	for (i in 1:length(x)) for (j in seq_len(i - 1)) {
 		k <- k + 1
 		rectidx1[k] <- i
 		rectidx2[k] <- j

R/step1_helper_facets.R

@@ -180,9 +180,9 @@ step1_rearrange_facets = function(tmo, o) {
 				}
 				if (length(popup.vars)) add_used_vars(popup.vars)
 
-				if (hover != "" && !hover %in% smeta$vars) stop("Incorrect hover label", call. = FALSE)
+				if (hover != "" && !hover %in% smeta$vars) rlang::arg_match0(hover, smeta$vars, "hover label", error_call = NULL)
 				if (hover != "") add_used_vars(hover)
-				if (id != "" && !id %in% smeta$vars) stop("Incorrect id", call. = FALSE)
+				if (id != "" && !id %in% smeta$vars) rlang::arg_match0(id, smeta$vars, arg_nm = "id", error_call = NULL)
 				if (id != "") add_used_vars(id)
 			})
 		})

R/step1_rearrange.R

@@ -50,7 +50,7 @@ step1_rearrange = function(tmel) {
 	if (any(is_opt)) for (id in which(is_opt)) {
 		o2 = oth[[id]]
 
-		if ("v3" %in% o2$calls) warning("v3 code detected: as of tmap v4, tm_legend should be specified per visual variable (e.g. with the argument fill.legend of tm_polygons", call. = FALSE)
+		if ("v3" %in% o2$calls) message("v3 code detected: as of tmap v4, the legend should be specified for each visual variable\n(e.g. with `fill.legend = tm_legend()` inside tm_polygons to control the legend of fill for polygons.", call. = FALSE)
 
 		# special case: position, in case c("left", "top") is used
 		pids = grep(".position", names(o2), fixed = TRUE)

R/tm_layers_cartogram.R

@@ -1,3 +1,5 @@
+#' @param type,itermax,expansion,inplace,share Additional options
+#'
 #' @rdname tm_cartogram
 #' @name opt_tm_cartogram
 #' @param type cartogram type, one of: "cont" for contiguous cartogram, "ncont" for non-contiguous cartogram and "dorling" for Dorling cartograms

R/tm_layers_symbols.R

@@ -24,7 +24,7 @@ opt_tm_bubbles = opt_tm_symbols
 #' @rdname tm_symbols
 #' @name opt_tm_squares
 #' @export
-opt_tm_sqaures = opt_tm_symbols
+opt_tm_squares = opt_tm_symbols
 
 
 
@@ -563,7 +563,7 @@ tm_squares = function(size = tm_const(),
 					  zindex = NA,
 					  group = NA,
 					  group.control = "check",
-					  options = opt_tm_sqaures(),
+					  options = opt_tm_squares(),
 					  ...) {
 
 	args = c(as.list(environment()), list(...))

R/tmapChart.R

@@ -102,7 +102,7 @@ bin_num = function(x1, breaks_def, chart) {
 	# are breaks (and bin_colors)
 	predefined = !is.null(breaks_def)
 
-	if (is.null(chart$breaks)) {
+	if (is.null(chart$breaks_def)) {
 		if (!predefined) {
 			breaks = pretty(x1)
 			ids = rep(1L, length(breaks) - 1)
@@ -112,7 +112,7 @@ bin_num = function(x1, breaks_def, chart) {
 			ids = 1L:(length(breaks) - 1L)
 		}
 	} else {
-		breaks = chart$breaks
+		breaks = chart$breaks_def
 		subbreaks = (all(breaks_def %in% breaks))
 
 		break_mids = (breaks[-1] + head(breaks, -1)) / 2

R/tmapGridAux.R

@@ -266,7 +266,8 @@ tmapGridGridPrep = function(a, bs, id, o) {
 					x2 <- x2[!lnsX_emp]
 					lnsX_proj <- lnsX_proj[!lnsX_emp]
 					xco <- st_coordinates(lnsX_proj)
-					co.x.lns <- lapply(unique(xco[,3]), function(i) {
+					# co.x.lns
+					co.x <- lapply(unique(xco[,3]), function(i) {
 						lco <- xco[xco[,3]==i, 1:2]
 						lco[, 1] <- (lco[, 1]-bbx_orig[1]) / (bbx_orig[3] - bbx_orig[1])
 						lco[, 2] <- (lco[, 2]-bbx_orig[2]) / (bbx_orig[4] - bbx_orig[2])
@@ -278,7 +279,7 @@ tmapGridGridPrep = function(a, bs, id, o) {
 
 					sel.x <- which(x2 %in% x)
 				} else {
-					co.x.lns <- numeric(0)
+					co.x <- numeric(0)
 				}
 
 				if (lnsSel[2]) {
@@ -291,7 +292,7 @@ tmapGridGridPrep = function(a, bs, id, o) {
 					y2 <- y2[!lnsY_emp]
 					lnsY_proj <- lnsY_proj[!lnsY_emp]
 					yco <- st_coordinates(lnsY_proj)
-					co.y.lns <- lapply(unique(yco[,3]), function(i) {
+					co.y <- lapply(unique(yco[,3]), function(i) {
 						lco <- yco[yco[,3]==i, 1:2]
 						lco[, 1] <- (lco[, 1]-bbx_orig[1]) / (bbx_orig[3] - bbx_orig[1])
 						lco[, 2] <- (lco[, 2]-bbx_orig[2]) / (bbx_orig[4] - bbx_orig[2])
@@ -303,7 +304,7 @@ tmapGridGridPrep = function(a, bs, id, o) {
 
 					sel.y <- which(y2 %in% y)
 				}	else {
-					co.y.lns <- numeric(0)
+					co.y <- numeric(0)
 				}
 
 
@@ -396,7 +397,7 @@ tmapGridGridXLab = function(bi, bbx, facet_row, facet_col, facet_page, o) {
 
 	# find coordinates for projected grid labels
 	if (!is.na(a$crs)) {
-		glabelsx <- get_gridline_labels(lco=a$co.x.lns[a$sel.x], xax = as.integer(is_top))
+		glabelsx <- get_gridline_labels(lco=a$co.x[a$sel.x], xax = as.integer(is_top))
 		cogridx <- glabelsx$cogrid
 		idsx <- glabelsx$ids
 		labelsx <- labelsx[idsx]
@@ -473,7 +474,7 @@ tmapGridGridYLab = function(bi, bbx, facet_row, facet_col, facet_page, o) {
 
 	# find coordinates for projected grid labels
 	if (!is.na(a$crs)) {
-		glabelsy <- get_gridline_labels(lco=a$co.y.lns[a$sel.y], yax = 0)
+		glabelsy <- get_gridline_labels(lco=a$co.y[a$sel.y], yax = 0)
 		cogridy <- glabelsy$cogrid
 		idsy <- glabelsy$ids
 		labelsy <- labelsy[idsy]
@@ -603,7 +604,7 @@ tmapGridGrid = function(bi, bbx, facet_row, facet_col, facet_page, id, pane, gro
 	# find coordinates for projected grid labels
 	if (!is.na(a$crs)) {
 		if (selx) {
-			glabelsx <- get_gridline_labels(lco=a$co.x.lns[a$sel.x], xax = labelsXw + spacerX+marginX)
+			glabelsx <- get_gridline_labels(lco=a$co.x[a$sel.x], xax = labelsXw + spacerX+marginX)
 			cogridx <- glabelsx$cogrid
 			idsx <- glabelsx$ids
 			labelsx <- labelsx[idsx]
@@ -614,7 +615,7 @@ tmapGridGrid = function(bi, bbx, facet_row, facet_col, facet_page, id, pane, gro
 		# }
 
 		if (sely) {
-			glabelsy <- get_gridline_labels(lco=a$co.y.lns[a$sel.y], yax = labelsYw + spacerY+marginY)
+			glabelsy <- get_gridline_labels(lco=a$co.y[a$sel.y], yax = labelsYw + spacerY+marginY)
 			cogridy <- glabelsy$cogrid
 			idsy <- glabelsy$ids
 			labelsy <- labelsy[idsy]
@@ -647,13 +648,13 @@ tmapGridGrid = function(bi, bbx, facet_row, facet_col, facet_page, id, pane, gro
 	# crop projected grid lines, and extract polylineGrob ingredients
 	if (!is.na(a$crs)) {
 		lnsList <- list(
-			if (any(selx)) st_multilinestring(a$co.x.lns) else NULL,
-			if (any(sely)) st_multilinestring(a$co.y.lns) else NULL
+			if (any(selx)) st_multilinestring(a$co.x) else NULL,
+			if (any(sely)) st_multilinestring(a$co.y) else NULL
 		)
 		lnsSel <- !vapply(lnsList, is.null, logical(1))
 		if (!any(lnsSel)) {
-			grid.co.x.lns <- numeric(0)
-			grid.co.y.lns <- numeric(0)
+			grid.co.x <- numeric(0)
+			grid.co.y <- numeric(0)
 		} else {
 			lns <- st_sf(ID=c("x", "y")[lnsSel], geometry = st_sfc(lnsList[lnsSel], crs = 4326)) # trick for 0-1 coordinates
 			sf_bbox <- tmaptools::bb_poly(bb(c(labelsYw + spacerY + marginY, labelsXw + spacerX + marginX, 1, 1)), projection = 4326)

R/tmapScaleAsIs.R

@@ -55,7 +55,7 @@ most_common_cat = function(x) {
 	tab = table(x)
 	nm = names(tab)[which.max(tab)]
 	tryCatch({
-		as(nm, cls)	
+		methods::as(nm, cls)	
 	}, error = function(e) {
 		nm	
 	})

examples/tm_lines.R

@@ -1,9 +1,12 @@
 tm_shape(rivers) +
-	tm_lines(lwd = "strokelwd", lwd.scale = tm_scale_asis(values.scale = 0.2, value.neutral = 2),
-			 col = "scalerank", col.scale = tm_scale_categorical(values = "seaborn.dark"))
+	tm_lines(lwd = "strokelwd",
+			 lwd.scale = tm_scale_asis(values.scale = 0.2, value.neutral = 2),
+			 col = "scalerank",
+			 col.scale = tm_scale_categorical(values = "seaborn.dark"))
 
 tm_shape(World) +
-	tm_lines(col = "continent", col.scale = tm_scale_categorical(values = "seaborn.dark"),
+	tm_lines(col = "continent",
+			 col.scale = tm_scale_categorical(values = "seaborn.dark"),
 			 lty = "continent",
 			 lwd = 1.5,
 			 lty.legend = tm_legend_combine("col"))

examples/tm_symbols.R

@@ -3,17 +3,26 @@ 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.scale = tm_scale(
+			  	values = cols4all::c4a("brewer.pastel1")[c(3,7,7,2,6,1,2,2)]
+			  ),
 			  col.legend = tm_legend_hide()) +
 	tm_shape(rivers) +
-	tm_lines(lwd = "strokelwd", lwd.scale = tm_scale_asis(values.scale = .3), col = cols4all::c4a("brewer.pastel1")[2]) +
+	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.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.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", options = opt_tm_labels(remove.overlap = FALSE))
 
@@ -91,7 +100,7 @@ if (require(ggplot2) && require(dplyr) && require(tidyr) && require(tmaptools) &
 
 	grobs2 = grobs
 	grobs2[[6]] = 21
-
+	names(grobs2) <- as.character(NLD_prov$name)
 	NLD_prov$population[1:5] = 500000
 	tm_shape(NLD_prov) +
 		tm_polygons(group = "Provinces") +
@@ -134,10 +143,10 @@ if (require(ggplot2) && require(dplyr) && require(tidyr) && require(tmaptools) &
 			geom_point(aes(x=p%%16, y=-(p%/%16), shape=p), size=5, fill="red") +
 			geom_text(mapping=aes(x=p%%16, y=-(p%/%16+0.25), label=p), size=3) +
 			scale_shape_identity() +
-			theme(axis.title=element_blank(),
-				  axis.text=element_blank(),
-				  axis.ticks=element_blank(),
-				  panel.background=element_blank())
+			theme(axis.title = element_blank(),
+				  axis.text = element_blank(),
+				  axis.ticks = element_blank(),
+				  panel.background = element_blank())
 	}
 }
 

examples/tm_text.R

@@ -9,7 +9,8 @@ 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(),
-			col = "upside_down", col.scale = tm_scale_categorical(values = c("#9900BB", "#228822")),
+			col = "upside_down",
+			col.scale = tm_scale_categorical(values = c("#9900BB", "#228822")),
 			col.legend = tm_legend_hide()) +
 	tm_title_out("Which Hemisphere?", position = tm_pos_out("center", "top", pos.v = "bottom"))
 
@@ -19,17 +20,26 @@ 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.scale = tm_scale(
+			  	  values = cols4all::c4a("brewer.pastel1")[c(3,7,7,2,6,1,2,2)]
+			  ),
 			  col.legend = tm_legend_hide()) +
 tm_shape(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_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_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.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.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")