From a623c47b5ae8cf2f7dd83d2cad42cbf54784a9bc Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 25 Jun 2024 14:58:28 -0400 Subject: [PATCH 01/10] Commit doc change --- man/tm_cartogram.Rd | 2 +- man/tm_lines.Rd | 4 +- man/tm_polygons.Rd | 4 +- man/tm_symbols.Rd | 4 +- man/tmap_internal.Rd | 94 ++++++++++++++++++++++++++++++++++++++++++++ 5 files changed, 101 insertions(+), 7 deletions(-) create mode 100644 man/tmap_internal.Rd diff --git a/man/tm_cartogram.Rd b/man/tm_cartogram.Rd index a896f180..893e8a9f 100644 --- a/man/tm_cartogram.Rd +++ b/man/tm_cartogram.Rd @@ -63,7 +63,7 @@ numeric data variables. If one list of formatting options is provided, it is applied to all numeric variables of \code{popup.vars}. Also, a (named) list of lists can be provided. In that case, each list of formatting options is applied to the named variable.} - \item{\code{hover}}{name of the data variable that specifies the hover labels} + \item{\code{hover}}{name of the data variable that specifies the hover labels (view mode only). Set to \code{FALSE} to disable hover labels. By default \code{FALSE}, unless \code{id} is specified. In that case, it is set to \code{id},} \item{\code{id}}{name of the data variable that specifies the indices of the spatial features. Only used for \code{"view"} mode.} }} diff --git a/man/tm_lines.Rd b/man/tm_lines.Rd index 95c936bd..620c07c5 100644 --- a/man/tm_lines.Rd +++ b/man/tm_lines.Rd @@ -36,7 +36,7 @@ tm_lines( group.control = "check", popup.vars = NA, popup.format = list(), - hover = "", + hover = NA, id = "", options = opt_tm_lines(), ... @@ -67,7 +67,7 @@ tm_lines( \item{popup.format}{list of formatting options for the popup values. See the argument \code{legend.format} for options. Only applicable for numeric data variables. If one list of formatting options is provided, it is applied to all numeric variables of \code{popup.vars}. Also, a (named) list of lists can be provided. In that case, each list of formatting options is applied to the named variable.} -\item{hover}{name of the data variable that specifies the hover labels} +\item{hover}{name of the data variable that specifies the hover labels (view mode only). Set to \code{FALSE} to disable hover labels. By default \code{FALSE}, unless \code{id} is specified. In that case, it is set to \code{id},} \item{id}{name of the data variable that specifies the indices of the spatial features. Only used for \code{"view"} mode.} diff --git a/man/tm_polygons.Rd b/man/tm_polygons.Rd index 76910fef..78c47511 100644 --- a/man/tm_polygons.Rd +++ b/man/tm_polygons.Rd @@ -48,7 +48,7 @@ tm_polygons( group.control = "check", popup.vars = NA, popup.format = list(), - hover = "", + hover = NA, id = "", options = opt_tm_polygons(), ... @@ -107,7 +107,7 @@ it is applied to all numeric variables of \code{popup.vars}. Also, a (named) list of lists can be provided. In that case, each list of formatting options is applied to the named variable.} -\item{hover}{name of the data variable that specifies the hover labels} +\item{hover}{name of the data variable that specifies the hover labels (view mode only). Set to \code{FALSE} to disable hover labels. By default \code{FALSE}, unless \code{id} is specified. In that case, it is set to \code{id},} \item{id}{name of the data variable that specifies the indices of the spatial features. Only used for \code{"view"} mode.} diff --git a/man/tm_symbols.Rd b/man/tm_symbols.Rd index c115de07..27d3ab0e 100644 --- a/man/tm_symbols.Rd +++ b/man/tm_symbols.Rd @@ -86,7 +86,7 @@ tm_symbols( group.control = "check", popup.vars = NA, popup.format = list(), - hover = "", + hover = NA, id = "", options = opt_tm_symbols(), ... @@ -251,7 +251,7 @@ variables. If one list of formatting options is provided, it is applied to all numeric variables of \code{popup.vars}. Also, a (named) list of lists can be provided. In that case, each list of formatting options is applied to the named variable.} -\item{hover}{name of the data variable that specifies the hover labels} +\item{hover}{name of the data variable that specifies the hover labels (view mode only). Set to \code{FALSE} to disable hover labels. By default \code{FALSE}, unless \code{id} is specified. In that case, it is set to \code{id},} \item{id}{name of the data variable that specifies the indices of the spatial features. Only used for \code{"view"} mode.} diff --git a/man/tmap_internal.Rd b/man/tmap_internal.Rd new file mode 100644 index 00000000..b1433410 --- /dev/null +++ b/man/tmap_internal.Rd @@ -0,0 +1,94 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tm_element.R, R/tmapGpar.R, R/tmapScale_.R, +% R/tmapTrans.R +\name{tm_element} +\alias{tm_element} +\alias{tm_element_list} +\alias{tmapGpar} +\alias{tmapTpar} +\alias{tmapUsrCls} +\alias{tmapScale} +\alias{tmapTransCentroid} +\alias{tmapTransRaster} +\alias{tmapTransPolygons} +\alias{tmapTransLines} +\alias{tmapTransCartogram} +\title{Internal methods for tmap extensions} +\usage{ +tm_element(..., subclass = NULL) + +tm_element_list(...) + +tmapGpar( + fill = NULL, + col = NULL, + shape = NULL, + size = NULL, + fill_alpha = NULL, + col_alpha = NULL, + lty = NULL, + lwd = NULL, + linejoin = NULL, + lineend = NULL, + ... +) + +tmapTpar(...) + +tmapUsrCls(x) + +tmapScale(aes, value, scale, legend, chart, free) + +tmapTransCentroid( + shpTM, + xmod = NULL, + ymod = NULL, + ord__, + plot.order, + args, + scale +) + +tmapTransRaster(shpTM, ord__, plot.order, args) + +tmapTransPolygons(shpTM, ord__, plot.order, args, scale) + +tmapTransLines(shpTM, ord__, plot.order, args, scale) + +tmapTransCartogram(shpTM, size, ord__, plot.order, args, scale) +} +\arguments{ +\item{...}{args} + +\item{subclass}{subclass} + +\item{fill, col, shape, size, fill_alpha, col_alpha, lty, lwd, linejoin, lineend}{visual variables} + +\item{x}{x} + +\item{aes}{aes} + +\item{value}{value} + +\item{scale}{scale} + +\item{legend}{legend} + +\item{chart}{chart} + +\item{free}{free} + +\item{shpTM}{shpTM} + +\item{xmod, ymod}{xmod and ymod} + +\item{ord__}{ord} + +\item{plot.order}{plot.order} + +\item{args}{args} +} +\description{ +Internal methods for tmap extensions +} +\keyword{internal} From 31ee4edf057ec2caa50fd4506e4ce8c91dd3d1c2 Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 25 Jun 2024 15:06:39 -0400 Subject: [PATCH 02/10] Depend on R 3.6 to use S3 method directly --- DESCRIPTION | 2 +- NAMESPACE | 14 ++------------ R/print.R | 7 +------ R/tmap_arrange.R | 7 +------ man/print.tmap.Rd | 2 +- man/tmap_arrange.Rd | 2 +- 6 files changed, 7 insertions(+), 27 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 40e1e421..ba971bdc 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -22,7 +22,7 @@ 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), diff --git a/NAMESPACE b/NAMESPACE index 124d48c1..75448ef9 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/print.R b/R/print.R index ca2a1a96..16d4bc2f 100644 --- a/R/print.R +++ b/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, ...) } diff --git a/R/tmap_arrange.R b/R/tmap_arrange.R index e842cce3..14a81f3f 100644 --- a/R/tmap_arrange.R +++ b/R/tmap_arrange.R @@ -48,12 +48,7 @@ tmap_arrange <- function(..., ncol = NA, nrow = NA, widths = NA, heights = NA, s } #' @rdname tmap_arrange -#' @rawNamespace -#' if(getRversion() >= "3.6.0") { -#' S3method(knitr::knit_print, tmap_arrange) -#' } else { -#' export(knit_print.tmap_arrange) -#' } +#' @exportS3Method knitr::knit_print knit_print.tmap_arrange <- function(x, ..., options = NULL) { print_tmap_arrange(x, knit=TRUE, ..., options = options) } diff --git a/man/print.tmap.Rd b/man/print.tmap.Rd index ced9cc2d..4c40f32f 100644 --- a/man/print.tmap.Rd +++ b/man/print.tmap.Rd @@ -15,7 +15,7 @@ ... ) -knit_print.tmap(x, ..., options = NULL) +\method{knit_print}{tmap}(x, ..., options = NULL) } \arguments{ \item{x}{tmap object.} diff --git a/man/tmap_arrange.Rd b/man/tmap_arrange.Rd index b68c3c01..ab1e0811 100644 --- a/man/tmap_arrange.Rd +++ b/man/tmap_arrange.Rd @@ -17,7 +17,7 @@ tmap_arrange( outer.margins = 0.02 ) -knit_print.tmap_arrange(x, ..., options = NULL) +\method{knit_print}{tmap_arrange}(x, ..., options = NULL) \method{print}{tmap_arrange}(x, knit = FALSE, ..., options = NULL) } From f81faa1fd9668a33c16bc180090ddcfeca8af118 Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 25 Jun 2024 15:07:16 -0400 Subject: [PATCH 03/10] Check if hover is NA (equivalent to "") #851 --- R/step1_helper_facets.R | 4 ++-- R/step2_data.R | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/R/step1_helper_facets.R b/R/step1_helper_facets.R index a3fe99ce..6701d308 100644 --- a/R/step1_helper_facets.R +++ b/R/step1_helper_facets.R @@ -189,8 +189,8 @@ step1_rearrange_facets = function(tmo, o) { } if (length(popup.vars)) add_used_vars(popup.vars) - if (hover != "" && !hover %in% smeta$vars) rlang::arg_match0(hover, smeta$vars, "hover label", error_call = NULL) - if (hover != "") add_used_vars(hover) + if (!is.na(hover) && hover != "" && !hover %in% smeta$vars) rlang::arg_match0(hover, smeta$vars, "hover label", error_call = NULL) + if (!is.na(hover) && 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) }) diff --git a/R/step2_data.R b/R/step2_data.R index a2695511..27ce3776 100644 --- a/R/step2_data.R +++ b/R/step2_data.R @@ -88,7 +88,7 @@ step2_data = function(tm) { } else { copy(dt[, c(tml$popup.vars, "tmapID__"), with = FALSE]) } - hover.data = if (tml$hover == "") { + hover.data = if (tml$hover == "" || is.na(tml$hover)) { NULL } else { as.character(dt[[tml$hover]]) From 2ff5bab8f7cd0a9275d6ac76ad028d65225fff1c Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 25 Jun 2024 15:24:31 -0400 Subject: [PATCH 04/10] Move methods to Imports, remove utils. Truncate example width. --- DESCRIPTION | 3 +-- NAMESPACE | 1 - R/tm_layers_aux.R | 2 +- R/tmap_animation.R | 1 - examples/tm_symbols.R | 3 ++- man/tm_symbols.Rd | 3 ++- 6 files changed, 6 insertions(+), 7 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index ba971bdc..268d0ff3 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -21,7 +21,6 @@ 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.6.0) Imports: classInt (>= 0.4-3), @@ -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, diff --git a/NAMESPACE b/NAMESPACE index 75448ef9..2bcc4599 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -294,4 +294,3 @@ importFrom(htmlwidgets,saveWidget) importFrom(leaflet,providers) importFrom(rlang,expr) importFrom(rlang,missing_arg) -importFrom(utils,browseURL) diff --git a/R/tm_layers_aux.R b/R/tm_layers_aux.R index b0d96fa3..2745207f 100644 --- a/R/tm_layers_aux.R +++ b/R/tm_layers_aux.R @@ -55,7 +55,7 @@ tm_tiles = function(server = NULL, alpha = NULL, zoom = NULL, max.native.zoom = subclass = c("tm_tiles", "tm_aux_layer"))) } -#' @import leaflet +#' @importFrom leaflet providers #' @export leaflet::providers diff --git a/R/tmap_animation.R b/R/tmap_animation.R index f7fdfb70..85e4c0f7 100644 --- a/R/tmap_animation.R +++ b/R/tmap_animation.R @@ -35,7 +35,6 @@ #' @concept animation #' @example ./examples/tmap_animation.R #' @import tmaptools -#' @importFrom utils browseURL #' @export tmap_animation <- function(tm, filename = NULL, width = NA, height = NA, dpi = NA, delay = 40, fps = NA, loop = TRUE, outer.margins = NA, asp = NULL, scale = NA, restart.delay = NULL, ...) { .tmapOptions <- get("tmapOptions", envir = .TMAP) diff --git a/examples/tm_symbols.R b/examples/tm_symbols.R index d4914f71..5871631a 100644 --- a/examples/tm_symbols.R +++ b/examples/tm_symbols.R @@ -41,7 +41,8 @@ tm_shape(land) + tm_shape(NLD_prov, crs = 4326) + tm_polygons() + tm_shape(airports) + tm_symbols(shape=airplane, size="natlscale", - legend.size.show = FALSE, scale=1, border.col = NULL, id="name", popup.vars = TRUE) + legend.size.show = FALSE, scale=1, border.col = NULL, + id="name", popup.vars = TRUE) #tm_view(set.view = c(lon = 15, lat = 48, zoom = 4)) tmap_mode(current.mode) } diff --git a/man/tm_symbols.Rd b/man/tm_symbols.Rd index 27d3ab0e..509ecf78 100644 --- a/man/tm_symbols.Rd +++ b/man/tm_symbols.Rd @@ -344,7 +344,8 @@ tm_shape(land) + tm_shape(NLD_prov, crs = 4326) + tm_polygons() + tm_shape(airports) + tm_symbols(shape=airplane, size="natlscale", - legend.size.show = FALSE, scale=1, border.col = NULL, id="name", popup.vars = TRUE) + legend.size.show = FALSE, scale=1, border.col = NULL, + id="name", popup.vars = TRUE) #tm_view(set.view = c(lon = 15, lat = 48, zoom = 4)) tmap_mode(current.mode) } From fe4d00e534bd035693e7324eb66063e95ac11e6c Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 25 Jun 2024 15:29:47 -0400 Subject: [PATCH 05/10] Add item to NEWS file --- NEWS.md | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/NEWS.md b/NEWS.md index 70240522..43584a0d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,21 @@ * 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). + +```r +tmap_mode("view") +# v3 +tm_shape(World) + + tm_polygons(id = "footprint") + +# v4 +tm_shape(World) + + tm_polygons(id = "footprint", hover = "footprint") +``` + # 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) From 97c86b732870357a17a56c9f1fb5b2b7e7b802b9 Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 25 Jun 2024 16:36:02 -0400 Subject: [PATCH 06/10] Tweak `hover` to allow for `TRUE` or `FALSE` special behavior. (as documented) --- NEWS.md | 11 ----------- R/step1_helper_facets.R | 12 +++++++++--- 2 files changed, 9 insertions(+), 14 deletions(-) diff --git a/NEWS.md b/NEWS.md index 43584a0d..4b9d9410 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,17 +6,6 @@ * In view mode, `hover` is now independent from `id` (#851). -```r -tmap_mode("view") -# v3 -tm_shape(World) + - tm_polygons(id = "footprint") - -# v4 -tm_shape(World) + - tm_polygons(id = "footprint", hover = "footprint") -``` - # 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) diff --git a/R/step1_helper_facets.R b/R/step1_helper_facets.R index 6701d308..4db5ed9f 100644 --- a/R/step1_helper_facets.R +++ b/R/step1_helper_facets.R @@ -188,11 +188,17 @@ 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 (!is.na(hover) && hover != "" && !hover %in% smeta$vars) rlang::arg_match0(hover, smeta$vars, "hover label", error_call = NULL) - if (!is.na(hover) && hover != "") add_used_vars(hover) + # if hover = FALSE, disable hovering + if (isFALSE(hover)) hover <- "" + # If hover is not specified, default to id + if (identical(hover, NA)) hover <- id + # If hover = TRUE, set to id + if (isTRUE(hover)) hover <- id if (id != "" && !id %in% smeta$vars) rlang::arg_match0(id, smeta$vars, arg_nm = "id", error_call = NULL) if (id != "") add_used_vars(id) + if (!is.na(hover) && hover != "" && !hover %in% smeta$vars) rlang::arg_match0(hover, smeta$vars, "hover", error_call = NULL) + if (!is.na(hover) && hover != "") add_used_vars(hover) + }) }) From f1e41149f6b8ba5fae38ee56535f8caaae2b7ef4 Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 25 Jun 2024 17:48:38 -0400 Subject: [PATCH 07/10] Namespace stars and sf calls + use `=` instead of `<-`, use `TRUE` instead of `T`, `FALSE` instead of `F` --- R/misc_other.R | 84 +++++++++++++------------- R/misc_stars.R | 8 +-- R/misc_text.R | 18 +++--- R/process_legend_format.R | 16 ++--- R/process_meta.R | 2 +- R/qtm.R | 16 ++--- R/step4_plot.R | 4 +- R/tmapGridAux.R | 112 +++++++++++++++++------------------ R/tmapGridText.R | 2 +- R/tmapLeaflet_layers.R | 10 ++-- R/tmapShape.R | 12 ++-- R/tmapShape_simplification.R | 10 ++-- R/tmapTrans.R | 38 ++++++------ R/tme_graphics.R | 6 +- data-raw/NLD_muni_NLD_prov.R | 8 +-- data-raw/World-fix.R | 24 ++++---- data-raw/World.R | 14 ++--- data-raw/land.R | 2 +- data-raw/metro.R | 2 +- data-raw/rivers.R | 2 +- examples/tm_symbols.R | 3 +- examples/tmap_animation.R | 2 +- sandbox/grid_design.R | 2 +- sandbox/issues.R | 38 ++++++------ sandbox/main2.R | 22 +++---- sandbox/test_data.R | 18 +++--- tests/testing_facet_vars.Rmd | 18 +++--- tests/testing_stars.Rmd | 12 ++-- 28 files changed, 252 insertions(+), 253 deletions(-) diff --git a/R/misc_other.R b/R/misc_other.R index 588afc7a..5e5fd9a6 100644 --- a/R/misc_other.R +++ b/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) { diff --git a/R/misc_stars.R b/R/misc_stars.R index d8fc71af..c802e866 100644 --- a/R/misc_stars.R +++ b/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 } diff --git a/R/misc_text.R b/R/misc_text.R index 1dee3066..8238e234 100644 --- a/R/misc_text.R +++ b/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,24 +74,24 @@ 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 { @@ -99,6 +99,6 @@ expr_to_char <- function(txt) { } } -is_num_string <- function(x) { +is_num_string = function(x) { suppressWarnings(!is.na(as.numeric(x))) } diff --git a/R/process_legend_format.R b/R/process_legend_format.R index fbd59e5b..1762587c 100644 --- a/R/process_legend_format.R +++ b/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)) diff --git a/R/process_meta.R b/R/process_meta.R index ec15a24f..135af422 100644 --- a/R/process_meta.R +++ b/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) diff --git a/R/qtm.R b/R/qtm.R index c381f24c..99e03142 100644 --- a/R/qtm.R +++ b/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 } diff --git a/R/step4_plot.R b/R/step4_plot.R index 5b00493c..a3428a79 100644 --- a/R/step4_plot.R +++ b/R/step4_plot.R @@ -395,7 +395,7 @@ step4_plot = function(tm, vp, return.asp, show, knit, args) { while(prod(fn_lim) > n_lim) { fn_lim[which.max(fn_lim)] = fn_lim[which.max(fn_lim)] - 1L } - d = d[by1<= fn_lim[1] & by2<= fn_lim[2] & by3<= fn_lim[3]] + d = d[by1<= fn_lim[1] & by2<= fn_lim[2] & by3 <= fn_lim[3]] o$fl = mapply(function(a, b) a[1:b], o$fl, fn_lim, SIMPLIFY = FALSE) o$fn = fn_lim o$n = n_lim @@ -403,7 +403,7 @@ step4_plot = function(tm, vp, return.asp, show, knit, args) { } d[, bbox:=lapply(bbox, FUN = function(bbx) { - if (!is.na(bbx) && !is.na(longlat) && longlat && !st_is_longlat(bbx)) { + if (!is.na(bbx) && !is.na(longlat) && longlat && !sf::st_is_longlat(bbx)) { sf::st_bbox(sf::st_transform(tmaptools::bb_poly(bbx), crs = 4326)) } else { bbx diff --git a/R/tmapGridAux.R b/R/tmapGridAux.R index 0ed3e906..f85682e8 100644 --- a/R/tmapGridAux.R +++ b/R/tmapGridAux.R @@ -112,7 +112,7 @@ tmapGridTilesPrep = function(a, bs, id, o) { } -grid_nonoverlap <- function(x, s) { +grid_nonoverlap = function(x, s) { n = length(x) x = c(-x[1], x, 1 + (1 - x[n])) @@ -196,8 +196,8 @@ tmapGridGridPrep = function(a, bs, id, o) { } ## find natural breaks - custom.x <- !is.na(x[1]) - custom.y <- !is.na(y[1]) + custom.x = !is.na(x[1]) + custom.y = !is.na(y[1]) if (!custom.x) x <- pretty30(bbx[c(1,3)], n=n.x, longlat = !is.na(crs) && sf::st_is_longlat(crs_bb)) if (!custom.y) y <- pretty30(bbx[c(2,4)], n=n.y, longlat = !is.na(crs) && sf::st_is_longlat(crs_bb)) @@ -265,7 +265,7 @@ tmapGridGridPrep = function(a, bs, id, o) { x2 <- x2[!lnsX_emp] lnsX_proj <- lnsX_proj[!lnsX_emp] - xco <- st_coordinates(lnsX_proj) + xco <- sf::st_coordinates(lnsX_proj) # co.x.lns co.x <- lapply(unique(xco[,3]), function(i) { lco <- xco[xco[,3]==i, 1:2] @@ -284,14 +284,14 @@ tmapGridGridPrep = function(a, bs, id, o) { if (lnsSel[2]) { lnsY = sf::st_sfc(lapply(y2, function(y) { - st_linestring(matrix(c(seq(x2.min, x2.max, length.out=ndiscr), rep(y,ndiscr)), ncol=2)) + sf::st_linestring(matrix(c(seq(x2.min, x2.max, length.out=ndiscr), rep(y,ndiscr)), ncol=2)) }), crs = crs) lnsY_proj <- sf::st_transform(lnsY, crs = crs_bb) lnsY_emp <- sf::st_is_empty(lnsY_proj) y2 <- y2[!lnsY_emp] lnsY_proj <- lnsY_proj[!lnsY_emp] - yco <- st_coordinates(lnsY_proj) + yco <- sf::st_coordinates(lnsY_proj) 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]) @@ -492,25 +492,25 @@ tmapGridGridYLab = function(bi, bbx, facet_row, facet_col, facet_page, o) { cogridy2 = cogridy[sely2] - spacerY <- convertWidth(unit(.5, "lines"), unitTo="inch", valueOnly=TRUE) * cex / W - marginY <- convertWidth(unit(a$labels.margin.y, "lines"), unitTo="inch", valueOnly=TRUE) * cex / W + spacerY <- grid::convertWidth(grid::unit(.5, "lines"), unitTo="inch", valueOnly=TRUE) * cex / W + marginY <- grid::convertWidth(grid::unit(a$labels.margin.y, "lines"), unitTo="inch", valueOnly=TRUE) * cex / W just <- ifelse(a$labels.rot[2] == 90, "bottom", ifelse(a$labels.rot[2] == 270, "top", ifelse(a$labels.rot[2] == 180, "left", "right"))) if (a$ticks[2]) { if (is_left) { - ticks <- polylineGrob(x = rep(c(1-spacerY*.5-marginY, 1), length(cogridy2)), y = rep(cogridy2, each = 2), id = rep(1:length(cogridy2), each = 2), gp=gpar(col=a$col, lwd=a$lwd)) + ticks <- grid::polylineGrob(x = rep(c(1-spacerY*.5-marginY, 1), length(cogridy2)), y = rep(cogridy2, each = 2), id = rep(1:length(cogridy2), each = 2), gp=gpar(col=a$col, lwd=a$lwd)) } else { - ticks <- polylineGrob(x = rep(c(0, spacerY*.5+marginY), length(cogridy2)), y = rep(cogridy2, each = 2), id = rep(1:length(cogridy2), each = 2), gp=gpar(col=a$col, lwd=a$lwd)) + ticks <- grid::polylineGrob(x = rep(c(0, spacerY*.5+marginY), length(cogridy2)), y = rep(cogridy2, each = 2), id = rep(1:length(cogridy2), each = 2), gp=gpar(col=a$col, lwd=a$lwd)) } } else { ticks <- NULL } if (is_left) { - labels <- textGrob(labelsy2, y=cogridy2, x=1 - spacerY - marginY, just=just, rot=a$labels.rot[2], gp=gpar(col=a$labels.col, cex=cex, fontface=gt$fontface, fontfamily=gt$fontfamily)) + labels = grid::textGrob(labelsy2, y=cogridy2, x=1 - spacerY - marginY, just=just, rot=a$labels.rot[2], gp=gpar(col=a$labels.col, cex=cex, fontface=gt$fontface, fontfamily=gt$fontfamily)) } else { - labels <- textGrob(labelsy2, y=cogridy2, x=1-spacerY*.5-marginY, just=just, rot=a$labels.rot[2], gp=gpar(col=a$labels.col, cex=cex, fontface=gt$fontface, fontfamily=gt$fontfamily)) + labels = grid::textGrob(labelsy2, y=cogridy2, x=1-spacerY*.5-marginY, just=just, rot=a$labels.rot[2], gp=gpar(col=a$labels.col, cex=cex, fontface=gt$fontface, fontfamily=gt$fontfamily)) } res = gTree(children = gList(ticks, labels), name = "gridTicksLabelsY") @@ -563,11 +563,11 @@ tmapGridGrid = function(bi, bbx, facet_row, facet_col, facet_page, id, pane, gro # find margins due to grid labels if (!is.na(o$frame)) { if (o$frame.double.line) { - fw <- (6 * convertWidth(unit(1, "points"), unitTo = "inch", valueOnly = TRUE) * o$frame.lwd) / fW - fh <- (6 * convertHeight(unit(1, "points"), unitTo = "inch", valueOnly = TRUE) * o$frame.lwd) / fH + fw <- (6 * grid::convertWidth(unit(1, "points"), unitTo = "inch", valueOnly = TRUE) * o$frame.lwd) / fW + fh <- (6 * grid::convertHeight(unit(1, "points"), unitTo = "inch", valueOnly = TRUE) * o$frame.lwd) / fH } else { - fw <- (convertWidth(unit(1, "points"), unitTo = "inch", valueOnly = TRUE) * o$frame.lwd) / fW - fh <- (convertHeight(unit(1, "points"), unitTo = "inch", valueOnly = TRUE) * o$frame.lwd) / fH + fw <- (grid::convertWidth(unit(1, "points"), unitTo = "inch", valueOnly = TRUE) * o$frame.lwd) / fW + fh <- (grid::convertHeight(unit(1, "points"), unitTo = "inch", valueOnly = TRUE) * o$frame.lwd) / fH } } else { fw <- 0 @@ -580,10 +580,10 @@ tmapGridGrid = function(bi, bbx, facet_row, facet_col, facet_page, id, pane, gro if (a$labels.rot[1] %in% c(0, 180)) { labelsXw <- if (selx) (max(text_height_inch(labelsx)) * cex + fh) / fH else 0 } else { - labelsXw <- if (selx) (max(text_width_inch(labelsx, space=FALSE)) * cex + fh) / fH else 0 + labelsXw <- if (selx) (max(text_width_inch(labelsx, space = FALSE)) * cex + fh) / fH else 0 } - spacerX <- convertHeight(unit(.5, "lines"), unitTo="inch", valueOnly=TRUE) * cex / fH - marginX <- convertWidth(unit(a$labels.margin.x, "lines"), unitTo="inch", valueOnly=TRUE) * cex / fW + spacerX <- grid::convertHeight(unit(.5, "lines"), unitTo="inch", valueOnly = TRUE) * cex / fH + marginX <- grid::convertWidth(unit(a$labels.margin.x, "lines"), unitTo="inch", valueOnly = TRUE) * cex / fW } else { labelsXw <- spacerX <- marginX <- 0 } @@ -595,8 +595,8 @@ tmapGridGrid = function(bi, bbx, facet_row, facet_col, facet_page, id, pane, gro } else { labelsYw <- if (sely) (max(text_height_inch(labelsy, to_width = TRUE)) * cex + fw) / fW else 0 } - spacerY <- convertWidth(unit(.5, "lines"), unitTo="inch", valueOnly=TRUE) * cex / fW - marginY <- convertWidth(unit(a$labels.margin.y, "lines"), unitTo="inch", valueOnly=TRUE) * cex / fW + spacerY <- grid::convertWidth(grid::unit(.5, "lines"), unitTo="inch", valueOnly=TRUE) * cex / fW + marginY <- grid::convertWidth(grid::unit(a$labels.margin.y, "lines"), unitTo="inch", valueOnly=TRUE) * cex / fW } else { labelsYw <- spacerY <- marginY <- 0 } @@ -648,17 +648,17 @@ 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) else NULL, - if (any(sely)) st_multilinestring(a$co.y) else NULL + if (any(selx)) sf::st_multilinestring(a$co.x) else NULL, + if (any(sely)) sf::st_multilinestring(a$co.y) else NULL ) lnsSel <- !vapply(lnsList, is.null, logical(1)) if (!any(lnsSel)) { 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 + lns <- sf::st_sf(ID=c("x", "y")[lnsSel], geometry = sf::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) - lns_crop <- suppressWarnings(suppressMessages(st_intersection(lns, sf_bbox))) + lns_crop <- suppressWarnings(suppressMessages(sf::st_intersection(lns, sf_bbox))) # quick fix for #564 if (!all(sf::st_geometry_type(lns_crop) == "MULTILINESTRING")) { @@ -668,14 +668,14 @@ tmapGridGrid = function(bi, bbx, facet_row, facet_col, facet_page, id, pane, gro } if (any(selx)) { - cogridxlns <- as.data.frame(st_coordinates(st_geometry(lns_crop)[1])[,1:3]) + cogridxlns <- as.data.frame(sf::st_coordinates(sf::st_geometry(lns_crop)[1])[,1:3]) names(cogridxlns) <- c("x", "y", "ID") } else { cogridxlns <- numeric(0) } if (any(sely)) { - cogridylns <- as.data.frame(st_coordinates(st_geometry(lns_crop)[sum(lnsSel)])[,1:3]) + cogridylns <- as.data.frame(sf::st_coordinates(sf::st_geometry(lns_crop)[sum(lnsSel)])[,1:3]) names(cogridylns) <- c("x", "y", "ID") } else { cogridylns <- numeric(0) @@ -763,62 +763,62 @@ tmapGridGrid = function(bi, bbx, facet_row, facet_col, facet_page, id, pane, gro -get_gridline_labels <- function(lco, xax=NA, yax=NA) { - k <- length(lco) - d <- ifelse(!is.na(xax), 1, 2) +get_gridline_labels = function(lco, xax = NA, yax = NA) { + k = length(lco) + d = ifelse(is.na(xax), 2, 1) - lns <- st_sf(geometry=st_sfc(lapply(lco, function(l) { - st_linestring(l) + lns = sf::st_sf(geometry = sf::st_sfc(lapply(lco, function(l) { + sf::st_linestring(l) })), crs = 4326) # trick for 0-1 coordinates if (!is.na(xax)) { - ax <- st_sf(geometry=st_sfc(st_linestring(matrix(c(0, 1, xax, xax), nrow=2))), crs = 4326) + ax = sf::st_sf(geometry = sf::st_sfc(sf::st_linestring(matrix(c(0, 1, xax, xax), nrow=2))), crs = 4326) #ax <- SpatialLines(list(Lines(Line(matrix(c(0, 1, xax, xax), nrow=2)), ID="base"))) } else { - ax <- st_sf(geometry=st_sfc(st_linestring(matrix(c(yax, yax, 0, 1), nrow=2))), crs = 4326) + ax = sf::st_sf(geometry = sf::st_sfc(sf::st_linestring(matrix(c(yax, yax, 0, 1), nrow=2))), crs = 4326) #ax <- SpatialLines(list(Lines(Line(matrix(c(yax, yax, 0, 1), nrow=2)), ID="base"))) } - gint <- suppressMessages(st_intersects(lns, ax, sparse = FALSE, prepared = FALSE))[,1] + gint = suppressMessages(sf::st_intersects(lns, ax, sparse = FALSE, prepared = FALSE))[ ,1] - ins <- vapply(lco, function(m) { - l <- m[1,] + ins = vapply(lco, function(m) { + l = m[1,] if (!is.na(xax)) { - res <- l[1] >= 0 && l[1] <= 1 && l[2] >= xax && l[2] <= 1 + res = l[1] >= 0 && l[1] <= 1 && l[2] >= xax && l[2] <= 1 } else { - res <- l[1] >= yax && l[1] <= 1 && l[2] >= 0 && l[2] <= 1 + res = l[1] >= yax && l[1] <= 1 && l[2] >= 0 && l[2] <= 1 } if (res) l[d] else -1 }, numeric(1)) - cogrid <- ifelse(gint, 0, ins) - ids <- 1:length(cogrid) # number of grid labels per grid line (could be 2 for warped grid lines) + cogrid = ifelse(gint, 0, ins) + ids = seq_along(cogrid) # number of grid labels per grid line (could be 2 for warped grid lines) if (any(gint)) { - cogrid <- as.list(cogrid) - ids <- as.list(ids) + cogrid = as.list(cogrid) + ids = as.list(ids) - wgint <- which(gint) - gints <- suppressMessages(st_intersection(lns[gint, ], ax)) + wgint = which(gint) + gints = suppressMessages(sf::st_intersection(lns[gint, ], ax)) # count number of intersections per coordinate - gnrs <- vapply(st_geometry(gints), function(g) { - nr <- nrow(g) + gnrs = vapply(sf::st_geometry(gints), function(g) { + nr = nrow(g) if (is.null(nr)) 1L else nr }, integer(1)) - gints <- suppressWarnings(st_cast(x = st_cast(gints, "MULTIPOINT"), to = "POINT")) + gints = suppressWarnings(sf::st_cast(x = sf::st_cast(gints, "MULTIPOINT"), to = "POINT")) - coor <- st_coordinates(gints)[,d] + coor = sf::st_coordinates(gints)[,d] - ids2 <- unlist(mapply(rep, 1:length(wgint), gnrs, SIMPLIFY = FALSE), use.names = FALSE) - j <- 1L + ids2 = unlist(mapply(rep, 1:length(wgint), gnrs, SIMPLIFY = FALSE), use.names = FALSE) + j = 1L for (i in which(gint)) { - cogrid[[i]] <- unname(coor[ids2 == j]) - ids[[i]] <- rep(ids[[i]], gnrs[j]) - j <- j + 1L + cogrid[[i]] = unname(coor[ids2 == j]) + ids[[i]] = rep(ids[[i]], gnrs[j]) + j = j + 1L } - cogrid <- unlist(cogrid, use.names = FALSE) - ids <- unlist(ids, use.names = FALSE) + cogrid = unlist(cogrid, use.names = FALSE) + ids = unlist(ids, use.names = FALSE) } list(cogrid = cogrid, ids = ids) } diff --git a/R/tmapGridText.R b/R/tmapGridText.R index 4d84c697..c819da71 100644 --- a/R/tmapGridText.R +++ b/R/tmapGridText.R @@ -171,7 +171,7 @@ tmapGridText = function(shpTM, dt, gp, bbx, facet_row, facet_col, facet_page, id } if (args$remove.overlap) { - im = st_intersects(s, sparse = FALSE) + im = sf::st_intersects(s, sparse = FALSE) sel = rep(TRUE, length(s)) rs = rowSums(im) while(any(rs>1)) { diff --git a/R/tmapLeaflet_layers.R b/R/tmapLeaflet_layers.R index ae888321..d9c8bff0 100644 --- a/R/tmapLeaflet_layers.R +++ b/R/tmapLeaflet_layers.R @@ -22,7 +22,7 @@ tmapLeafletPolygons = function(shpTM, dt, pdt, popup.format, hdt, idt, gp, bbx, opt = leaflet::pathOptions(interactive = TRUE, pane = pane) if (o$use.WebGL) { - shp2 = sf::st_sf(id = 1:length(shp), geom = shp) + shp2 = sf::st_sf(id = seq_along(shp), geom = shp) shp3 = suppressWarnings(sf::st_cast(shp2, "POLYGON")) gp3 = lapply(gp, function(gpi) {if (length(gpi) == 1) gpi else gpi[shp3$id]}) popups2 = popups[shp3$id] @@ -80,7 +80,7 @@ tmapLeafletLines = function(shpTM, dt, pdt, popup.format, hdt, idt, gp, bbx, fac opt = leaflet::pathOptions(interactive = TRUE, pane = pane) if (o$use.WebGL) { - shp2 = sf::st_sf(id = 1:length(shp), geom = shp) + shp2 = sf::st_sf(id = seq_along(shp), geom = shp) shp3 = suppressWarnings(sf::st_cast(shp2, "LINESTRING")) gp3 = lapply(gp, function(gpi) {if (length(gpi) == 1) gpi else gpi[shp3$id]}) lf %>% @@ -246,7 +246,7 @@ tmapLeafletRaster = function(shpTM, dt, gp, pdt, popup.format, hdt, idt, bbx, fa #m[1,5] = 4 - shp2 = st_as_stars(m, dimensions = shp) + shp2 = stars::st_as_stars(m, dimensions = shp) lf = get_lf(facet_row, facet_col, facet_page) @@ -256,8 +256,8 @@ tmapLeafletRaster = function(shpTM, dt, gp, pdt, popup.format, hdt, idt, bbx, fa leafem::addStarsImage(shp2, band = 1, colors = pal_col, opacity = pal_opacity, group = group, options = opts) %>% assign_lf(facet_row, facet_col, facet_page) } else { - #shp2 = st_as_stars(list(values = tmapID), dimensions = shp) - #shpTM <- shapeTM(sf::st_geometry(sf::st_as_sf(shp2)), as.vector(tmapID)) + #shp2 = stars::st_as_stars(list(values = tmapID), dimensions = shp) + #shpTM = shapeTM(sf::st_geometry(sf::st_as_sf(shp2)), as.vector(tmapID)) m = matrix(tmapID, nrow = nrow(shp), ncol = ncol(shp)) shp2 = structure(list(tmapID = m), class = "stars", dimensions = shp) diff --git a/R/tmapShape.R b/R/tmapShape.R index 5e218246..43aa1fbf 100644 --- a/R/tmapShape.R +++ b/R/tmapShape.R @@ -106,10 +106,10 @@ tmapShape.SpatRaster = function(shp, is.main, crs, bbox, unit, filter, shp_name, #dt = data.table::melt(dt, id.vars = "tmapID__", variable.name = "layer", value.name = "value") xy_dim = dim(shp)[1:2] - b = st_bbox(shp) + b = sf::st_bbox(shp) - crs = st_crs(shp) + crs = sf::st_crs(shp) shp = structure(list(x = structure(list(from = 1, to = xy_dim[2], offset = b[1], delta = (b[3] - b[1]) / xy_dim[2], refsys = crs, point = FALSE, values = NULL), class = "dimension"), @@ -234,7 +234,7 @@ tmapShape.stars = function(shp, is.main, crs, bbox, unit, filter, shp_name, smet dimcols = dimnms_new[-dimid] # columns names, used for default facetting dimvls = lapply(dimcols, function(d) stars::st_get_dimension_values(shp, d)) shpnames = names(shp) - shp = stars::st_set_dimensions(shp, dimnms[dimid], values = 1L:length(geoms)) + shp = stars::st_set_dimensions(shp, dimnms[dimid], values = seq_along(geoms)) shp = stars::st_set_dimensions(shp, names = dimnms_new) } @@ -245,7 +245,7 @@ tmapShape.stars = function(shp, is.main, crs, bbox, unit, filter, shp_name, smet } else { shp = geoms } - shpTM = shapeTM(shp = shp, tmapID = 1L:length(shp), bbox = bbox) + shpTM = shapeTM(shp = shp, tmapID = seq_along(shp), bbox = bbox) shpclass = "sfc" @@ -339,13 +339,13 @@ tmapShape.sf = function(shp, is.main, crs, bbox, unit, filter, shp_name, smeta, sfc = sf::st_zm(sfc) } - dt = as.data.table(sf::st_drop_geometry(shp)) + dt = data.table::as.data.table(sf::st_drop_geometry(shp)) dtcols = copy(names(dt)) #if (is.null(bbox)) bbox = sf::st_bbox(sfc) - if (is.null(filter)) filter = rep(TRUE, nrow(dt)) + if (is.null(filter)) filter = rep_len(TRUE, nrow(dt)) dt[, ':='(tmapID__ = 1L:nrow(dt), sel__ = filter)] make_by_vars(dt, tmf, smeta) diff --git a/R/tmapShape_simplification.R b/R/tmapShape_simplification.R index 21d10a25..45233954 100644 --- a/R/tmapShape_simplification.R +++ b/R/tmapShape_simplification.R @@ -1,15 +1,15 @@ -downsample_stars <- function(x, max.raster) { +downsample_stars = function(x, max.raster) { k = length(dim(x)) - xy_dim <- get_xy_dim(x) + xy_dim = get_xy_dim(x) fact = round(sqrt(prod(xy_dim) / max.raster) - 1) - n <- dim(x) + n = dim(x) n[] = 0L - n[names(xy_dim)] <- fact + n[names(xy_dim)] = fact if (inherits(x, "stars_proxy") || (fact > 0)) { - y = st_downsample(x, n) + y = stars::st_downsample(x, n) message("stars object downsampled to ", paste(get_xy_dim(y), collapse = " by "), " cells.") } else { y = x diff --git a/R/tmapTrans.R b/R/tmapTrans.R index e6a7dc55..f86c8393 100644 --- a/R/tmapTrans.R +++ b/R/tmapTrans.R @@ -37,32 +37,32 @@ delta_per_lineheight = function(x, n = 20, scale = 1) { get_midpoint_angle = function(shp) { lShp = sf::st_cast(shp, "MULTILINESTRING") - coor <- st_coordinates(lShp) - coors <- split.data.frame(coor[,1:2], f = coor[,ncol(coor)], drop=FALSE) - co <- do.call(rbind, lapply(coors, get_midpoint)) + coor = sf::st_coordinates(lShp) + coors = split.data.frame(coor[,1:2], f = coor[, ncol(coor)], drop=FALSE) + co = do.call(rbind, lapply(coors, get_midpoint)) pShp = sf::st_as_sf(as.data.frame(co), coords = c("X", "Y"), crs = sf::st_crs(shp)) bbx = sf::st_bbox(shp) - deltax <- bbx[3] - bbx[1] - deltay <- bbx[4] - bbx[2] - delta <- max(deltax, deltay) + deltax = bbx[3] - bbx[1] + deltay = bbx[4] - bbx[2] + delta = max(deltax, deltay) - pbShp <- st_cast(st_geometry(st_buffer(pShp, dist = delta / 100)), "MULTILINESTRING") + pbShp = sf::st_cast(sf::st_geometry(sf::st_buffer(pShp, dist = delta / 100)), "MULTILINESTRING") iShps <- mapply(function(x,y,z) { - res = st_intersection(x,y) - if (!st_is_empty(res)) { - st_cast(res, "MULTIPOINT") + res = sf::st_intersection(x,y) + if (!sf::st_is_empty(res)) { + sf::st_cast(res, "MULTIPOINT") } else { z } }, lShp, pbShp,pShp) angles = vapply(iShps, function(x) { - if (length(x) == 0) 0 else .get_direction_angle(st_coordinates(x)[,1:2, drop = FALSE]) + if (length(x) == 0) 0 else .get_direction_angle(sf::st_coordinates(x)[,1:2, drop = FALSE]) }, numeric(1)) - angles[angles>90 & angles < 270] = angles[angles>90 & angles < 270] - 180 + angles[angles > 90 & angles < 270] = angles[angles > 90 & angles < 270] - 180 list(shp = sf::st_geometry(pShp), angles = angles) } @@ -84,11 +84,11 @@ tmapTransCentroid = function(shpTM, xmod = NULL, ymod = NULL, ord__, plot.order, ### stars s = structure(list(values = matrix(TRUE, nrow = nrow(shp))), dimensions = shp, class = "stars") - strs = st_as_stars(list(values = m), dimensions = shp) + strs = stars::st_as_stars(list(values = m), dimensions = shp) shp = sf::st_as_sfc(s, as_points = TRUE) } else if (is_stars) { - shp = st_sfc() - tmapID = integer(0) + shp = sf::st_sfc() + tmapID = integer(0L) } else { geom_types = sf::st_geometry_type(shp) @@ -165,7 +165,7 @@ tmapTransPolygons = function(shpTM, ord__, plot.order, args, scale) { s = structure(list(values = matrix(TRUE, nrow = nrow(shp))), dimensions = shp, class = "stars") shp = sf::st_as_sfc(s, as_points = FALSE) } else if (is_stars) { - shp = st_sfc() + shp = sf::st_sfc() tmapID = integer(0) } else { @@ -199,7 +199,7 @@ tmapTransPolygons = function(shpTM, ord__, plot.order, args, scale) { } if (plot.order$aes == "AREA" && !is_stars) { - o = order(without_units(st_area(shp)), decreasing = !plot.order$reverse) + o = order(without_units(sf::st_area(shp)), decreasing = !plot.order$reverse) shp = shp[o] tmapID = tmapID[o] } @@ -216,7 +216,7 @@ tmapTransLines = function(shpTM, ord__, plot.order, args, scale) { within(shpTM, { is_stars = inherits(shp, "dimensions") if (is_stars) { - shp = st_sfc() + shp = sf::st_sfc() tmapID = integer(0) } else { @@ -251,7 +251,7 @@ tmapTransLines = function(shpTM, ord__, plot.order, args, scale) { } if (plot.order$aes == "LENGTH") { - o = order(without_units(st_length(shp)), decreasing = !plot.order$reverse) + o = order(without_units(sf::st_length(shp)), decreasing = !plot.order$reverse) shp = shp[o] tmapID = tmapID[o] } diff --git a/R/tme_graphics.R b/R/tme_graphics.R index ff4461c9..ea0996c8 100644 --- a/R/tme_graphics.R +++ b/R/tme_graphics.R @@ -17,8 +17,8 @@ # sf::st_as_grob(geoms, gp = gp) # }, # symbols = function(x, size, col, shape, alpha, border.col, border.lwd, border.lty) { -# geoms <- st_centroid(sf::st_geometry(x)) -# co = st_coordinates(geoms) +# geoms = sf::st_centroid(sf::st_geometry(x)) +# co = sf::st_coordinates(geoms) # gp = gpar(fill=col, col=border.col, lwd=border.lwd, lty=border.lty) # # pointsGrob(x=co[,1], y = co[,2], @@ -42,7 +42,7 @@ # # t_polygon = function(x, col, alpha, border.col, border.lwd, border.lty) { # -# geoms <- st_geometry(x) +# geoms = sf::st_geometry(x) # # gp=gpar(fill=col, col=border.col, lwd=border.lwd, lty=border.lty) # diff --git a/data-raw/NLD_muni_NLD_prov.R b/data-raw/NLD_muni_NLD_prov.R index 804943bb..8967f348 100644 --- a/data-raw/NLD_muni_NLD_prov.R +++ b/data-raw/NLD_muni_NLD_prov.R @@ -87,11 +87,11 @@ library(sf) data(NLD_muni) data(NLD_prov) -NLD_muni <- as(NLD_muni, "sf") -NLD_prov <- as(NLD_prov, "sf") +NLD_muni <- methods::as(NLD_muni, "sf") +NLD_prov <- methods::as(NLD_prov, "sf") -NLD_muni <- st_transform(NLD_muni, crs = 28992) -NLD_prov <- st_transform(NLD_prov, crs = 28992) +NLD_muni <- sf::st_transform(NLD_muni, crs = 28992) +NLD_prov <- sf::st_transform(NLD_prov, crs = 28992) save(NLD_muni, file="data/NLD_muni.rda", compress="xz") save(NLD_prov, file="data/NLD_prov.rda", compress="xz") diff --git a/data-raw/World-fix.R b/data-raw/World-fix.R index 55f210c6..46c78231 100644 --- a/data-raw/World-fix.R +++ b/data-raw/World-fix.R @@ -3,17 +3,17 @@ library(spData) library(giscoR) library(tmap) -sf_use_s2(FALSE) +sf::sf_use_s2(FALSE) # load 'broken' World dataset from tmap data(World) -bb = st_bbox(giscoR::gisco_get_countries()) +bb = sf::st_bbox(giscoR::gisco_get_countries()) W2 = World |> - st_transform(crs = 4326) |> - st_intersection(st_as_sfc(bb)) + sf::st_transform(crs = 4326) |> + sf::st_intersection(sf::st_as_sfc(bb)) -sf_use_s2(TRUE) +sf::sf_use_s2(TRUE) isv = sf::st_is_valid(W2) W2$name[!isv] @@ -30,21 +30,21 @@ tm_shape(W2, projection = "+proj=ortho +lon_0=0 +lat_0=90") + tm_polygons() tm_shape(W2, projection = "+proj=ortho +lon_0=0 +lat_0=45") + tm_polygons() # valid? -W2_ortho_0_0 = st_transform(W2, "+proj=ortho +lon_0=0 +lat_0=0") -st_is_valid(W2_ortho_0_0) +W2_ortho_0_0 = sf::st_transform(W2, "+proj=ortho +lon_0=0 +lat_0=0") +sf::st_is_valid(W2_ortho_0_0) -W2_ortho_0_90 = st_transform(W2, "+proj=ortho +lon_0=0 +lat_0=90") -st_is_valid(W2_ortho_0_90) +W2_ortho_0_90 = sf::st_transform(W2, "+proj=ortho +lon_0=0 +lat_0=90") +sf::st_is_valid(W2_ortho_0_90) -W2_ortho_0_45 = st_transform(W2, "+proj=ortho +lon_0=0 +lat_0=45") -st_is_valid(W2_ortho_0_45) +W2_ortho_0_45 = sf::st_transform(W2, "+proj=ortho +lon_0=0 +lat_0=45") +sf::st_is_valid(W2_ortho_0_45) # s2plot works for 0 45: library(s2plot) s2plot::s2plot(W2, col = "grey90", projection = s2plot::s2plot_projection_orthographic("POINT (0 45)")) -st_geometry(W2) = st_cast(st_geometry(W2), "MULTIPOLYGON") +sf::st_geometry(W2) = sf::st_cast(sf::st_geometry(W2), "MULTIPOLYGON") # overwrite and save diff --git a/data-raw/World.R b/data-raw/World.R index 6977bdf9..afdbdc56 100644 --- a/data-raw/World.R +++ b/data-raw/World.R @@ -7,13 +7,13 @@ library(dplyr) ## STEP 1 Download main shape W <- ne_countries(returnclass = "sf") -all(st_is_valid(W)) +all(sf::st_is_valid(W)) ## STEP 2 Download detailed shape to extract area size (these areas will be used as fallback source. The main source of area sizes is the World Bank (see STEP 5 below) W_detail <- ne_countries(returnclass = "sf", scale = 10) -W_detail_GallPeters <- st_transform(W_detail, crs = 3410) -W_detail_GallPeters$area <- st_area(W_detail_GallPeters) +W_detail_GallPeters <- sf::st_transform(W_detail, crs = 3410) +W_detail_GallPeters$area <- sf::st_area(W_detail_GallPeters) W$area_from_shp <- units::set_units(W_detail_GallPeters$area[match(W$name_long, W_detail_GallPeters$name_long)], km^2) @@ -107,7 +107,7 @@ tmap_arrange(tm1, tm2, sync = TRUE) ## Tidy up W4 <- W3 %>% - select(iso_a3, name, sovereignt, continent, area, pop_est, pop_est_dens, economy, income_grp, gdp_cap_est, life_exp, well_being, footprint, inequality, HPI, geometry) %>% + dplyr::select(iso_a3, name, sovereignt, continent, area, pop_est, pop_est_dens, economy, income_grp, gdp_cap_est, life_exp, well_being, footprint, inequality, HPI, geometry) %>% mutate(iso_a3 = factor(iso_a3), name = factor(name), sovereignt = factor(sovereignt), @@ -115,9 +115,9 @@ W4 <- W3 %>% economy = factor(economy), income_grp = factor(income_grp)) -World <- st_transform(W4, crs = "+proj=eck4 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0") -World <- st_make_valid(World) +World <- sf::st_transform(W4, crs = "+proj=eck4 +lon_0=0 +x_0=0 +y_0=0 +ellps=WGS84 +datum=WGS84 +units=m +no_defs +towgs84=0,0,0") +World <- sf::st_make_valid(World) -all(st_is_valid(World)) +all(sf::st_is_valid(World)) save(World, file="data/World.rda", compress="xz") diff --git a/data-raw/land.R b/data-raw/land.R index e0401458..64c37c02 100644 --- a/data-raw/land.R +++ b/data-raw/land.R @@ -59,7 +59,7 @@ save(land, file="./data/land.rda", compress="xz") # convert to raster -#land <- st_as_stars(land) +#land <- stars::st_as_stars(land) #save(land, file="./data/land.rda", compress="xz") diff --git a/data-raw/metro.R b/data-raw/metro.R index ec2e673c..307ff689 100644 --- a/data-raw/metro.R +++ b/data-raw/metro.R @@ -82,7 +82,7 @@ save(metro, file="./data/metro.rda", compress="xz") # convert to sf (version 2.0) library(sf) data(metro) -metro <- as(metro, "sf") +metro <- methods::as(metro, "sf") save(metro, file="./data/metro.rda", compress="xz") diff --git a/data-raw/rivers.R b/data-raw/rivers.R index db26ab04..2bde7892 100644 --- a/data-raw/rivers.R +++ b/data-raw/rivers.R @@ -21,7 +21,7 @@ rivers$name <- iconv( ) x <- grep("I_WAS_NOT_ASCII", iconv(levels(rivers$name), "latin1", "ASCII", sub="I_WAS_NOT_ASCII")) -rivers = st_set_crs(rivers, 4326) +rivers = sf::st_set_crs(rivers, 4326) rivers = rivers %>% filter(!is.na(type)) diff --git a/examples/tm_symbols.R b/examples/tm_symbols.R index 5871631a..a7643a00 100644 --- a/examples/tm_symbols.R +++ b/examples/tm_symbols.R @@ -53,9 +53,8 @@ tm_shape(land) + ######################## # create grid of 25 points in the Atlantic -library(sf) atlantic_grid = cbind(expand.grid(x = -51:-47, y = 20:24), id = seq_len(25)) -x = st_as_sf(atlantic_grid, coords = c("x", "y"), crs = 4326) +x = sf::st_as_sf(atlantic_grid, coords = c("x", "y"), crs = 4326) tm_shape(x, bbox = tmaptools::bb(x, ext = 1.2)) + tm_symbols(shape = "id", diff --git a/examples/tmap_animation.R b/examples/tmap_animation.R index 6d61d3ef..2bb36a08 100644 --- a/examples/tmap_animation.R +++ b/examples/tmap_animation.R @@ -38,7 +38,7 @@ m4 <- tm_shape(World) + tm_shape(metro) + tm_bubbles(col = "red") + tm_text("name", ymod = -1) + -tm_facets(by = "name", free.coords = F, nrow = 1, ncol = 1) + +tm_facets(by = "name", free.coords = FALSE, nrow = 1, ncol = 1) + tm_layout(panel.show = FALSE, frame = FALSE) tmap_animation(m4, filename = "World_cities.mp4", diff --git a/sandbox/grid_design.R b/sandbox/grid_design.R index 89dbb033..d4650f6d 100644 --- a/sandbox/grid_design.R +++ b/sandbox/grid_design.R @@ -27,7 +27,7 @@ tmapGridInit2(o) gts = get("gts", envir = .TMAP_GRID) g = get("g", envir = .TMAP_GRID) -bbx = st_bbox(World) +bbx = sf::st_bbox(World) g$fasp diff --git a/sandbox/issues.R b/sandbox/issues.R index b54bc47d..99f17876 100644 --- a/sandbox/issues.R +++ b/sandbox/issues.R @@ -52,20 +52,20 @@ tm_shape(NLD_prov) + tm_shape(NLD_prov) + tm_fill() + - tm_grid(labels.inside.frame = F) + + tm_grid(labels.inside.frame = FALSE) + tm_layout(meta.margins = c(0, 0, 0, .6)) + tm_scalebar(width = 10, position = tm_pos_out()) tm_shape(NLD_prov) + tm_fill() + - tm_grid(labels.inside.frame = F) + + tm_grid(labels.inside.frame = FALSE) + tm_scalebar(breaks = c(0,10,20,100), width = 1, position = tm_pos_in()) tm_shape(NLD_prov) + tm_fill() + - tm_grid(labels.inside.frame = T) + + tm_grid(labels.inside.frame = TRUE) + tm_scalebar(breaks = c(0,50,100,250), position = tm_pos_in()) @@ -74,11 +74,11 @@ tm_shape(NLD_prov) + tm_shape(NLD_prov) + tm_fill() + - tm_grid(labels.inside.frame = F) + + tm_grid(labels.inside.frame = FALSE) + tm_scalebar(position = tm_pos_out(), width = 1) tm_shape(NLD_prov) + tm_fill() + - tm_grid(labels.inside.frame = F) + + tm_grid(labels.inside.frame = FALSE) + tm_scalebar(position = tm_pos_in()) tm_shape(World) + @@ -176,9 +176,9 @@ osf_retrieve_node("xykzv") |> lc = rast("testdata/land_cover.tif") cameroon = ne_countries(country = "Cameroon", returnclass = "sf") |> - st_transform(crs = st_crs(lc)) + sf::st_transform(crs = sf::st_crs(lc)) -lc_cameroon = crop(lc, cameroon, mask = TRUE) +lc_cameroon = terra::crop(lc, cameroon, mask = TRUE) lc_palette_df = read.csv("testdata/lc_palette.csv") coltb = lc_palette_df[c("value", "color")] @@ -304,15 +304,15 @@ reprex::reprex({ library(stars) library(mapview) m = matrix(1:20, 4) -s0 = st_as_stars(m) +s0 = stars::st_as_stars(m) s = s0 -st_crs(s) <- 4326 -st_crs(s0) <- 4326 -st_geotransform(s0) <- c(5, 1.5, 0.2, 0, 0.2, 1.5) +sf::st_crs(s) <- 4326 +sf::st_crs(s0) <- 4326 +stars::st_geotransform(s0) <- c(5, 1.5, 0.2, 0, 0.2, 1.5) -s0_4326 = st_transform(s0, crs = 4326) +s0_4326 = sf::st_transform(s0, crs = 4326) stars:::is_curvilinear(s0) stars:::is_curvilinear(s0_4326) @@ -324,7 +324,7 @@ s0_4326 -d = st_dimensions(s0) +d = sf::st_dimensions(s0) has_raster(s0) && isTRUE(attr(s0, "raster")$curvilinear) @@ -412,18 +412,18 @@ library(mapview) #m = matrix(1:4, 2) m = matrix(c(3,4,1,2), 2) -s0 = st_as_stars(m) +s0 = stars::st_as_stars(m) s = s0 -st_crs(s) <- 4326 -st_crs(s0) <- 4326 +sf::st_crs(s) <- 4326 +sf::st_crs(s0) <- 4326 -st_geotransform(s0) <- c(5, 1.5, 0.2, 0, 0.2, 1.5) +stars::st_geotransform(s0) <- c(5, 1.5, 0.2, 0, 0.2, 1.5) tm_shape(s, crs = 3857) + tm_raster() tm_shape(s0, crs = 3857) + tm_raster() -tm_shape(s) + tm_raster() +tm_shape(s) + tm_raster() #tm_shape(s0) + tm_raster() mapview::mapview(s) @@ -472,7 +472,7 @@ levels(landr) terra::levels(land) -lc2 = terra::spatSample(lc, 1e5, method = "regular", as.raster = T) +lc2 = terra::spatSample(lc, 1e5, method = "regular", as.raster = TRUE) tm_shape(lc2) + tm_raster("land_cover") + tm_facets("land_cover") tm_shape(lc) + tm_raster("land_cover") + tm_facets("land_cover") diff --git a/sandbox/main2.R b/sandbox/main2.R index fe07c80c..f729a46e 100644 --- a/sandbox/main2.R +++ b/sandbox/main2.R @@ -228,37 +228,37 @@ tm_shape(metro) + tm_facets_wrap(by = "pop2020_class") tm_shape(metro) + - tm_symbols(fill = "pop2020", size = "pop2010", size.scale = tm_scale_intervals(), fill.free = F, size.free = T) + + tm_symbols(fill = "pop2020", size = "pop2010", size.scale = tm_scale_intervals(), fill.free = FALSE, size.free = TRUE) + tm_facets_wrap(by = "pop2020_class") tm_shape(metro) + - tm_symbols(size = "pop2010", size.free = T, size.scale = tm_scale_intervals()) + + tm_symbols(size = "pop2010", size.free = TRUE, size.scale = tm_scale_intervals()) + tm_facets_wrap(by = "pop2020_class") tm_shape(metro) + - tm_symbols(fill = "pop2010", fill.free = T, fill.scale = tm_scale_intervals()) + + tm_symbols(fill = "pop2010", fill.free = TRUE, fill.scale = tm_scale_intervals()) + tm_facets_wrap(by = "pop2020_class") tm_shape(metro) + - tm_symbols(fill = "pop2010", fill.free = T, fill.scale = tm_scale_intervals(as.count = TRUE)) + + tm_symbols(fill = "pop2010", fill.free = TRUE, fill.scale = tm_scale_intervals(as.count = TRUE)) + tm_facets_wrap(by = "pop2020_class") tm_shape(World) + - tm_polygons("HPI2", fill.scale = tm_scale_intervals(as.count = T, n = 15)) + tm_polygons("HPI2", fill.scale = tm_scale_intervals(as.count = TRUE, n = 15)) tm_shape(World) + tm_polygons("HPI3", fill.scale = tm_scale_discrete(ticks = 12:50, values = "RdYlBu")) tm_shape(World) + - tm_polygons("HPI2", fill.scale = tm_scale_intervals(n=14, midpoint = 30, values = "RdYlBu", as.count = T)) + tm_polygons("HPI2", fill.scale = tm_scale_intervals(n=14, midpoint = 30, values = "RdYlBu", as.count = TRUE)) tm_shape(World) + - tm_polygons("HPI2", fill.scale = tm_scale_intervals(n=14, midpoint = 30, values = "RdYlBu", as.count = T), fill.legend = tm_legend(position = tm_lp_out("right", "center"))) + + tm_polygons("HPI2", fill.scale = tm_scale_intervals(n=14, midpoint = 30, values = "RdYlBu", as.count = TRUE), fill.legend = tm_legend(position = tm_lp_out("right", "center"))) + tm_options(meta.auto.margins = 0.1) @@ -342,7 +342,7 @@ tm_shape(landsat_terra) + tm_rgb(tm_mv("landsat_4", "landsat_3", "landsat_2"), col.scale = tm_scale_rgb(maxValue = 31961)) -land_terra = rast(as(land, "Raster")) +land_terra = terra::rast(methods::as(land, "Raster")) tm_shape(land) + tm_raster("trees") @@ -423,9 +423,9 @@ library(sf) library(raster) library(terra) library(stars) -r<- raster(matrix(data=runif(1000, min = -2, max=5), nrow=100, ncol=100)) -st_crs(r) -st_crs(rast(r)) +r = raster(matrix(data=runif(1000, min = -2, max=5), nrow=100, ncol=100)) +sf::st_crs(r) +sf::st_crs(terra::rast(r)) diff --git a/sandbox/test_data.R b/sandbox/test_data.R index 5b83a0cc..bbb7156c 100644 --- a/sandbox/test_data.R +++ b/sandbox/test_data.R @@ -11,16 +11,16 @@ data(metro, package = "tmap") data(rivers, package = "tmap") prec_file = system.file("nc/test_stageiv_xyt.nc", package = "stars") -(prec = read_ncdf(prec_file, curvilinear = c("lon", "lat"), ignore_bounds = TRUE)) +(prec = stars::read_ncdf(prec_file, curvilinear = c("lon", "lat"), ignore_bounds = TRUE)) sf::read_sf(system.file("gpkg/nc.gpkg", package = "sf"), "nc.gpkg") %>% - st_transform(st_crs(prec)) -> nc # transform from NAD27 to WGS84 + sf::st_transform(sf::st_crs(prec)) -> nc # transform from NAD27 to WGS84 prec_nc = aggregate(prec, by = nc, FUN = max) -tif = system.file("tif/L7_ETMs.tif", package = "stars") %>% read_stars() +tif = system.file("tif/L7_ETMs.tif", package = "stars") %>% stars::read_stars() tif2 = c(tif,tif, along = 'testdim') -weather = read_ncdf(system.file('nc/bcsd_obs_1999.nc', package = 'stars')) -weather1 = st_set_dimensions(merge(weather), names = c('longitude','latitude','time','attributes')) +weather = stars::read_ncdf(system.file('nc/bcsd_obs_1999.nc', package = 'stars')) +weather1 = stars::st_set_dimensions(merge(weather), names = c('longitude','latitude','time','attributes')) weather2 = split(weather1, 'time') #install.packages("starsdata", repos = "http://pebesma.staff.ifgi.de", type = "source") @@ -28,7 +28,7 @@ weather2 = split(weather1, 'time') granule = system.file("sentinel/S2A_MSIL1C_20180220T105051_N0206_R051_T32ULE_20180221T134037.zip", package = "starsdata") s2 = paste0("SENTINEL2_L1C:/vsizip/", granule, "/S2A_MSIL1C_20180220T105051_N0206_R051_T32ULE_20180221T134037.SAFE/MTD_MSIL1C.xml:10m:EPSG_32632") #gran = read_stars(s2, proxy = FALSE) -gran_p = read_stars(s2, proxy = TRUE) +gran_p = stars::read_stars(s2, proxy = TRUE) rm(granule, s2) gc() @@ -41,12 +41,12 @@ landsat_stars2 = split(landsat_stars) lux <- vect(system.file("ex/lux.shp", package="terra")) -land_terra = rast(as(land, "Raster")) +land_terra = terra::rast(methods::as(land, "Raster")) ls_stars = landsat_stars[,,,1,drop=TRUE] -ls_terra = rast(as(ls_stars, "Raster")) +ls_terra = terra::rast(methods::as(ls_stars, "Raster")) names(ls_stars) = "layer" la_stars = land[3] -la_terra = rast(as(la_stars, 'Raster')) +la_terra = terra::rast(methods::as(la_stars, 'Raster')) names(la_terra) = "trees" diff --git a/tests/testing_facet_vars.Rmd b/tests/testing_facet_vars.Rmd index 43668397..c41d7c43 100644 --- a/tests/testing_facet_vars.Rmd +++ b/tests/testing_facet_vars.Rmd @@ -46,16 +46,16 @@ World$economy_int[1:100] = NA landsat_stars = read_stars(system.file("raster/landsat.tif", package = "spDataLarge")) landsat_terra = rast(system.file("raster/landsat.tif", package = "spDataLarge")) -tif_stars = system.file("tif/L7_ETMs.tif", package = "stars") %>% read_stars() -tif_terra = system.file("tif/L7_ETMs.tif", package = "stars") %>% rast() +tif_stars = system.file("tif/L7_ETMs.tif", package = "stars") %>% stars::read_stars() +tif_terra = system.file("tif/L7_ETMs.tif", package = "stars") %>% terra::rast() -prec = read_ncdf(system.file("nc/test_stageiv_xyt.nc", package = "stars"), curvilinear = c("lon", "lat"), ignore_bounds = TRUE) +prec = stars::read_ncdf(system.file("nc/test_stageiv_xyt.nc", package = "stars"), curvilinear = c("lon", "lat"), ignore_bounds = TRUE) nc = sf::read_sf(system.file("gpkg/nc.gpkg", package = "sf"), "nc.gpkg") %>% - st_transform(st_crs(prec)) + sf::st_transform(sf::st_crs(prec)) prec_nc = aggregate(prec, by = nc, FUN = max) -weather = read_ncdf(system.file('nc/bcsd_obs_1999.nc', package = 'stars')) -weather1 = st_set_dimensions(merge(weather), names = c('longitude','latitude','time','attributes')) +weather = stars::read_ncdf(system.file('nc/bcsd_obs_1999.nc', package = 'stars')) +weather1 = stars::st_set_dimensions(merge(weather), names = c('longitude','latitude','time','attributes')) weather2 = split(weather1, 'time') @@ -229,9 +229,9 @@ tm_shape(weather22) + ```{r} -tm_shape(World) + tm_polygons("pop_est", fill.free = F) + tm_facets("continent") -tm_shape(World) + tm_polygons("pop_est", fill.free = T) + tm_facets("continent") -tm_shape(World) + tm_polygons("pop_est", fill.free = T) + tm_facets("continent", nrows = 1) +tm_shape(World) + tm_polygons("pop_est", fill.free = FALSE) + tm_facets("continent") +tm_shape(World) + tm_polygons("pop_est", fill.free = TRUE) + tm_facets("continent") +tm_shape(World) + tm_polygons("pop_est", fill.free = TRUE) + tm_facets("continent", nrows = 1) ``` diff --git a/tests/testing_stars.Rmd b/tests/testing_stars.Rmd index 1a810b26..0284e2e5 100644 --- a/tests/testing_stars.Rmd +++ b/tests/testing_stars.Rmd @@ -25,19 +25,19 @@ library(terra) data(land) -landsat_stars = read_stars(system.file("raster/landsat.tif", package = "spDataLarge")) -landsat_terra = rast(system.file("raster/landsat.tif", package = "spDataLarge")) +landsat_stars = stars::read_stars(system.file("raster/landsat.tif", package = "spDataLarge")) +landsat_terra = terra::rast(system.file("raster/landsat.tif", package = "spDataLarge")) tif_stars = system.file("tif/L7_ETMs.tif", package = "stars") %>% read_stars() tif_terra = system.file("tif/L7_ETMs.tif", package = "stars") %>% rast() -prec = read_ncdf(system.file("nc/test_stageiv_xyt.nc", package = "stars"), curvilinear = c("lon", "lat"), ignore_bounds = TRUE) +prec = stars::read_ncdf(system.file("nc/test_stageiv_xyt.nc", package = "stars"), curvilinear = c("lon", "lat"), ignore_bounds = TRUE) nc = sf::read_sf(system.file("gpkg/nc.gpkg", package = "sf"), "nc.gpkg") %>% - st_transform(st_crs(prec)) + sf::st_transform(sf::st_crs(prec)) prec_nc = aggregate(prec, by = nc, FUN = max) -weather = read_ncdf(system.file('nc/bcsd_obs_1999.nc', package = 'stars')) -weather1 = st_set_dimensions(merge(weather), names = c('longitude','latitude','time','attributes')) +weather = stars::read_ncdf(system.file('nc/bcsd_obs_1999.nc', package = 'stars')) +weather1 = stars::st_set_dimensions(merge(weather), names = c('longitude','latitude','time','attributes')) weather2 = split(weather1, 'time') From 3f4dbac3e682676e5109a7ea6767bf58c8ee0143 Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 25 Jun 2024 17:49:44 -0400 Subject: [PATCH 08/10] Update doc --- man/tm_symbols.Rd | 3 +-- man/tmap_animation.Rd | 2 +- 2 files changed, 2 insertions(+), 3 deletions(-) diff --git a/man/tm_symbols.Rd b/man/tm_symbols.Rd index 509ecf78..334720a1 100644 --- a/man/tm_symbols.Rd +++ b/man/tm_symbols.Rd @@ -356,9 +356,8 @@ tm_shape(land) + ######################## # create grid of 25 points in the Atlantic -library(sf) atlantic_grid = cbind(expand.grid(x = -51:-47, y = 20:24), id = seq_len(25)) -x = st_as_sf(atlantic_grid, coords = c("x", "y"), crs = 4326) +x = sf::st_as_sf(atlantic_grid, coords = c("x", "y"), crs = 4326) tm_shape(x, bbox = tmaptools::bb(x, ext = 1.2)) + tm_symbols(shape = "id", diff --git a/man/tmap_animation.Rd b/man/tmap_animation.Rd index a607d1ec..914f241b 100644 --- a/man/tmap_animation.Rd +++ b/man/tmap_animation.Rd @@ -109,7 +109,7 @@ m4 <- tm_shape(World) + tm_shape(metro) + tm_bubbles(col = "red") + tm_text("name", ymod = -1) + -tm_facets(by = "name", free.coords = F, nrow = 1, ncol = 1) + +tm_facets(by = "name", free.coords = FALSE, nrow = 1, ncol = 1) + tm_layout(panel.show = FALSE, frame = FALSE) tmap_animation(m4, filename = "World_cities.mp4", From 29cf4f3836226c51a94a5277d99a809cff37010d Mon Sep 17 00:00:00 2001 From: olivroy Date: Tue, 25 Jun 2024 17:50:01 -0400 Subject: [PATCH 09/10] Use `=` instead of `<-` in new code --- R/step1_helper_facets.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/step1_helper_facets.R b/R/step1_helper_facets.R index 4db5ed9f..c5a94a34 100644 --- a/R/step1_helper_facets.R +++ b/R/step1_helper_facets.R @@ -189,11 +189,11 @@ step1_rearrange_facets = function(tmo, o) { } if (length(popup.vars)) add_used_vars(popup.vars) # if hover = FALSE, disable hovering - if (isFALSE(hover)) hover <- "" + if (isFALSE(hover)) hover = "" # If hover is not specified, default to id - if (identical(hover, NA)) hover <- id + if (identical(hover, NA)) hover = id # If hover = TRUE, set to id - if (isTRUE(hover)) hover <- id + if (isTRUE(hover)) hover = id if (id != "" && !id %in% smeta$vars) rlang::arg_match0(id, smeta$vars, arg_nm = "id", error_call = NULL) if (id != "") add_used_vars(id) if (!is.na(hover) && hover != "" && !hover %in% smeta$vars) rlang::arg_match0(hover, smeta$vars, "hover", error_call = NULL) From 6eb63dc3f8e178599c0f6cb76bca2546b60b51ea Mon Sep 17 00:00:00 2001 From: olivroy <52606734+olivroy@users.noreply.github.com> Date: Wed, 26 Jun 2024 11:09:59 -0400 Subject: [PATCH 10/10] Update R/step2_data.R --- R/step2_data.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/step2_data.R b/R/step2_data.R index 27ce3776..a2695511 100644 --- a/R/step2_data.R +++ b/R/step2_data.R @@ -88,7 +88,7 @@ step2_data = function(tm) { } else { copy(dt[, c(tml$popup.vars, "tmapID__"), with = FALSE]) } - hover.data = if (tml$hover == "" || is.na(tml$hover)) { + hover.data = if (tml$hover == "") { NULL } else { as.character(dt[[tml$hover]])