Add future_Filter() [#125]

Author: HenrikBengtsson

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: future.apply
-Version: 1.11.3-9023
+Version: 1.11.3-9024
 Title: Apply Function to Elements in Parallel using Futures
 Depends:
     R (>= 3.2.0),

NAMESPACE

@@ -5,6 +5,7 @@ S3method(future_by,default)
 S3method(future_kernapply,default)
 S3method(future_kernapply,ts)
 export(future_.mapply)
+export(future_Filter)
 export(future_Map)
 export(future_apply)
 export(future_by)

NEWS.md

@@ -15,7 +15,10 @@
    parallel RNG seed. Consolidating random number generation to the
    core package will allow us to add central support for custom
    parallel RNG methods beyond the built-in L'Ecuyer-CMRG method.
-   
+
+ * Added `future_Filter()`, which is parallel version of
+   `base::Filter()`.
+
  * Added `future_kernapply()`, which is parallel version of
    `stats::kernapply()`.
 

R/future_Filter.R

@@ -0,0 +1,30 @@
+#' @inheritParams future_mapply
+#' 
+#' @param f A function of the arity \eqn{k} if `future_Map()` is called with
+#' \eqn{k} arguments. Unary for `future_Filter()`.
+#' 
+#' @param x A vector-like object to iterate over.
+#' 
+#' @return
+#' See [base::Filter()] for details.
+#'
+#' @examples
+#' is_even <- function(x) { x %% 2 == 0 }
+#' x <- sample.int(100, size = 1000, replace = TRUE)
+#' y <- Filter(is_even, x)
+#'
+#' @author
+#' The implementations of `future_Filter()` is adopted from the source code
+#' of the corresponding base \R function `Filter()`, which is licensed under
+#' GPL (>= 2) with 'The R Core Team' as the copyright holder.
+#' 
+#' @rdname future_mapply
+#' @export
+future_Filter <- function(f, x, ...) {
+  f <- match.fun(f)
+  z <- unlist(future_lapply(x, f, ...))
+  if (is.null(z)) 
+    return(x[integer()])
+  ind <- as.logical(z)
+  x[which(ind)]
+}

README.md

@@ -1,3 +1,5 @@
+
+
 <div id="badges"><!-- pkgdown markup -->
 <a href="https://CRAN.R-project.org/web/checks/check_results_future.apply.html"><img border="0" src="https://www.r-pkg.org/badges/version/future.apply" alt="CRAN check status"/></a> <a href="https://github.com/futureverse/future.apply/actions?query=workflow%3AR-CMD-check"><img border="0" src="https://github.com/futureverse/future.apply/actions/workflows/R-CMD-check.yaml/badge.svg?branch=develop" alt="R CMD check status"/></a>     <a href="https://app.codecov.io/gh/futureverse/future.apply"><img border="0" src="https://codecov.io/gh/futureverse/future.apply/branch/develop/graph/badge.svg" alt="Coverage Status"/></a> 
 </div>
@@ -42,19 +44,20 @@ Where does the **[future.apply]** package fit in the software stack?  You can th
 <br>
 </td>
 <td>
-Future-versions of common goto <code>*apply()</code> functions available in base R (of the <strong>base</strong> package):<br>
+Future-versions of common goto <code>*apply()</code> functions available in base R (of the <strong>base</strong> and <strong>stats</strong> packages):<br>
 <code>future_apply()</code>, 
 <code>future_by()</code>, 
 <code>future_eapply()</code>, 
+<code>future_Filter()</code>, 
 <code>future_lapply()</code>, 
+<code>future_kernapply()</code>,
 <code>future_Map()</code>, 
 <code>future_mapply()</code>, 
 <code>future_.mapply()</code>, 
 <code>future_replicate()</code>,
 <code>future_sapply()</code>,
-<code>future_tapply()</code>,
-<code>future_vapply()</code>, and
-<code>future_kernapply()</code>.
+<code>future_tapply()</code>, and
+<code>future_vapply()</code>.
 <br>
 <em>The following function is not implemented:</em><br>
 <code>future_rapply()</code><br>
@@ -182,3 +185,4 @@ This will install the package from source.
 ## Contributing
 
 To contribute to this package, please see [CONTRIBUTING.md](CONTRIBUTING.md).
+

inst/testme/test-future_Filter.R

@@ -0,0 +1,28 @@
+#' @tags future_Filter
+#' @tags sequential multisession multicore
+
+library(future.apply)
+
+message("*** future_Filter() ...")
+
+is_even <- function(x) { x %% 2 == 0 }
+x <- sample.int(100, size = 1000, replace = TRUE)
+
+y_truth <- x[vapply(x, FUN.VALUE = NA, FUN = is_even)]
+str(y_truth)
+
+for (strategy in supportedStrategies()) {
+  message(sprintf("*** strategy = %s ...", sQuote(strategy)))
+  plan(strategy)
+
+  y <- Filter(is_even, x)
+  str(y)
+
+  stopifnot(identical(y, y_truth))
+  
+  message(sprintf("*** strategy = %s ... done", sQuote(strategy)))
+}
+
+plan(sequential)
+
+message("*** future_Filter() ... DONE")

man/future_mapply.Rd

@@ -0,0 +1,3 @@
+## This runs testme test script inst/testme/test-future_Filter.R
+## Don't edit - it was autogenerated by inst/testme/deploy.R
+future.apply:::testme("future_Filter")

tests/test-future_Filter.R

@@ -57,15 +57,16 @@ Future-versions of common goto <code>*apply()</code> functions available in base
 <code>future_apply()</code>, 
 <code>future_by()</code>, 
 <code>future_eapply()</code>, 
+<code>future_Filter()</code>, 
 <code>future_lapply()</code>, 
+<code>future_kernapply()</code>,
 <code>future_Map()</code>, 
 <code>future_mapply()</code>, 
 <code>future_.mapply()</code>, 
 <code>future_replicate()</code>,
 <code>future_sapply()</code>,
-<code>future_tapply()</code>,
-<code>future_vapply()</code>, and
-<code>future_kernapply()</code>.
+<code>future_tapply()</code>, and
+<code>future_vapply()</code>.
 <br>
 <em>The following function is not implemented:</em><br>
 <code>future_rapply()</code><br>