Lints + add tests + fix R CMD CHECK

DESCRIPTION

@@ -60,7 +60,7 @@ Suggests:
     rmarkdown,
     shiny,
     terra,
-    testthat (>= 3.0.0),
+    testthat (>= 3.2.0),
     tidyr
 VignetteBuilder: 
     knitr

R/global-variables.R

@@ -23,3 +23,12 @@ utils::globalVariables(c(
   "t2", "t3", "t4", "text.fontface", "text.fontfamily", "title.bg.alpha",
   "tmapID__", "vneutral"
 ))
+
+# Add more to silence R CMD CHECK (see if some are false positive)
+utils::globalVariables(c(
+	"aes", "alpha", "col_alpha", "frame", "grid.show", "label.na", "legend",
+	"legend.bg.alpha", "lin", "m", "n", "overlays_tiles", "show", "show.labels",
+	"show.warnings", "total", "trans.args", "type", "values", "xlab.rotation",
+	"xlab.show", "xlab.side", "xlab.space", "xlab.text", "ylab.rotation",
+	"ylab.show", "ylab.side", "ylab.space", "ylab.text", "z"
+))

R/misc_stars.R

@@ -35,7 +35,7 @@ has_rotate_or_shear = function (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
 }
@@ -58,9 +58,9 @@ is_rectilinear = function (x) {
 }
 
 regular_intervals = function (x, epsilon = 1e-10) {
-	if (length(x) <= 1) 
+	if (length(x) <= 1) {
 		FALSE
-	else {
+	} else {
 		ud = if (is.atomic(x)) 
 			unique(diff(x))
 		else {

R/pkg.R

@@ -18,7 +18,6 @@
 #' Shape specification:
 #' \tabular{ll}{
 #' [tm_shape()]\tab Specify a shape object \cr
-#' --------------------------- \tab ------------------------------------------- \cr
 #' }
 #' 
 #' Aesthetics base layers:
@@ -42,13 +41,11 @@
 #' [tm_markers()]\tab Create a layer of markers \cr
 #' [tm_iso()]\tab Create a layer of iso/contour lines \cr
 #' [tm_rgb()]\tab Create a raster layer of an image \cr
-#' --------------------------- \tab ------------------------------------------- \cr
 #' }
 #' 
 #' Faceting (small multiples)
 #' \tabular{ll}{
 #' [tm_facets()]\tab Define facets \cr
-#' --------------------------- \tab ------------------------------------------- \cr
 #' }
 #' 
 #' Attributes:
@@ -60,7 +57,6 @@
 #' [tm_logo()]\tab Create a logo \cr
 #' [tm_xlab()] and [tm_ylab()]\tab Create axis labels \cr
 #' [tm_minimap()]\tab Create a minimap (view mode only) \cr
-#' --------------------------- \tab ------------------------------------------- \cr
 #' }
 #' 
 #' Layout element:
@@ -70,7 +66,6 @@
 #' [tm_view()]\tab Configure the interactive view mode \cr
 #' [tm_style()]\tab Apply a predefined style \cr
 #' [tm_format()]\tab Apply a predefined format \cr
-#' --------------------------- \tab ------------------------------------------- \cr
 #' }
 #' 
 #' Change options:
@@ -79,13 +74,11 @@
 #' [ttm()]\tab Toggle between the modes \cr
 #' [tmap_options()]\tab Set global tmap options (from [tm_layout()], [tm_view()], and a couple of others) \cr
 #' [tmap_style()]\tab Set the default style \cr
-#' --------------------------- \tab ------------------------------------------- \cr
 #' }
 #' 
 #' Create icons:
 #' \tabular{ll}{
 #' [tmap_icons()]\tab Specify icons for markers or proportional symbols \cr
-#' --------------------------- \tab ------------------------------------------- \cr
 #' }
 #' 
 #' 
@@ -97,7 +90,6 @@
 #' [tmap_animation()]\tab Create an animation \cr
 #' [tmap_arrange()]\tab Create small multiples of separate maps \cr
 #' [tmap_save()]\tab Save thematic maps (either as image or HTML file) \cr
-#' --------------------------- \tab ------------------------------------------- \cr
 #' }
 #' 
 #' @section Spatial datasets: 
@@ -108,7 +100,6 @@
 #' [`metro`]\tab Metropolitan areas ([`sf`][`sf::sf`] object of points) \cr
 #' [`rivers`]\tab Rivers ([`sf`][`sf::sf`] object of lines) \cr
 #' [`land`]\tab Global land cover ([`stars`][stars::st_as_stars()] object)\cr
-#' --------------------------- \tab ------------------------------------------- \cr
 #' }
 #' 
 #' @author Martijn Tennekes \email{mtennekes@@gmail.com}

R/process_meta.R

@@ -221,18 +221,24 @@ process_meta = function(o, d, cdt, aux) {
 				lineHin <- convertHeight(unit(grid.labels.size, "lines"), "inch", valueOnly=TRUE)
 
 				if (grid.labels.show[1]) {
-					gridx = pretty30(bbx[c(1,3)], n=5, longlat = !is.na(o$grid.crs) && sf::st_is_longlat(proj))
-					xbbstringWin <- max(convertWidth(stringWidth(do.call("fancy_breaks", c(list(vec=gridx, intervals=FALSE), grid.labels.format))), "inch", valueOnly = TRUE)) * grid.labels.size
+					gridx = pretty30(bbx[c(1,3)], n = 5, longlat = !is.na(o$grid.crs) && sf::st_is_longlat(proj))
+					xbbstringWin <- max(convertWidth(stringWidth(do.call("fancy_breaks", c(list(vec=gridx, intervals = FALSE), grid.labels.format))), "inch", valueOnly = TRUE)) * grid.labels.size
 					xgridHin <- ifelse(!is.na(grid.labels.space.x), grid.labels.space.x * lineHin, ifelse(grid.labels.rot[1] %in% c(0, 180), 1.375 * lineHin, xbbstringWin + lineHin * .75) + grid.labels.margin.x * lineHin)
 
 				} else {
 					xgridHin = 0
 				}
 
 				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(convertWidth(stringWidth(do.call("fancy_breaks", c(list(vec=gridy, intervals=FALSE), grid.labels.format))), "inch", valueOnly = TRUE)) * grid.labels.size
-					ygridWin <- ifelse(!is.na(grid.labels.space.y), grid.labels.space.y * lineHin, ifelse(grid.labels.rot[2] %in% c(0, 180), ybbstringWin + lineHin * .75, 1.375 * lineHin) + grid.labels.margin.y * lineHin)
+					gridy = pretty30(bbx[c(2,4)], n = 5, longlat = !is.na(o$grid.crs) && sf::st_is_longlat(proj))
+					ybbstringWin <- max(
+						convertWidth(
+							stringWidth(do.call("fancy_breaks", c(
+								list(vec=gridy, intervals=FALSE), grid.labels.format))), "inch", valueOnly = TRUE)
+						)
+
+					ybbstringWin = ybbstringWin * grid.labels.size
+					ygridWin = ifelse(!is.na(grid.labels.space.y), grid.labels.space.y * lineHin, ifelse(grid.labels.rot[2] %in% c(0, 180), ybbstringWin + lineHin * .75, 1.375 * lineHin) + grid.labels.margin.y * lineHin)
 				} else {
 					ygridWin = 0
 				}

R/step1_helper_facets.R

@@ -158,9 +158,9 @@ step1_rearrange_facets = function(tmo, o) {
 
 
 
-				if (identical(popup.vars, TRUE)) {
+				if (isTRUE(popup.vars)) {
 					popup.vars = smeta$vars
-				} else if (identical(popup.vars, FALSE)) {
+				} else if (isFALSE(popup.vars)) {
 					popup.vars = character(0)
 				} else if (is.na(popup.vars[1])) {
 					popup.vars = setdiff(get("used_vars", envir = .TMAP), c("AREA", "LENGTH", "MAP_COLORS"))
@@ -169,6 +169,7 @@ step1_rearrange_facets = function(tmo, o) {
 				popup.format = process_label_format(popup.format, o$label.format)
 
 				if (!all(popup.vars %in% smeta$vars)) {
+					# TODO add a more informative message that says which variables are incorrect.
 					stop("Incorrrect popup.vars specification", call. = FALSE)
 				}
 				if (length(popup.vars)) add_used_vars(popup.vars)
@@ -361,6 +362,5 @@ step1_rearrange_facets = function(tmo, o) {
 	tmf = get_tmf(lapply(tmo, function(tmoi) tmoi$tmf))
 	tmo$tmf_global = tmf
 	tmo
-
 }
 

R/step1_helper_meta.R

@@ -18,12 +18,29 @@ preprocess_meta_step1 = function(o) {
 		legend.title.color = ifelse(is.null(legend.title.color), attr.color, legend.title.color[1])
 		title.color = ifelse(is.null(title.color), attr.color, title.color[1])
 
-		legend.inside.box = if (!is.logical(legend.frame)) TRUE else legend.frame
-		if (identical(title.bg.color, TRUE)) title.bg.color = bg.color
+		legend.inside.box = if (!is.logical(legend.frame)) {
+			TRUE
+		} else {
+			legend.frame
+		}
+
+		if (isTRUE(title.bg.color)) {
+			title.bg.color = bg.color
+		}
 
-		if (identical(frame, TRUE)) frame = attr.color else if (identical(frame, FALSE)) frame = NA 
+		if (isTRUE(frame)) {
+			frame = attr.color 
+		} else if (isFALSE(frame)) {
+			frame = NA
+		}
 
-		if (is.logical(legend.frame)) if (identical(legend.frame, TRUE)) legend.frame = attr.color else legend.frame = NA 
+		if (is.logical(legend.frame)) {
+			if (isTRUE(legend.frame)) {
+				legend.frame = attr.color
+			}  else {
+				legend.frame = NA 
+			} 
+		}
 		# 		
 		# 		between.margin.in <- convertHeight(unit(between.margin, "lines") * scale, "inch", valueOnly=TRUE)
 		# 		
@@ -64,9 +81,9 @@ preprocess_meta_step1 = function(o) {
 
 		if (is.na(legend.bg.color)) legend.bg.color = !is.na(legend.frame)
 		if (!is.na(legend.bg.color)) {
-			legend.bg.color = if (identical(legend.bg.color, FALSE)) {
+			legend.bg.color = if (isFALSE(legend.bg.color)) {
 				NA
-			} else if (identical(legend.bg.color, TRUE)) {
+			} else if (isTRUE(legend.bg.color)) {
 				bg.color
 			} else {
 				do.call("process_color", c(list(col=legend.bg.color, alpha=legend.bg.alpha), pc))				}
@@ -80,7 +97,7 @@ preprocess_meta_step1 = function(o) {
 		} else {
 			as.vector(bb(earth.boundary))
 		}
-		earth.boundary = !identical(earth.boundary, FALSE)
+		earth.boundary = !isFALSE(earth.boundary)
 
 		#earth.boundary.lwd = earth.boundary.lwd * scale
 		#frame.lwd = frame.lwd * scale

R/step2_helper_data.R

@@ -140,7 +140,7 @@ getdts = function(aes, unm, p, q, o, dt, shpvars, layer, mfun, args, plot.order)
 
 			# edit free argument. If NA, it is set to FALSE, and for the vars dimension to TRUE.
 			fr = rep(aes$free, length.out = 3)
-			if (any(is.na(fr))) {
+			if (anyNA(fr)) {
 				fr = rep(FALSE, 3)
 				if (length(v)) fr[v] = TRUE
 			}

R/step3_trans.R

@@ -65,8 +65,8 @@ step3_trans = function(tm) {
 
 		adi$shpDT = NULL
 
-		adi	
-	})	
+		adi
+	})
 
 
 	list(tmo = bd, aux = aux, cmp = cmp, o = o)

R/step4_helper_legends.R

@@ -1,7 +1,7 @@
 step4_plot_collect_legends = function(tmx) {
 	# collect legends
 	dt_template = data.table::data.table(by1__ = integer(0), by2__ =  integer(0), by3__ =  integer(0), legend = list())
-	
+
 	if (!length(tmx)) {
 		legs = dt_template
 	} else {
@@ -55,7 +55,6 @@ step4_plot_collect_legends = function(tmx) {
 					l
 				}, legs2, names(legs2), SIMPLIFY = FALSE)
 
-
 				copy_neutral = (length(legs) > 1)
 
 				legs3 = mapply(function(legs_aes, legnm, i) {

R/tm_layers_aux.R

@@ -62,13 +62,13 @@ leaflet::providers
 #' @rdname tm_grid
 #' @export
 tm_graticules = function(x = NA,
-						  y = NA,
-						  n.x = NA,
-						  n.y = NA,
-						  crs = 4326,
-						  labels.format = list(suffix = intToUtf8(176)),
-						  labels.cardinal = TRUE,
-						  ...) {
+						 y = NA,
+						 n.x = NA,
+						 n.y = NA,
+						 crs = 4326,
+						 labels.format = list(suffix = intToUtf8(176)),
+						 labels.cardinal = TRUE,
+						 ...) {
 	do.call(
 		tm_grid,
 		c(list(x = x, y = y, n.x = n.x, n.y = n.y, crs = crs, labels.format = labels.format, labels.cardinal = labels.cardinal), list(...))

R/tm_layers_symbols.R

@@ -266,7 +266,9 @@ v3_symbols = function(args, args_called) {
 							   label.format = imp("legend.format", list()))
 		fill.scale.args$fun_pref = if (style == "cat") {
 			"categorical"
-		} else if (style %in% c("fixed", "sd", "equal", "pretty", "quantile", "kmeans", "hclust", "bclust", "fisher", "jenks", "dpih", "headtails", "log10_pretty")) {
+		} else if (style %in% c("fixed", "sd", "equal", "pretty", "quantile",
+								"kmeans", "hclust", "bclust", "fisher", "jenks",
+								"dpih", "headtails", "log10_pretty")) {
 			"intervals"
 		} else if (style == "cont") {
 			"continuous"

R/tmapGetShapeMeta.R

@@ -15,7 +15,7 @@ tmapGetShapeMeta1 = function(shp, o) {
 #' Internal method that extracts meta data from shape objects
 #'
 #' @param shp the shape
-#' @param shape meta (from tmapGetShapeMeta1)
+#' @param smeta meta (from tmapGetShapeMeta1)
 #' @param o the list of options
 #' @export
 #' @keywords internal
@@ -195,7 +195,7 @@ get_fact_levels_na = function(x, o) {
 			anyna = (sum(tab) != length(x)) # note that NA can already be included in the levels (in that case anyna = FALSE)
 			levs = levels(x)[tab != 0]
 		} else {
-			anyna = any(is.na(x))
+			anyna = anyNA(x)
 			levs = levels(x)
 		}
 

R/tmapGridComp_leg_portrait.R

@@ -473,7 +473,7 @@ tmapGridLegPlot.tm_legend_standard_portrait = function(comp, o, fH, fW) {
 	} else if (comp$type == "rect") {
 		#gps = split_gp(gp, n = nlev)
 
-		diffAlpha = !any(is.na(c(gp$fill_alpha, gp$col_alpha))) && !(length(gp$fill_alpha) == length(gp$col_alpha) && all(gp$fill_alpha == gp$col_alpha))
+		diffAlpha = !anyNA(c(gp$fill_alpha, gp$col_alpha)) && !(length(gp$fill_alpha) == length(gp$col_alpha) && all(gp$fill_alpha == gp$col_alpha))
 
 
 		if (diffAlpha) {

R/tmapGridWrap.R

@@ -8,7 +8,7 @@ tmapGridWrap = function(label, facet_row, facet_col, facet_page, o) {
 	row = g$rows_panel_ids[facet_row]
 	col = g$cols_panel_ids[facet_col]
 
-	frame.col = if (identical(o$frame, FALSE)) o$attr.color else if (identical(o$frame, TRUE)) o$attr.color else o$frame
+	frame.col = if (isFALSE(o$frame)) o$attr.color else if (isTRUE(o$frame)) o$attr.color else o$frame
 
 	#scale = o$scale * o$scale_down
 

R/tmapGrid_layers.R

@@ -16,7 +16,7 @@ tmapGridPolygons = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page
 	gp = rescale_gp(gp, o$scale_down)
 
 	# none should contain NA's && (length or content should be different)
-	diffAlpha = !any(is.na(c(gp$fill_alpha, gp$col_alpha))) && !(length(gp$fill_alpha) == length(gp$col_alpha) && all(gp$fill_alpha == gp$col_alpha))
+	diffAlpha = !anyNA(c(gp$fill_alpha, gp$col_alpha)) && !(length(gp$fill_alpha) == length(gp$col_alpha) && all(gp$fill_alpha == gp$col_alpha))
 
 
 	if (diffAlpha) {

R/tmapLeafletInit.R

@@ -173,7 +173,7 @@ view_set_bounds <- function(lf, bbx, o) {
 		lims = unname(bbx)
 	}
 	if (!(identical(o$set.bounds, FALSE))) {
-		lf = lf %>% setMaxBounds(lims[1], lims[2], lims[3],lims[4])
+		lf = lf %>% leaflet::setMaxBounds(lims[1], lims[2], lims[3],lims[4])
 	}
 
 	if (is.na(o$set.view[1])) {

R/tmapScale_defaults.R

@@ -335,7 +335,7 @@ tmapValuesSubmit_shape = function(x, args) {
 		# copy-pasted from v3, but not the best place
 		# improvement of just needed (-> trans?)
 		args = within(args, {
-			if (any(is.na(just))) {
+			if (anyNA(just)) {
 				just = c(.5, .5)
 				just.override = FALSE
 			} else {

R/tmapScale_misc.R

@@ -15,7 +15,7 @@ get_scale_defaults = function(scale, o, aes, layer, cls, ct = NULL) {
 			}
 		} else values
 
-		value.na = if (is.na(value.na) || identical(value.na, TRUE)) {
+		value.na = if (is.na(value.na) || isTRUE(value.na)) {
 			m = getPalMeta(as.character(values[1]))
 			ona = getAesOption("value.na", o, aes, layer, cls = cls)	
 
@@ -43,7 +43,7 @@ get_scale_defaults = function(scale, o, aes, layer, cls, ct = NULL) {
 		# label.na NA: show NA is there are any
 		# label.na "qwerty" always snow NA's
 
-		label.show = !identical(label.na, FALSE) && (identical(label.na, TRUE) || (!is.na(label.na) && label.na != ""))
+		label.show = !isFALSE(label.na) && (isTRUE(label.na) || (!is.na(label.na) && label.na != ""))
 		if (is.na(label.na)) label.show = NA # will be TRUE if there are NAs
 		if (is.logical(label.na)) label.na = getAesOption("label.na", o, aes, layer, cls = cls)
 	})
@@ -67,8 +67,8 @@ tmapScale_returnNA = function(n, legend, value.na, label.na, label.show, na.show
 		rep(0L, n)
 	}
 
-	if (identical(label.show, FALSE)) {
-		legend = within(legend,{
+	if (isFALSE(label.show)) {
+		legend = within(legend, {
 			title = NA
 			nitems = 0
 			labels = NA 

R/tmap_format.R

@@ -10,7 +10,7 @@
 #'   When `format` is defined, it returns the option list corresponding the that format.
 #' @seealso 
 #' * [tm_layout()] for predefined styles
-#' * `tmap_style_catalogue` (not migrated to v4 yet) to create a style catalogue of all available styles
+#' * `tmap_style_catalogue` (not migrated to v4 yet) to create a style catalogue of all available styles.
 #' * [tmap_options()] for tmap options
 #' @example ./examples/tmap_format.R
 #' @rdname tmap_format