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)
+
  })
  })