No longer import sp by default

DESCRIPTION

@@ -59,9 +59,10 @@ Imports:
     methods,
     png,
     raster (>= 3.6.3),
+    rlang,
     RColorBrewer,
     scales (>= 1.0.0),
-    sp,
+    sf (>= 0.9-6),
     stats,
     viridisLite,
     xfun
@@ -73,8 +74,8 @@ Suggests:
     RJSONIO,
     rmarkdown,
     s2,
-    sf (>= 0.9-6),
-    shiny,
+    shiny (>= 1.0.0),
+    sp,
     terra,
     testthat (>= 3.0.0)
 Config/testthat/edition: 3

NAMESPACE

@@ -175,6 +175,7 @@ importFrom(grDevices,rgb)
 importFrom(htmlwidgets,JS)
 importFrom(magrittr,"%>%")
 importFrom(methods,substituteDirect)
+importFrom(rlang,is_installed)
 importFrom(stats,na.omit)
 importFrom(stats,quantile)
 importFrom(utils,getFromNamespace)

NEWS.md

@@ -1,5 +1,7 @@
 # leaflet (development version)
 
+* `{leaflet}` no longer install sp by default and attempts to convert object to sf internally before creating a map and warns when it fails conversion (@olivroy, #942).
+
 * Color palette improvements. All color palette functions now support all `{viridisLite}` palettes ("magma", "inferno", "plasma", "viridis", "cividis", "rocket", "mako", and "turbo") (@jack-davison, #924).
 
 * Updated vignettes to replace `{sp}`/`{raster}` usage with `{sf}`/`{terra}` and their corresponding examples. (@jack-davison, #928)

R/layers.R

@@ -329,7 +329,6 @@ addRasterImage <- function(
 #'   addRasterImage(rr, opacity = 0.75) %>%
 #'   addRasterLegend(rr, opacity = 0.75)
 #'
-#' @md
 #' @export
 addRasterLegend <- function(map, x, layer = 1, ...) {
   stopifnot(inherits(x, "SpatRaster"))
@@ -478,12 +477,7 @@ addRasterImage_SpatRaster <- function(
   options = gridOptions(),
   data = getMapData(map)
 ) {
-  if (!is_installed("terra", "1.6-3")) { # for terra::has.RGB()
-    stop(
-      "`addRasterImage()` for SpatRaster objects requires {terra} 1.6-3 or higher",
-      call. = FALSE
-    )
-  }
+  rlang::check_installed("terra (>= 1.6-3)", reason = "to use addRasterImage() for SpatRaster objects.") # for terra::has.RGB()
 
   options$opacity <- opacity
   options$attribution <- attribution

R/leaflet-package.R

@@ -9,6 +9,7 @@
 #' @importFrom stats quantile
 #' @importFrom utils getFromNamespace
 #' @importFrom utils packageVersion
+#' @importFrom rlang is_installed
 ## usethis namespace: end
 NULL
 

R/leaflet.R

@@ -35,14 +35,17 @@ leafletSizingPolicy <- function(
 #'
 #' The `data` argument is only needed if you are going to reference
 #' variables in this object later in map layers. For example, `data` can be
-#' a data frame containing columns `latitude` and `longtitude`, then
+#' a data frame containing columns `latitude` and `longitude`, then
 #' we may add a circle layer to the map by
-#' `leaflet(data) %>% addCircles(lat = ~latitude, lng = ~longtitude)`,
+#' `leaflet(data) %>% addCircles(lat = ~latitude, lng = ~longitude)`,
 #' where the variables in the formulae will be evaluated in the `data`.
 #' @param data a data object. Currently supported objects are matrix, data
 #' frame, spatial data from the \pkg{sf} package,
-#' `SpatVector` from the \pkg{terra} package, and the Spatial*
-#' objects from the \pkg{sp} package that represent points, lines, or polygons.
+#' `SpatVector` from the \pkg{terra} package
+#'
+#' \pkg{sp} object are normalized to \pkg{sf} objects with [sf::st_as_sf()].
+#' Conversion may fail for `sp::Polygons`, `sp::Lines`, `sp::Polygon` etc.
+#' You are encouraged to use the appropriate function to create them. `sf::st_polygon()` for example.
 #'
 #' @param width the width of the map
 #' @param height the height of the map
@@ -58,13 +61,20 @@ leafletSizingPolicy <- function(
 leaflet <- function(data = NULL, width = NULL, height = NULL,
                    padding = 0, options = leafletOptions(),
                    elementId = NULL, sizingPolicy = leafletSizingPolicy(padding = padding)) {
-
   # Validate the CRS if specified
- if (!is.null(options[["crs"]]) &&
-     !inherits(options[["crs"]], "leaflet_crs")) {
+  if (!is.null(options[["crs"]]) &&
+      !inherits(options[["crs"]], "leaflet_crs")) {
     stop("CRS in mapOptions should be a return value of leafletCRS() function")
   }
 
+  # If is legacy sp object, transform to sf.
+  is_sp <- tryCatch(identical(attr(class(data), "package"), "sp"), error = function(e) FALSE)
+  if (is_sp) {
+    rlang::check_installed("sp")
+    # transform object to sf if possible
+    data <- maybe_as_sf(data)
+  }
+
   map <- htmlwidgets::createWidget(
     "leaflet",
     structure(

R/normalize-sp.R

@@ -1,4 +1,24 @@
-# metaData --------------------------------------------------------
+# Typically, this will work on Spatial* objects, but will fail with sp::Polygons / sp::Lines etc.
+# https://r-spatial.github.io/sf/reference/st_as_sf.html#ref-examples
+maybe_as_sf <- function(data) {
+  tryCatch(
+    {
+      data <- sf::st_as_sf(data)
+    },
+    error = function(e) {
+      rlang::warn(c(
+        "Couldn't transform the sp object to sf.\nConsider using recreating objects with the sf package.",
+        paste0("Objects of type ", class(data), "may not be handled well by sf.")
+        ),
+        .frequency_id = "sp-sf-conversion-leaflet",
+        .frequency = "once",
+        parent = e
+     )
+  })
+  data
+}
+
+# metaData (no longer used due to conversion to sf) ----------------------------
 
 #' @export
 metaData.SpatialPointsDataFrame <- function(obj) obj@data
@@ -7,7 +27,7 @@ metaData.SpatialLinesDataFrame <- function(obj) obj@data
 #' @export
 metaData.SpatialPolygonsDataFrame <- function(obj) obj@data
 
-# pointData ---------------------------------------------------------------
+# pointData (no longer used due to conversion to sf) -------------------------
 
 #' @export
 pointData.SpatialPoints <- function(obj) {
@@ -33,9 +53,12 @@ polygonData_sp <- function(obj) {
 polygonData.Polygon <- polygonData_sp
 #' @export
 polygonData.Polygons <- polygonData_sp
+
+# No longer used due to conversion to sf
 #' @export
 polygonData.SpatialPolygons <- polygonData_sp
 
+# No longer used due to conversion to sf
 #' @export
 polygonData.SpatialPolygonsDataFrame <- function(obj) {
   if (length(obj@polygons) > 0) {
@@ -50,9 +73,12 @@ polygonData.SpatialPolygonsDataFrame <- function(obj) {
 polygonData.Line <- polygonData_sp
 #' @export
 polygonData.Lines <- polygonData_sp
+
+# No longer used due to conversion to sf
 #' @export
 polygonData.SpatialLines <- polygonData_sp
 
+# No longer used due to conversion to sf
 #' @export
 polygonData.SpatialLinesDataFrame <- function(obj) {
   if (length(obj@lines) > 0) {
@@ -81,6 +107,7 @@ sp_bbox <- function(x) {
   bbox
 }
 
+# No longer used due to conversion to sf
 #' @export
 to_multipolygon_list.SpatialPolygons <- function(x) {
   lapply(x@polygons, to_multipolygon)
@@ -99,14 +126,14 @@ to_multipolygon.Polygons <- function(x) {
       if (any(vapply(pgons@Polygons, methods::slot, logical(1), "hole"))) {
         if (!requireNamespace("sf")) {
           stop("You attempted to use an sp Polygons object that is missing hole ",
-            "information. Leaflet can use the {sf} package to infer hole ",
-            "assignments, but it is not installed. Please install the {sf} ",
-            "package, and try the operation again.")
+               "information. Leaflet can use the {sf} package to infer hole ",
+               "assignments, but it is not installed. Please install the {sf} ",
+               "package, and try the operation again.")
         } else if (packageVersion("sf") < "1.0.10") {
           stop("You attempted to use an sp Polygons object that is missing hole ",
-            "information. Leaflet can use the {sf} package to infer hole ",
-            "assignments, but only with sf v1.0-10 and above. Please upgrade ",
-            "the {sf} package, and try the operation again.")
+               "information. Leaflet can use the {sf} package to infer hole ",
+               "assignments, but only with sf v1.0-10 and above. Please upgrade ",
+               "the {sf} package, and try the operation again.")
         }
         x <- to_multipolygon_list(sf::st_geometry(sf::st_as_sf(sp::SpatialPolygons(list(pgons)))))
         return(x[[1]])
@@ -132,6 +159,7 @@ to_ring.Polygon <- function(x) {
   sp_coords(x)
 }
 
+# No longer used due to conversion to sf
 #' @export
 to_multipolygon_list.SpatialLines <- function(x) {
   lapply(x@lines, to_multipolygon)

R/normalize-terra.R

@@ -51,8 +51,7 @@ polygonData.SpatVector <- function(obj) {
 
 # helpers -----------------------------------------------------------------
 check_crs_terra <- function(x) {
-  stopifnot(is_installed("terra"))
-
+  rlang::check_installed("terra")
   crs <- terra::crs(x)
 
   # Don't have enough information to check

R/normalize.R

@@ -55,6 +55,13 @@ derivePoints <- function(data, lng = NULL, lat = NULL,
                          missingLng = missing(lng),
                          missingLat = missing(lat),
                          funcName = "f") {
+  # If is legacy sp object, transform to sf.
+  is_sp <- tryCatch(identical(attr(class(data), "package"), "sp"), error = function(e) FALSE)
+  if (!is.null(data) && is_sp) {
+    rlang::check_installed("sp")
+    # transform object to sf if possible
+    data <- maybe_as_sf(data)
+  }
   if (missingLng || missingLat) {
     if (is.null(data)) {
       stop("Point data not found; please provide ", funcName,
@@ -80,6 +87,14 @@ derivePolygons <- function(data, lng = NULL, lat = NULL,
   if (missingLng != missingLat) {
     stop(funcName, " must be called with both lng and lat, or with neither.")
   }
+  # If is legacy sp object, transform to sf.
+  is_sp <- tryCatch(identical(attr(class(data), "package"), "sp"), error = function(e) FALSE)
+  if (!is.null(data) && is_sp) {
+    rlang::check_installed("sp")
+    # transform object to sf if possible
+    data <- maybe_as_sf(data)
+  }
+
   if (missingLng) {
     if (is.null(data)) {
       stop("Polygon data not found; please provide ", funcName,

R/staticimports.R

@@ -24,24 +24,6 @@ get_package_version <- function(pkg) {
   }
 }
 
-is_installed <- function(pkg, version = NULL) {
-  installed <- isNamespaceLoaded(pkg) || nzchar(system_file_cached(package = pkg))
-
-  if (is.null(version)) {
-    return(installed)
-  }
-
-  if (!is.character(version) && !inherits(version, "numeric_version")) {
-    # Avoid https://bugs.r-project.org/show_bug.cgi?id=18548
-    alert <- if (identical(Sys.getenv("TESTTHAT"), "true")) stop else warning
-    alert("`version` must be a character string or a `package_version` or `numeric_version` object.")
-
-    version <- numeric_version(sprintf("%0.9g", version))
-  }
-
-  installed && isTRUE(get_package_version(pkg) >= version)
-}
-
 # Borrowed from pkgload::shim_system.file, with some modifications. This behaves
 # like `system.file()`, except that (1) for packages loaded with
 # `devtools::load_all()`, it will return the path to files in the package's

R/utils.R

@@ -1,5 +1,5 @@
 # @staticimports pkg:staticimports
-#  is_installed system_file get_package_version
+#  system_file get_package_version
 
 # Given a local and/or remote operation and a map, execute one or the other
 # depending on the type of the map object (regular or map proxy). If code was
@@ -211,41 +211,35 @@ invokeRemote <- function(map, method, args = list()) {
 
   sess <- map$session
   if (map$deferUntilFlush) {
-    if (is_installed("shiny", "0.12.1.9000")) {
 
-      # See comment on sessionFlushQueue.
+    # See comment on sessionFlushQueue.
 
-      if (is.null(sessionFlushQueue[[sess$token]])) {
-        # If the current session doesn't have an entry in the sessionFlushQueue,
-        # initialize it with a blank list.
-        sessionFlushQueue[[sess$token]] <- list()
+    if (is.null(sessionFlushQueue[[sess$token]])) {
+      # If the current session doesn't have an entry in the sessionFlushQueue,
+      # initialize it with a blank list.
+      sessionFlushQueue[[sess$token]] <- list()
 
-        # If the session ends before the next onFlushed call, remove the entry
-        # for this session from the sessionFlushQueue.
-        endedUnreg <- sess$onSessionEnded(function() {
-          rm(list = sess$token, envir = sessionFlushQueue)
-        })
+      # If the session ends before the next onFlushed call, remove the entry
+      # for this session from the sessionFlushQueue.
+      endedUnreg <- sess$onSessionEnded(function() {
+        rm(list = sess$token, envir = sessionFlushQueue)
+      })
 
-        # On the next flush, pass all the messages to the client, and remove the
-        # entry from sessionFlushQueue.
-        sess$onFlushed(function() {
-          on.exit(rm(list = sess$token, envir = sessionFlushQueue), add = TRUE)
-          endedUnreg()
-          for (msg in sessionFlushQueue[[sess$token]]) {
-            sess$sendCustomMessage("leaflet-calls", msg)
-          }
-        }, once = TRUE) # nolint
-      }
-
-      # Append the current value to the apporpriate sessionFlushQueue entry,
-      # which is now guaranteed to exist.
-      sessionFlushQueue[[sess$token]] <- c(sessionFlushQueue[[sess$token]], list(msg))
-
-    } else {
+      # On the next flush, pass all the messages to the client, and remove the
+      # entry from sessionFlushQueue.
       sess$onFlushed(function() {
-        sess$sendCustomMessage("leaflet-calls", msg)
+        on.exit(rm(list = sess$token, envir = sessionFlushQueue), add = TRUE)
+        endedUnreg()
+        for (msg in sessionFlushQueue[[sess$token]]) {
+          sess$sendCustomMessage("leaflet-calls", msg)
+        }
       }, once = TRUE) # nolint
     }
+
+    # Append the current value to the apporpriate sessionFlushQueue entry,
+    # which is now guaranteed to exist.
+    sessionFlushQueue[[sess$token]] <- c(sessionFlushQueue[[sess$token]], list(msg))
+
   } else {
     sess$sendCustomMessage("leaflet-calls", msg)
   }

data-raw/gadmCHE.R

@@ -3,11 +3,12 @@
 # switzerland
 # rds
 # level 1
+# raster::getData() no longer works. geodata is recommended instead.
 gadmCHE <- raster::getData("GADM", country = "CHE", level = 1, path = tempdir())
 
 gadmCHE$NAME_1 <- iconv(gadmCHE$NAME_1, "UTF-8", "ASCII//TRANSLIT")
 gadmCHE$VARNAME_1 <- iconv(gadmCHE$VARNAME_1, "UTF-8", "ASCII//TRANSLIT")
 
-devtools::use_data(gadmCHE, overwrite = TRUE)
+usethis::use_data(gadmCHE, overwrite = TRUE)
 
 print(tools::showNonASCIIfile("data/gadmCHE.rda"))

tests/testthat/_snaps/normalize-2.md

@@ -1,4 +1,4 @@
-# normalize
+# normalize sp
 
     [[1]]
     [[1]][[1]]

tests/testthat/helper.R

@@ -1,4 +1,4 @@
-create_square <- function(width = 2, lng = 0, lat = 0, hole = FALSE, type = Polygon) {
+create_square <- function(width = 2, lng = 0, lat = 0, hole = FALSE, type = sp::Polygon) {
   lngs <- c(lng - width / 2, lng + width / 2, lng + width / 2, lng - width / 2)
   lats <- c(lat + width / 2, lat + width / 2, lat - width / 2, lat - width / 2)