st_sample with type="hexagon" and n=1; fixes #1945

Author: edzer

DESCRIPTION

@@ -83,6 +83,7 @@ Suggests:
     Matrix,
     microbenchmark,
     odbc,
+    pbapply,
     pillar,
     pool,
     raster,

NEWS.md

@@ -1,12 +1,16 @@
 # version 1.0-8
 
+* fix `st_sample()` with `type = "hexagonal"` for corner case (n=1), add a `progress` argument for a progress bar; #1945
+
+* add package `pbapply` to Suggests; #1945
+
 * add pdf driver to windows build; #1942
 
 * clarify `pipeline` argument in `st_transform()` when axis order is ambiguous; #1934
 
 * handle argument `xpd` in calls to `plot.sfc_POLYGON()` and `plot.sfc_MULTIPOLYGON()`
 
-* `pivot_wider()` method added, by Henning Teickner; #1915
+* add `pivot_wider()` method, by Henning Teickner; #1915
 
 * add `gdal_addo()` to add or remove overviews from raster images; #1921
 

R/sample.R

@@ -25,6 +25,7 @@ st_sample = function(x, size, ...) UseMethod("st_sample")
 #' @param by_polygon logical; for \code{MULTIPOLYGON} geometries, should the effort be split by \code{POLYGON}? See https://github.com/r-spatial/sf/issues/1480
 #' the same as specified by \code{size}? \code{TRUE} by default. Only applies to polygons, and
 #' when \code{type = "random"}.
+#' @param progress logical; if \code{TRUE} show progress bar (only if \code{size} is a vector).
 #' @return an \code{sfc} object containing the sampled \code{POINT} geometries
 #' @details if \code{x} has dimension 2 (polygons) and geographical coordinates (long/lat), uniform random sampling on the sphere is applied, see e.g. \url{http://mathworld.wolfram.com/SpherePointPicking.html}
 #'
@@ -93,13 +94,18 @@ st_sample.sf = function(x, size, ...) st_sample(st_geometry(x), size, ...)
 #' @export
 #' @name st_sample
 st_sample.sfc = function(x, size, ..., type = "random", exact = TRUE, warn_if_not_integer = TRUE,
-		by_polygon = FALSE) {
+		by_polygon = FALSE, progress = FALSE) {
 
 	if (!missing(size) && warn_if_not_integer && any(size %% 1 != 0))
 		warning("size is not an integer")
 	if (!missing(size) && length(size) > 1) { # recurse:
 		size = rep(size, length.out = length(x))
-		ret = lapply(1:length(x), function(i) st_sample(x[i], size[i], type = type, exact = exact, ...))
+		ret = if (progress) {
+				if (!requireNamespace("pbapply", quietly = TRUE))
+					stop("package pbapply required, please install it first")
+				pbapply::pblapply(1:length(x), function(i) st_sample(x[i], size[i], type = type, exact = exact, ...))
+			} else
+				lapply(1:length(x), function(i) st_sample(x[i], size[i], type = type, exact = exact, ...))
 		st_set_crs(do.call(c, ret), st_crs(x))
 	} else {
 		res = switch(max(st_dimension(x)) + 1,
@@ -249,7 +255,7 @@ hex_grid_points = function(obj, pt, dx) {
 
 	y = rep(y, each = length(x))
 	x = rep(c(x, x + dx / 2), length.out = length(y))
-	xy = cbind(x, y)[x >= xlim[1] & x <= xlim[2] & y >= ylim[1] & y <= ylim[2], ]
+	xy = cbind(x, y)[x >= xlim[1] & x <= xlim[2] & y >= ylim[1] & y <= ylim[2], , drop = FALSE]
 	colnames(xy) = NULL
 	st_sfc(lapply(seq_len(nrow(xy)), function(i) st_point(xy[i,])), crs = st_crs(bb))
 }