From 5540efbfdaca5e0e1c9ced4973eb7fd41c554f3f Mon Sep 17 00:00:00 2001
From: dshkol <shkolnikd@gmail.com>
Date: Wed, 30 Dec 2020 08:59:31 +0800
Subject: [PATCH] enable mcmapply

---
 R/filter_by_quadkey.R    | 26 +++++++++++++++++++++++---
 man/filter_by_quadkey.Rd |  9 +++++++--
 2 files changed, 30 insertions(+), 5 deletions(-)

diff --git a/R/filter_by_quadkey.R b/R/filter_by_quadkey.R
index bdc22eb..9238deb 100644
--- a/R/filter_by_quadkey.R
+++ b/R/filter_by_quadkey.R
@@ -41,6 +41,8 @@ tileXYToQuadKey <- function(xTile, yTile, z) {
 #'
 #' @param tiles From `get_performance_tiles()`
 #' @param bbox [sf::st_bbox()] bounding box describing area from which to include tiles.
+#' @param parallel Enables use of a parallel backend using [parallel::mcmapply()]. Turned off by default. This setting is not recommended for use on Windows machines.
+#' @param ncores Explicitly set number of cores to use if using [parallel::mcmapply()] is enabled. Will otherwise default the max available minus 1.
 
 #' @return A filtered version of the `tiles` input
 #' @export
@@ -55,17 +57,35 @@ tileXYToQuadKey <- function(xTile, yTile, z) {
 #' filter_by_quadkey(tiles, bbox = sf::st_bbox(nc))
 #' }
 #'
-filter_by_quadkey <- function(tiles, bbox) {
+filter_by_quadkey <- function(tiles, bbox, parallel = FALSE, ncores = NULL) {
   assertthat::assert_that(inherits(bbox, "bbox"))
 
+  # Check if paralellization is feasible
+  if(parallel) {
+    assertthat::see_if(.Platform$OS.type != "windows", msg = "Parallel likely will not work on Windows.")
+    if(is.null(ncores)) ncores = parallel::detectCores()-1L
+    else {
+      assertthat::assert_that(is.numeric(ncores))
+      assertthat::see_if(ncores <= parallel::detectCores(), msg = "More cores selected than are available.")
+    }
+  }
+
   # make sure the coordinates are lat/lon if sf is installed
   if (rlang::is_installed("sf")) {
     bbox <- sf::st_bbox(sf::st_transform(sf::st_as_sfc(bbox), 4326))
   }
 
-  tile_grid <- slippymath::bbox_to_tile_grid(bbox, zoom = 16)
+  tile_grid <- slippymath::bbox_to_tile_grid(bbox, zoom = 16L)
 
-  quadkeys <- mapply(tileXYToQuadKey, xTile = tile_grid$tiles$x, yTile = tile_grid$tiles$y, MoreArgs = list(z = 16))
+  # Use parallelism if enabled and default to regular mapply otherwise
+  if(!parallel) {
+    quadkeys <- mapply(tileXYToQuadKey, xTile = tile_grid$tiles$x, yTile = tile_grid$tiles$y, MoreArgs = list(z = 16L))
+  } else {
+    quadkeys <- parallel::mcmapply(tileXYToQuadKey, xTile = tile_grid$tiles$x, yTile = tile_grid$tiles$y, MoreArgs = list(z = 16L),
+                         SIMPLIFY = TRUE, USE.NAMES = TRUE,
+                         mc.preschedule = TRUE, mc.set.seed = TRUE,
+                         mc.silent = FALSE, mc.cores = ncores, mc.cleanup = TRUE)
+  }
 
   tiles[tiles$quadkey %in% quadkeys, ]
 }
diff --git a/man/filter_by_quadkey.Rd b/man/filter_by_quadkey.Rd
index 229b6a0..a6f278b 100644
--- a/man/filter_by_quadkey.Rd
+++ b/man/filter_by_quadkey.Rd
@@ -4,12 +4,16 @@
 \alias{filter_by_quadkey}
 \title{Filter Tiles by Quadkey}
 \usage{
-filter_by_quadkey(tiles, bbox)
+filter_by_quadkey(tiles, bbox, parallel = FALSE, ncores = NULL)
 }
 \arguments{
 \item{tiles}{From \code{get_performance_tiles()}}
 
 \item{bbox}{\code{\link[sf:st_bbox]{sf::st_bbox()}} bounding box describing area from which to include tiles.}
+
+\item{parallel}{Enables use of a parallel backend using \code{\link[parallel:mclapply]{parallel::mcmapply()}}. Turned off by default. This setting is not recommended for use on Windows machines.}
+
+\item{ncores}{Explicitly set number of cores to use if using \code{\link[parallel:mclapply]{parallel::mcmapply()}} is enabled. Will otherwise default the max available minus 1.}
 }
 \value{
 A filtered version of the \code{tiles} input
@@ -23,7 +27,8 @@ A filtered version of the \code{tiles} input
 filter_by_quadkey(tiles, bbox = sf::st_bbox(c(xmin = 16.1, xmax = 16.6, ymax = 48.6, ymin = 47.9), crs = st_crs(4326)))
 
 # Filters tiles to a bounding box specified by an `sf` object
-nc <- st_read(system.file("gpkg/nc.gpkg", package="sf"), quiet = TRUE)
+nc <- st_read(system.file("gpkg/nc.gpkg", package = "sf"), quiet = TRUE)
 filter_by_quadkey(tiles, bbox = sf::st_bbox(nc))
 }
+
 }