Various lints

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/process_meta.R

@@ -231,8 +231,14 @@ 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(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)
+ 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"))
@@ -362,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/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/tmapGetShapeMeta.R

@@ -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/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 

data-raw/land.R

@@ -98,13 +98,20 @@ bbx <- st_bbox(land)
 crs <- st_crs(land)
 
 dimensions <- structure(list(
- x = structure(list(from = 1, to = ncols, offset = bbx["xmin"],
- delta = (bbx["xmax"] - bbx["xmin"]) / ncols, refsys = crs$proj4string, point = NULL, values = NULL),
- class = "dimension"),
- y = structure(list(from = 1, to = nrows, offset = bbx["ymax"],
- delta = (bbx["ymin"] - bbx["ymax"]) / nrows, refsys = crs$proj4string, point = NULL, values = NULL),
- class = "dimension")),
- raster = stars:::get_raster(), class = "dimensions")
+ x = structure(list(
+ from = 1, to = ncols, offset = bbx["xmin"],
+ delta = (bbx["xmax"] - bbx["xmin"]) / ncols,
+ refsys = crs$proj4string, point = NULL, values = NULL
+ ), class = "dimension"),
+ y = structure(list(
+ from = 1, to = nrows, offset = bbx["ymax"],
+ delta = (bbx["ymin"] - bbx["ymax"]) / nrows,
+ refsys = crs$proj4string, point = NULL, values = NULL
+ ), class = "dimension")
+ ),
+ raster = stars:::get_raster(),
+ class = "dimensions"
+ )
 
 s1 <- stars::st_as_stars(ms)
 attr(s1, "dimensions") <- dimensions

data-raw/metro.R

@@ -40,7 +40,7 @@ ct$Country.Code[ct$Country.Code==729] <- 736 # all Sudan cities are in Sudan (no
 
 ct$iso_a3 <- ccodes$iso_a3[match(ct$Country.Code, ccodes$ccode)]
 
-!any(is.na(ct$iso_a3))
+!anyNA(ct$iso_a3)
 
 ct$name <- gsub("Basilan City (including City of Isabela)", "Basilan City", ct$name,fixed=TRUE)
 ct$name <- gsub("Gaza (incl. Ash Shati Camp)", "Gaza", ct$name,fixed=TRUE)

tests/testthat/test-tm_layers_aux.R

@@ -20,7 +20,11 @@ test_that("Base layer works at different positions", {
  tm_shape(metro) +
  tm_symbols(fill = "pop2020") +
  tm_layout(bg.color = "grey95")
- expect_warning(print(t), "legends is too high")
+ expect_s3_class(t, "tmap")
+ expect_equal(
+ attr(t[[1]], "class"),
+ c("tm_basemap", "tm_aux_layer", "tm_element", "list")
+ )
  tm_shape(Africa) +
  tm_polygons("HPI", fill.scale = tm_scale(values = "viridis")) +
  tm_basemap("OpenStreetMap")+
@@ -60,9 +64,10 @@ test_that("Base layer works at different positions", {
 })
 
 test_that("Projected CRS warp work", {
- tm_shape(NLD_prov) +
+ t <- tm_shape(NLD_prov) +
  tm_basemap("OpenStreetMap") +
  tm_borders()
+ expect_s3_class(t, "tmap")
 })
 
 
@@ -85,4 +90,4 @@ test_that("tm_graticules(labels.show = FALSE) doesn't show labels. (#795)", {
  tm_fill() +
  tm_graticules(labels.show = TRUE)
  expect_false(identical(lab, no_lab))
-})
+})