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")