Repository: HenrikBengtsson/future.apply Branch: develop Commit: ad7ae16630ac Files: 139 Total size: 342.5 KB Directory structure: gitextract_3rrfdcst/ ├── .Rbuildignore ├── .Rinstignore ├── .github/ │ ├── .gitignore │ ├── ISSUE_TEMPLATE/ │ │ ├── bug_report.md │ │ ├── config.yml │ │ └── feature_request.md │ └── workflows/ │ ├── R-CMD-check.yaml │ ├── rhub.yaml │ └── test-coverage.yaml ├── .gitignore ├── CONDUCT.md ├── CONTRIBUTING.md ├── DESCRIPTION ├── Makefile ├── NAMESPACE ├── NEWS.md ├── R/ │ ├── 000.import.R │ ├── 001.bquote.R │ ├── 001.import_future_functions.R │ ├── chunking.R │ ├── condition-handlers.R │ ├── fold.R │ ├── future.apply-package.R │ ├── future_Filter.R │ ├── future_Map.R │ ├── future_apply.R │ ├── future_by.R │ ├── future_eapply.R │ ├── future_kernapply.R │ ├── future_lapply.R │ ├── future_mapply.R │ ├── future_replicate.R │ ├── future_sapply.R │ ├── future_tapply.R │ ├── future_vapply.R │ ├── future_xapply.R │ ├── globals.R │ ├── makeChunks.R │ ├── options.R │ ├── testme.R │ ├── utils,conditions.R │ ├── utils-debug.R │ ├── utils.R │ └── zzz.R ├── README.md ├── cran-comments.md ├── incl/ │ ├── OVERVIEW.md │ ├── future_Filter.R │ ├── future_apply.R │ ├── future_by.R │ ├── future_lapply.R │ ├── future_mapply.R │ ├── make_rng_seeds.R │ └── random_seed_utils.R ├── inst/ │ ├── CITATION │ ├── WORDLIST │ └── testme/ │ ├── _epilogue/ │ │ ├── 001.undo-future.R │ │ ├── 002.undo-state.R │ │ ├── 090.gc.R │ │ ├── 099.session_info.R │ │ ├── 995.detritus-connections.R │ │ └── 999.detritus-files.R │ ├── _prologue/ │ │ ├── 001.load.R │ │ ├── 002.record-state.R │ │ ├── 030.imports.R │ │ ├── 050.utils.R │ │ ├── 090.context.R │ │ ├── 090.options.R │ │ ├── 091.envvars.R │ │ ├── 099.future-setup.R │ │ └── 995.detrius-connections.R │ ├── deploy.R │ ├── run.R │ ├── test-fold.R │ ├── test-future_Filter.R │ ├── test-future_apply.R │ ├── test-future_by.R │ ├── test-future_eapply.R │ ├── test-future_kernapply.R │ ├── test-future_lapply,RNG.R │ ├── test-future_lapply,globals.R │ ├── test-future_lapply.R │ ├── test-future_mapply,globals.R │ ├── test-future_mapply.R │ ├── test-future_replicate.R │ ├── test-future_sapply.R │ ├── test-future_tapply.R │ ├── test-future_vapply.R │ ├── test-globals,tricky2.R │ ├── test-globals,tricky_recursive.R │ ├── test-options,nested.R │ ├── test-rng.R │ ├── test-stdout.R │ └── test-utils.R ├── man/ │ ├── fold.Rd │ ├── future.apply.Rd │ ├── future.apply.options.Rd │ ├── future_apply.Rd │ ├── future_by.Rd │ ├── future_kernapply.Rd │ ├── future_lapply.Rd │ ├── future_mapply.Rd │ └── makeChunks.Rd ├── pkgdown/ │ ├── _pkgdown.yml │ └── _pkgdown.yml.rsp ├── revdep/ │ ├── README.md │ ├── cran.md │ ├── failures.md │ ├── notes.md │ ├── problems.md │ ├── revdepcheck.Renviron │ ├── revdepcheck.init.sh │ ├── run.R │ ├── run.pbs │ └── run.sge ├── tests/ │ ├── incl/ │ │ ├── end.R │ │ └── start,load-only.R │ ├── test-fold.R │ ├── test-future_Filter.R │ ├── test-future_apply.R │ ├── test-future_by.R │ ├── test-future_eapply.R │ ├── test-future_kernapply.R │ ├── test-future_lapply,RNG.R │ ├── test-future_lapply,globals.R │ ├── test-future_lapply.R │ ├── test-future_mapply,globals.R │ ├── test-future_mapply.R │ ├── test-future_replicate.R │ ├── test-future_sapply.R │ ├── test-future_tapply.R │ ├── test-future_vapply.R │ ├── test-globals,tricky2.R │ ├── test-globals,tricky_recursive.R │ ├── test-options,nested.R │ ├── test-rng.R │ ├── test-stdout.R │ └── test-utils.R └── vignettes/ └── future.apply-1-overview.md.rsp ================================================ FILE CONTENTS ================================================ ================================================ FILE: .Rbuildignore ================================================ #---------------------------- # Git and SVN related #---------------------------- ^.svn ^.git ^.make ^INSTALL[.]md$ ^OVERVIEW[.]md$ ^README[.]md$ ^CONDUCT[.]md$ ^CONTRIBUTING[.]md$ #---------------------------- # devtools #---------------------------- ^revdep #---------------------------- # Travis-CI et al. #---------------------------- ^[.]travis[.]yml$ ^travis-tool[.]sh$ ^pkg-build[.]sh$ ^appveyor[.]yml$ ^covr-utils.R$ ^[.]covr[.]R$ ^[.]covr[.]rds$ #---------------------------- # R related #---------------------------- Rplots.pdf$ ^cran-comments[.].*$ ^vignettes/.*[.](pdf|PDF)$ ^vignettes/.*[.](r|R)$ ^vignettes/[.]install_extras$ ^Makefile$ ^incl ^NAMESPACE,.*[.]txt$ ^nohup.*$ ^[.]R ^[.]benchmark ^[.]devel ^[.]test ^[.]check ^.*[.]tar[.]gz$ #---------------------------- # Package specific #---------------------------- ^[.]BatchJobs[.]R$ ^[.]future #---------------------------- # Miscellaneous #---------------------------- ^.ghi ^.issues ^.local ^docs ^pkgdown [.]Rdump ^\.github$ ================================================ FILE: .Rinstignore ================================================ # Certain LaTeX files (e.g. bib, bst, sty) must be part of the build # such that they are available for R CMD check. These are excluded # from the install using .Rinstignore in the top-level directory # such as this one. doc/.*[.](bib|bst|sty)$ ================================================ FILE: .github/.gitignore ================================================ *.html ================================================ FILE: .github/ISSUE_TEMPLATE/bug_report.md ================================================ --- name: Bug report about: Create a report to help us improve (Please use future's 'Discussions' for Q&A) title: '' labels: '' assignees: '' --- (Please use for Q&A) **Describe the bug** A clear and concise description of what the bug is. **Reproduce example** A reproducible example using R code. **Expected behavior** A clear and concise description of what you expected to happen. **Session information** Please share your session information, e.g. ```r > sessionInfo() ``` ================================================ FILE: .github/ISSUE_TEMPLATE/config.yml ================================================ lank_issues_enabled: true contact_links: - name: Support & Discussions url: https://github.com/futureverse/future/discussions/ about: Got a question? Something is not working? Want to share an idea? ================================================ FILE: .github/ISSUE_TEMPLATE/feature_request.md ================================================ --- name: Feature request about: Suggest an idea for this project (Please use future's 'Discussions' for Q&A) title: '' labels: '' assignees: '' --- (Please use for Q&A) **Wish or feature request** A clear and concise description of what the problem is. For example, I would like to be able to ... ================================================ FILE: .github/workflows/R-CMD-check.yaml ================================================ on: [push, pull_request] name: R-CMD-check jobs: R-CMD-check: if: "! contains(github.event.head_commit.message, '[ci skip]')" timeout-minutes: 30 runs-on: ${{ matrix.config.os }} name: ${{ matrix.config.os }} (${{ matrix.config.r }}) ${{ matrix.config.label }} strategy: fail-fast: false matrix: config: - {os: windows-latest, r: 'devel' } - {os: windows-latest, r: 'release' } - {os: windows-latest, r: 'oldrel' } - {os: macOS-latest, r: 'devel' } - {os: macOS-latest, r: 'release' } - {os: macOS-latest, r: 'oldrel' } - {os: ubuntu-latest, r: 'devel', strict: true, label: 'strict' } - {os: ubuntu-latest, r: 'release' } - {os: ubuntu-latest, r: 'oldrel' } - {os: ubuntu-latest, r: 'oldrel-1' } - {os: ubuntu-latest, r: 'oldrel-2' } - {os: ubuntu-latest, r: '4.0' } - {os: ubuntu-latest, r: 'release' , language: ko, label: ko } - {os: ubuntu-latest, r: 'release' , globals_keepWhere: true, label: 'keepWhere' } - {os: ubuntu-latest, r: 'release' , globals_keepWhere: false, label: '!keepWhere' } - {os: windows-latest, r: 'devel', future_version: develop, label: 'w/ future-develop' } - {os: ubuntu-latest, r: 'release', future_version: develop, label: 'w/ future-develop' } env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} R_KEEP_PKG_SOURCE: yes R_REMOTES_NO_ERRORS_FROM_WARNINGS: true ## Test in other locale (optional) LANGUAGE: ${{ matrix.config.language }} ## R CMD check _R_CHECK_CRAN_INCOMING_: false _R_CHECK_MATRIX_DATA_: true _R_CHECK_SUGGESTS_ONLY_: true _R_CHECK_THINGS_IN_TEMP_DIR_: true ## Specific to 'rcmdcheck' RCMDCHECK_ERROR_ON: note ## Specific to futures R_FUTURE_RNG_ONMISUSE: error R_FUTURE_GLOBALS_KEEPWHERE: ${{ matrix.config.globals_keepWhere }} R_FUTURE_VERSION: ${{ matrix.config.future_version }} R_GLOBALS_VERSION: ${{ matrix.config.globals_version }} steps: - uses: actions/checkout@v4 - uses: r-lib/actions/setup-pandoc@v2 - uses: r-lib/actions/setup-r@v2 with: r-version: ${{ matrix.config.r }} http-user-agent: ${{ matrix.config.http-user-agent }} use-public-rspm: true - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::rcmdcheck needs: check - name: Install package itself (special case) run: | install.packages(".", repos = NULL, type = "source") ## needed by parallel workers shell: Rscript {0} - name: Test with specific future version? run: | globals_version <- Sys.getenv("R_GLOBALS_VERSION") if (nzchar(globals_version)) { install.packages("remotes") remotes::install_github("futureverse/future", ref=globals_version) } future_version <- Sys.getenv("R_FUTURE_VERSION") if (nzchar(future_version)) { install.packages("remotes") remotes::install_github("futureverse/future", ref=future_version) } shell: Rscript {0} - name: Session info run: | options(width = 100) parallelly::availableCores(which = "all") sapply(c(physical_cores = FALSE, logical_cores = TRUE), parallel::detectCores) if (require(RhpcBLASctl, quietly=TRUE)) c(get_num_procs = get_num_procs(), get_num_cores = get_num_cores(), blas_get_num_procs = blas_get_num_procs(), omp_get_num_procs = omp_get_num_procs(), omp_get_max_threads = omp_get_max_threads()) capabilities() pkgs <- installed.packages()[, "Package"] sessioninfo::session_info(pkgs, include_base = TRUE) ## Verify LANGUAGE settings by generating a translatable error cat(sprintf("LANGUAGE=%s\n", sQuote(Sys.getenv("LANGUAGE")))) cat(sprintf("locales: %s\n", sQuote(Sys.getlocale()))) tryCatch(log("a"), error = conditionMessage) shell: Rscript {0} - name: Check run: | if ("${{ matrix.config.strict }}" == "true") { Sys.setenv(NOT_CRAN = "true") Sys.setenv(R_FUTURE_GLOBALENV_ONMISUSE = "error") Sys.setenv(R_FUTURE_RNG_ONMISUSE = "error") Sys.setenv(R_FUTURE_FUTURE_EARLYSIGNAL = "defunct") Sys.setenv(R_FUTURE_FUTURE_LOCAL = "defunct") Sys.setenv(R_FUTURE_FUTURE_GC = "defunct") Sys.setenv(R_FUTURE_PLAN_EARLYSIGNAL = "defunct") Sys.setenv(R_FUTURE_RESOLVED_RUN = "defunct") } if (nzchar(Sys.getenv("R_FUTURE_PLAN"))) Sys.setenv(RCMDCHECK_ERROR_ON = "error") rcmdcheck::rcmdcheck( args = c("--no-manual", "--as-cran"), check_dir = "check" ) shell: Rscript {0} - name: Upload check results if: failure() uses: actions/upload-artifact@v4 with: name: ${{ runner.os }}-r${{ matrix.config.r }}-results path: check ================================================ FILE: .github/workflows/rhub.yaml ================================================ # R-hub's generic GitHub Actions workflow file. It's canonical location is at # https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml # You can update this file to a newer version using the rhub2 package: # # rhub::rhub_setup() # # It is unlikely that you need to modify this file manually. name: R-hub run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}" on: workflow_dispatch: inputs: config: description: 'A comma separated list of R-hub platforms to use.' type: string default: 'linux,windows,macos' name: description: 'Run name. You can leave this empty now.' type: string id: description: 'Unique ID. You can leave this empty now.' type: string jobs: setup: runs-on: ubuntu-latest outputs: containers: ${{ steps.rhub-setup.outputs.containers }} platforms: ${{ steps.rhub-setup.outputs.platforms }} steps: # NO NEED TO CHECKOUT HERE - uses: r-hub/actions/setup@v1 with: config: ${{ github.event.inputs.config }} id: rhub-setup linux-containers: needs: setup if: ${{ needs.setup.outputs.containers != '[]' }} runs-on: ubuntu-latest name: ${{ matrix.config.label }} strategy: fail-fast: false matrix: config: ${{ fromJson(needs.setup.outputs.containers) }} container: image: ${{ matrix.config.container }} steps: - uses: r-hub/actions/checkout@v1 - uses: r-hub/actions/platform-info@v1 with: token: ${{ secrets.RHUB_TOKEN }} job-config: ${{ matrix.config.job-config }} - uses: r-hub/actions/setup-deps@v1 with: token: ${{ secrets.RHUB_TOKEN }} job-config: ${{ matrix.config.job-config }} - uses: r-hub/actions/run-check@v1 with: token: ${{ secrets.RHUB_TOKEN }} job-config: ${{ matrix.config.job-config }} other-platforms: needs: setup if: ${{ needs.setup.outputs.platforms != '[]' }} runs-on: ${{ matrix.config.os }} name: ${{ matrix.config.label }} strategy: fail-fast: false matrix: config: ${{ fromJson(needs.setup.outputs.platforms) }} steps: - uses: r-hub/actions/checkout@v1 - uses: r-hub/actions/setup-r@v1 with: job-config: ${{ matrix.config.job-config }} token: ${{ secrets.RHUB_TOKEN }} - uses: r-hub/actions/platform-info@v1 with: token: ${{ secrets.RHUB_TOKEN }} job-config: ${{ matrix.config.job-config }} - uses: r-hub/actions/setup-deps@v1 with: job-config: ${{ matrix.config.job-config }} token: ${{ secrets.RHUB_TOKEN }} - uses: r-hub/actions/run-check@v1 with: job-config: ${{ matrix.config.job-config }} token: ${{ secrets.RHUB_TOKEN }} ================================================ FILE: .github/workflows/test-coverage.yaml ================================================ on: workflow_dispatch: # Enables manual triggering name: test-coverage.yaml permissions: read-all jobs: test-coverage: runs-on: ubuntu-latest env: GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} steps: - uses: actions/checkout@v4 - name: Assert CODECOV_TOKEN is set run: | if [[ -z "${{secrets.CODECOV_TOKEN}}" ]]; then >&2 echo "::error::ERROR: 'secrets.CODECOV_TOKEN' not set" exit 1 fi - uses: r-lib/actions/setup-r@v2 with: use-public-rspm: true - uses: r-lib/actions/setup-r-dependencies@v2 with: extra-packages: any::covr, any::xml2, any::remotes needs: coverage - name: Install itself run: | install.packages(".", repos = NULL, type = "source") remotes::install_github("futureverse/globals", ref = "develop") remotes::install_github("futureverse/future", ref = "develop") shell: Rscript {0} - name: Test coverage run: | cov <- covr::package_coverage( quiet = FALSE, clean = FALSE, install_path = file.path(normalizePath(Sys.getenv("RUNNER_TEMP"), winslash = "/"), "package") ) print(cov) covr::to_cobertura(cov) shell: Rscript {0} - uses: codecov/codecov-action@v4 with: fail_ci_if_error: ${{ github.event_name != 'pull_request' && true || false }} file: ./cobertura.xml plugin: noop disable_search: true token: ${{ secrets.CODECOV_TOKEN }} - name: Upload test results if: failure() uses: actions/upload-artifact@v4 with: name: coverage-test-failures path: ${{ runner.temp }}/package ================================================ FILE: .gitignore ================================================ .Rhistory *~ **/*~ .R .benchmark .check .devel .test *.o *.dll *.Rout .RData *.Rproj* *.swp .covr.rds .future .ghi .issues .make .local revdep/data.sqlite revdep/cache revdep/checks revdep/library docs/ .Rdump ================================================ FILE: CONDUCT.md ================================================ # Contributor Covenant Code of Conduct ## Our Pledge In the interest of fostering an open and welcoming environment, we as contributors and maintainers pledge to making participation in our project and our community a harassment-free experience for everyone, regardless of age, body size, disability, ethnicity, gender identity and expression, level of experience, nationality, personal appearance, race, religion, or sexual identity and orientation. ## Our Standards Examples of behavior that contributes to creating a positive environment include: * Using welcoming and inclusive language * Being respectful of differing viewpoints and experiences * Gracefully accepting constructive criticism * Focusing on what is best for the community * Showing empathy towards other community members Examples of unacceptable behavior by participants include: * The use of sexualized language or imagery and unwelcome sexual attention or advances * Trolling, insulting/derogatory comments, and personal or political attacks * Public or private harassment * Publishing others' private information, such as a physical or electronic address, without explicit permission * Other conduct which could reasonably be considered inappropriate in a professional setting ## Our Responsibilities Project maintainers are responsible for clarifying the standards of acceptable behavior and are expected to take appropriate and fair corrective action in response to any instances of unacceptable behavior. Project maintainers have the right and responsibility to remove, edit, or reject comments, commits, code, wiki edits, issues, and other contributions that are not aligned to this Code of Conduct, or to ban temporarily or permanently any contributor for other behaviors that they deem inappropriate, threatening, offensive, or harmful. ## Scope This Code of Conduct applies both within project spaces and in public spaces when an individual is representing the project or its community. Examples of representing a project or community include using an official project e-mail address, posting via an official social media account, or acting as an appointed representative at an online or offline event. Representation of a project may be further defined and clarified by project maintainers. ## Enforcement Instances of abusive, harassing, or otherwise unacceptable behavior may be reported by contacting the project team. All complaints will be reviewed and investigated and will result in a response that is deemed necessary and appropriate to the circumstances. The project team is obligated to maintain confidentiality with regard to the reporter of an incident. Further details of specific enforcement policies may be posted separately. Project maintainers who do not follow or enforce the Code of Conduct in good faith may face temporary or permanent repercussions as determined by other members of the project's leadership. ## Attribution This Code of Conduct is adapted from the [Contributor Covenant][homepage], version 1.4, available at [http://contributor-covenant.org/version/1/4][version] [homepage]: http://contributor-covenant.org [version]: http://contributor-covenant.org/version/1/4/ ================================================ FILE: CONTRIBUTING.md ================================================ # Contributing to the 'future.apply' package This Git repository uses the [Git Flow](https://nvie.com/posts/a-successful-git-branching-model/) branching model (the [`git flow`](https://github.com/petervanderdoes/gitflow-avh) extension is useful for this). The [`develop`](https://github.com/futureverse/future.apply/tree/develop) branch contains the latest contributions and other code that will appear in the next release, and the [`master`](https://github.com/futureverse/future.apply) branch contains the code of the latest release, which is exactly what is currently on [CRAN](https://cran.r-project.org/package=future.apply). Contributing to this package is easy. Just send a [pull request](https://help.github.com/articles/using-pull-requests/). When you send your PR, make sure `develop` is the destination branch on the [future.apply repository](https://github.com/futureverse/future.apply). Your PR should pass `R CMD check --as-cran`, which will also be checked by GitHub Actions and when the PR is submitted. We abide to the [Code of Conduct](https://www.contributor-covenant.org/version/2/0/code_of_conduct/) of Contributor Covenant. ================================================ FILE: DESCRIPTION ================================================ Package: future.apply Version: 1.20.2-9000 Title: Apply Function to Elements in Parallel using Futures Depends: R (>= 3.2.0), future (>= 1.49.0) Imports: globals, parallel, utils Suggests: datasets, stats, tools, listenv, R.rsp, markdown VignetteBuilder: R.rsp Authors@R: c(person("Henrik", "Bengtsson", role = c("aut", "cre", "cph"), email = "henrikb@braju.com", comment = c(ORCID = "0000-0002-7579-5165")), person("R Core Team", role = c("cph", "ctb"))) Description: Implementations of apply(), by(), eapply(), lapply(), Map(), .mapply(), mapply(), replicate(), sapply(), tapply(), and vapply() that can be resolved using any future-supported backend, e.g. parallel on the local machine or distributed on a compute cluster. These future_*apply() functions come with the same pros and cons as the corresponding base-R *apply() functions but with the additional feature of being able to be processed via the future framework . License: GPL (>= 2) LazyLoad: TRUE URL: https://future.apply.futureverse.org, https://github.com/futureverse/future.apply BugReports: https://github.com/futureverse/future.apply/issues Language: en-US Encoding: UTF-8 RoxygenNote: 7.3.3 Roxygen: list(markdown = TRUE) ================================================ FILE: Makefile ================================================ include .make/Makefile ================================================ FILE: NAMESPACE ================================================ # Generated by roxygen2: do not edit by hand S3method(future_by,data.frame) 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) export(future_eapply) export(future_kernapply) export(future_lapply) export(future_mapply) export(future_replicate) export(future_sapply) export(future_tapply) export(future_vapply) importFrom(future,Future) importFrom(future,FutureError) importFrom(future,FutureInterruptError) importFrom(future,as.FutureGlobals) importFrom(future,cancel) importFrom(future,future) importFrom(future,getGlobalsAndPackages) importFrom(future,nbrOfWorkers) importFrom(future,resolve) importFrom(future,value) importFrom(globals,findGlobals) importFrom(globals,globalsByName) importFrom(parallel,splitIndices) importFrom(stats,end) importFrom(stats,frequency) importFrom(stats,kernapply) importFrom(stats,ts) importFrom(utils,capture.output) importFrom(utils,globalVariables) importFrom(utils,head) importFrom(utils,packageVersion) importFrom(utils,str) ================================================ FILE: NEWS.md ================================================ # Version (development version) * ... # Version 1.20.2 [2026-02-19] ## Miscellaneous * This is a maintenance update with internal updates only. # Version 1.20.1 [2025-12-08] ## Bug Fixes * `future_apply(..., future.globals = list(...))` would produce 'Error in if (chunk_size > maxSize) { : missing value where TRUE/FALSE needed'. # Version 1.20.0 [2025-06-06] ## Significant changes * All **future.apply** functions will now cancel any remaining non-resolved futures if one of the futures produces an error, or a user interrupt (Ctrl-C) is detected. If the backend where the futures are running supports it, the canceled futures are also interrupted, which results in compute resources being freed up sooner and the **future.apply** function returning sooner. ## New Features * Added `future_Filter()`, which is parallel version of `base::Filter()`. * Added `future_kernapply()`, which is parallel version of `stats::kernapply()`. * Now **future.apply** lets **future** take care of the generation of 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. ## Deprecated and Defunct * Specifying the function `FUN` for `future_by()` as a character string is defunct. It should be specified as a function, e.g. `FUN = sqrt` and ``FUN = `[[` ``, which is what `base::by()` requires. Use of a string has been deprecated since **future.apply** 1.10.0 (2022-11-04). # Version 1.11.3 [2024-10-27] ## Bug Fixes * Use of `future.seed = TRUE` could result in an error `!any(seed_next != seed) is not TRUE` in rare cases. # Version 1.11.2 [2024-03-27] ## Miscellaneous * Relaxed one unit test that triggered an error on 32-bit architectures. # Version 1.11.1 [2023-12-19] ## Bug Fixes * Option `future.globals.maxSize` was never passed down to parallel workers. * The assertion of argument `INDEX` of `future_tapply()` would fail with another error in R (< 3.6.0), if `INDEX` was incorrect in the first place. # Version 1.11.0 [2023-05-20] ## Significant Changes * `future_tapply()` now accepts data frames as input, just as `tapply()` does in R (>= 4.3.0). * In R (>= 4.3.0), `future_tapply(X, INDEX, ...)` now accepts `INDEX` being a formula when `X` is a data frames, just as `tapply()` does in R (>= 4.3.0). An error is produced if used in R (< 4.3.0). * In R (>= 4.3.0), `future_by(X, INDICES, ...)` now accepts `INDICES` being a formula when `X` is a data frames, just as `by()` does in R (>= 4.3.0). An error is produced if used in R (< 4.3.0). ## New Features * Now **future** operators such as `%globals%`, `%seed%`, and `%stdout%` can be used to control the corresponding `future.*` arguments, e.g. `y <- future_lapply(1:3, FUN = my_fun) %seed% TRUE` is the same as `y <- future_lapply(1:3, FUN = my_fun, future.seed = TRUE)`. ## Bug Fixes * Contrary to `lapply(X, ...)`, `future_lapply(X, ...)` failed to use method-specific `[[` subsetting, if the class of `X` implemented one. `future_mapply()` and other functions had the same problem. The reason was that when `X` is partitioned into chunks, it would lose the class attribute before subsetting with `[[`. # Version 1.10.0 [2022-11-04] ## Bug Fixes * Functions `future_eapply()`, `future_lapply()`, `future_sapply()`, and `future_vapply()` failed if `FUN` was specified as the name of a function rather than the function object itself, e.g. `future_lapply(1:3, FUN = "sqrt")`. ## Deprecated and Defunct * Specifying the function `FUN` for `future_by()` as a character string is deprecated, because `base::by()` does not support it. It should be specified as a function, e.g. `FUN = sqrt` and ``FUN = `[[` ``. # Version 1.9.1 [2022-09-07] ## Bug Fixes * Some warnings and errors showed the wrong call. ## Miscellaneous * Fix some HTML5 issues in help pages. ## Significant Changes * `future_mapply()` and `future_Map()` was updated to match the new behavior of `mapply()` and `Map()` in R (>= 4.2.0), which follows the "max-or-0-if-any" recycling rule. ## Performance * Now captured standard output and conditions are deleted as soon as they have been relayed. This requires **future** (>= 1.25.0). ## Deprecated and Defunct * Removed moot argument `future.lazy` from all functions. Regardless of setting it to TRUE or FALSE, futures would be resolved momentarily and always before the apply returned. # Version 1.8.1 [2021-08-09] ## Bug Fixes * `citEntry()` in CITATION used argument `notes` instead of `note`. # Version 1.8.0 [2021-08-09] ## New Features * Add argument `future.envir` to all `future_nnn()` functions, which is passed as argument `envir` to `future()`. * Add option `future.apply.debug` for debugging features specific to this package. It defaults to option `future.debug`. ## Performance * Internal `getGlobalsAndPackagesXApply()` now avoids calculating the object size of `...` arguments if option `future.globals.maxSize` is +Inf. ## Bug Fixes * `f <- function(...) future_lapply(X, function(x) list(...)); f(a=1)` would produce an error on 'unused argument (a = 1)" with the upcoming release of **future** 1.22.0. # Version 1.7.0 [2021-01-02] ## New Features * The automatic capturing of conditions can be disabled by specifying `future.conditions = NULL`. * Warnings and errors on using the RNG without specifying `future.seed` are now tailored to the **future.apply** package. # Version 1.6.0 [2020-06-30] ## Significant Changes * `future_apply()` gained argument `simplify`, which is added to R-devel (to become R 4.1.0). ## Bug Fixes * `future_apply(X, FUN, ...)` would pass all `future.*` arguments except `future.globals`, `future.packages`, and `future.labels` to the `FUN` function instead of processing them locally. This would often result in the `FUN` producing an error on "unused argument". It also affected `future.seed` not being applied, which means for some `FUN` functions that did not produce this error, non-reproducible results could have been produced. # Version 1.5.0 [2020-04-16] ## New Features * Add `future_.mapply()` corresponding to `.mapply()` in the **base** package. ## Bug Fixes * `future_mapply()` would chunk up `MoreArgs` when `future.seed = TRUE`. # Version 1.4.0 [2020-01-06] ## New Features * Now all `future_nnn()` functions set a label on each future that reflects the name of the `future_nnn()` function and the index of the chunk, e.g. `"future_lapply-3"`. The format can be controlled by argument `future.label`. ## Performance * The assertion of the maximum size of globals per chunk is now significantly faster for `future_apply()`. ## Bug Fixes * `future_lapply(X)` and `future_mapply(FUN, X)` would drop `names` argument of the returned empty list when `length(X) == 0`. * Package could set `.Random.seed` to NULL, instead of removing it, which in turn would produce a warning on "'.Random.seed' is not an integer vector but of type 'NULL', so ignored" when the next random number generated. # Version 1.3.0 [2019-06-17] ## New Features * Now `future.conditions` defaults to the same as argument `conditions` of `future::future()`. If the latter changes, this package will follow. * Debug messages are now prepended with a timestamp. ## Bug Fixes * The error "sprintf(...) : 'fmt' length exceeds maximal format length 8192" could be produced when debugging tried to report on too many globals. # Version 1.2.0 [2019-03-06] ## New Features * Added `future_by()`. ## Bug Fixes * Attributes `add` and `ignore` of argument `future.globals` were ignored although support for them was added in **future** (>= 1.10.0). * Validation of L'Ecuyer-CMRG RNG seeds failed in recent R devel. # Version 1.1.0 [2019-01-16] ## Significant Changes * Added argument `future.stdout` and `future.conditions` for controlling whether standard output and conditions (e.g. messages and warnings) produced during the evaluation of futures should be captured and relayed or not. Standard output is guaranteed to be relayed in the same order as it would when using sequential processing. Analogously for conditions. However, standard output is always relayed before conditions. Errors are always relayed. Relaying of non-error conditions requires **future** (>= 1.11.0). ## New Features * Elements can be processed in random order by setting attribute `ordering` to `"random"` of argument `future.chunk.size` or `future.scheduling`, e.g. `future.chunk.size = structure(TRUE, ordering = "random")`. This can help improve load balancing in cases where there is a correlation between processing time and ordering of the elements. Note that the order of the returned values is not affected when randomizing the processing order. * Swapped order of arguments `future.lazy` and `future.seed` to be consistent with ditto arguments of `future::future()`. # Version 1.0.1 [2018-08-26] ## Documentation / Licence * The license is GPL (>= 2). Previously it was documented as GPL (>= 2.1) but that is a non-existing GPL version. ## Bug Fixes * For list objects `X` where `X != as.list(X), future_lapply(X)` did not give the same result as `lapply(X)`. Analogously for `future_vapply(X)`. * `future_mapply()` could drop class attribute on elements iterated over, because `.subset()` was used internally instead of `` `[`() ``. For instance, iteration over `Date` objects were affected. # Version 1.0.0 [2018-06-19] ## Significant Changes * License changed from LGPL (>= 2.1) to GPL (>= 2) to make sure it is compatible with the source code adopted from R base's `apply()`, `Map()`, `replicate()`, `sapply()`, and `tapply()`, which are all GPL (>= 2). ## New Features * Added `future_apply()`, `future_mapply()`, and `future_Map()`. * Added argument `future.chunk.size` as an alternative to argument `future.scheduling` for controlling the average number of elements processed per future ("chunk"). In R 3.5.0, the **parallel** package introduced argument `chunk.size`. * The maximum total size of globals allowed (option `future.globals.maxSize`) per future ("chunk") is now scaled up by the number of elements processed by the future ("chunk") making the protection approximately invariant to the amount of chunking (arguments `future.scheduling` and `future.chunk.size`). ## Bug Fixes * `future_lapply(X, ...)` did not search for globals in `X`. * `future_vapply()` did not return the same dimension names as `vapply()` when `FUN.VALUE` had no names but `FUN(X[[1]])` had. ## Software Quality * Test code coverage is 100%. # Version 0.2.0 [2018-05-01] ## New Features * Added `future_eapply()`, `future_tapply()`, `future_vapply()`, and `future_replicate()`. # Version 0.1.0 [2018-01-15] * Package submitted to CRAN. # Version 0.0.3 [2017-12-06] ## Documentation * Vignette now covers the basics of the package and describes its role in the R package ecosystem together with a road map going forward. ## Software Quality * Added more package tests. Code coverage is currently at 100%. # Version 0.0.2 [2017-12-06] ## Performance * `future_lapply(x, ...)` is now much faster and more memory efficient for large `x` vectors because it uses internal `fold()` function that is more efficient (memory and speed) version of `base::Reduce(f, x)`, especially when `length(x)` is large. # Version 0.0.0-9000 [2017-08-31] ## New Features * Added `future_sapply()`. * Added `future_lapply()` - originally from the **future** package. * Created package. ================================================ FILE: R/000.import.R ================================================ import_from <- function(name, mode = "function", default = NULL, package) { ns <- getNamespace(package) if (exists(name, mode = mode, envir = ns, inherits = FALSE)) { get(name, mode = mode, envir = ns, inherits = FALSE) } else if (!is.null(default)) { default } else { stop(sprintf("No such '%s' %s: %s()", package, mode, name)) } } import_future <- function(name, mode = "function", default = NULL) { import_from(name, mode = mode, default = default, package = "future") } import_base <- function(name, mode = "function", default = NULL) { import_from(name, mode = mode, default = default, package = "base") } ================================================ FILE: R/001.bquote.R ================================================ #' @importFrom utils globalVariables globalVariables(c(".", "..")) bquote_compile <- import_future("bquote_compile") bquote_apply <- import_future("bquote_apply") ================================================ FILE: R/001.import_future_functions.R ================================================ ## To be imported from 'future', if available sQuoteLabel <- NULL .debug <- NULL make_rng_seeds <- import_future("make_rng_seeds") get_random_seed <- import_future("get_random_seed") set_random_seed <- import_future("set_random_seed") next_random_seed <- import_future("next_random_seed") is_valid_random_seed <- import_future("is_valid_random_seed") is_lecyer_cmrg_seed <- import_future("is_valid_random_seed") as_lecyer_cmrg_seed <- import_future("as_lecyer_cmrg_seed") ## Import private functions from 'future' import_future_functions <- function() { .debug <<- import_future(".debug", mode = "environment", default = new.env(parent = emptyenv())) ## future (>= 1.49.0) sQuoteLabel <<- import_future("sQuoteLabel") } ================================================ FILE: R/chunking.R ================================================ `chunkWith[[` <- function(x, subset) { if (getOption("future.apply.chunkWith", "[[") == "[") { return(x[subset]) } ## Make sure to preserve behavior of S3 method-specific ## `[[` subsetting like lapply() and mapply() does it ny <- length(subset) y <- vector("list", length = ny) names(y) <- names(x)[subset] for (kk in seq_len(ny)) { idx <- subset[kk] value <- x[[idx]] if (is.null(value)) { y[kk] <- list(value) } else { y[[kk]] <- value } } y } ================================================ FILE: R/condition-handlers.R ================================================ #' @importFrom future FutureInterruptError onInterrupt <- function(int, fcn_name, debug = FALSE) { if (debug) { mdebug_push("onInterrupt() ...") mdebug(sprintf("Received <%s>", class(int)[1])) on.exit(mdebug_pop()) } when <- Sys.time() host <- Sys.info()[["nodename"]] pid <- Sys.getpid() msg <- sprintf("%s() interrupted at %s, while running on %s (pid %s)", fcn_name, format(when, format = "%FT%T"), sQuote(host), pid) ## By signaling the interrupt as an error, the next handler, which should ## be onError(), will take care of canceling outstanding futures stop(FutureInterruptError(msg)) } #' @importFrom future cancel resolve value onError <- function(ex, futures, debug = FALSE) { if (debug) { mdebug_push("onError() ...") mdebug(sprintf("Received <%s>", class(ex)[1])) on.exit(mdebug_pop()) } ## Canceling all futures msg <- sprintf("Caught %s. Canceling all iterations ...", class(ex)[1]) warning(msg, immediate. = TRUE, call. = FALSE) futures <- cancel(futures) ## Make sure all workers finish before continuing futures <- resolve(futures) ## Collect all results for (f in futures) tryCatch(value(f), error = identity) if (debug) mdebug(sprintf("Signaling: <%s>", class(ex)[1])) stop(ex) } ================================================ FILE: R/fold.R ================================================ #' Efficient Fold, Reduce, Accumulate, Combine of a Vector #' #' @param x A vector. #' #' @param f A binary function, i.e. a function take takes two arguments. #' #' @param left If `TRUE`, vector is combined from the left (the first element), #' otherwise the right (the last element). #' #' @param unname If `TRUE`, function `f` is called as #' \code{f(unname(y), x[[ii]])}, otherwise as \code{f(y, x[[ii]])}, #' which may introduce name `"y"`. #' #' @param threshold An integer (>= 2) specifying the length where the #' recursive divide-and-conquer call will stop and incremental building of #' the partial value is performed. Using `threshold = +Inf` will disable #' recursive folding. #' #' @return A vector. #' #' @details #' In order for recursive folding to give the same results as non-recursive #' folding, binary function `f` must be _associative_ with itself, i.e. #' \code{f(f(x[[1]], x[[2]]), x[[3]])} equals #' \code{f(x[[1]], f(x[[2]]), x[[3]])}. #' #' This function is a more efficient (memory and speed) of #' \code{\link[base:Reduce]{Reduce(f, x, right = !left, accumulate = FALSE)}}, #' especially when `x` is long. #' #' @keywords internal fold <- function(x, f, left = TRUE, unname = TRUE, threshold = 1000L) { f <- match.fun(f) n <- length(x) if (n == 0L) return(NULL) if (!is.vector(x) || is.object(x)) x <- as.list(x) if (n == 1L) return(x[[1]]) stop_if_not(length(left) == 1, is.logical(left), !is.na(left)) stop_if_not(length(threshold) == 1, is.numeric(threshold), !is.na(threshold), threshold >= 2) if (n >= threshold) { ## Divide and conquer, i.e. split, build the two parts, and merge n_mid <- n %/% 2 y_left <- Recall(f = f, x = x[ 1:n_mid], left = left, unname = unname, threshold = threshold) y_right <- Recall(f = f, x = x[(n_mid+1L):n], left = left, unname = unname, threshold = threshold) y <- f(y_left, y_right) y_left <- y_right <- NULL } else { ## Incrementally build result vector if (left) { y <- x[[1L]] if (unname) { for (ii in 2:n) y <- forceAndCall(n = 2L, FUN = f, unname(y), x[[ii]]) } else { for (ii in 2:n) y <- forceAndCall(n = 2L, FUN = f, y, x[[ii]]) } } else { y <- x[[n]] if (unname) { for (ii in (n-1):1) y <- forceAndCall(n = 2L, FUN = f, x[[ii]], unname(y)) } else { for (ii in (n-1):1) y <- forceAndCall(n = 2L, FUN = f, x[[ii]], y) } } } y } ================================================ FILE: R/future.apply-package.R ================================================ #' future.apply: Apply Function to Elements in Parallel using Futures #' #' The \pkg{future.apply} package provides parallel implementations of #' common "apply" functions provided by base \R. The parallel processing #' is performed via the \pkg{future} ecosystem, which provides a large #' number of parallel backends, e.g. on the local machine, a remote cluster, #' and a high-performance compute cluster. #' #' Currently implemented functions are: #' #' * [future_apply()]: a parallel version of [apply()][base::apply] #' * [future_by()]: a parallel version of [by()][base::by] #' * [future_eapply()]: a parallel version of [eapply()][base::lapply] #' * [future_lapply()]: a parallel version of [lapply()][base::lapply] #' * [future_mapply()]: a parallel version of [mapply()][base::mapply] #' * [future_sapply()]: a parallel version of [sapply()][base::sapply] #' * [future_tapply()]: a parallel version of [tapply()][base::tapply] #' * [future_vapply()]: a parallel version of [vapply()][base::vapply] #' * [future_Map()]: a parallel version of [Map()][Map] #' * [future_replicate()]: a parallel version of [replicate()][base::replicate] #' * [future_.mapply()]: a parallel version of [.mapply()][base::.mapply] #' #' Reproducibility is part of the core design, which means that perfect, #' parallel random number generation (RNG) is supported regardless of the #' amount of chunking, type of load balancing, and future backend being used. #' #' Since these `future_*()` functions have the same arguments as the #' corresponding base \R function, start using them is often as simple as #' renaming the function in the code. For example, after attaching the package: #' ```r #' library(future.apply) #' ``` #' code such as: #' ```r #' x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE,FALSE,FALSE,TRUE)) #' y <- lapply(x, quantile, probs = 1:3/4) #' ``` #' can be updated to: #' ```r #' y <- future_lapply(x, quantile, probs = 1:3/4) #' ``` #' #' The default settings in the \pkg{future} framework is to process code #' _sequentially_. To run the above in parallel on the local machine #' (on any operating system), use: #' ```r #' plan(multisession) #' ``` #' first. That's it! #' #' To go back to sequential processing, use `plan(sequential)`. #' If you have access to multiple machines on your local network, use: #' ```r #' plan(cluster, workers = c("n1", "n2", "n2", "n3")) #' ``` #' This will set up four workers, one on `n1` and `n3`, and two on `n2`. #' If you have SSH access to some remote machines, use: #' ```r #' plan(cluster, workers = c("m1.myserver.org", "m2.myserver.org)) #' ``` #' See the \pkg{future} package and [future::plan()] for more examples. #' #' The \pkg{future.batchtools} package provides support for high-performance #' compute (HPC) cluster schedulers such as SGE, Slurm, and TORQUE / PBS. #' For example, #' #' * `plan(batchtools_slurm)`: #' Process via a Slurm scheduler job queue. #' * `plan(batchtools_torque)`: #' Process via a TORQUE / PBS scheduler job queue. #' #' This builds on top of the queuing framework that the \pkg{batchtools} #' package provides. For more details on backend configuration, please see #' the \pkg{future.batchtools} and \pkg{batchtools} packages. #' #' These are just a few examples of parallel/distributed backend for the #' future ecosystem. For more alternatives, see the 'Reverse dependencies' #' section on the #' [future CRAN package page](https://cran.r-project.org/package=future). #' #' @author #' Henrik Bengtsson, except for the implementations of `future_apply()`, #' `future_Map()`, `future_replicate()`, `future_sapply()`, and #' `future_tapply()`, which are adopted from the source code of the #' corresponding base \R functions, which are licensed under GPL (>= 2) #' with 'The R Core Team' as the copyright holder. #' Because of these dependencies, the license of this package is GPL (>= 2). #' #' @keywords manip programming iteration #' #' @aliases future.apply-package #' @name future.apply "_PACKAGE" ================================================ FILE: R/future_Filter.R ================================================ #' @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()][Filter] for details. #' #' @example incl/future_Filter.R #' #' @author #' The implementation 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)] } ================================================ FILE: R/future_Map.R ================================================ #' @inheritParams future_mapply #' #' @param f A function of the arity \eqn{k} if `future_Map()` is called with #' \eqn{k} arguments. #' #' @return #' `future_Map()` is a simple wrapper to `future_mapply()` which does not #' attempt to simplify the result. #' See [base::Map()][Map] for details. #' #' @export #' #' @author #' The implementation of `future_Map()` is adopted from the source code #' of the corresponding base \R function `Map()`, which is licensed under #' GPL (>= 2) with 'The R Core Team' as the copyright holder. #' #' @rdname future_mapply future_Map <- function(f, ..., future.envir = parent.frame(), future.label = "future_Map-%d") { f <- match.fun(f) future_mapply(FUN = f, ..., SIMPLIFY = FALSE, future.envir = future.envir, future.label = future.label) } ================================================ FILE: R/future_apply.R ================================================ #' Apply Functions Over Array Margins via Futures #' #' `future_apply()` implements [base::apply()] using future with perfect #' replication of results, regardless of future backend used. #' It returns a vector or array or list of values obtained by applying a #' function to margins of an array or matrix. #' #' @inheritParams future_lapply #' #' @param X an array, including a matrix. #' #' @param MARGIN A vector giving the subscripts which the function will be #' applied over. For example, for a matrix `1` indicates rows, `2` indicates #' columns, `c(1, 2)` indicates rows and columns. #' Where `X` has named dimnames, it can be a character vector selecting #' dimension names. #' #' @param \ldots (optional) Additional arguments passed to `FUN()`, except #' `future.*` arguments, which are passed on to [future_lapply()] used #' internally. #' #' @param simplify a logical indicating whether results should be simplified #' if possible. #' #' @return #' Returns a vector or array or list of values obtained by applying a #' function to margins of an array or matrix. #' See [base::apply()] for details. #' #' @author #' The implementation of `future_apply()` is adopted from the source code #' of the corresponding base \R function, which is licensed under GPL (>= 2) #' with 'The R Core Team' as the copyright holder. #' #' @example incl/future_apply.R #' #' @importFrom future nbrOfWorkers #' @export future_apply <- function(X, MARGIN, FUN, ..., simplify = TRUE, future.envir = parent.frame(), future.stdout = TRUE, future.conditions = "condition", future.globals = TRUE, future.packages = NULL, future.seed = FALSE, future.scheduling = 1.0, future.chunk.size = NULL, future.label = "future_apply-%d") { debug <- isTRUE(getOption("future.debug")) debug <- isTRUE(getOption("future.apply.debug", debug)) FUN <- match.fun(FUN) simplify <- isTRUE(simplify) ## Ensure that X is an array object dl <- length(dim(X)) if(!dl) stop("dim(X) must have a positive length") if(is.object(X)) X <- if(dl == 2L) as.matrix(X) else as.array(X) ## now record dim as coercion can change it ## (e.g. when a data frame contains a matrix). d <- dim(X) dn <- dimnames(X) ds <- seq_len(dl) ## Extract the margins and associated dimnames if (is.character(MARGIN)) { if(is.null(dnn <- names(dn))) # names(NULL) is NULL stop("'X' must have named dimnames") MARGIN <- match(MARGIN, dnn) if (anyNA(MARGIN)) stop("not all elements of 'MARGIN' are names of dimensions") } s.call <- ds[-MARGIN] s.ans <- ds[MARGIN] d.call <- d[-MARGIN] d.ans <- d[MARGIN] dn.call <- dn[-MARGIN] dn.ans <- dn[MARGIN] ## dimnames(X) <- NULL ## do the calls d2 <- prod(d.ans) if(d2 == 0L) { ## arrays with some 0 extents: return ``empty result'' trying ## to use proper mode and dimension: ## The following is still a bit `hackish': use non-empty X newX <- array(vector(typeof(X), 1L), dim = c(prod(d.call), 1L)) ans <- forceAndCall(1, FUN, if(length(d.call) < 2L) newX[,1] else array(newX[, 1L], d.call, dn.call), ...) return(if(is.null(ans)) ans else if(length(d.ans) < 2L) ans[1L][-1L] else array(ans, d.ans, dn.ans)) } ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Support %globals%, %packages%, %seed%, ... ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - opts <- getOption("future.disposable", NULL) if (length(opts) > 0) { for (name in names(opts)) { var <- sprintf("future.%s", name) assign(var, opts[[name]], envir = environment(), inherits = FALSE) } if (!identical(attr(opts, "dispose"), FALSE)) { options(future.disposable = NULL) } } ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Globals and Packages ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - gp <- getGlobalsAndPackagesXApply( FUN, args = list(X = X, ...), envir = environment(), future.globals = future.globals, future.packages = future.packages, debug = debug ) globals <- gp$globals packages <- gp$packages gp <- NULL ## Check size of global variables? ## Doing it here, on the matrix object, is much faster than doing it for ## the list elements passed to future_lapply() oldMaxSize <- maxSize <- getOption("future.globals.maxSize") if (is.null(maxSize) || is.finite(maxSize)) { if (is.null(maxSize)) maxSize <- 500 * 1024^2 objectSize <- import_future("objectSize") size <- objectSize(X) nWorkers <- nbrOfWorkers() chunk_size <- size / nWorkers other_size <- attr(globals, "total_size") ## Calculate size of the 'globals', if not already done if (is.na(other_size)) other_size <- objectSize(X) if (is.numeric(other_size)) chunk_size <- chunk_size + other_size if (chunk_size > maxSize) { asIEC <- import_future("asIEC") msg <- sprintf("The total size of %s (of class %s and type %s) is %s and the total size of the other argument is %s. With %d workers, this translates to %s per worker needed for future_apply(), which exceeds the maximum allowed size of %s (option 'future.globals.maxSize').", sQuote("X"), sQuote(class(X)[1]), sQuote(typeof(X)), asIEC(size), asIEC(other_size), nWorkers, asIEC(chunk_size), asIEC(maxSize)) if (debug) mdebug(msg) stop(msg) } on.exit(options(future.globals.maxSize = oldMaxSize), add = TRUE) options(future.globals.maxSize = +Inf) } newX <- aperm(X, c(s.call, s.ans)) dim(newX) <- c(prod(d.call), d2) if(length(d.call) < 2L) {# vector if (length(dn.call)) dimnames(newX) <- c(dn.call, list(NULL)) newX <- lapply(1L:d2, FUN = function(i) newX[,i]) } else newX <- lapply(1L:d2, FUN = function(i) array(newX[,i], dim = d.call, dimnames = dn.call)) globals$...future.FUN <- NULL ans <- future_lapply( X = newX, FUN = FUN, ..., future.envir = future.envir, future.stdout = future.stdout, future.conditions = future.conditions, future.seed = future.seed, future.scheduling = future.scheduling, future.chunk.size = future.chunk.size, future.globals = globals, future.packages = packages, future.label = future.label ) ## answer dims and dimnames ans.list <- !simplify || is.recursive(ans[[1L]]) l.ans <- length(ans[[1L]]) ans.names <- names(ans[[1L]]) if(!ans.list) ans.list <- any(lengths(ans) != l.ans) if(!ans.list && length(ans.names)) { all.same <- vapply(ans, function(x) identical(names(x), ans.names), NA) if (!all(all.same)) ans.names <- NULL } len.a <- if(ans.list) d2 else length(ans <- unlist(ans, recursive = FALSE)) if(length(MARGIN) == 1L && len.a == d2) { names(ans) <- if(length(dn.ans[[1L]])) dn.ans[[1L]] # else NULL ans } else if(len.a == d2) array(ans, d.ans, dn.ans) else if(len.a && len.a %% d2 == 0L) { if(is.null(dn.ans)) dn.ans <- vector(mode="list", length(d.ans)) dn1 <- list(ans.names) if(length(dn.call) && !is.null(n1 <- names(dn <- dn.call[1])) && nzchar(n1) && length(ans.names) == length(dn[[1]])) names(dn1) <- n1 dn.ans <- c(dn1, dn.ans) array(ans, c(len.a %/% d2, d.ans), if(!is.null(names(dn.ans)) || !all(vapply(dn.ans, is.null, NA))) dn.ans) } else ans } ================================================ FILE: R/future_by.R ================================================ #' Apply a Function to a Data Frame Split by Factors via Futures #' #' @inheritParams future_lapply #' #' @param data An \R object, normally a data frame, possibly a matrix. #' #' @param INDICES A factor or a list of factors, each of length `nrow(data)`. #' #' @param FUN a function to be applied to (usually data-frame) subsets of `data`. #' #' @param \ldots Additional arguments pass to [future_lapply()] and #' then to `FUN()`. #' #' @param simplify logical: see [base::tapply()]. #' #' @return #' An object of class "by", giving the results for each subset. #' This is always a list if simplify is false, otherwise a list #' or array (see [base::tapply()]). #' See also [base::by()] for details. #' #' @example incl/future_by.R #' #' @details #' Internally, `data` is grouped by `INDICES` into a list of `data` #' subset elements which is then processed by [future_lapply()]. #' When the groups differ significantly in size, the processing time #' may differ significantly between the groups. #' To correct for processing-time imbalances, adjust the amount of chunking #' via arguments `future.scheduling` and `future.chunk.size`. #' #' @section Note on 'stringsAsFactors': #' The `future_by()` is modeled as closely as possible to the #' behavior of `base::by()`. Both functions have "default" S3 methods that #' calls `data <- as.data.frame(data)` internally. This call may in turn call #' an S3 method for `as.data.frame()` that coerces strings to factors or not #' depending on whether it has a `stringsAsFactors` argument and what its #' default is. #' For example, the S3 method of `as.data.frame()` for lists changed its #' (effective) default from `stringsAsFactors = TRUE` to #' `stringsAsFactors = TRUE` in R 4.0.0. #' #' #' @rdname future_by #' @export future_by <- function(data, INDICES, FUN, ..., simplify = TRUE, future.envir = parent.frame()) { future.envir <- force(future.envir) UseMethod("future_by") } #' @export future_by.default <- function(data, INDICES, FUN, ..., simplify = TRUE, future.envir = parent.frame()) { ndim <- length(dim(data)) .SUBSETTER <- if (ndim == 0L) { function(row) data[row, , drop = TRUE] } else { function(row) data[row, , drop = FALSE] } data <- as.data.frame(data) future_by_internal(data = data, INDICES = INDICES, FUN = FUN, ..., simplify = simplify, .INDICES.NAME = deparse(substitute(INDICES))[1L], .CALL = match.call(), .SUBSETTER = .SUBSETTER, future.envir = future.envir) } #' @export future_by.data.frame <- function(data, INDICES, FUN, ..., simplify = TRUE, future.envir = parent.frame()) { if (inherits(INDICES, "formula")) INDICES <- .formula2varlist(INDICES, data) future_by_internal(data = data, INDICES = INDICES, FUN = FUN, ..., simplify = simplify, .INDICES.NAME = deparse(substitute(INDICES))[1L], .CALL = match.call(), .SUBSETTER = function(row) data[row, , drop = FALSE], future.envir = future.envir) } future_by_internal <- function(data, INDICES, FUN, ..., simplify = TRUE, .SUBSETTER, .CALL, .INDICES.NAME, future.envir = parent.frame(), future.label = "future_by-%d") { fcn_name <- "future_by_internal" debug <- isTRUE(getOption("future.debug")) debug <- isTRUE(getOption("future.apply.debug", debug)) if (debug) { mdebugf_push("%s() ...", fcn_name) on.exit(mdebug_pop()) } FUN <- future_by_match_FUN(FUN) ## to be removed /HB 2022-10-24 stop_if_not(is.function(FUN)) stop_if_not(is.function(.SUBSETTER)) if (!is.list(INDICES)) { INDEX <- vector("list", length = 1L) INDEX[[1L]] <- INDICES names(INDEX) <- .INDICES.NAME INDICES <- INDEX INDEX <- NULL ## Not needed anymore } INDICES <- lapply(INDICES, FUN = as.factor) nI <- length(INDICES) if (!nI) stop("'INDICES' is of length zero") nd <- nrow(data) if (!all(lengths(INDICES) == nd)) { stop("All elements of argument 'INDICES' must have same length as 'data'") } namelist <- lapply(INDICES, FUN = levels) extent <- lengths(namelist, use.names = FALSE) cumextent <- cumprod(extent) if (cumextent[nI] > .Machine$integer.max) stop("total number of levels >= 2^31") storage.mode(cumextent) <- "integer" ngroup <- cumextent[nI] group <- as.integer(INDICES[[1L]]) if (nI > 1L) { for (i in 2L:nI) { group <- group + cumextent[i - 1L] * (as.integer(INDICES[[i]]) - 1L) } } cumextent <- NULL ## Not needed anymore levels(group) <- as.character(seq_len(ngroup)) class(group) <- "factor" ans <- split(seq_len(nd), f = group) names(ans) <- NULL index <- as.logical(lengths(ans) > 0L) group <- NULL ## Not needed anymore grouped_data <- lapply(X = ans[index], FUN = .SUBSETTER) ans <- future_lapply(X = grouped_data, FUN = FUN, ..., future.envir = future.envir, future.label = future.label) grouped_data <- NULL ## Not needed anymore ansmat <- array({ if (simplify && all(lengths(ans) == 1L)) { ans <- unlist(ans, recursive = FALSE, use.names = FALSE) if (!is.null(ans) && is.atomic(ans)) vector(typeof(ans)) else NA } else { vector("list", length = prod(extent)) } }, dim = extent, dimnames = namelist) if (length(ans) > 0L) ansmat[index] <- ans ans <- NULL ## Not needed anymore structure(ansmat, call = .CALL, class = "by" ) } future_by_match_FUN <- function(FUN) { if (is.function(FUN)) return(FUN) .Defunct(msg = "Specifying the function 'FUN' for future_by() as a character string is defunct in future.apply (>= 1.12.0), because base::by() does not support it. Instead, specify it as a function, e.g. FUN = sqrt and FUN = `[[`", package = .packageName) match.fun(FUN) } ================================================ FILE: R/future_eapply.R ================================================ #' @inheritParams future_lapply #' #' @param env An \R environment. #' #' @param all.names If `TRUE`, the function will also be applied to variables #' that start with a period (`.`), otherwise not. #' See [base::eapply()] for details. #' #' @return #' A named (unless `USE.NAMES = FALSE`) list. #' See [base::eapply()] for details. #' #' @rdname future_lapply #' @export future_eapply <- function(env, FUN, ..., all.names = FALSE, USE.NAMES = TRUE, future.envir = parent.frame(), future.label = "future_eapply-%d") { FUN <- match.fun(FUN) names <- ls(envir = env, all.names = all.names, sorted = FALSE) X <- mget(names, envir = env, inherits = FALSE) if (!USE.NAMES) names(X) <- NULL future_lapply(X = X, FUN = FUN, ..., future.envir = future.envir, future.label = future.label) } ================================================ FILE: R/future_kernapply.R ================================================ #' Apply Smoothing Kernel in Parallel #' #' `future_kernapply()` is a futurized version of #' [stats::kernapply()], i.e. it computes, in parallel, the #' convolution between an input sequence and a specific kernel. #' Parallelization takes place over columns when `x` is a matrix, #' including a `ts` matrix. #' #' @inheritParams stats::kernapply #' #' @returns #' See [stats::kernapply()] for details. #' #' @examples #' library(datasets) #' library(stats) #' #' X <- EuStockMarkets[, 1:2] #' k <- kernel("daniell", 50) # a long moving average #' X_smooth <- future_kernapply(X, k = k) #' #' @export future_kernapply <- function(x, ...) { UseMethod("future_kernapply") } #' @rdname future_kernapply #' #' @importFrom stats kernapply #' @export future_kernapply.default <- function(x, k, circular = FALSE, ...) { if (is.vector(x)) return(kernapply(x, k, circular = circular)) else if (is.matrix(x)) return(future_apply(x, MARGIN = 2, FUN = kernapply, k, circular = circular)) else stop("'future_kernapply' is not available for object 'x'") } #' @rdname future_kernapply #' #' @importFrom stats kernapply end frequency ts #' @export future_kernapply.ts <- function(x, k, circular = FALSE, ...) { if (!is.matrix(x)) y <- kernapply(as.vector(x), k, circular = circular) else y <- future_apply(x, MARGIN = 2, FUN = kernapply, k, circular = circular) ts(y, end = end(x), frequency = frequency(x)) } ================================================ FILE: R/future_lapply.R ================================================ #' Apply a Function over a List or Vector via Futures #' #' `future_lapply()` implements [base::lapply()] using futures with perfect #' replication of results, regardless of future backend used. #' Analogously, this is true for all the other `future_nnn()` functions. #' #' @param X A vector-like object to iterate over. #' #' @param FUN A function taking at least one argument. #' #' @param \ldots (optional) Additional arguments passed to `FUN()`. #' For `future_*apply()` functions and `replicate()`, any `future.*` arguments #' part of \ldots are passed on to `future_lapply()` used internally. #' Importantly, if this is called inside another function which also declares #' \ldots arguments, do not forget to explicitly pass such \ldots arguments #' down to the `future_*apply()` function too, which will then pass them on #' to `FUN()`. See below for an example. #' #' @param future.envir An [environment] passed as argument `envir` to #' [future::future()] as-is. #' #' @param future.stdout If `TRUE` (default), then the standard output of the #' underlying futures is captured, and re-outputted as soon as possible. #' If `FALSE`, any output is silenced (by sinking it to the null device #' as it is outputted). #' If `NA` (not recommended), output is _not_ intercepted. #' #' @param future.conditions A character string of conditions classes to be #' captured and relayed. The default is the same as the `condition` #' argument of [future::Future()]. #' To not intercept conditions, use `conditions = character(0L)`. #' Errors are always relayed. #' #' @param future.globals A logical, a character vector, or a named list for #' controlling how globals are handled. For details, see below section. #' #' @param future.packages (optional) a character vector specifying packages #' to be attached in the R environment evaluating the future. #' #' @param future.seed A logical or an integer (of length one or seven), #' or a list of `length(X)` with pre-generated random seeds. #' For details, see below section. #' #' @param future.scheduling Average number of futures ("chunks") per worker. #' If `0.0`, then a single future is used to process all elements #' of `X`. #' If `1.0` or `TRUE`, then one future per worker is used. #' If `2.0`, then each worker will process two futures #' (if there are enough elements in `X`). #' If `Inf` or `FALSE`, then one future per element of #' `X` is used. #' Only used if `future.chunk.size` is `NULL`. #' #' @param future.chunk.size The average number of elements per future ("chunk"). #' If `Inf`, then all elements are processed in a single future. #' If `NULL`, then argument `future.scheduling` is used. #' #' @param future.label If a character string, then each future is assigned #' a label `sprintf(future.label, chunk_idx)`. If TRUE, then the #' same as `future.label = "future_lapply-%d"`. If FALSE, no labels #' are assigned. #' #' @return #' For `future_lapply()`, a list with same length and names as `X`. #' See [base::lapply()] for details. #' #' @section Global variables: #' Argument `future.globals` may be used to control how globals #' should be handled similarly to how the `globals` argument is used with #' `future()`. #' Since all function calls use the same set of globals, this function can do #' any gathering of globals upfront (once), which is more efficient than if #' it would be done for each future independently. #' If `TRUE` (default), then globals are automatically identified and gathered. #' If a character vector of names is specified, then those globals are gathered. #' If a named list, then those globals are used as is. #' In all cases, `FUN` and any \ldots arguments are automatically #' passed as globals to each future created as they are always needed. #' #' @section Reproducible random number generation (RNG): #' Unless `future.seed` is `FALSE` or `NULL`, this function guarantees to #' generate the exact same sequence of random numbers _given the same initial #' seed / RNG state_ - this regardless of type of futures, scheduling #' ("chunking") strategy, and number of workers. #' #' RNG reproducibility is achieved by pregenerating the random seeds for all #' iterations (over `X`) by using parallel RNG streams. In each #' iteration, these seeds are set before calling `FUN(X[[ii]], ...)`. #' _Note, for large `length(X)` this may introduce a large overhead._ #' #' If `future.seed = TRUE`, then \code{\link[base:Random]{.Random.seed}} #' is used if it holds a parallel RNG seed, otherwise one is created #' randomly. #' #' If `future.seed = FALSE`, it is expected that none of the #' `FUN(X[[ii]], ...)` function calls use random number generation. #' If they do, then an informative warning or error is produced depending #' on settings. See [future::future()] for more details. #' Using `future.seed = NULL`, is like `future.seed = FALSE` but without #' the check whether random numbers were generated or not. #' #' As input, `future.seed` may also take a fixed initial seed (integer), #' either as a full parallel RNG seed, or as a seed generating such a #' full parallel seed. This seed will be used to generated `length(X)` #' parallel RNG streams. #' #' In addition to the above, it is possible to specify a pre-generated #' sequence of RNG seeds as a list such that #' `length(future.seed) == length(X)` and where each element is an #' integer seed vector that can be assigned to #' \code{\link[base:Random]{.Random.seed}}. One approach to generate a #' set of valid RNG seeds based on fixed initial seed (here `42L`) is: #' #' ```r #' seeds <- future_lapply(seq_along(X), FUN = function(x) .Random.seed, #' future.chunk.size = Inf, future.seed = 42L) #' ``` #' #' **Note that `as.list(seq_along(X))` is _not_ a valid set of such #' `.Random.seed` values.** #' #' In all cases but `future.seed = FALSE` and `NULL`, the RNG state of the #' calling R processes after this function returns is guaranteed to be #' "forwarded one step" from the RNG state that was before the call and #' in the same way regardless of `future.seed`, `future.scheduling` #' and future strategy used. This is done in order to guarantee that an \R #' script calling `future_lapply()` multiple times should be numerically #' reproducible given the same initial seed. #' #' #' @section Load balancing ("chunking"): #' Whether load balancing ("chunking") should take place or not can be #' controlled by specifying either argument #' `future.scheduling = ` or `future.chunk.size = `. #' #' The value `future.chunk.size` specifies the average number of elements #' processed per future ("chunks"). #' If `+Inf`, then all elements are processed in a single future (one worker). #' If `NULL`, then argument `future.scheduling` is used. #' #' The value `future.scheduling` specifies the average number of futures #' ("chunks") that each worker processes. #' If `0.0`, then a single future is used to process all iterations; #' none of the other workers are not used. #' If `1.0` or `TRUE`, then one future per worker is used. #' If `2.0`, then each worker will process two futures (if there are #' enough iterations). #' If `+Inf` or `FALSE`, then one future per iteration is used. #' The default value is `scheduling = 1.0`. #' #' #' @section Control processing order of elements: #' Attribute `ordering` of `future.chunk.size` or `future.scheduling` can #' be used to control the ordering the elements are iterated over, which #' only affects the processing order and _not_ the order values are returned. #' This attribute can take the following values: #' * index vector - a numeric vector of length `length(X)` #' * function - a function taking one argument which is called as #' `ordering(length(X))` and which must return an #' index vector of length `length(X)`, e.g. #' `function(n) rev(seq_len(n))` for reverse ordering. #' * `"random"` - this will randomize the ordering via random index #' vector `sample.int(length(X))`. #' #' For example, `future.scheduling = structure(TRUE, ordering = "random")`. #' _Note_, when elements are processed out of order, then captured standard #' output and conditions are relayed in that order as well. #' #' @example incl/future_lapply.R #' #' @keywords manip programming iteration #' #' @importFrom globals findGlobals #' @export future_lapply <- local({ tmpl_expr <- bquote_compile({ "# future.apply::future_lapply(): process chunk of elements" lapply(seq_along(...future.elements_ii), FUN = function(jj) { ...future.X_jj <- ...future.elements_ii[[jj]] .(expr_FUN) }) }) tmpl_expr_with_rng <- bquote_compile({ "# future.apply::future_lapply(): process chunk of elements while setting random seeds" lapply(seq_along(...future.elements_ii), FUN = function(jj) { ...future.X_jj <- ...future.elements_ii[[jj]] assign(".Random.seed", ...future.seeds_ii[[jj]], envir = globalenv(), inherits = FALSE) .(expr_FUN) }) }) function(X, FUN, ..., future.envir = parent.frame(), future.stdout = TRUE, future.conditions = "condition", future.globals = TRUE, future.packages = NULL, future.seed = FALSE, future.scheduling = 1.0, future.chunk.size = NULL, future.label = "future_lapply-%d") { fcn_name <- "future_lapply" args_name <- "X" ## Coerce to as.list()? if (!is.vector(X) || is.object(X)) X <- as.list(X) ## Nothing to do? nX <- length(X) if (nX == 0L) return(as.list(X)) FUN <- match.fun(FUN) debug <- isTRUE(getOption("future.debug")) debug <- isTRUE(getOption("future.apply.debug", debug)) if (debug) { mdebugf_push("%s() ...", fcn_name) on.exit(mdebug_pop()) } ## NOTE TO SELF: We'd ideally have a 'future.envir' argument also for ## this function, cf. future(). However, it's not yet clear to me how ## to do this, because we need to have globalsOf() to search for globals ## from the current environment in order to identify the globals of ## arguments 'FUN' and '...'. /HB 2017-03-10 envir <- environment() ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Future expression ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ...future.FUN <- NULL ## To please R CMD check ## Does FUN() rely on '...' being a global? ## If so, make sure to *not* pass '...' to FUN() globals_FUN <- findGlobals(FUN, dotdotdot = "return") if (debug) { mdebugf("Globals in FUN(): [n=%d] %s", length(globals_FUN), commaq(globals_FUN)) } global_dotdotdot <- ("..." %in% globals_FUN) if (global_dotdotdot) { ## Yes; don't pass '...' to FUN() expr_FUN <- quote({ ...future.FUN(...future.X_jj) }) if (debug) mdebugf("=> Will not pass '...' to FUN(): %s", commaq(deparse(expr_FUN))) } else { ## No; okay to pass '...' to FUN() expr_FUN <- quote({ ...future.FUN(...future.X_jj, ...) }) if (debug) mdebugf("=> Will pass '...' to FUN(): %s", commaq(deparse(expr_FUN))) } ## With or without RNG? expr <- bquote_apply( if (is.null(future.seed) || isFALSE(future.seed) || isNA(future.seed)) { tmpl_expr } else { tmpl_expr_with_rng } ) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Process ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - values <- future_xapply( FUN = FUN, nX = nX, chunk_args = X, args = list(...), get_chunk = `chunkWith[[`, expr = expr, envir = envir, future.envir = future.envir, future.globals = future.globals, future.packages = future.packages, future.scheduling = future.scheduling, future.chunk.size = future.chunk.size, future.stdout = future.stdout, future.conditions = future.conditions, future.seed = future.seed, future.label = future.label, fcn_name = fcn_name, args_name = args_name, debug = debug ) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Reduce ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - names(values) <- names(X) values } }) ================================================ FILE: R/future_mapply.R ================================================ #' Apply a Function to Multiple List or Vector Arguments #' #' `future_mapply()` implements [base::mapply()] using futures with perfect #' replication of results, regardless of future backend used. #' Analogously to `mapply()`, `future_mapply()` is a multivariate version of #' `future_sapply()`. #' It applies `FUN` to the first elements of each \ldots argument, #' the second elements, the third elements, and so on. #' Arguments are recycled if necessary. #' #' @inheritParams future_lapply #' #' @param FUN A function to apply, found via [base::match.fun()]. #' #' @param \ldots Arguments to vectorize over, will be recycled to common #' length, or zero if one of them is of length zero. #' #' @param MoreArgs A list of other arguments to `FUN`. #' #' @param SIMPLIFY A logical or character string; attempt to reduce the #' result to a vector, matrix or higher dimensional array; see the simplify #' argument of [base::sapply()]. #' #' @param USE.NAMES A logical; use names if the first \ldots argument has #' names, or if it is a character vector, use that character vector as the #' names. #' #' @param future.globals A logical, a character vector, or a named list for #' controlling how globals are handled. #' For details, see [future_lapply()]. #' #' @param future.seed A logical or an integer (of length one or seven), or #' a list of `max(lengths(list(...)))` with pre-generated random seeds. #' For details, see [future_lapply()]. #' #' @return #' `future_mapply()` returns a list, or for `SIMPLIFY = TRUE`, a vector, #' array or list. See [base::mapply()] for details. #' #' @example incl/future_mapply.R #' #' @keywords manip programming iteration #' #' @export future_mapply <- function(FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES = TRUE, future.envir = parent.frame(), future.stdout = TRUE, future.conditions = "condition", future.globals = TRUE, future.packages = NULL, future.seed = FALSE, future.scheduling = 1.0, future.chunk.size = NULL, future.label = "future_mapply-%d") { fcn_name <- "future_mapply" args_name <- "..." FUN <- match.fun(FUN) dots <- list(...) ## Nothing to do? if (length(dots) == 0L) return(list()) ns <- lengths(dots) ## Nothing to do? ## "max-or-0-if-any" recycling rule was introduced in R (>= 4.2.0) if (any(ns == 0L)) { if (!USE.NAMES) return(list()) values <- list() first <- dots[[1]] names <- names(first) if (length(names) > 0L) { names <- character(0L) } else if (is.null(names) && is.character(first)) { names <- character(0L) } names(values) <- names return(values) } stop_if_not(all(ns > 0L)) ## Recycle? nX <- max(ns) stretch <- which(ns < nX) if (length(stretch) > 0L) { for (kk in stretch) dots[[kk]] <- rep(dots[[kk]], length.out = nX) ns <- lengths(dots) } stop_if_not(all(ns == nX)) stop_if_not(is.null(MoreArgs) || is.list(MoreArgs)) debug <- isTRUE(getOption("future.debug")) debug <- isTRUE(getOption("future.apply.debug", debug)) if (debug) { mdebugf_push("%s() ...", fcn_name) on.exit(mdebug_pop()) } ## NOTE TO SELF: We'd ideally have a 'future.envir' argument also for ## this function, cf. future(). However, it's not yet clear to me how ## to do this, because we need to have globalsOf() to search for globals ## from the current environment in order to identify the globals of ## arguments 'FUN' and '...'. /HB 2017-03-10 envir <- future.envir envir <- environment() ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Support %globals%, %packages%, %seed%, ... ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - opts <- getOption("future.disposable", NULL) if (length(opts) > 0) { for (name in names(opts)) { var <- sprintf("future.%s", name) assign(var, opts[[name]], envir = environment(), inherits = FALSE) } if (!identical(attr(opts, "dispose"), FALSE)) { options(future.disposable = NULL) } } ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Future expression ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ...future.FUN <- NULL ## To please R CMD check ## Set .Random.seed? if (is.null(future.seed) || isFALSE(future.seed) || isNA(future.seed)) { expr <- quote({ args <- c(list(FUN = ...future.FUN), ...future.elements_ii, MoreArgs = list(MoreArgs), SIMPLIFY = FALSE, USE.NAMES = FALSE) do.call(mapply, args = args) }) } else { expr <- quote({ ...future.FUN2 <- function(..., ...future.seeds_ii_jj) { assign(".Random.seed", ...future.seeds_ii_jj, envir = globalenv(), inherits = FALSE) ...future.FUN(...) } args <- c(list(FUN = ...future.FUN2), ...future.elements_ii, list(...future.seeds_ii_jj = ...future.seeds_ii), MoreArgs = list(MoreArgs), SIMPLIFY = FALSE, USE.NAMES = FALSE) do.call(mapply, args = args) }) } ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Process ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - values <- future_xapply( FUN = FUN, nX = nX, chunk_args = dots, MoreArgs = MoreArgs, get_chunk = function(X, chunk) lapply(X, FUN = `chunkWith[[`, chunk), expr = expr, envir = envir, future.envir = future.envir, future.globals = future.globals, future.packages = future.packages, future.scheduling = future.scheduling, future.chunk.size = future.chunk.size, future.stdout = future.stdout, future.conditions = future.conditions, future.seed = future.seed, future.label = future.label, fcn_name = fcn_name, args_name = args_name, debug = debug ) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Reduce ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - if (USE.NAMES && length(dots) > 0L) { if (is.null(names1 <- names(dots[[1L]])) && is.character(dots[[1L]])) { names(values) <- dots[[1L]] } else if (!is.null(names1)) { names(values) <- names1 } } if (!isFALSE(SIMPLIFY) && length(values) > 0L) { values <- simplify2array(values, higher = (SIMPLIFY == "array")) } values } #' @param dots A list of arguments to vectorize over (vectors or lists of #' strictly positive length, or all of zero length). #' #' @return #' `future_.mapply()` returns a list. See [base::.mapply()] for details. #' #' @details #' Note that [base::.mapply()], which `future_.mapply()` is modeled after #' is listed as an "internal" function in \R despite being exported. #' #' @rdname future_mapply #' @export future_.mapply <- function(FUN, dots, MoreArgs, ..., future.label = "future_.mapply-%d") { args <- c( list(FUN = FUN), dots, list( MoreArgs = MoreArgs, SIMPLIFY = FALSE, USE.NAMES = FALSE, ..., future.label = future.label ) ) do.call(future_mapply, args = args, envir = parent.frame()) } ================================================ FILE: R/future_replicate.R ================================================ #' @inheritParams future_lapply #' #' @param n The number of replicates. #' #' @param expr An \R expression to evaluate repeatedly. #' #' @return #' `future_replicate()` is a wrapper around `future_sapply()` and return #' simplified object according to the `simplify` argument. #' See [base::replicate()] for details. #' Since `future_replicate()` usually involves random number generation (RNG), #' it uses `future.seed = TRUE` by default in order produce sound random #' numbers regardless of future backend and number of background workers used. #' #' @export #' #' @rdname future_lapply future_replicate <- function(n, expr, simplify = "array", future.seed = TRUE, ..., future.envir = parent.frame(), future.label = "future_replicate-%d") future_sapply(X = integer(n), FUN = eval.parent(substitute(function(...)expr)), simplify = simplify, future.seed = future.seed, ..., future.envir = future.envir, future.label = future.label) ================================================ FILE: R/future_sapply.R ================================================ #' @inheritParams future_lapply #' #' @param simplify See [base::sapply()] and [base::tapply()], respectively. #' #' @param USE.NAMES See [base::sapply()]. #' #' @return #' For `future_sapply()`, a vector with same length and names as \code{X}. #' See [base::sapply()] for details. #' #' @export #' #' @author #' The implementations of `future_replicate()`, `future_sapply()`, and #' `future_tapply()` are adopted from the source code of the corresponding #' base \R functions, which are licensed under GPL (>= 2) with #' 'The R Core Team' as the copyright holder. #' #' @rdname future_lapply future_sapply <- function(X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE, future.envir = parent.frame(), future.label = "future_sapply-%d") { FUN <- match.fun(FUN) answer <- future_lapply(X = X, FUN = FUN, ..., future.envir = future.envir, future.label = future.label) if (USE.NAMES && is.character(X) && is.null(names(answer))) names(answer) <- X if (!isFALSE(simplify) && length(answer)) simplify2array(answer, higher = (simplify == "array")) else answer } ================================================ FILE: R/future_tapply.R ================================================ #' @inheritParams future_lapply #' #' @param X An \R object for which a \code{\link[base]{split}} method #' exists. Typically vector-like, allowing subsetting with #' \code{\link[base]{[}}, or a data frame. #' #' @param INDEX A list of one or more factors, each of same length as `X`. #' The elements are coerced to \code{\link[base]{factor}}s by #' \code{\link[base:as.factor]{as.factor()}}. Can also be a formula, which #' is useful if `X` is a data frame; see the `f` argument in #' \code{\link[base:split]{split()}} for interpretation. #' #' @param default See [base::tapply()]. #' #' @return #' `future_tapply()` returns an array with mode `"list"`, unless #' `simplify = TRUE` (default) _and_ `FUN` returns a scalar, in which #' case the mode of the array is the same as the returned scalars. #' See [base::tapply()] for details. #' #' @rdname future_lapply #' @export future_tapply <- function(X, INDEX, FUN = NULL, ..., default = NA, simplify = TRUE, future.envir = parent.frame(), future.label = "future_tapply-%d") { FUN <- if (!is.null(FUN)) match.fun(FUN) if (inherits(INDEX, "formula")) { if (!is.data.frame(X)) stop("'X' must be a data frame when 'INDEX' is a formula") INDEX <- .formula2varlist(INDEX, X) } if (!is.list(INDEX)) INDEX <- list(INDEX) INDEX <- lapply(INDEX, FUN = as.factor) nI <- length(INDEX) if (!nI) stop("'INDEX' is of length zero") if (!is.object(X) && !all(lengths(INDEX) == length(X))) stop("arguments must have same length") namelist <- lapply(INDEX, FUN = levels) extent <- lengths(namelist, use.names = FALSE) cumextent <- cumprod(extent) if (cumextent[nI] > .Machine$integer.max) stop("total number of levels >= 2^31") storage.mode(cumextent) <- "integer" ngroup <- cumextent[nI] group <- as.integer(INDEX[[1L]]) if (nI > 1L) { for (i in 2L:nI) { group <- group + cumextent[i - 1L] * (as.integer(INDEX[[i]]) - 1L) } } if (is.null(FUN)) return(group) levels(group) <- as.character(seq_len(ngroup)) class(group) <- "factor" ans <- split(X, f = group) names(ans) <- NULL index <- as.logical(lengths(ans)) ans <- future_lapply(X = ans[index], FUN = FUN, ..., future.envir = future.envir, future.label = future.label) ansmat <- array({ if (simplify && all(lengths(ans) == 1L)) { ans <- unlist(ans, recursive = FALSE, use.names = FALSE) if (!is.null(ans) && is.na(default) && is.atomic(ans)) vector(typeof(ans)) else default } else { vector("list", prod(extent)) } }, dim = extent, dimnames = namelist) if (length(ans) > 0L) ansmat[index] <- ans ansmat } .formula2varlist <- import_base(".formula2varlist", default = local({ if (!exists("errorCondition", mode = "function", envir = baseenv(), inherits = FALSE)) { errorCondition <- function(message, ..., class = NULL, call = NULL) { structure( list(message = as.character(message), call = call, ...), class = c(class, "error", "condition") ) } } function(...) { stop(errorCondition("future_tapply(X, INDEX, ...), where 'INDEX' is a formula, requires R (>= 4.3.0"), class = "NotSupportedByThisRVersionError") } })) ================================================ FILE: R/future_vapply.R ================================================ #' @inheritParams future_lapply #' #' @param FUN.VALUE A template for the required return value from #' each `FUN(X[ii], ...)`. #' Types may be promoted to a higher type within the ordering #' logical < integer < double < complex, but not demoted. #' See [base::vapply()] for details. #' #' @return #' For `future_vapply()`, a vector with same length and names as \code{X}. #' See [base::vapply()] for details. #' #' @export #' #' @rdname future_lapply future_vapply <- function(X, FUN, FUN.VALUE, ..., USE.NAMES = TRUE, future.envir = parent.frame(), future.label = "future_vapply-%d") { ## Coerce to as.list()? if (!is.vector(X) || is.object(X)) X <- as.list(X) n <- length(X) FUN <- match.fun(FUN) stop_if_not(is.function(FUN)) stop_if_not(is.vector(FUN.VALUE) || is.array(FUN.VALUE)) type <- typeof(FUN.VALUE) times <- length(FUN.VALUE) dim <- dim(FUN.VALUE) stop_if_not(is.logical(USE.NAMES), length(USE.NAMES) == 1L, !is.na(USE.NAMES)) valid_types <- switch( type, logical = "logical", integer = c("logical", "integer"), double = c("logical", "integer", "double"), complex = c("logical", "integer", "double", "complex"), type ) x_FUN <- FUN res <- future_lapply(X, FUN = function(x, ...) { value <- x_FUN(x, ...) if (length(value) != times) { stopf("values must be length %d, but FUN(X[[ii]]) result is length %d", times, length(value)) } stop_if_not(all(dim(value) == dim), typeof(value) %in% valid_types) value }, ..., future.envir = future.envir, future.label = future.label) if (!is.null(dim)) { dim_res <- c(dim, n) } else if (times != 1L) { dim_res <- c(times, n) } else { dim_res <- NULL } if (USE.NAMES && length(res) > 0L) { if (is.null(dim)) { names_FUN.VALUE <- names(FUN.VALUE) if (is.null(names_FUN.VALUE)) names_FUN.VALUE <- names(res[[1]]) } else { names_FUN.VALUE <- dimnames(FUN.VALUE) if (is.null(names_FUN.VALUE)) names_FUN.VALUE <- dimnames(res[[1]]) } } res <- unlist(res, use.names = FALSE) if (is.null(res)) res <- vector(mode = type, length = 0L) if (!is.null(dim_res)) dim(res) <- dim_res if (USE.NAMES) { if (is.array(res)) { n_dim <- length(dim(res)) dimnames <- vector("list", length = n_dim) if (is.null(dim)) { names <- names(X) if (!is.null(names)) dimnames[[2]] <- names names <- names_FUN.VALUE if (!is.null(names)) dimnames[[1]] <- names } else { names <- names(X) if (!is.null(names)) dimnames[[n_dim]] <- names names <- names_FUN.VALUE if (!is.null(names)) dimnames[-n_dim] <- names } if (!all(unlist(lapply(dimnames, FUN = is.null), use.names = FALSE))) { dimnames(res) <- dimnames } } else { names(res) <- names(X) } } res } ================================================ FILE: R/future_xapply.R ================================================ #' @importFrom future cancel Future nbrOfWorkers future resolve value as.FutureGlobals getGlobalsAndPackages future_xapply <- local({ tmpl_expr_options <- bquote_compile({ "# future.apply:::future_xapply(): preserve future option" ...future.globals.maxSize.org <- getOption("future.globals.maxSize") if (!identical(...future.globals.maxSize.org, ...future.globals.maxSize)) { oopts <- options(future.globals.maxSize = ...future.globals.maxSize) on.exit(options(oopts), add = TRUE) } .(expr) }) function(FUN, nX, chunk_args, args = NULL, MoreArgs = NULL, expr, envir = parent.frame(), future.envir, future.globals, future.packages, future.scheduling, future.chunk.size, future.stdout, future.conditions, future.seed, future.label, get_chunk, fcn_name = "future_xapply", args_name, ..., debug) { if (debug) { mdebugf_push("%s() -> future_xapply() ...", fcn_name) on.exit(mdebug_pop()) } stop_if_not(is.function(FUN)) stop_if_not(is.logical(future.stdout), length(future.stdout) == 1L) stop_if_not(length(future.scheduling) == 1L, !is.na(future.scheduling), is.numeric(future.scheduling) || is.logical(future.scheduling)) stop_if_not(length(future.label) == 1L, !is.na(future.label), is.logical(future.label) || is.character(future.label)) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Support %globals%, %packages%, %seed%, ... ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - opts <- getOption("future.disposable", NULL) if (length(opts) > 0) { for (name in names(opts)) { var <- sprintf("future.%s", name) assign(var, opts[[name]], envir = environment(), inherits = FALSE) } if (!identical(attr(opts, "dispose"), FALSE)) { options(future.disposable = NULL) } } ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Reproducible RNG (for sequential and parallel processing) ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - seeds <- make_rng_seeds(nX, seed = future.seed) ## Future expression (with or without setting the RNG state) and ## pass possibly tweaked 'future.seed' to future() if (is.null(seeds)) { stop_if_not(is.null(future.seed) || isFALSE(future.seed)) } else { ## If RNG seeds are used (given or generated), make sure to reset ## the RNG state afterward oseed <- next_random_seed() if (debug) mdebugf("Will set RNG state on exit: %s", hpaste(oseed)) on.exit(set_random_seed(oseed)) ## As seed=FALSE but without the RNG check future.seed <- NULL } ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Load balancing ("chunking") ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - chunks <- makeChunks(nX, nbrOfWorkers = nbrOfWorkers(), future.scheduling = future.scheduling, future.chunk.size = future.chunk.size) if (debug) mdebugf("Number of chunks: %d", length(chunks)) ## Process elements in a custom order? ordering <- attr(chunks, "ordering") if (!is.null(ordering)) { if (debug) mdebugf("Index remapping (attribute 'ordering'): [n = %d] %s", length(ordering), hpaste(ordering)) chunks <- lapply(chunks, FUN = function(idxs) .subset(ordering, idxs)) } ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Globals and Packages ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - gp <- getGlobalsAndPackagesXApply(FUN = FUN, args = args, MoreArgs = MoreArgs, envir = envir, future.globals = future.globals, future.packages = future.packages, debug = debug) packages <- gp$packages globals <- gp$globals scanForGlobals <- gp$scanForGlobals gp <- NULL ## Add argument placeholders globals_extra <- as.FutureGlobals(list( ...future.elements_ii = NULL, ...future.seeds_ii = NULL, ...future.globals.maxSize = NULL )) attr(globals_extra, "resolved") <- TRUE attr(globals_extra, "total_size") <- 0 globals <- c(globals, globals_extra) ## At this point a globals should be resolved and we should know their total size ## stop_if_not(attr(globals, "resolved"), !is.na(attr(globals, "total_size"))) if (debug) { mdebugf("Globals pass to each chunk: [n=%d] %s", length(globals), commaq(names(globals))) mstr(globals) } ## To please R CMD check ...future.FUN <- ...future.elements_ii <- ...future.seeds_ii <- ...future.globals.maxSize <- NULL globals.maxSize <- getOption("future.globals.maxSize") globals.maxSize.default <- globals.maxSize if (is.null(globals.maxSize.default)) globals.maxSize.default <- 500 * 1024^2 nchunks <- length(chunks) if (debug) mdebugf("Number of futures (= number of chunks): %d", nchunks) ## Drop captured standard output and conditions as soon as they have ## been relayed? if (isTRUE(future.stdout)) { future.stdout <- structure(future.stdout, drop = TRUE) } if (length(future.conditions) > 0) { future.conditions <- structure(future.conditions, drop = TRUE) } ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - ## Futures ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - expr <- bquote_apply(tmpl_expr_options) ## Create labels? if (isTRUE(future.label)) { future.label <- sprintf("%s-%%d", fcn_name) } if (is.character(future.label)) { labels <- sprintf(future.label, seq_len(nchunks)) stopifnot(length(labels) == nchunks) } else { labels <- NULL } if (debug) mdebugf("Launching %d futures (chunks) ...", nchunks) fs <- vector("list", length = nchunks) values <- tryCatch({ for (ii in seq_along(chunks)) { chunk <- chunks[[ii]] if (debug) mdebugf("Chunk #%d of %d ...", ii, length(chunks)) args_ii <- get_chunk(chunk_args, chunk) globals_ii <- globals ## Subsetting outside future is more efficient globals_ii[["...future.elements_ii"]] <- args_ii packages_ii <- packages if (scanForGlobals) { if (debug) mdebugf(" - Finding globals in '%s' for chunk #%d ...", args_name, ii) gp <- getGlobalsAndPackages(args_ii, envir = envir, globals = TRUE) globals_args <- gp$globals packages_args <- gp$packages gp <- NULL if (debug) { mdebugf(" + additional globals found: [n=%d] %s", length(globals_args), commaq(names(globals_args))) mdebugf(" + additional namespaces needed: [n=%d] %s", length(packages_args), commaq(packages_args)) } ## Export also globals found in arguments? if (length(globals_args) > 0L) { reserved <- intersect(c("...future.FUN", "...future.elements_ii", "...future.seeds_ii"), names(globals_args)) if (length(reserved) > 0) { stop("Detected globals in '%s' using reserved variables names: ", args_name, commaq(reserved)) } globals_args <- as.FutureGlobals(globals_args) globals_ii <- unique(c(globals_ii, globals_args)) ## Packages needed due to globals in arguments? if (length(packages_args) > 0L) packages_ii <- unique(c(packages_ii, packages_args)) } if (debug) mdebugf(" - Finding globals in '%s' for chunk #%d ... DONE", args_name, ii) } args_ii <- NULL ## stop_if_not(attr(globals_ii, "resolved")) if (!is.null(globals.maxSize)) { globals_ii["...future.globals.maxSize"] <- list(globals.maxSize) } ## Adjust option 'future.globals.maxSize' to account for the fact that more ## than one element is processed per future. The adjustment is done by ## scaling up the limit by the number of elements in the chunk. This is ## a "good enough" approach. ## (https://github.com/futureverse/future.apply/issues/8). if (length(chunks) > 1L) { options(future.globals.maxSize = length(chunks) * globals.maxSize.default) if (debug) mdebugf(" - Adjusted option 'future.globals.maxSize': %.0f -> %d * %.0f = %.0f (bytes)", globals.maxSize.default, length(chunks), globals.maxSize.default, getOption("future.globals.maxSize")) on.exit(options(future.globals.maxSize = globals.maxSize), add = TRUE) } ## Using RNG seeds or not? if (is.null(seeds)) { if (debug) mdebug(" - seeds: ") } else { if (debug) mdebugf(" - seeds: [%d] ", length(chunk)) globals_ii[["...future.seeds_ii"]] <- seeds[chunk] } if (debug) { mdebugf(" - All globals exported: [n=%d] %s", length(globals_ii), commaq(names(globals_ii))) } ## FIXME: Handle interrupts also here, i.e. as soon as we have ## launched the first future, we should be able to interrupt it fs[[ii]] <- future( expr, substitute = FALSE, envir = future.envir, stdout = future.stdout, conditions = future.conditions, globals = globals_ii, packages = packages_ii, seed = future.seed, label = labels[ii] ) if (debug) { mdebug("Created future:") mprint(fs[[ii]]) } ## Not needed anymore rm(list = c("chunk", "globals_ii")) if (debug) mdebugf("Chunk #%d of %d ... DONE", ii, nchunks) } ## for (ii ...) if (debug) mdebugf("Launching %d futures (chunks) ... DONE", nchunks) ## 4. Resolving futures if (debug) mdebugf("Resolving %d futures (chunks) ...", nchunks) ## Check for RngFutureCondition:s when resolving futures? if (isFALSE(future.seed)) { withCallingHandlers({ values <- local({ oopts <- options(future.rng.onMisuse.keepFuture = FALSE) on.exit(options(oopts)) value(fs) }) }, RngFutureCondition = function(cond) { ## One of "our" futures? idx <- NULL ## Compare future UUIDs or whole futures? uuid <- attr(cond, "uuid") if (!is.null(uuid)) { ## (a) Future UUIDs are available for (kk in seq_along(fs)) { if (identical(fs[[kk]]$uuid, uuid)) idx <- kk } } else { ## (b) Future UUIDs are not available, use Future object? f <- attr(cond, "future") if (is.null(f)) return() ## Nothing to do? if (!isFALSE(f$seed)) return() ## shouldn't really happen for (kk in seq_along(fs)) { if (identical(fs[[kk]], f)) idx <- kk } } ## Nothing more to do, i.e. not one of our futures? if (is.null(idx)) return() ## Adjust message to give instructions relevant to this package f <- fs[[idx]] label <- sQuoteLabel(f) message <- sprintf("UNRELIABLE VALUE: One of the %s iterations (%s) unexpectedly generated random numbers without declaring so. There is a risk that those random numbers are not statistically sound and the overall results might be invalid. To fix this, specify 'future.seed=TRUE'. This ensures that proper, parallel-safe random numbers are produced via a parallel RNG method. To disable this check, use 'future.seed = NULL', or set option 'future.rng.onMisuse' to \"ignore\".", sQuote(.packageName), label) cond$message <- message if (inherits(cond, "warning")) { warning(cond) invokeRestart("muffleWarning") } else if (inherits(cond, "error")) { stop(cond) } }) ## withCallingHandlers() } else { ## value() exits early if it detects a future with an error. ## In future (>= 1.40.0), non-resolved futures will be automatically ## canceled if there's an error. value(fs) } }, interrupt = function(int) { onInterrupt(int, fcn_name = fcn_name, debug = debug) }, error = function(e) { onError(e, futures = fs, debug = debug) }) ## tryCatch() ## Not needed anymore rm(list = "fs") if (debug) { mdebugf(" - Number of value chunks collected: %d", length(values)) mdebugf("Resolving %d futures (chunks) ... DONE", nchunks) } ## Sanity check stop_if_not(length(values) == nchunks) if (debug) mdebugf("Reducing values from %d chunks ...", nchunks) values2 <- do.call(c, args = values) if (debug) { mdebugf(" - Number of values collected after concatenation: %d", length(values2)) mdebugf(" - Number of values expected: %d", nX) } assert_values2(nX, values, values2, fcn_name = fcn_name, debug = debug) values <- values2 rm(list = "values2") ## Sanity check (this may happen if the future backend is broken) stop_if_not(length(values) == nX) ## Were elements processed in a custom order? if (length(values) > 1L && !is.null(ordering)) { invOrdering <- vector(mode(ordering), length = nX) idx <- 1:nX invOrdering[.subset(ordering, idx)] <- idx rm(list = c("ordering", "idx")) if (debug) mdebugf("Reverse index remapping (attribute 'ordering'): [n = %d] %s", length(invOrdering), hpaste(invOrdering)) values <- .subset(values, invOrdering) rm(list = c("invOrdering")) } if (debug) mdebugf("Reducing values from %d chunks ... DONE", nchunks) values } ## future_xapply() }) ================================================ FILE: R/globals.R ================================================ #' @importFrom globals globalsByName #' @importFrom future as.FutureGlobals getGlobalsAndPackages resolve getGlobalsAndPackagesXApply <- function(FUN, args = NULL, MoreArgs = NULL, envir, future.globals = TRUE, future.packages = NULL, debug = NA) { use_args <- !is.null(args) if (is.na(debug)) { debug <- isTRUE(getOption("future.debug")) debug <- isTRUE(getOption("future.apply.debug", debug)) } if (debug) { mdebug_push("getGlobalsAndPackagesXApply() ...") on.exit(mdebug_pop()) } packages <- NULL globals <- future.globals scanForGlobals <- FALSE if (is.logical(globals)) { if (debug) mdebugf("future.globals: %s", globals) ## Gather all globals? if (globals) { scanForGlobals <- TRUE expr <- do.call(call, args = c(list("FUN"), if (use_args) args else MoreArgs)) } else { expr <- NULL attr(globals, "add") <- c(attr(globals, "add"), c("FUN", if (use_args) "..." else "MoreArgs")) } gp <- getGlobalsAndPackages(expr, envir = envir, globals = globals) globals <- gp$globals packages <- gp$packages gp <- NULL if (debug) { mdebugf("globals found/used: [n=%d] %s", length(globals), commaq(names(globals))) mdebugf("needed namespaces: [n=%d] %s", length(packages), commaq(packages)) } } else if (is.character(globals)) { if (debug) mdebugf("future.globals: %s", commaq(globals)) globals <- unique(c(globals, "FUN", if (use_args) "..." else "MoreArgs")) globals <- globalsByName(globals, envir = envir, mustExist = FALSE) } else if (is.list(globals)) { names <- names(globals) if (debug) mdebugf("future.globals: with names %s", commaq(names(globals))) if (length(globals) > 0 && is.null(names)) { stop("Invalid argument 'future.globals'. All globals must be named") } } else { stop("Invalid argument 'future.globals': ", mode(globals)) } globals <- as.FutureGlobals(globals) stop_if_not(inherits(globals, "FutureGlobals")) names <- names(globals) if (!is.element("FUN", names)) { globals <- c(globals, FUN = FUN) } if (use_args) { if (debug) mdebug("use_args: TRUE") if (!is.element("...", names)) { if (debug) mdebug_push("Getting '...' globals ...") dotdotdot <- globalsByName("...", envir = envir, mustExist = TRUE) dotdotdot <- as.FutureGlobals(dotdotdot) dotdotdot <- resolve(dotdotdot) if (debug) { mdebugf("'...' content: [n=%d] %s", length(dotdotdot[[1]]), commaq(names(dotdotdot[[1]]))) mstr(dotdotdot) } ## Recalculate the total size? maxSize <- getOption("future.globals.maxSize") if (is.null(maxSize) || is.finite(maxSize)) { objectSize <- import_future("objectSize") attr(dotdotdot, "total_size") <- objectSize(dotdotdot) } if (debug) mdebug_pop() globals <- c(globals, dotdotdot) } } else if (!is.element("MoreArgs", names)) { globals <- c(globals, list(MoreArgs = MoreArgs)) } ## Assert there are no reserved variables names among globals reserved <- intersect(c("...future.FUN", "...future.elements_ii", "...future.seeds_ii"), names) if (length(reserved) > 0) { stop("Detected globals using reserved variables names: ", commaq(reserved)) } ## Avoid FUN() clash with mapply(..., FUN) below. names <- names(globals) names[names == "FUN"] <- "...future.FUN" names(globals) <- names if (debug) { mdebugf("Globals to be used in all futures (chunks): [n=%d] %s", length(globals), commaq(names(globals))) mstr(globals) } if (!is.null(future.packages)) { stop_if_not(is.character(future.packages)) future.packages <- unique(future.packages) stop_if_not(!anyNA(future.packages), all(nzchar(future.packages))) packages <- unique(c(packages, future.packages)) } if (debug) { mdebugf("Packages to be attached in all futures: [n=%d] %s", length(packages), commaq(packages)) } list(globals = globals, packages = packages, scanForGlobals = scanForGlobals) } ## findGlobalsStep1() ================================================ FILE: R/makeChunks.R ================================================ #' Create Chunks of Index Vectors #' #' _This is an internal function._ #' #' @param nbrOfElements (integer) Total number of elements to iterate over. #' #' @param nbrOfWorkers (integer) Number of workers available. #' #' @param future.scheduling (numeric) A strictly positive scalar. #' Only used if argument `future.chunk.size` is `NULL`. #' #' @param future.chunk.size (numeric) The maximum number of elements per #' chunk, or `NULL`. If `NULL`, then the chunk sizes are given by the #' `future.scheduling` argument. #' #' @return A list of chunks, where each chunk is an integer vector of #' unique indices \code{[1, nbrOfElements]}. The union of all chunks #' holds `nbrOfElements` elements and equals `1:nbrOfElements`. #' If `nbrOfElements == 0`, then an empty list is returned. #' #' @section Control processing order of elements: #' Attribute `ordering` of `future.chunk.size` or `future.scheduling` can #' be used to control the ordering the elements are iterated over, which #' only affects the processing order _not_ the order values are returned. #' This attribute can take the following values: #' * index vector - a numeric vector of length `nbrOfElements` specifying #' how elements are remapped #' * function - a function taking one argument which is called as #' `ordering(nbrOfElements)` and which must return an #' index vector of length `nbrOfElements`, e.g. #' `function(n) rev(seq_len(n))` for reverse ordering. #' * `"random"` - this will randomize the ordering via random index #' vector `sample.int(nbrOfElements)`. #' #' @importFrom parallel splitIndices #' @keywords internal makeChunks <- function(nbrOfElements, nbrOfWorkers, future.scheduling = 1.0, future.chunk.size = NULL) { stop_if_not(nbrOfElements >= 0L, nbrOfWorkers >= 1L) ## 'future.chunk.size != NULL' takes precedence over 'future.scheduling' if (!is.null(future.chunk.size)) { stop_if_not(length(future.chunk.size) == 1L, !is.na(future.chunk.size), future.chunk.size > 0) ## Same definition as parallel:::staticNChunks() in R (>= 3.5.0) nbrOfChunks <- max(1, ceiling(nbrOfElements / future.chunk.size)) ## Customized ordering? ordering <- attr(future.chunk.size, "ordering", exact = TRUE) } else { if (is.logical(future.scheduling)) { stop_if_not(length(future.scheduling) == 1L, !is.na(future.scheduling)) if (future.scheduling) { nbrOfChunks <- nbrOfWorkers if (nbrOfChunks > nbrOfElements) nbrOfChunks <- nbrOfElements } else { nbrOfChunks <- nbrOfElements } } else { ## Treat 'future.scheduling' as the number of chunks per worker, i.e. ## the number of chunks each worker should process on average. stop_if_not(length(future.scheduling) == 1L, !is.na(future.scheduling), future.scheduling >= 0) if (nbrOfWorkers > nbrOfElements) nbrOfWorkers <- nbrOfElements nbrOfChunks <- future.scheduling * nbrOfWorkers if (nbrOfChunks < 1L) { nbrOfChunks <- 1L } else if (nbrOfChunks > nbrOfElements) { nbrOfChunks <- nbrOfElements } } ## Customized ordering? ordering <- attr(future.scheduling, "ordering", exact = TRUE) } chunks <- splitIndices(nbrOfElements, ncl = nbrOfChunks) ## Customized ordering? if (nbrOfElements > 1L && !is.null(ordering)) { if (is.character(ordering) && ordering == "random") { map <- stealth_sample.int(nbrOfElements) } else if (is.numeric(ordering)) { map <- ordering } else if (is.function(ordering)) { map <- ordering(nbrOfElements) } else { stopf("Unknown value of attribute %s for argument %s: %s", "ordering", if (!is.null(future.chunk.size)) "future.chunk.size" else "future.scheduling", mode(ordering)) } if (!is.null(map)) { ## Simple validity check of "ordering". Looking for NAs, range, ## uniqueness is too expensive so skipped. stop_if_not(length(map) == nbrOfElements) attr(chunks, "ordering") <- map } } chunks } ================================================ FILE: R/options.R ================================================ #' Options used for future.apply #' #' Below are the \R options and environment variables that are used by the #' \pkg{future.apply} package and packages enhancing it.\cr #' \cr #' _WARNING: Note that the names and the default values of these options may #' change in future versions of the package. Please use with care until #' further notice._ #' #' For settings specific to the \pkg{future} package, see #' [future::future.options] page. #' #' @section Options for debugging future.apply: #' \describe{ #' \item{\option{future.apply.debug}:}{(logical) If `TRUE`, extensive debug messages are generated. (Default: `FALSE`)} #' } #' #' #' @section Environment variables that set R options: #' All of the above \R \option{future.apply.*} options can be set by #' corresponding environment variable \env{R_FUTURE_APPLY_*} _when the #' \pkg{future.apply} package is loaded_. #' For example, if `R_FUTURE_APPLY_DEBUG=TRUE`, then option #' \option{future.apply.debug} is set to `TRUE` (logical). #' #' @examples #' \dontrun{ #' options(future.apply.debug = TRUE) #' } #' #' @seealso #' To set \R options or environment variables when \R starts (even before the \pkg{future} package is loaded), see the \link[base]{Startup} help page. The \href{https://cran.r-project.org/package=startup}{\pkg{startup}} package provides a friendly mechanism for configuring \R's startup process. #' #' @aliases #' future.apply.debug #' R_FUTURE_APPLY_DEBUG #' #' @name future.apply.options NULL # Set an R option from an environment variable update_package_option <- function(name, mode = "character", default = NULL, split = NULL, trim = TRUE, disallow = c("NA"), force = FALSE, debug = FALSE) { ## Nothing to do? value <- getOption(name, NULL) if (!force && !is.null(value)) return(getOption(name, default = default)) ## name="future.plan.disallow" => env="R_FUTURE_PLAN_DISALLOW" env <- gsub(".", "_", toupper(name), fixed = TRUE) env <- paste("R_", env, sep = "") env_value <- value <- Sys.getenv(env, unset = NA_character_) ## Nothing to do? if (is.na(value)) { if (debug) mdebugf("Environment variable %s not set", sQuote(env)) return(getOption(name, default = default)) } if (debug) mdebugf("%s=%s", env, sQuote(value)) ## Trim? if (trim) value <- trim(value) ## Nothing to do? if (!nzchar(value)) return(getOption(name, default = default)) ## Split? if (!is.null(split)) { value <- strsplit(value, split = split, fixed = TRUE) value <- unlist(value, use.names = FALSE) if (trim) value <- trim(value) } ## Coerce? mode0 <- storage.mode(value) if (mode0 != mode) { suppressWarnings({ storage.mode(value) <- mode }) if (debug) { mdebugf("Coercing from %s to %s: %s", mode0, mode, commaq(value)) } } if (length(disallow) > 0) { if ("NA" %in% disallow) { if (any(is.na(value))) { stopf("Coercing environment variable %s=%s to %s would result in missing values for option %s: %s", sQuote(env), sQuote(env_value), sQuote(mode), sQuote(name), commaq(value)) } } if (is.numeric(value)) { if ("non-positive" %in% disallow) { if (any(value <= 0, na.rm = TRUE)) { stopf("Environment variable %s=%s specifies a non-positive value for option %s: %s", sQuote(env), sQuote(env_value), sQuote(name), commaq(value)) } } if ("negative" %in% disallow) { if (any(value < 0, na.rm = TRUE)) { stopf("Environment variable %s=%s specifies a negative value for option %s: %s", sQuote(env), sQuote(env_value), sQuote(name), commaq(value)) } } } } if (debug) { mdebugf("=> options(%s = %s) [n=%d, mode=%s]", dQuote(name), commaq(value), length(value), storage.mode(value)) } do.call(options, args = structure(list(value), names = name)) getOption(name, default = default) } ## Set future options based on environment variables update_package_options <- function(debug = FALSE) { update_package_option("future.apply.chunkWith", default = "[[", debug = debug) } ================================================ FILE: R/testme.R ================================================ ## This runs 'testme' test inst/testme/test-.R scripts ## Don't edit - it was autogenerated by inst/testme/deploy.R testme <- function(name) { path <- system.file(package = 'future.apply', 'testme', mustWork = TRUE) Sys.setenv(R_TESTME_PATH = path) Sys.setenv(R_TESTME_PACKAGE = 'future.apply') Sys.setenv(R_TESTME_NAME = name) on.exit(Sys.unsetenv('R_TESTME_NAME')) source(file.path(path, 'run.R')) } ================================================ FILE: R/utils,conditions.R ================================================ stopf <- function(fmt, ..., call. = TRUE, domain = NULL) { #nolint msg <- sprintf(fmt, ...) msg <- .makeMessage(msg, domain = domain) if (is.call(call.)) { call <- call. } else if (isTRUE(call.)) { call <- sys.call(which = -1L) } else { call <- NULL } cond <- simpleError(msg, call = call) stop(cond) } warnf <- function(fmt, ..., call. = TRUE, immediate. = FALSE, domain = NULL) { #nolint msg <- sprintf(fmt, ...) ## Cannot tweak 'call' when immediate. = TRUE if (isTRUE(immediate.)) { warning(msg, call. = call., immediate. = immediate., domain = domain) } else { msg <- .makeMessage(msg, domain = domain) if (is.call(call.)) { call <- call. } else if (isTRUE(call.)) { call <- sys.call(which = -1L) } else { call <- NULL } cond <- simpleWarning(msg, call = call) warning(cond) } } msgf <- function(fmt, ..., appendLF = FALSE, domain = NULL) { #nolint message(sprintf(fmt, ...), appendLF = appendLF, domain = domain) } ================================================ FILE: R/utils-debug.R ================================================ now <- function(x = Sys.time(), format = "[%H:%M:%OS3] ") { ## format(x, format = format) ## slower format(as.POSIXlt(x, tz = ""), format = format) } debug_indent <- local({ symbols <- rep(c("|", ":", ".", "'", ",", ";", "`"), times = 10L) function() { depth <- length(.debug[["stack"]]) if (depth == 0) return("") indent <- getOption("future.debug.indent", " ") paste(paste(symbols[seq_len(depth)], indent, sep = ""), collapse = "") } }) if (!exists(".debug", inherits = FALSE)) .debug <- new.env(parent = emptyenv()) if (!"stack" %in% names(".debug")) .debug$stack <- list() mdebug_push <- function(...) { msg <- mdebug(...) .debug$stack <- c(.debug$stack, msg) invisible(msg) } mdebugf_push <- function(...) { msg <- mdebugf(...) .debug$stack <- c(.debug$stack, msg) invisible(msg) } mdebug_pop <- function(...) { n <- length(.debug$stack) msg <- c(...) if (length(msg) == 0) { msg <- .debug$stack[n] msg <- sprintf("%s done", msg) } .debug$stack <- .debug$stack[-n] if (length(msg) == 0 || !is.na(msg)) mdebug(msg) } mdebugf_pop <- function(...) { n <- length(.debug$stack) msg <- .debug$stack[n] .debug$stack <- .debug$stack[-n] mdebug(sprintf("%s done", msg)) } mdebug <- function(..., prefix = now()) { prefix <- paste(prefix, debug_indent(), sep = "") msg <- paste(..., sep = "") message(sprintf("%s%s", prefix, msg)) invisible(msg) } mdebugf <- function(..., appendLF = TRUE, prefix = now()) { prefix <- paste(prefix, debug_indent(), sep = "") msg <- sprintf(...) message(sprintf("%s%s", prefix, msg), appendLF = appendLF) invisible(msg) } #' @importFrom utils capture.output mprint <- function(..., appendLF = TRUE, prefix = now()) { prefix <- paste(prefix, debug_indent(), sep = "") message(paste(prefix, capture.output(print(...)), sep = "", collapse = "\n"), appendLF = appendLF) } #' @importFrom utils capture.output str mstr <- function(..., appendLF = TRUE, prefix = now()) { prefix <- paste(prefix, debug_indent(), sep = "") message(paste(prefix, capture.output(str(...)), sep = "", collapse = "\n"), appendLF = appendLF) } ================================================ FILE: R/utils.R ================================================ isFALSE <- function(x) { is.logical(x) && length(x) == 1L && !is.na(x) && !x } isNA <- function(x) { is.logical(x) && length(x) == 1L && is.na(x) } stop_if_not <- function(...) { res <- list(...) for (ii in 1L:length(res)) { res_ii <- .subset2(res, ii) if (length(res_ii) != 1L || is.na(res_ii) || !res_ii) { mc <- match.call() call <- deparse(mc[[ii + 1]], width.cutoff = 60L) if (length(call) > 1L) call <- paste(call[1L], "....") stopf("%s is not TRUE", sQuote(call), call. = FALSE, domain = NA) } } NULL } ## From R.utils 2.0.2 (2015-05-23) hpaste <- function(..., sep = "", collapse = ", ", lastCollapse = NULL, maxHead = if (missing(lastCollapse)) 3 else Inf, maxTail = if (is.finite(maxHead)) 1 else Inf, abbreviate = "...") { if (is.null(lastCollapse)) lastCollapse <- collapse # Build vector 'x' x <- paste(..., sep = sep) n <- length(x) # Nothing todo? if (n == 0) return(x) if (is.null(collapse)) return(x) # Abbreviate? if (n > maxHead + maxTail + 1) { head <- x[seq_len(maxHead)] tail <- rev(rev(x)[seq_len(maxTail)]) x <- c(head, abbreviate, tail) n <- length(x) } if (!is.null(collapse) && n > 1) { if (lastCollapse == collapse) { x <- paste(x, collapse = collapse) } else { xT <- paste(x[1:(n-1)], collapse = collapse) x <- paste(xT, x[n], sep = lastCollapse) } } x } # hpaste() trim <- function(s) sub("[\t\n\f\r ]+$", "", sub("^[\t\n\f\r ]+", "", s)) comma <- function(x, sep = ", ") paste(x, collapse = sep) commaq <- function(x, sep = ", ") paste(sQuote(x), collapse = sep) if (getRversion() < "4.0.0") { ## When 'default' is specified, this is 30x faster than ## base::getOption(). The difference is that here we use ## use names(.Options) whereas in 'base' names(options()) ## is used. getOption <- local({ go <- base::getOption function(x, default = NULL) { if (missing(default) || match(x, table = names(.Options), nomatch = 0L) > 0L) go(x) else default } }) } #' @importFrom future FutureError #' @importFrom utils capture.output head str assert_values2 <- function(nX, values, values2, fcn_name, debug = FALSE) { if (length(values2) != nX) { chunk_sizes <- sapply(values, FUN = length) chunk_sizes <- table(chunk_sizes) chunk_summary <- sprintf("%d chunks with %s elements", chunk_sizes, names(chunk_sizes)) chunk_summary <- paste(chunk_summary, collapse = ", ") msg <- sprintf("Unexpected error in %s(): After gathering and merging the values from %d chunks in to a list, the total number of elements (= %d) does not match the number of input elements in 'X' (= %d). There were in total %d chunks and %d elements (%s)", fcn_name, length(values), length(values2), nX, length(values), sum(chunk_sizes), chunk_summary) if (debug) { mdebug(msg) mprint(chunk_sizes) mdebug("Results before merge chunks:") mstr(values) mdebug("Results after merge chunks:") mstr(values2) } msg <- sprintf("%s. Example of the first few values: %s", msg, paste(capture.output(str(head(values2, 3L))), collapse = "\\n")) ex <- FutureError(msg) stop(ex) } } stealth_sample.int <- function(n, size = n, replace = FALSE, ...) { oseed <- .GlobalEnv$.Random.seed on.exit({ if (is.null(oseed)) { rm(list = ".Random.seed", envir = .GlobalEnv, inherits = FALSE) } else { .GlobalEnv$.Random.seed <- oseed } }) sample.int(n = n, size = size, replace = replace, ...) } #' @importFrom utils packageVersion future_version <- local({ ver <- NULL function() { if (is.null(ver)) ver <<- packageVersion("future") ver } }) ================================================ FILE: R/zzz.R ================================================ .package <- new.env() ## covr: skip=all .onLoad <- function(libname, pkgname) { .package[["version"]] <- utils::packageVersion(pkgname) import_future_functions() update_package_option("future.apply.debug", mode = "logical") debug <- getOption("future.apply.debug", FALSE) if (debug) { envs <- Sys.getenv() envs <- envs[grep("R_FUTURE_APPLY_", names(envs), fixed = TRUE)] envs <- sprintf("- %s=%s", names(envs), sQuote(envs)) mdebug(paste(c("R environment variables specific to future.apply:", envs), collapse = "\n")) } ## Set future options based on environment variables update_package_options(debug = debug) } ================================================ FILE: README.md ================================================
CRAN check status R CMD check status Coverage Status
# future.apply: Apply Function to Elements in Parallel using Futures ## Introduction The purpose of this package is to provide worry-free parallel alternatives to base-R "apply" functions, e.g. `apply()`, `lapply()`, and `vapply()`. The goal is that one should be able to replace any of these in the core with its futurized equivalent and things will just work. For example, instead of doing: ```r library(datasets) library(stats) y <- lapply(mtcars, FUN = mean, trim = 0.10) ``` one can do: ```r library(future.apply) plan(multisession) ## Run in parallel on local computer library(datasets) library(stats) y <- future_lapply(mtcars, FUN = mean, trim = 0.10) ``` Reproducibility is part of the core design, which means that perfect, parallel random number generation (RNG) is supported regardless of the amount of chunking, type of load balancing, and future backend being used. To enable parallel RNG, use argument `future.seed = TRUE`. ## Role Where does the **[future.apply]** package fit in the software stack? You can think of it as a sibling to **[foreach]**, **[furrr]**, **[BiocParallel]**, **[plyr]**, etc. Just as **parallel** provides `parLapply()`, **foreach** provides `foreach()`, **BiocParallel** provides `bplapply()`, and **plyr** provides `llply()`, **future.apply** provides `future_lapply()`. Below is a table summarizing this idea:
Package Functions Backends
future.apply

 Future-versions of common goto *apply() functions available in base R (of the base and stats packages):
future_apply(), future_by(), future_eapply(), future_Filter(), future_lapply(), future_kernapply(), future_Map(), future_mapply(), future_.mapply(), future_replicate(), future_sapply(), future_tapply(), and future_vapply().
The following function is not implemented:
future_rapply()
 All future backends
parallel mclapply(), mcmapply(), clusterMap(), parApply(), parLapply(), parSapply(), ... Built-in and conditional on operating system
foreach foreach(), times() All future backends via doFuture
furrr future_imap(), future_map(), future_pmap(), future_map2(), ... All future backends
BiocParallel Bioconductor's parallel mappers:
bpaggregate(), bpiterate(), bplapply(), and bpvec() 		All future backends via doFuture (because it supports foreach) or via BiocParallel.FutureParam (direct BiocParallelParam support; prototype)
plyr **ply(..., .parallel = TRUE) functions:
aaply(), ddply(), dlply(), llply(), ... 		All future backends via doFuture (because it uses foreach internally)
Note that, except for the built-in **parallel** package, none of these higher-level APIs implement their own parallel backends, but they rather enhance existing ones. The **foreach** framework leverages backends such as **[doParallel]**, **[doMC]** and **[doFuture]**, and the **future.apply** framework leverages the **[future]** ecosystem and therefore backends such as built-in **parallel**, **[future.callr]**, and **[future.batchtools]**. By separating `future_lapply()` and friends from the **[future]** package, it helps clarifying the purpose of the **future** package, which is to define and provide the core Future API, which higher-level parallel APIs can build on and for which any futurized parallel backends can be plugged into. The API and identity of the **future.apply** package will be kept close to the `*apply()` functions in base R. In other words, it will _neither_ keep growing nor be expanded with new, more powerful apply-like functions beyond those core ones in base R. Such extended functionality should be part of a separate package. [batchtools]: https://cran.r-project.org/package=batchtools [BiocParallel]: https://bioconductor.org/packages/BiocParallel/ [doFuture]: https://cran.r-project.org/package=doFuture [doMC]: https://cran.r-project.org/package=doMC [doParallel]: https://cran.r-project.org/package=doParallel [foreach]: https://cran.r-project.org/package=foreach [future]: https://cran.r-project.org/package=future [future.apply]: https://cran.r-project.org/package=future.apply [future.batchtools]: https://cran.r-project.org/package=future.batchtools [future.callr]: https://cran.r-project.org/package=future.callr [furrr]: https://cran.r-project.org/package=furrr [plyr]: https://cran.r-project.org/package=plyr ## Installation R package future.apply is available on [CRAN](https://cran.r-project.org/package=future.apply) and can be installed in R as: ```r install.packages("future.apply") ``` ### Pre-release version To install the pre-release version that is available in Git branch `develop` on GitHub, use: ```r remotes::install_github("futureverse/future.apply", ref="develop") ``` This will install the package from source. ## Contributing To contribute to this package, please see [CONTRIBUTING.md](CONTRIBUTING.md). ================================================ FILE: cran-comments.md ================================================ # CRAN submission future.apply 1.11.3 on 2024-10-27 I've verified this submission has no negative impact on any of the 168 reverse package dependencies available on CRAN (n=161) and Bioconductor (n=7). ## Notes not sent to CRAN ### R CMD check validation The package has been verified using `R CMD check --as-cran` on: | R version | GitHub | mac/win-builder | | ------------- | ------ | --------------- | | 3.6.x | L | | | 4.1.x | L | | | 4.2.x | L | | | 4.3.x | L M W | W | | 4.4.x | L M W | M1 W | | devel | L M W | W | *Legend: OS: L = Linux, M = macOS, M1 = macOS M1, W = Windows* It has also be verified using various R-hub v2 checks. ================================================ FILE: incl/OVERVIEW.md ================================================ <% ## Reuse the main vignette md <- R.rsp::rstring(file="vignettes/future.apply-1-overview.md.rsp", postprocess=FALSE) ## Drop the header, i.e. anything before the first "H2" header md <- unlist(strsplit(md, split="\n", fixed=TRUE)) row <- grep("^## ", md)[1] if (!is.na(row)) md <- md[-seq_len(row-1)] ## Drop the footer, i.e. anything after the first horizontal line row <- grep("^---", md)[1] if (!is.na(row)) md <- md[seq_len(row-1)] ## Turn otherwise local links to CRAN for README.md md <- gsub(": (future-.*[.]html)", ": https://cran.r-project.org/web/packages/future.apply/vignettes/\\1", md) ## Output cat(md, sep="\n") %> ================================================ FILE: incl/future_Filter.R ================================================ ## --------------------------------------------------------- ## Filter() ## --------------------------------------------------------- is_even <- function(x) { x %% 2 == 0 } x <- sample.int(100, size = 1000, replace = TRUE) y <- future_Filter(is_even, x) ================================================ FILE: incl/future_apply.R ================================================ ## --------------------------------------------------------- ## apply() ## --------------------------------------------------------- X <- matrix(c(1:4, 1, 6:8), nrow = 2L) Y0 <- apply(X, MARGIN = 1L, FUN = table) Y1 <- future_apply(X, MARGIN = 1L, FUN = table) print(Y1) stopifnot(all.equal(Y1, Y0, check.attributes = FALSE)) ## FIXME Y0 <- apply(X, MARGIN = 1L, FUN = stats::quantile) Y1 <- future_apply(X, MARGIN = 1L, FUN = stats::quantile) print(Y1) stopifnot(all.equal(Y1, Y0)) ## --------------------------------------------------------- ## Parallel Random Number Generation ## --------------------------------------------------------- \donttest{ ## Regardless of the future plan, the number of workers, and ## where they are, the random numbers produced are identical X <- matrix(c(1:4, 1, 6:8), nrow = 2L) plan(multisession) set.seed(0xBEEF) Y1 <- future_apply(X, MARGIN = 1L, FUN = sample, future.seed = TRUE) print(Y1) plan(sequential) set.seed(0xBEEF) Y2 <- future_apply(X, MARGIN = 1L, FUN = sample, future.seed = TRUE) print(Y2) stopifnot(all.equal(Y1, Y2)) } \dontshow{ ## R CMD check: make sure any open connections are closed afterward if (!inherits(plan(), "sequential")) plan(sequential) } ================================================ FILE: incl/future_by.R ================================================ ## --------------------------------------------------------- ## by() ## --------------------------------------------------------- library(datasets) ## warpbreaks library(stats) ## lm() y0 <- by(warpbreaks, warpbreaks[,"tension"], function(x) lm(breaks ~ wool, data = x)) plan(multisession) y1 <- future_by(warpbreaks, warpbreaks[,"tension"], function(x) lm(breaks ~ wool, data = x)) plan(sequential) y2 <- future_by(warpbreaks, warpbreaks[,"tension"], function(x) lm(breaks ~ wool, data = x)) ================================================ FILE: incl/future_lapply.R ================================================ ## --------------------------------------------------------- ## lapply(), sapply(), tapply() ## --------------------------------------------------------- x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE, FALSE, FALSE, TRUE)) y0 <- lapply(x, FUN = quantile, probs = 1:3/4) y1 <- future_lapply(x, FUN = quantile, probs = 1:3/4) print(y1) stopifnot(all.equal(y1, y0)) y0 <- sapply(x, FUN = quantile) y1 <- future_sapply(x, FUN = quantile) print(y1) stopifnot(all.equal(y1, y0)) y0 <- vapply(x, FUN = quantile, FUN.VALUE = double(5L)) y1 <- future_vapply(x, FUN = quantile, FUN.VALUE = double(5L)) print(y1) stopifnot(all.equal(y1, y0)) ## --------------------------------------------------------- ## Parallel Random Number Generation ## --------------------------------------------------------- \donttest{ ## Regardless of the future plan, the number of workers, and ## where they are, the random numbers produced are identical plan(multisession) set.seed(0xBEEF) y1 <- future_lapply(1:5, FUN = rnorm, future.seed = TRUE) str(y1) plan(sequential) set.seed(0xBEEF) y2 <- future_lapply(1:5, FUN = rnorm, future.seed = TRUE) str(y2) stopifnot(all.equal(y1, y2)) } ## --------------------------------------------------------- ## Process chunks of data.frame rows in parallel ## --------------------------------------------------------- iris <- datasets::iris chunks <- split(iris, seq(1, nrow(iris), length.out = 3L)) y0 <- lapply(chunks, FUN = function(iris) sum(iris$Sepal.Length)) y0 <- do.call(sum, y0) y1 <- future_lapply(chunks, FUN = function(iris) sum(iris$Sepal.Length)) y1 <- do.call(sum, y1) print(y1) stopifnot(all.equal(y1, y0)) ## --------------------------------------------------------- ## Remember to pass down '...' arguments ## --------------------------------------------------------- ## It is important that we don't use '...' as a global variable, ## as attempted in the following not_okay_fcn() bad_fcn <- function(X, ...) { y <- future_lapply(X, FUN = function(x) { mean(x, ...) ## here '...' is a global variable }) y } ## Instead, make sure to pass '...' via arguments all the way through good_fcn <- function(X, ...) { ## outer '...' y <- future_lapply(X, FUN = function(x, ...) { mean(x, ...) ## here '...' is an argument of FUN() }, ...) ## pass outer '...' to FUN() y } \dontshow{ ## R CMD check: make sure any open connections are closed afterward if (!inherits(plan(), "sequential")) plan(sequential) } ================================================ FILE: incl/future_mapply.R ================================================ ## --------------------------------------------------------- ## mapply() ## --------------------------------------------------------- y0 <- mapply(rep, 1:4, 4:1) y1 <- future_mapply(rep, 1:4, 4:1) stopifnot(identical(y1, y0)) y0 <- mapply(rep, times = 1:4, x = 4:1) y1 <- future_mapply(rep, times = 1:4, x = 4:1) stopifnot(identical(y1, y0)) y0 <- mapply(rep, times = 1:4, MoreArgs = list(x = 42)) y1 <- future_mapply(rep, times = 1:4, MoreArgs = list(x = 42)) stopifnot(identical(y1, y0)) y0 <- mapply(function(x, y) seq_len(x) + y, c(a = 1, b = 2, c = 3), # names from first c(A = 10, B = 0, C = -10)) y1 <- future_mapply(function(x, y) seq_len(x) + y, c(a = 1, b = 2, c = 3), # names from first c(A = 10, B = 0, C = -10)) stopifnot(identical(y1, y0)) word <- function(C, k) paste(rep.int(C, k), collapse = "") y0 <- mapply(word, LETTERS[1:6], 6:1, SIMPLIFY = FALSE) y1 <- future_mapply(word, LETTERS[1:6], 6:1, SIMPLIFY = FALSE) stopifnot(identical(y1, y0)) ## --------------------------------------------------------- ## Parallel Random Number Generation ## --------------------------------------------------------- \donttest{ ## Regardless of the future plan, the number of workers, and ## where they are, the random numbers produced are identical plan(multisession) set.seed(0xBEEF) y1 <- future_mapply(stats::runif, n = 1:4, max = 2:5, MoreArgs = list(min = 1), future.seed = TRUE) print(y1) plan(sequential) set.seed(0xBEEF) y2 <- future_mapply(stats::runif, n = 1:4, max = 2:5, MoreArgs = list(min = 1), future.seed = TRUE) print(y2) stopifnot(all.equal(y1, y2)) } \dontshow{ ## R CMD check: make sure any open connections are closed afterward if (!inherits(plan(), "sequential")) plan(sequential) } ================================================ FILE: incl/make_rng_seeds.R ================================================ ## Set up L'Ecuyer-CMRG random seeds for 100 parallel tasks ## based on .Random.seed in the current R process seeds <- make_rng_seeds(100L, seed = TRUE) str(seeds) ================================================ FILE: incl/random_seed_utils.R ================================================ ## This example gives identical results in the two ## approaches only if .Random.seed already exists seed_org <- next_random_seed() set.seed(42) ## Draw two random number from 1:100 one after the other seed_before <- get_random_seed() x <- sample.int(100L, size = 1L) y <- sample.int(100L, size = 1L) seed_after <- get_random_seed() print(c(x, y)) ## Draw two random number from 1:100 at once set_random_seed(seed_before) z <- sample.int(100L, size = 2L) seed_after2 <- get_random_seed() print(z) ## The RNG state is the same after the second ... ## run as after the first, two-step, approach stopifnot(identical(seed_after2, seed_after)) ## .... and the exact same set of random numbers where ## drawn [only true in R (>= 4.0.0)] if (getRversion() >= "4.0.0") { stopifnot(identical(z, c(x, y))) } else { stopifnot(identical(z[seq_along(x)], x)) } set_random_seed(seed_org) stopifnot(identical(get_random_seed(), seed_org)) ================================================ FILE: inst/CITATION ================================================ utils::bibentry( header = "Please cite 'future' and the future framework using the following references:", # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # BibTeX entry: # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - bibtype = "article", key = "RJ-2021-048", author = "Henrik Bengtsson", title = "A Unifying Framework for Parallel and Distributed Processing in R using Futures", year = "2021", journal = "The R Journal", doi = "10.32614/RJ-2021-048", url = "https://doi.org/10.32614/RJ-2021-048", pages = "208--227", volume = "13", number = "2", # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Plain-text citation: # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - textVersion = paste0( "Henrik Bengtsson, ", "A Unifying Framework for Parallel and Distributed Processing in R using Futures, ", "The R Journal (2021) 13:2, pages 208-227, ", "doi:10.32614/RJ-2021-048" ) ) ================================================ FILE: inst/WORDLIST ================================================ AppVeyor arity batchtools benchmarking BiocParallel callr CMD CMRG doFuture doMC doParallel eapply foreach furrr futurized globals HPC L'Ecuyer lapply macOS mapply md plyr pre Pre pregenerating reproducibility Reproducibility Roadmap sapply SGE Slurm stringsAsFactors tapply vapply vectorize ================================================ FILE: inst/testme/_epilogue/001.undo-future.R ================================================ ## Undo future debug options(future.debug = FALSE) ## Undo future strategy future::plan(oplan) ================================================ FILE: inst/testme/_epilogue/002.undo-state.R ================================================ testme <- as.environment("testme") hpaste <- future:::hpaste ## Undo options ## (a) Reset options(oopts0) ## (b) Remove added local({ added <- setdiff(names(options()), names(oopts0)) opts <- vector("list", length = length(added)) names(opts) <- added options(opts) }) ## (c) Assert that everything was undone if (!identical(options(), oopts0)) { message("Failed to undo options:") oopts <- options() message(sprintf(" - Expected options: [n=%d] %s", length(oopts0), hpaste(sQuote(names(oopts0))))) extra <- setdiff(names(oopts), names(oopts0)) message(paste(sprintf(" - Options still there: [n=%d]", length(extra)), hpaste(sQuote(extra)))) missing <- setdiff(names(oopts0), names(oopts)) message(paste(sprintf(" - Options missing: [n=%d]", length(missing)), hpaste(sQuote(missing)))) message("Differences option by option:") void <- lapply(names(oopts0), FUN = function(name) { value0 <- oopts0[[name]] value <- oopts[[name]] if (!identical(value, value0)) { if (testme[["debug"]]) { utils::str(list(name = name, expected = value0, actual = value)) } } }) } ## Undo system environment variables ## (a) Reset do.call(Sys.setenv, args=as.list(oenvs0)) ## (b) Removed added added <- setdiff(names(Sys.getenv()), names(oenvs0)) Sys.unsetenv(added) ## (c) Assert that everything was undone if (!identical(Sys.getenv(), oenvs0)) { message("Failed to undo environment variables:") oenvs <- Sys.getenv() message(sprintf(" - Expected environment variables: [n=%d] %s", length(oenvs0), hpaste(sQuote(names(oenvs0))))) extra <- setdiff(names(oenvs), names(oenvs0)) message(paste(sprintf(" - Environment variables still there: [n=%d]", length(extra)), hpaste(sQuote(extra)))) missing <- setdiff(names(oenvs0), names(oenvs)) message(paste(sprintf(" - Environment variables missing: [n=%d]", length(missing)), hpaste(sQuote(missing)))) message("Differences environment variable by environment variable:") void <- lapply(names(oenvs0), FUN = function(name) { value0 <- unname(oenvs0[name]) value <- unname(oenvs[name]) if (!identical(value, value0)) { if (testme[["debug"]]) { utils::str(list(name = name, expected = value0, actual = value)) } } }) } ## Assert undo was successful if (testme[["debug"]]) { stopifnot(identical(options(), oopts0)) } ## Undo variables rm(list = c(setdiff(ls(envir = globalenv()), ovars)), envir = globalenv()) ================================================ FILE: inst/testme/_epilogue/090.gc.R ================================================ ## Travis CI specific: Explicit garbage collection because it ## looks like Travis CI might run out of memory during 'covr' ## testing and we now have so many tests. /HB 2017-01-11 if ("covr" %in% loadedNamespaces()) { res <- gc() testme <- as.environment("testme") if (testme[["debug"]]) print(res) } ================================================ FILE: inst/testme/_epilogue/099.session_info.R ================================================ testme <- as.environment("testme") if (testme[["debug"]]) { info <- utils::sessionInfo() message("Session information:") print(info) } ================================================ FILE: inst/testme/_epilogue/995.detritus-connections.R ================================================ ## Look for detritus files testme <- as.environment("testme") local({ delta <- diff_connections(get_connections(), testme[["testme_connections"]]) if (any(lengths(delta) > 0)) { message(sprintf("Detritus connections generated by test %s:", sQuote(testme[["name"]]))) print(delta) } }) ================================================ FILE: inst/testme/_epilogue/999.detritus-files.R ================================================ ## Look for detritus files testme <- as.environment("testme") local({ path <- dirname(tempdir()) if (basename(path) == "working_dir") { files <- dir(pattern = "^Rscript", path = path, all.files = TRUE, full.names = TRUE) if (length(files) > 0L) { message(sprintf("Detritus 'Rscript*' files generated by test %s:", sQuote(testme[["name"]]))) print(files) ## Remove detritus files produced by this test script, so that ## other test scripts will not fail because of these files. unlink(files) ## Signal the problem msg <- sprintf("Detected 'Rscript*' files: [n=%d] %s", length(files), paste(sQuote(basename(files)), collapse = ", ")) ## Are detritus files files expected by design on MS Windows? ## If so, produce a warning, otherwise an error if ("detritus-files" %in% testme[["tags"]] && .Platform[["OS.type"]] == "windows") { warning(msg, immediate. = TRUE) } else { stop(msg) } } } else { message(sprintf("Skipping, because path appears not to be an 'R CMD check' folder: %s", sQuote(path))) } }) ================================================ FILE: inst/testme/_prologue/001.load.R ================================================ testme <- as.environment("testme") loadNamespace(testme[["package"]]) ================================================ FILE: inst/testme/_prologue/002.record-state.R ================================================ ## Record original state ovars <- ls(envir = globalenv()) oenvs <- oenvs0 <- Sys.getenv() oopts0 <- options() ================================================ FILE: inst/testme/_prologue/030.imports.R ================================================ ## Private future functions fold <- future.apply:::fold hpaste <- future.apply:::hpaste mdebug <- future.apply:::mdebug mdebugf <- future.apply:::mdebugf import_from <- future.apply:::import_from get_random_seed <- future.apply:::get_random_seed set_random_seed <- future.apply:::set_random_seed next_random_seed <- future.apply:::next_random_seed as_lecyer_cmrg_seed <- future.apply:::as_lecyer_cmrg_seed is_lecyer_cmrg_seed <- future.apply:::is_lecyer_cmrg_seed make_rng_seeds <- future.apply:::make_rng_seeds ================================================ FILE: inst/testme/_prologue/050.utils.R ================================================ ## Local functions for test scripts printf <- function(...) cat(sprintf(...)) mstr <- function(...) message(paste(capture.output(str(...)), collapse = "\n")) ================================================ FILE: inst/testme/_prologue/090.context.R ================================================ fullTest <- (Sys.getenv("_R_CHECK_FULL_") != "") covr_testing <- ("covr" %in% loadedNamespaces()) on_macos <- grepl("^darwin", R.version$os) on_githubactions <- as.logical(Sys.getenv("GITHUB_ACTIONS", "FALSE")) ================================================ FILE: inst/testme/_prologue/090.options.R ================================================ ## Default options oopts <- options( warn = 1L, showNCalls = 500L, mc.cores = 2L, future.debug = FALSE, ## Reset the following during testing in case ## they are set on the test system future.availableCores.system = NULL, future.availableCores.fallback = NULL ) ================================================ FILE: inst/testme/_prologue/091.envvars.R ================================================ ## Comment: The below should be set automatically whenever the future package ## is loaded and 'R CMD check' runs. The below is added in case R is changed ## in the future and we fail to detect 'R CMD check'. Sys.setenv(R_PARALLELLY_MAKENODEPSOCK_CONNECTTIMEOUT = 2 * 60) Sys.setenv(R_PARALLELLY_MAKENODEPSOCK_TIMEOUT = 2 * 60) Sys.setenv(R_PARALLELLY_MAKENODEPSOCK_SESSIONINFO_PKGS = TRUE) Sys.setenv(R_FUTURE_WAIT_INTERVAL = 0.01) ## 0.01s (instead of default 0.2s) ## Label PSOCK cluster workers (to help troubleshooting) test_script <- grep("[.]R$", commandArgs(), value = TRUE)[1] if (is.na(test_script)) test_script <- "UNKNOWN" worker_label <- sprintf("future/tests/%s:%s:%s:%s", test_script, Sys.info()[["nodename"]], Sys.info()[["user"]], Sys.getpid()) Sys.setenv(R_PARALLELLY_MAKENODEPSOCK_RSCRIPT_LABEL = worker_label) ## Reset the following during testing in case ## they are set on the test system oenvs2 <- Sys.unsetenv(c( "R_PARALLELLY_AVAILABLECORES_SYSTEM", "R_PARALLELLY_AVAILABLECORES_FALLBACK", ## SGE "NSLOTS", "PE_HOSTFILE", ## Slurm "SLURM_CPUS_PER_TASK", ## TORQUE / PBS "NCPUS", "PBS_NUM_PPN", "PBS_NODEFILE", "PBS_NP", "PBS_NUM_NODES" )) ================================================ FILE: inst/testme/_prologue/099.future-setup.R ================================================ ## Use sequential futures by default oplan <- local({ oopts <- options(future.debug = FALSE) on.exit(options(oopts)) future::plan(future::sequential) }) supportedStrategies <- function(cores = NA_integer_, excl = "cluster", ...) { strategies <- future:::supportedStrategies(...) strategies <- setdiff(strategies, excl) if (!is.na(cores)) { if (cores == 1L) { strategies <- setdiff(strategies, c("multicore", "multisession")) } else if (cores > 1L) { strategies <- setdiff(strategies, "sequential") } } strategies } availCores <- min(2L, future::availableCores()) ================================================ FILE: inst/testme/_prologue/995.detrius-connections.R ================================================ get_connections <- function() { cons <- lapply(getAllConnections(), FUN = function(idx) { tryCatch({ con <- getConnection(idx) as.data.frame(c(index = idx, summary(con))) }, error = function(e) { NULL }) }) do.call(rbind, cons) } diff_connections <- function(after, before) { index <- NULL ## To please R CMD check ## Nothing to do? if (length(before) + length(after) == 0L) { return(c(added = NULL, removed = NULL, replaced = NULL)) } idxs <- setdiff(after[["index"]], before[["index"]]) if (length(idxs) > 0) { added <- subset(after, index %in% idxs) after <- subset(after, ! index %in% idxs) } else { added <- NULL } idxs <- setdiff(before[["index"]], after[["index"]]) if (length(idxs) > 0) { removed <- subset(before, index %in% idxs) before <- subset(before, ! index %in% idxs) } else { removed <- NULL } idxs <- intersect(before[["index"]], after[["index"]]) if (length(idxs) > 0) { replaced <- list() for (idx in idxs) { before_idx <- subset(before, index == idx) after_idx <- subset(after, index == idx) if (!identical(before_idx, after_idx)) { for (name in colnames(after_idx)) { value <- after_idx[[name]] if (!identical(before_idx[[name]], value)) { value <- sprintf("%s (was %s)", value, before_idx[[name]]) after_idx[[name]] <- value } } replaced <- c(replaced, list(after_idx)) } } replaced <- do.call(rbind, replaced) } else { replaced <- NULL } list(added = added, removed = removed, replaced = replaced) } testme <- as.environment("testme") testme[["testme_connections"]] <- get_connections() ================================================ FILE: inst/testme/deploy.R ================================================ #!/usr/bin/env Rscript source <- "./inst/testme" if (!utils::file_test("-d", source)) { stop("Source 'testme' folder not found: ", sQuote(source)) } target <- "./tests" if (!utils::file_test("-d", target)) { stop("Target 'tests' folder not found: ", sQuote(target)) } r_path <- "./R" if (!utils::file_test("-d", r_path)) { stop("Target 'R' folder not found: ", sQuote(r_path)) } desc <- "./DESCRIPTION" if (!utils::file_test("-f", desc)) { stop("'DESCRIPTION' file not found: ", sQuote(desc)) } pkgname <- read.dcf(desc)[, "Package"] if (is.na(pkgname) || !nzchar(pkgname)) { stop("Failed to infer package name from 'DESCRIPTION' file: ", sQuote(pkgname)) } else if (!requireNamespace(pkgname)) { stop("Package fail to load: ", sQuote(pkgname)) } files <- dir(path = source, pattern = "^test-.*[.]R$", full.names = TRUE) message(sprintf("Deploying %d test scripts ...", length(files))) ## Generate R unit test script code <- c( "## This runs 'testme' test inst/testme/test-.R scripts", "## Don't edit - it was autogenerated by inst/testme/deploy.R", "testme <- function(name) {", sprintf(" path <- system.file(package = '%s', 'testme', mustWork = TRUE)", pkgname), " Sys.setenv(R_TESTME_PATH = path)", sprintf(" Sys.setenv(R_TESTME_PACKAGE = '%s')", pkgname), " Sys.setenv(R_TESTME_NAME = name)", " on.exit(Sys.unsetenv('R_TESTME_NAME'))", " source(file.path(path, 'run.R'))", "}" ) writeLines(code, con = file.path("./R/testme.R")) for (kk in seq_along(files)) { file <- files[kk] source_file <- basename(file) name <- sub("^test-", "", sub("[.]R$", "", source_file)) target_file <- file.path(target, source_file) message(sprintf("%02d/%02d test script %s", kk, length(files), sQuote(target_file))) ## Assert that testme script can be parsed res <- tryCatch(parse(file = file), error = identity) if (inherits(res, "error")) { stop("Syntax error: ", sQuote(file)) } ## Generate R unit test script code <- c( "#! /usr/bin/env Rscript", sprintf("## This runs testme test script inst/testme/test-%s.R", name), "## Don't edit - it was autogenerated by inst/testme/deploy.R", sprintf('%s:::testme("%s")', pkgname, name) ) writeLines(code, con = target_file) Sys.chmod(target_file, mode = "0755") } message(sprintf("Deploying %d test scripts ... done", length(files))) ================================================ FILE: inst/testme/run.R ================================================ #!/usr/bin/env Rscript #' Run a 'testme' Test Script #' #' R usage: #' testme("") #' #' Command-line usage: #' tests/test-.R #' #' Command-line usage without package re-install: #' inst/testme/run.R --name= #' inst/testme/run.R #' #' Options: #' --package= The name of the package being tested #' (Environment variable: `R_TESTME_PACKAGE`) #' (Default: The `Package` field of the DESCRIPTION file) #' --name= The name of the test to run, used to locate the test #' script `test-.R` #' (Environment variable: `R_TESTME_NAME`) #' --not-cran Set environment variable `NOT_CRAN=true` #' --coverage=summary Estimate test code coverage with basic summary #' --coverage=tally Estimate test code coverage with full tally summary #' --coverage=report Estimate test code coverage with full HTML report #' --debug Output debug messages #' (Environment variable: `R_TESTME_DEBUG`) #' #' Examples: #' testme/test-abc.R #' testme/test-abc.R --not-cran #' tests/test-cpuLoad.R --coverage=report #' #' inst/testme/run.R inst/testme/test-abc.R #' inst/testme/run.R inst/testme/test-abc.R --coverage #' #' Environment variables: #' * R_TESTME_PACKAGE #' * R_TESTME_NAME #' * R_TESTME_PATH #' * R_TESTME_FILTER_NAME #' * R_TESTME_FILTER_TAGS #' * R_TESTME_COVERAGE #' * R_TESTME_DEBUG main <- function() { cmd_args <- commandArgs(trailingOnly = TRUE) pattern <- "--package=([[:alpha:][:alnum:]]+)" idx <- grep(pattern, cmd_args) if (length(idx) > 0L) { stopifnot(length(idx) == 1L) testme_package <- gsub(pattern, "\\1", cmd_args[idx]) cmd_args <- cmd_args[-idx] } else { testme_package <- Sys.getenv("R_TESTME_PACKAGE", NA_character_) if (is.na(testme_package)) { desc <- read.dcf("DESCRIPTION") testme_package <- desc[1, "Package"] } } pattern <- "--path=([[:alpha:][:alnum:]]+)" idx <- grep(pattern, cmd_args) if (length(idx) > 0L) { stopifnot(length(idx) == 1L) path <- gsub(pattern, "\\1", cmd_args[idx]) cmd_args <- cmd_args[-idx] } else { path <- Sys.getenv("R_TESTME_PATH", NA_character_) if (is.na(path)) { path <- file.path("inst", "testme") } if (!utils::file_test("-d", path)) { stop("There exist no such 'R_TESTME_PATH' folder: ", sQuote(path)) } } pattern <- "--name=([[:alpha:][:alnum:]]+)" idx <- grep(pattern, cmd_args) if (length(idx) > 0L) { stopifnot(length(idx) == 1L) testme_name <- gsub(pattern, "\\1", cmd_args[idx]) cmd_args <- cmd_args[-idx] } else { testme_name <- NULL } pattern <- "^--not-cran" idx <- grep(pattern, cmd_args) if (length(idx) > 0L) { cmd_args <- cmd_args[-idx] Sys.setenv(NOT_CRAN = "TRUE") } pattern <- "^--debug" idx <- grep(pattern, cmd_args) if (length(idx) > 0L) { cmd_args <- cmd_args[-idx] Sys.setenv(R_TESTME_DEBUG = "TRUE") } pattern <- "^--coverage(|=([[:alpha:][:alnum:]]+))$" idx <- grep(pattern, cmd_args) if (length(idx) > 0L) { value <- gsub(pattern, "\\2", cmd_args[idx]) if (!nzchar(value)) { coverage <- "summary" } else { coverage <- match.arg(value, choices = c("none", "summary", "tally", "report")) } cmd_args <- cmd_args[-idx] } else { value <- Sys.getenv("R_TESTME_COVERAGE", "none") coverage <- match.arg(value, choices = c("none", "summary", "tally", "report")) } if (coverage != "none") { if (!utils::file_test("-f", "DESCRIPTION")) { stop("Current folder does not look like a package folder") } } ## Fallback for 'testme_name'? if (is.null(testme_name)) { if (length(cmd_args) > 0) { stopifnot(length(cmd_args) == 1L) file <- cmd_args[1] if (utils::file_test("-f", file)) { testme_name <- gsub("(^test-|[.]R$)", "", basename(file)) } else { stop("No such file: ", file) } } else { testme_name <- Sys.getenv("R_TESTME_NAME", NA_character_) if (is.na(testme_name)) { stop("testme: Environment variable 'R_TESTME_NAME' is not set") } } } testme_file <- file.path(path, sprintf("test-%s.R", testme_name)) if (!utils::file_test("-f", testme_file)) { stop("There exist no such 'testme' file: ", sQuote(testme_file)) } ## ----------------------------------------------------------------- ## testme environment ## ----------------------------------------------------------------- on_cran <- function() { not_cran <- Sys.getenv("NOT_CRAN", NA_character_) if (is.na(not_cran)) { not_cran <- FALSE } else { not_cran <- isTRUE(as.logical(not_cran)) } !interactive() && !not_cran } ## on_cran() ## Get test script tags tags <- local({ lines <- readLines(testme_file, warn = FALSE) pattern <- "^#'[[:blank:]]+@tags[[:blank:]]+" lines <- grep(pattern, lines, value = TRUE) tags <- sub(pattern, "", lines) tags }) if (length(tags) > 0) { tags <- sub("[[:blank:]]*$", "", tags) tags <- unlist(strsplit(tags, split = "[[:blank:]]+")) tags <- sort(unique(tags)) } else { tags <- character(0L) } debug <- isTRUE(as.logical(Sys.getenv("R_TESTME_DEBUG"))) coverage <- match.arg(coverage, choices = c("none", "summary", "tally", "report")) ## Create 'testme' environment on the search() path testme_config <- list( testme = TRUE, package = testme_package, name = testme_name, tags = tags, status = "created", start = proc.time(), script = testme_file, path = path, on_cran = on_cran(), coverage = coverage, debug = debug ) if ("testme" %in% search()) detach(name = "testme") testme <- attach(testme_config, name = "testme", warn.conflicts = FALSE) rm(list = c("tags", "testme_package", "testme_name", "testme_file")) ## ----------------------------------------------------------------- ## Filters ## ----------------------------------------------------------------- ## Skip on CRAN? To run these tests, set env var NOT_CRAN=true if ("skip_on_cran" %in% tags && on_cran()) { testme[["status"]] <- "skipped" } code <- Sys.getenv("R_TESTME_FILTER_NAME", NA_character_) if (!is.na(code)) { expr <- tryCatch(parse(text = code), error = identity) if (inherits(expr, "error")) { stop("Syntax error in R_TESTME_FILTER_NAME: ", sQuote(code)) } keep <- tryCatch(eval(expr, envir = testme), error = identity) if (inherits(keep, "error")) { stop("Evaluation of R_TESTME_FILTER_NAME=%s produced an error: %s", sQuote(code), conditionMessage(keep)) } if (!isTRUE(keep)) testme[["status"]] <- "skipped" } code <- Sys.getenv("R_TESTME_FILTER_TAGS", NA_character_) if (!is.na(code)) { expr <- tryCatch(parse(text = code), error = identity) if (inherits(expr, "error")) { stop("Syntax error in R_TESTME_FILTER_TAGS: ", sQuote(code)) } keep <- tryCatch(eval(expr, envir = testme), error = identity) if (inherits(keep, "error")) { stop("Evaluation of R_TESTME_FILTER_TAGS=%s produced an error: %s", sQuote(code), conditionMessage(keep)) } if (!isTRUE(keep)) testme[["status"]] <- "skipped" } testme_run_test(testme) } ## main() #' @param testme A names list #' testme_run_test <- function(testme) { message(sprintf("Test %s ...", sQuote(testme[["name"]]))) if (testme[["debug"]]) { message("testme:") message(paste(utils::capture.output(utils::str(as.list(testme))), collapse = "\n")) } path <- testme[["path"]] ## Process prologue scripts, if they exist if (testme[["status"]] != "skipped" && utils::file_test("-d", file.path(path, "_prologue"))) { testme[["status"]] <- "prologue" local({ ## Find all prologue scripts files <- dir(file.path(path, "_prologue"), pattern = "*[.]R$", full.names = TRUE) files <- sort(files) testme[["prologue_scripts"]] <- files ## Source all prologue scripts inside the 'testme' environment expr <- bquote({ files <- prologue_scripts if (.(testme[["debug"]])) message(sprintf("Sourcing %d prologue scripts ...", length(files))) for (kk in seq_along(files)) { file <- files[kk] if (.(testme[["debug"]])) message(sprintf("%02d/%02d prologue script %s", kk, length(files), sQuote(file))) source(file, local = TRUE) } if (.(testme[["debug"]])) message(sprintf("Sourcing %d prologue scripts ... done", length(files))) rm(list = c("kk", "file", "files")) }) eval(expr, envir = testme) }) # ## In case prologue scripts overwrote some elements in 'testme' # for (name in names(testme_config)) { # testme[[name]] <- testme_config[[name]] # } } ## Run test script ## Note, prologue scripts may trigger test to be skipped if (testme[["status"]] != "skipped") { if (testme[["debug"]]) message("Running test script: ", sQuote(testme[["script"]])) testme[["status"]] <- "failed" str(testme[["coverage"]]) if (testme[["coverage"]] != "none") { pkg_env <- pkgload::load_all() cov <- covr::environment_coverage(pkg_env[["env"]], test_files = testme[["script"]]) ## Keep source files with non-zero coverage tally <- covr::tally_coverage(cov) tally <- subset(tally, value > 0) cov <- cov[covr::display_name(cov) %in% unique(tally$filename)] testme[["test_coverage"]] <- cov } else { testme[["test_coverage"]] <- NULL source(testme[["script"]], echo = TRUE) } testme[["status"]] <- "success" } ## Process epilogue scripts, if they exist ## Note, epilogue scripts may change status or produce check errors if (testme[["status"]] == "success" && utils::file_test("-d", file.path(path, "_epilogue"))) { testme[["status"]] <- "epilogue" local({ ## Find all epilogue scripts files <- dir(file.path(path, "_epilogue"), pattern = "*[.]R$", full.names = TRUE) files <- sort(files) testme[["epilogue_scripts"]] <- files ## Source all epilogue scripts inside the 'testme' environment expr <- bquote({ files <- epilogue_scripts if (.(testme[["debug"]])) message(sprintf("Sourcing %d epilogue scripts ...", length(files))) for (kk in seq_along(files)) { file <- files[kk] if (.(testme[["debug"]])) message(sprintf("%02d/%02d epilogue script %s", kk, length(files), sQuote(file))) source(file, local = TRUE) } if (.(testme[["debug"]])) message(sprintf("Sourcing %d epilogue scripts ... done", length(files))) rm(list = c("kk", "file", "files")) }) eval(expr, envir = testme) }) testme[["status"]] <- "success" } testme[["stop"]] <- proc.time() dt <- testme[["stop"]] - testme[["start"]] dt_str <- sprintf("%s=%.1gs", names(dt), dt) message("Test time: ", paste(dt_str, collapse = ", ")) if ("testme" %in% search()) detach(name = "testme") cov <- testme[["test_coverage"]] if (!is.null(cov)) { message("Source files covered by the test script:") if (length(cov) > 0) { print(cov) if ("tally" %in% testme[["coverage"]]) { tally <- covr::tally_coverage(cov) print(tally) } if ("report" %in% testme[["coverage"]]) { html <- covr::report(cov, browse = FALSE) browseURL(html) Sys.sleep(5.0) } } else { message("* No source files were covered by this test!") } } message(sprintf("Test %s ... %s", sQuote(testme[["name"]]), testme[["status"]])) } ## testme_run_test() main() ================================================ FILE: inst/testme/test-fold.R ================================================ #' @tags fold loadNamespace("future.apply") message("*** fold() ...") x1s <- list( a = NULL, b = 1, c = c(a = 1, b = 2), d = 1:10e3 ) x2s <- lapply(x1s, FUN = as.list) names(x2s) <- toupper(names(x1s)) x3s <- list( E = data.frame(a = 1:3), F = data.frame(a = 1:3, b = letters[1:3], stringsAsFactors=FALSE) ) xs <- c(x1s, x2s, x3s) fcns <- list("c" = base::c, "cbind" = base::cbind) for (kk in seq_along(xs)) { x_name <- names(xs)[kk] for (fcn_name in names(fcns)) { fcn <- fcns[[fcn_name]] message(sprintf(" - #%d. %s(x[['%s']]) ...", kk, fcn_name, x_name)) x <- xs[[kk]] str(list(x = x)) y0 <- Reduce(x, f = fcn) y1 <- fold(x, f = fcn) y2 <- fold(x, f = fcn, unname = FALSE) str(list(y0 = y0, y1 = y1, y2 = y2)) stopifnot(all.equal(unname(y1), unname(y0))) stopifnot(all.equal(unname(y2), unname(y0))) if (!fcn_name %in% "cbind") { stopifnot(all.equal(y1, y0)) stopifnot(all.equal(y2, y0)) } y0 <- Reduce(x, f = fcn, right = TRUE) y1 <- fold(x, f = fcn, left = FALSE) y2 <- fold(x, f = fcn, left = FALSE, unname = FALSE) str(list(y0 = y0, y1 = y1, y2 = y2)) stopifnot(all.equal(unname(y1), unname(y0))) stopifnot(all.equal(unname(y2), unname(y0))) if (!fcn_name %in% "cbind") { stopifnot(all.equal(y1, y0)) stopifnot(all.equal(y2, y0)) } message(sprintf(" - #%d. %s(x[['%s']]) ... DONE", kk, fcn_name, x_name)) } } make_table <- function(n) { data.frame(key = sample(n), value = sample(n), stringsAsFactors=FALSE) } sizes <- rep(10, 20) set.seed(3180) tables <- lapply(sizes, make_table) key_merge <- function(x, y) merge(x, y, by = "key", all = FALSE) suppressWarnings( folded <- fold(tables, key_merge, left = TRUE, unname = FALSE, threshold = 6L) ) suppressWarnings( reduced <- Reduce(key_merge, tables[-1], tables[[1]]) ) stopifnot(all.equal(unname(folded), unname(reduced))) message("*** fold() ... DONE") ================================================ FILE: inst/testme/test-future_Filter.R ================================================ #' @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") ================================================ FILE: inst/testme/test-future_apply.R ================================================ #' @tags future_apply #' @tags sequential multisession multicore library(future.apply) message("*** future_apply() ...") z0 <- NULL for (strategy in supportedStrategies()) { message(sprintf("*** strategy = %s ...", sQuote(strategy))) plan(strategy) message("- From example(apply) ...") X <- matrix(c(1:4, 1, 6:8), nrow = 2L) Y0 <- apply(X, MARGIN = 1L, FUN = table) Y1 <- future_apply(X, MARGIN = 1L, FUN = table) print(Y1) stopifnot(all.equal(Y1, Y0, check.attributes = FALSE)) ## FIXME Y2 <- future_apply(X, MARGIN = 1L, FUN = "table") print(Y2) stopifnot(identical(Y2, Y1)) Y0 <- apply(X, MARGIN = 1L, FUN = stats::quantile) Y1 <- future_apply(X, MARGIN = 1L, FUN = stats::quantile) print(Y1) stopifnot(all.equal(Y1, Y0)) x <- cbind(x1 = 3, x2 = c(4:1, 2:5)) names(dimnames(x)) <- c("row", "col") x3 <- array(x, dim = c(dim(x), 3), dimnames = c(dimnames(x), list(C = paste0("cop.", 1:3)))) y0 <- apply(x, MARGIN = 2L, FUN = identity) stopifnot(identical(y0, x)) y1 <- future_apply(x, MARGIN = 2L, FUN = identity) print(y1) stopifnot(identical(y1, y0)) y0 <- apply(x3, MARGIN = 2:3, FUN = identity) stopifnot(identical(y0, x3)) y1 <- future_apply(x3, MARGIN = 2:3, FUN = identity) print(y1) stopifnot(identical(y1, y0)) z <- array(1:24, dim = 2:4) y0 <- apply(z, MARGIN = 1:2, FUN = function(x) seq_len(max(x))) y1 <- future_apply(z, MARGIN = 1:2, FUN = function(x) seq_len(max(x))) print(y1) stopifnot(identical(y1, y0)) message("- apply(X, MARGIN = , ...) ...") X <- matrix(1:2, nrow = 2L, ncol = 1L, dimnames = list(rows = c("a", "b"))) y0 <- apply(X, MARGIN = "rows", FUN = identity) y1 <- future_apply(X, MARGIN = "rows", FUN = identity) print(y1) stopifnot(identical(y1, y0)) message("- apply(X, ...) - dim(X) > 2 ...") X <- array(1:12, dim = c(2, 2, 3)) y0 <- apply(X, MARGIN = 1L, FUN = identity) y1 <- future_apply(X, MARGIN = 1L, FUN = identity) print(y1) stopifnot(identical(y1, y0)) message("- apply(X, ...) - not all same names ...") FUN <- function(x) { if (x[1] == 1L) names(x) <- letters[seq_along(x)] x } X <- matrix(1:4, nrow = 2L, ncol = 2L) y0 <- apply(X, MARGIN = 1L, FUN = FUN) y1 <- future_apply(X, MARGIN = 1L, FUN = FUN) print(y1) stopifnot(identical(y1, y0)) message("- example(future_apply) - reproducible RNG ...") z1 <- future_apply(X, MARGIN = 1L, FUN = sample, future.seed = 0xBEEF, ## Test also all other 'future.*' arguments future.stdout = TRUE, future.conditions = NULL, future.globals = TRUE, future.packages = NULL, future.scheduling = 1.0, future.chunk.size = NULL, future.label = "future_apply-%d" ) print(z1) if (is.null(z0)) { z0 <- z1 } else { stopifnot(identical(z1, z0)) } plan(sequential) message(sprintf("*** strategy = %s ... done", sQuote(strategy))) } ## for (strategy in ...) message("*** apply(X, ...) - prod(dim(X)) == 0 [non-parallel] ...") X <- matrix(nrow = 0L, ncol = 2L) y0 <- apply(X, MARGIN = 1L, FUN = identity) y1 <- future_apply(X, MARGIN = 1L, FUN = identity) print(y1) stopifnot(identical(y1, y0)) message("*** exceptions ...") ## Error: dim(X) must have a positive length res <- tryCatch({ y <- future_apply(1L, MARGIN = 1L, FUN = identity) }, error = identity) stopifnot(inherits(res, "error")) ## Error: 'X' must have named dimnames X <- matrix(1:2, nrow = 2L, ncol = 1L) res <- tryCatch({ y <- future_apply(X, MARGIN = "rows", FUN = identity) }, error = identity) stopifnot(inherits(res, "error")) ## Error: not all elements of 'MARGIN' are names of dimensions X <- matrix(1:2, nrow = 2L, ncol = 1L, dimnames = list(rows = c("a", "b"))) res <- tryCatch({ y <- future_apply(X, MARGIN = "cols", FUN = identity) }, error = identity) stopifnot(inherits(res, "error")) message("*** future_apply() ... DONE") ================================================ FILE: inst/testme/test-future_by.R ================================================ #' @tags future_by #' @tags listenv #' @tags sequential multisession multicore library(future.apply) library(listenv) all_equal_but_call <- function(target, current, ...) { attr(target, "call") <- NULL attr(current, "call") <- NULL all.equal(target = target, current = current, ...) } message("*** future_by() ...") ## --------------------------------------------------------- ## by() ## --------------------------------------------------------- if (require("datasets") && require("stats")) { ## warpbreaks & lm() ## Use a local variable to test that it is properly exported, because ## 'warpbreaks' is available in all R sessions data <- warpbreaks y0 <- by(data[, 1:2], INDICES = data[,"tension"], FUN = summary) y1 <- by(data[, 1], INDICES = data[, -1], FUN = summary, digits = 2L) y2 <- by(data, INDICES = data[,"tension"], FUN = function(x, ...) { lm(breaks ~ wool, data = x, ...) }, singular.ok = FALSE) ## now suppose we want to extract the coefficients by group tmp <- with(data, by(data, INDICES = tension, FUN = function(x) { lm(breaks ~ wool, data = x) })) y3 <- sapply(tmp, coef) ## Source: {r-source}/tests/reg-tests-1d.R by2 <- function(data, INDICES, FUN) { by(data, INDICES = INDICES, FUN = FUN) } future_by2 <- function(data, INDICES, FUN) { future_by(data, INDICES = INDICES, FUN = FUN) } y4 <- by2(data, INDICES = data[,"tension"], FUN = summary) for (cores in 1:availCores) { message(sprintf("Testing with %d cores ...", cores)) options(mc.cores = cores) strategies <- supportedStrategies(cores) for (strategy in supportedStrategies()) { message(sprintf("- plan('%s') ...", strategy)) plan(strategy) y0f <- future_by(data[, 1:2], INDICES = data[,"tension"], FUN = summary) stopifnot(all_equal_but_call(y0f, y0, check.attributes = FALSE)) y1f <- future_by(data[, 1], INDICES = data[, -1], FUN = summary, digits = 2L) stopifnot(all_equal_but_call(y1f, y1)) y2f <- future_by(data, INDICES = data[,"tension"], FUN = function(x, ...) { lm(breaks ~ wool, data = x, ...) }, singular.ok = FALSE) stopifnot(all_equal_but_call(y2f, y2)) ## now suppose we want to extract the coefficients by group tmp <- with(data, future_by(data, INDICES = tension, FUN = function(x) { lm(breaks ~ wool, data = x) })) y3f <- sapply(tmp, coef) stopifnot(all_equal_but_call(y3f, y3)) y4f <- future_by2(data, INDICES = data[,"tension"], FUN = summary) stopifnot(all_equal_but_call(y4f, y4)) ## Defunct /HB 2025-01-11 res <- tryCatch({ y4f2 <- future_by2(data, INDICES = data[,"tension"], FUN = "summary") }, error = identity) stopifnot(inherits(res, "error")) if (getRversion() >= "3.6.0") { stopifnot(inherits(res, "defunctError")) } } ## for (strategy ...) message(sprintf("Testing with %d cores ... DONE", cores)) } ## for (cores ...) } ## if (require("stats")) message("*** future_by() ... DONE") ================================================ FILE: inst/testme/test-future_eapply.R ================================================ #' @tags future_eapply #' @tags sequential multisession multicore library(future.apply) message("*** future_eapply() ...") message("- From example(eapply) ...") for (strategy in supportedStrategies()) { message(sprintf("*** strategy = %s ...", sQuote(strategy))) plan(strategy) env <- new.env(hash = FALSE) env$a <- 1:10 env$beta <- exp(-3:3) env$logic <- c(TRUE, FALSE, FALSE, TRUE) y0 <- unlist(eapply(env, mean, USE.NAMES = FALSE)) y1 <- unlist(future_eapply(env, mean, USE.NAMES = FALSE)) stopifnot(all.equal(y1, y0)) y0 <- eapply(env, quantile, probs = 1:3/4) y1 <- future_eapply(env, quantile, probs = 1:3/4) stopifnot(all.equal(y1, y0)) y0 <- eapply(env, quantile) y1 <- future_eapply(env, quantile) stopifnot(all.equal(y1, y0)) y2 <- future_eapply(env, "quantile") stopifnot(all.equal(y2, y0)) plan(sequential) message(sprintf("*** strategy = %s ... done", sQuote(strategy))) } ## for (strategy in ...) message("*** future_eapply() ... DONE") ================================================ FILE: inst/testme/test-future_kernapply.R ================================================ if (require("datasets") && require("stats")) { library(future.apply) library(datasets) plan(multisession) ## Adopted from example("kernapply", package = "stats") ## ------------------------------------------------------ ## Test {future_}kernapply() for 'default' ## ------------------------------------------------------ X <- EuStockMarkets[, 1:2] X <- unclass(X) stopifnot(inherits(X, "matrix"), !inherits(X, "ts")) k1 <- kernel("daniell", m = 50L) stopifnot(inherits(k1, "tskernel")) X1_truth <- kernapply(X, k = k1) str(X1_truth) X1 <- future_kernapply(X, k = k1) str(X1) stopifnot(identical(X1, X1_truth)) ## ------------------------------------------------------ ## Test {future_}kernapply() for 'ts' ## ------------------------------------------------------ X <- EuStockMarkets[, 1:2] stopifnot(inherits(X, "matrix"), inherits(X, "ts")) k1 <- kernel("daniell", m = 50L) stopifnot(inherits(k1, "tskernel")) X1_truth <- kernapply(X, k = k1) str(X1_truth) X1 <- future_kernapply(X, k = k1) str(X1) stopifnot(identical(X1, X1_truth)) plan(sequential) } ================================================ FILE: inst/testme/test-future_lapply,RNG.R ================================================ #' @tags future_lapply #' @tags sequential multisession multicore library(future.apply) message("*** future_lapply() and RNGs ...") options(future.debug = FALSE) message("* future_lapply(x, ..., future.seed = ) ...") res <- tryCatch({ y <- future_lapply(1:3, FUN = identity, future.seed = as.list(1:2)) }, error = identity) print(res) stopifnot(inherits(res, "simpleError")) res <- tryCatch({ y <- future_lapply(1:3, FUN = identity, future.seed = list(1, 2, 3:4)) }, error = identity) print(res) stopifnot(inherits(res, "simpleError")) res <- tryCatch({ y <- future_lapply(1:3, FUN = identity, future.seed = as.list(1:3)) }, error = identity) print(res) stopifnot(inherits(res, "simpleError")) seeds <- lapply(1:3, FUN = as_lecyer_cmrg_seed) res <- tryCatch({ y <- future_lapply(1:3, FUN = identity, future.seed = lapply(seeds, FUN = as.numeric)) }, error = identity) print(res) stopifnot(inherits(res, "simpleError")) seeds[[1]][1] <- seeds[[1]][1] + 1L res <- tryCatch({ y <- future_lapply(1:3, FUN = identity, future.seed = seeds) }, error = identity) print(res) stopifnot(inherits(res, "simpleError")) message("* future_lapply(x, ..., future.seed = ) ... DONE") ## Iterate of the same set in all tests x <- 1:5 message("* future_lapply(x, ..., future.seed = FALSE) ...") y0 <- y0_nested <- seed00 <- NULL for (cores in 1:availCores) { message(sprintf(" - Testing with %d cores ...", cores)) options(mc.cores = cores) for (strategy in supportedStrategies(cores)) { message(sprintf("* plan('%s') ...", strategy)) plan(strategy) set.seed(0xBEEF) seed0 <- get_random_seed() y <- future_lapply(x, FUN = function(i) i, future.seed = FALSE) y <- unlist(y) seed <- get_random_seed() if (is.null(y0)) { y0 <- y seed00 <- seed } str(list(y = y)) stopifnot(identical(seed, seed0), identical(seed, seed00)) ## NOTE: We cannot guarantee the same random numbers, because ## future.seed = FALSE. message(sprintf("* plan('%s') ... DONE", strategy)) } ## for (strategy ...) message(sprintf(" - Testing with %d cores ... DONE", cores)) } ## for (core ...) message("* future_lapply(x, ..., future.seed = FALSE) ... DONE") seed_sets <- list( A = TRUE, ## B = NA, C = 42L, D = as_lecyer_cmrg_seed(42L), E = list(), F = vector("list", length = length(x)), G = NULL ) ## Generate sequence of seeds of the current RNGkind() ## NOTE: This is NOT a good way to generate random seeds!!! seeds <- lapply(seq_along(x), FUN = function(i) { set.seed(i) globalenv()$.Random.seed }) seed_sets$E <- seeds ## Generate sequence of L'Ecyer CMRG seeds seeds <- seed_sets$F seeds[[1]] <- seed_sets$D for (kk in 2:length(x)) seeds[[kk]] <- parallel::nextRNGStream(seeds[[kk - 1]]) seed_sets$F <- seeds seed_sets$G <- seed_sets$A rm(list = "seeds") for (name in names(seed_sets)) { future.seed <- seed_sets[[name]] if (is.list(future.seed)) { label <- sprintf("", length(future.seed), length(future.seed[[1]])) } else { label <- hpaste(future.seed) } message(sprintf("* future_lapply(x, ..., future.seed = %s) ...", label)) set.seed(0xBEEF) y0 <- seed00 <- NULL for (cores in 1:availCores) { message(sprintf(" - Testing with %d cores ...", cores)) options(mc.cores = cores) for (strategy in supportedStrategies(cores)) { message(sprintf("* plan('%s') ...", strategy)) plan(strategy) set.seed(0xBEEF) seed0 <- get_random_seed() y <- future_lapply(x, FUN = function(i) { rnorm(1L) }, future.seed = future.seed) y <- unlist(y) seed <- get_random_seed() if (is.null(y0)) { y0 <- y seed00 <- seed } str(list(y = y)) stopifnot(!identical(seed, seed0), identical(seed, seed00), identical(y, y0)) ## RNG-based results should also be identical regardless of ## load-balance scheduling. for (scheduling in list(FALSE, TRUE, 0, 0.5, 2.0, Inf)) { set.seed(0xBEEF) seed0 <- get_random_seed() y <- future_lapply(x, FUN = function(i) { rnorm(1L) }, future.seed = future.seed, future.scheduling = scheduling) seed <- get_random_seed() y <- unlist(y) str(list(y = y)) stopifnot(!identical(seed, seed0), identical(seed, seed00), identical(y, y0)) } ## Nested future_lapply():s for (scheduling in list(FALSE, TRUE)) { y <- future_lapply(x, FUN = function(i) { .seed <- globalenv()$.Random.seed z <- future_lapply(1:3, FUN = function(j) { list(j = j, seed = globalenv()$.Random.seed) }, future.seed = .seed) ## Assert that all future seeds are unique seeds <- lapply(z, FUN = function(x) x$seed) for (kk in 2:length(seeds)) stopifnot(!all(seeds[[kk]] == seeds[[1]])) list(i = i, seed = .seed, sample = rnorm(1L), z = z) }, future.seed = 42L, future.scheduling = scheduling) if (is.null(y0_nested)) y0_nested <- y str(list(y = y)) ## Assert that all future seeds (also nested ones) are unique seeds <- Reduce(c, lapply(y, FUN = function(x) { c(list(seed = x$seed), lapply(x$z, FUN = function(x) x$seed)) })) for (kk in 2:length(seeds)) stopifnot(!all(seeds[[kk]] == seeds[[1]])) stopifnot(identical(y, y0_nested)) } message(sprintf("* plan('%s') ... DONE", strategy)) } ## for (strategy ...) message(sprintf(" - Testing with %d cores ... DONE", cores)) } ## for (cores ...) message(sprintf("* future_lapply(x, ..., future.seed = %s) ... DONE", label)) } ## for (name ...) message("*** future_lapply() and RNGs ... DONE") ================================================ FILE: inst/testme/test-future_lapply,globals.R ================================================ #' @tags future_lapply #' @tags sequential multisession multicore library(future.apply) library(tools) ## toTitleCase() options(future.debug = FALSE) options(future.apply.debug = TRUE) message("*** future_lapply() - globals ...") plan(cluster, workers = "localhost") a <- 1 b <- 2 globals_set <- list( A = FALSE, B = TRUE, C = c("a", "b"), D = list(a = 2, b = 3) ) x <- list(1) y_truth <- list(A = NULL, B = list(1), C = list(1), D = list(2)) str(y_truth) for (name in names(globals_set)) { globals <- globals_set[[name]] message("Globals set ", sQuote(name)) y <- tryCatch({ future_lapply(x, FUN = function(x) { median(c(x, a, b)) }, future.globals = globals, future.packages = "utils") }, error = identity) print(y) stopifnot((name == "A" && inherits(y, "error")) || identical(y, y_truth[[name]])) } message("*** future_lapply() - globals ... DONE") message("*** future_lapply() - manual globals ...") d <- 42 y <- future_lapply(1:2, FUN = function(x) { x * d }, future.globals = structure(FALSE, add = "d")) stopifnot(identical(y, list(42, 84))) e <- 42 res <- tryCatch({ future_lapply(1:2, FUN = function(x) { 2 * e }, future.globals = structure(TRUE, ignore = "e")) }, error = identity) stopifnot(inherits(res, "error")) message("*** future_lapply() - manual globals ... DONE") ## Test adopted from http://stackoverflow.com/questions/42561088/nested-do-call-within-a-foreach-dopar-environment-cant-find-function-passed-w message("*** future_lapply() - tricky globals ...") my_add <- function(a, b) a + b call_my_add <- function(a, b) { do.call(my_add, args = list(a = a, b = b)) } call_my_add_caller <- function(a, b, FUN = call_my_add) { do.call(FUN, args = list(a = a, b = b)) } main <- function(x = 1:2, caller = call_my_add_caller, args = list(FUN = call_my_add)) { results <- future_lapply(x, FUN = function(i) { do.call(caller, args = c(list(a = i, b = i + 1L), args)) }) results } x <- list(list(1:2)) z_length <- lapply(x, FUN = do.call, what = length) fun <- function(...) sum(...) z_fun <- lapply(x, FUN = do.call, what = fun) y0 <- NULL for (strategy in supportedStrategies()) { plan(strategy) y <- main(1:3) if (is.null(y0)) y0 <- y stopifnot(identical(y, y0)) message("- future_lapply(x, FUN = do.call, ...) ...") z <- future_lapply(x, FUN = do.call, what = length) stopifnot(identical(z, z_length)) z <- future_lapply(x, FUN = do.call, what = fun) stopifnot(identical(z, z_fun)) message("- future_lapply(x, ...) - passing arguments via '...' ...") ## typeof() == "list" obj <- data.frame(a = 1:2) stopifnot(typeof(obj) == "list") y <- future_lapply(1L, function(a, b) typeof(b), b = obj) stopifnot(identical(y[[1]], typeof(obj))) ## typeof() == "environment" obj <- new.env() stopifnot(typeof(obj) == "environment") y <- future_lapply(1L, function(a, b) typeof(b), b = obj) stopifnot(identical(y[[1]], typeof(obj))) ## typeof() == "S4" if (requireNamespace("methods")) { obj <- methods::getClass("MethodDefinition") stopifnot(typeof(obj) == "S4") y <- future_lapply(1L, function(a, b) typeof(b), b = obj) stopifnot(identical(y[[1]], typeof(obj))) } message("- future_lapply(X, ...) - 'X' containing globals ...") ## From https://github.com/futureverse/future.apply/issues/12 a <- 42 b <- 21 X <- list( function(b) 2 * a, function() b / 2, function() a + b, function() nchar(toTitleCase("hello world")) ) z0 <- lapply(X, FUN = function(f) f()) str(z0) z1 <- future_lapply(X, FUN = function(f) f()) str(z1) stopifnot(identical(z1, z0)) # message("- future_lapply(x, ...) - passing '...' as a global ...") # ## https://github.com/futureverse/future/issues/417 # fcn0 <- function(...) { lapply(1, FUN = function(x) list(...)) } # z0 <- fcn0(a = 1) # str(list(z0 = z0)) # stopifnot(identical(z0, list(list(a = 1)))) # fcn <- function(...) { future_lapply(1, FUN = function(x) list(...)) } # z1 <- fcn(a = 1) # str(list(z1 = z1)) # stopifnot(identical(z1, z0)) ## https://github.com/futureverse/future.apply/issues/47 message("- future_lapply(X, ...) - '{ a <- a + 1; a }' ...") a <- 1 z0 <- lapply(1, function(ii) { a <- a + 1 a }) z1 <- future_lapply(1, function(ii) { a <- a + 1 a }) stopifnot(identical(z1, z0)) ## https://github.com/futureverse/future.apply/issues/47 message("- future_lapply(X, ...) - '{ a; a <- a + 1 }' ...") z2 <- tryCatch(future_lapply(1, function(ii) { a a <- a + 1 }), error = identity) stopifnot(identical(z2, z0)) ## https://github.com/futureverse/future.apply/issues/85 message("- future_lapply(..., future.globals = ) ...") a <- 0 y <- future_lapply(1, FUN = function(x) a, future.globals = list(a = 42)) str(y) stopifnot(y[[1]] == 42) } ## for (strategy ...) message("*** future_lapply() - tricky globals ... DONE") message("*** future_lapply() - missing arguments ...") ## Here 'abc' becomes missing, i.e. missing(abc) is TRUE foo <- function(x, abc) future_lapply(x, FUN = function(y) y) y <- foo(1:2) stopifnot(identical(y, as.list(1:2))) message("*** future_lapply() - missing arguments ... DONE") message("*** future_lapply() - false positives ...") ## Here 'abc' becomes a promise, which fails to resolve ## iff 'xyz' does not exist. (Issue #161) suppressWarnings(rm(list = "xyz")) foo <- function(x, abc) future_lapply(x, FUN = function(y) y) y <- foo(1:2, abc = (xyz >= 3.14)) stopifnot(identical(y, as.list(1:2))) message("*** future_lapply() - false positives ... DONE") message("*** future_lapply() - too large ...") oMaxSize <- getOption("future.globals.maxSize") X <- replicate(10L, 1:100, simplify = FALSE) FUN <- function(x) { getOption("future.globals.maxSize") } y0 <- lapply(X, FUN = FUN) stopifnot(all(sapply(y0, FUN = identical, oMaxSize))) sizes <- unclass(c(FUN = object.size(FUN), X = object.size(X))) cat(sprintf("Baseline size of globals: %.2f KiB\n", sizes[["FUN"]] / 1024)) message("- true positive ...") options(future.globals.maxSize = 1L) res <- tryCatch({ y <- future_lapply(X, FUN = FUN) }, error = identity) stopifnot(inherits(res, "error")) res <- NULL options(future.globals.maxSize = oMaxSize) maxSize <- getOption("future.globals.maxSize") y <- future_lapply(X, FUN = FUN) str(y) stopifnot(all(sapply(y, FUN = identical, oMaxSize))) message("- approximately invariant to chunk size ...") maxSize <- sizes[["FUN"]] + sizes[["X"]] / length(X) options(future.globals.maxSize = maxSize) for (chunk.size in c(1L, 2L, 5L, 10L)) { y <- future_lapply(X, FUN = FUN, future.chunk.size = chunk.size) str(y) stopifnot(all(unlist(y) == maxSize)) cat(sprintf("maxSize = %g bytes\nfuture.globals.maxSize = %g bytes\n", maxSize, getOption("future.globals.maxSize"))) stopifnot(getOption("future.globals.maxSize") == maxSize) } y <- NULL options(future.globals.maxSize = oMaxSize) message("*** future_lapply() - too large ... DONE") message("*** future_lapply() - globals exceptions ...") res <- tryCatch({ y <- future_lapply(1, FUN = function(x) x, future.globals = 42) }, error = identity) stopifnot(inherits(res, "error")) res <- tryCatch({ y <- future_lapply(1, FUN = function(x) x, future.globals = list(1)) }, error = identity) stopifnot(inherits(res, "error")) res <- tryCatch({ y <- future_lapply(1, FUN = function(x) x, future.globals = "...future.FUN") }, error = identity) stopifnot(inherits(res, "error")) res <- tryCatch({ y <- future_lapply(1, FUN = function(x) x, future.globals = "...future.FUN") }, error = identity) stopifnot(inherits(res, "error")) ...future.elements_ii <- 42L X <- list(function() 2 * ...future.elements_ii) res <- tryCatch({ y <- future_lapply(X, FUN = function(f) f()) }, error = identity) stopifnot(inherits(res, "error")) message("*** future_lapply() - globals exceptions ... DONE") ================================================ FILE: inst/testme/test-future_lapply.R ================================================ #' @tags future_lapply #' @tags listenv #' @tags sequential multisession multicore library(future.apply) library(listenv) message("*** future_lapply() ...") x_a <- list(a = "integer", b = "numeric", c = "character", c = "list") str(list(x_a = x_a)) y_a <- lapply(x_a, FUN = base::vector, length = 2L) str(list(y_a = y_a)) x_b <- list(a = c("hello", b = 1:100)) str(list(x_b = x_b)) y_b <- lapply(x_b, FUN = future:::hpaste, collapse = "; ", maxHead = 3L) str(list(y_b = y_b)) x_c <- list() y_c <- listenv() y_c$A <- 3L x_c$a <- y_c y_c<- listenv() y_c$A <- 3L y_c$B <- c("hello", b = 1:100) x_c$b <- y_c print(x_c) y_c <- lapply(x_c, FUN = listenv::mapping) str(list(y_c = y_c)) for (cores in 1:availCores) { message(sprintf("Testing with %d cores ...", cores)) options(mc.cores = cores) strategies <- supportedStrategies(cores) for (strategy in supportedStrategies()) { message(sprintf("- plan('%s') ...", strategy)) plan(strategy) for (scheduling in list(FALSE, TRUE, structure(TRUE, ordering = "random"), structure(TRUE, ordering = function(n) rev(seq_len(n))))) { message("- future_lapply(x, FUN = vector, ...) ...") y <- future_lapply(x_a, FUN = vector, length = 2L, future.scheduling = scheduling) str(list(y = y)) stopifnot(identical(y, y_a)) y <- future_lapply(x_a, FUN = "vector", length = 2L, future.scheduling = scheduling) str(list(y = y)) stopifnot(identical(y, y_a)) message("- future_lapply(x, FUN = base::vector, ...) ...") y <- future_lapply(x_a, FUN = base::vector, length = 2L, future.scheduling = scheduling) str(list(y = y)) stopifnot(identical(y, y_a)) message("- future_lapply(x, FUN = future:::hpaste, ...) ...") y <- future_lapply(x_b, FUN = future:::hpaste, collapse = "; ", maxHead = 3L, future.scheduling = scheduling) str(list(y = y)) stopifnot(identical(y, y_b)) message("- future_lapply(x, FUN = listenv::listenv, ...) ...") y <- future_lapply(x_c, FUN = listenv::mapping, future.scheduling = scheduling) str(list(y = y)) stopifnot(identical(y, y_c)) } ## for (scheduling ...) message("- future_lapply(x, FUN, ...) for large length(x) ...") a <- 3.14 x_d <- 1:1e4 y <- future_lapply(x_d, FUN = function(z) sqrt(z + a)) y <- unlist(y, use.names = FALSE) stopifnot(all.equal(y, sqrt(x_d + a))) message("- future_lapply(x, FUN = table, ...) ...") x <- list(a = 1:4, b = 5:8) y0 <- lapply(x, FUN = table) y1 <- future_lapply(x, FUN = table) stopifnot(all.equal(y1, y0, check.attributes = FALSE)) ## FIXME message("- future_lapply(x, ...) where length(x) != length(as.list(x)) ...") x <- structure(list(a = 1, b = 2), class = "Foo") as.list.Foo <- function(x, ...) c(x, c = 3) y0 <- lapply(x, FUN = length) stopifnot(identical(y0, list(a = 1L, b = 1L, c = 1L))) y1 <- future_lapply(x, FUN = length) stopifnot(identical(y1, y0)) rm(list = "as.list.Foo") message("- future_lapply(x, ...) where x[[i]] subsets via S3 method ...") x <- structure(list(a = 1, b = 2), class = "Foo") `[[.Foo` <- function(x, ...) 0 y0 <- lapply(x, FUN = identity) stopifnot(identical(y0, list(a = 0, b = 0))) y1 <- future_lapply(x, FUN = identity) if (getOption("future.apply.chunkWith", "[[") == "[") { stopifnot(identical(y1, unclass(x))) } else { stopifnot(identical(y1, y0)) } rm(list = "[[.Foo") } ## for (strategy ...) message(sprintf("Testing with %d cores ... DONE", cores)) } ## for (cores ...) message("*** future_lapply() - special cases ...") X <- list() names(X) <- character(0L) y <- future_lapply(X, FUN = identity) stopifnot(length(y) == 0L, !is.null(names(y)), identical(y, X)) X <- character(0L) y0 <- lapply(X, FUN = identity) y <- future_lapply(X, FUN = identity) stopifnot(identical(y, y0)) X <- character(0L) names(X) <- character(0L) y0 <- lapply(X, FUN = identity) y <- future_lapply(X, FUN = identity) stopifnot(identical(y, y0)) message("*** future_lapply() - special cases ... DONE") message("*** future_lapply() - exceptions ...") res <- tryCatch({ future_lapply(1:3, FUN = identity, future.chunk.size = structure(1L, ordering = "invalid")) }, error = identity) stopifnot(inherits(res, "error")) message("*** future_lapply() - exceptions ... DONE") message("*** future_lapply() ... DONE") ================================================ FILE: inst/testme/test-future_mapply,globals.R ================================================ #' @tags future_mapply #' @tags sequential multisession multicore library(future.apply) library(tools) ## toTitleCase() message("*** future_mapply() - globals ...") #plan(cluster, workers = "localhost") plan(sequential) options(future.debug = FALSE) a <- 1 b <- 2 globals_set <- list( A = FALSE, B = TRUE, C = c("a", "b"), D = list(a = 1, b = 2) ) x <- list(1) for (name in names(globals_set)) { globals <- globals_set[[name]] message("Globals set ", sQuote(name)) str(globals) y_truth <- tryCatch({ mapply(function(x) { median(c(x, a, b)) }, x) }, error = identity) y1 <- tryCatch({ future_mapply(function(x) { median(c(x, a, b)) }, x) }, error = identity) print(y1) stopifnot(identical(y1, y_truth)) y2 <- tryCatch({ future_mapply(function(x) { median(c(x, a, b)) }, x, future.globals = globals, future.packages = "utils") }, error = identity) print(y2) stopifnot(identical(y2, y_truth)) } message("*** future_mapply() - globals ... DONE") ## Test adopted from http://stackoverflow.com/questions/42561088/nested-do-call-within-a-foreach-dopar-environment-cant-find-function-passed-w message("*** future_mapply() - tricky globals ...") my_add <- function(a, b) a + b call_my_add <- function(a, b) { do.call(my_add, args = list(a = a, b = b)) } call_my_add_caller <- function(a, b, FUN = call_my_add) { do.call(FUN, args = list(a = a, b = b)) } main <- function(x = 1:2, caller = call_my_add_caller, args = list(FUN = call_my_add)) { results <- future_mapply(function(i) { do.call(caller, args = c(list(a = i, b = i + 1L), args)) }, x) results } x <- list(list(1:2)) z_length <- mapply(do.call, args = x, MoreArgs = list(what = length)) fun <- function(...) sum(...) z_fun <- mapply(do.call, args = x, MoreArgs = list(what = fun)) y0 <- NULL for (strategy in supportedStrategies()) { plan(strategy) y <- main(1:3) if (is.null(y0)) y0 <- y stopifnot(identical(y, y0)) message("- future_mapply(do.call, x, ...) ...") z <- future_mapply(do.call, args = x, MoreArgs = list(what = length)) stopifnot(identical(z, z_length)) z <- future_mapply(do.call, args = x, MoreArgs = list(what = fun)) stopifnot(identical(z, z_fun)) message("- future_mapply(FUN, x, ...) - passing arguments via '...' ...") ## typeof() == "list" obj <- data.frame(a = 1:2) stopifnot(typeof(obj) == "list") y <- future_mapply(function(a, b) typeof(b), 1L, MoreArgs = list(b = obj)) stopifnot(identical(y[[1]], typeof(obj))) ## typeof() == "environment" obj <- new.env() stopifnot(typeof(obj) == "environment") y <- future_mapply(function(a, b) typeof(b), 1L, MoreArgs = list(b = obj)) stopifnot(identical(y[[1]], typeof(obj))) ## typeof() == "S4" if (requireNamespace("methods")) { obj <- methods::getClass("MethodDefinition") stopifnot(typeof(obj) == "S4") y <- future_mapply(function(a, b) typeof(b), 1L, MoreArgs = list(b = obj)) stopifnot(identical(y[[1]], typeof(obj))) } message("- future_mapply(FUN, X, ...) - 'X' containing globals ...") ## From https://github.com/futureverse/future.apply/issues/12 a <- 42 b <- 21 X <- list( function(b) 2 * a, function() b / 2, function() a + b, function() nchar(toTitleCase("hello world")) ) z0 <- mapply(function(s, f) f() + s, s = seq_along(X), X) str(z0) z1 <- future_mapply(function(s, f) f() + s, s = seq_along(X), X) str(z1) stopifnot(identical(z1, z0)) } message("*** future_mapply() - tricky globals ... DONE") message("*** future_mapply() - missing arguments ...") ## Here 'abc' becomes missing, i.e. missing(abc) is TRUE foo <- function(x, abc) mapply(function(y) y, x) y0 <- foo(1:2) foo <- function(x, abc) future_mapply(function(y) y, x) y <- foo(1:2) stopifnot(identical(y, y0)) message("*** future_mapply() - missing arguments ... DONE") message("*** future_mapply() - false positives ...") ## Here 'abc' becomes a promise, which fails to resolve ## iff 'xyz' does not exist. (Issue #161) suppressWarnings(rm(list = "xyz")) foo <- function(x, abc) mapply(function(y) y, x) y0 <- foo(1:2, abc = (xyz >= 3.14)) foo <- function(x, abc) future_mapply(function(y) y, x) y <- foo(1:2, abc = (xyz >= 3.14)) stopifnot(identical(y, y0)) message("*** future_mapply() - false positives ... DONE") message("*** future_mapply() - too large ...") X <- replicate(10L, 1:100, simplify = FALSE) FUN <- function(x) { getOption("future.globals.maxSize") } y0 <- mapply(FUN = FUN, X) sizes <- unclass(c(FUN = object.size(FUN), X = object.size(X))) cat(sprintf("Baseline size of globals: %.2f KiB\n", sizes[["FUN"]] / 1024)) message("- true positive ...") oMaxSize <- getOption("future.globals.maxSize") options(future.globals.maxSize = 1L) res <- tryCatch({ y <- future_mapply(FUN = FUN, X) }, error = identity) stopifnot(inherits(res, "error")) res <- NULL options(future.globals.maxSize = oMaxSize) maxSize <- getOption("future.globals.maxSize") y <- future_mapply(FUN = FUN, X) str(y) stopifnot(all(sapply(y, FUN = identical, oMaxSize))) message("- approximately invariant to chunk size ...") maxSize <- sizes[["FUN"]] + sizes[["X"]] / length(X) maxSize <- 4.0 * maxSize ## Add a bit of leeway options(future.globals.maxSize = maxSize) for (chunk.size in c(1L, 2L, 5L, structure(10L, ordering = "random"))) { y <- future_mapply(FUN = FUN, X, future.chunk.size = chunk.size) str(y) stopifnot(all(unlist(y) == maxSize)) cat(sprintf("maxSize = %g bytes\nfuture.globals.maxSize = %g bytes\n", maxSize, getOption("future.globals.maxSize"))) stopifnot(getOption("future.globals.maxSize") == maxSize) } y <- NULL options(future.globals.maxSize = oMaxSize) message("*** future_mapply() - too large ... DONE") message("*** future_mapply() - globals exceptions ...") res <- tryCatch({ y <- future_mapply(function(x) x, 1, future.globals = 42) }, error = identity) stopifnot(inherits(res, "error")) res <- tryCatch({ y <- future_mapply(function(x) x, 1, future.globals = list(1)) }, error = identity) stopifnot(inherits(res, "error")) res <- tryCatch({ y <- future_mapply(function(x) x, 1, future.globals = "...future.FUN") }, error = identity) stopifnot(inherits(res, "error")) ...future.elements_ii <- 42L X <- list(function() 2 * ...future.elements_ii) res <- tryCatch({ y <- future_mapply(FUN = function(f) f(), X) }, error = identity) stopifnot(inherits(res, "error")) message("*** future_mapply() - globals exceptions ... DONE") ================================================ FILE: inst/testme/test-future_mapply.R ================================================ #' @tags future_mapply #' @tags sequential multisession multicore library(future.apply) message("*** future_mapply() ...") message("- Parallel RNG truth (for later)...") plan(sequential) y_rng_0 <- future_mapply(stats::runif, n = 1:4, max = 2:5, MoreArgs = list(min = 1), future.seed = 0xBEEF) print(y_rng_0) for (strategy in supportedStrategies()) { message(sprintf("*** strategy = %s ...", sQuote(strategy))) plan(strategy) message("- From example(mapply) ...") y0 <- mapply(rep, 1:4, 4:1) y1 <- future_mapply(rep, 1:4, 4:1) stopifnot(identical(y1, y0)) y2 <- future_mapply("rep", 1:4, 4:1) stopifnot(identical(y2, y0)) y0 <- mapply(rep, times = 1:4, x = 4:1) y1 <- future_mapply(rep, times = 1:4, x = 4:1) stopifnot(identical(y1, y0)) y0 <- mapply(rep, times = 1:4, MoreArgs = list(x = 42)) y1 <- future_mapply(rep, times = 1:4, MoreArgs = list(x = 42)) stopifnot(identical(y1, y0)) y0 <- mapply(function(x, y) seq_len(x) + y, c(a = 1, b = 2, c = 3), # names from first c(A = 10, B = 0, C = -10)) y1 <- future_mapply(function(x, y) seq_len(x) + y, c(a = 1, b = 2, c = 3), # names from first c(A = 10, B = 0, C = -10)) stopifnot(identical(y1, y0)) message("- future_.mapply()") dots <- list(c(a = 1, b = 2, c = 3), # names from first c(A = 10, B = 0, C = -10)) y2 <- .mapply(function(x, y) seq_len(x) + y, dots = dots, MoreArgs = list()) names(y0) <- NULL ## .mapply() don't set names stopifnot(all.equal(y2, y0)) y3 <- future_.mapply(function(x, y) seq_len(x) + y, dots = dots, MoreArgs = list()) stopifnot(all.equal(y3, y2)) word <- function(C, k) paste(rep.int(C, k), collapse = "") for (chunk.size in list(1L, structure(2L, ordering = "random"), structure(3L, ordering = 5:1))) { y0 <- mapply(word, LETTERS[1:5], 5:1, SIMPLIFY = FALSE) y1 <- future_mapply(word, LETTERS[1:5], 5:1, SIMPLIFY = FALSE, future.chunk.size = chunk.size) stopifnot(identical(y1, y0)) dots <- list(LETTERS[1:5], 5:1) MoreArgs <- list() y2 <- .mapply(word, dots = dots, MoreArgs = list()) names(y0) <- NULL ## .mapply() don't set names stopifnot(all.equal(y2, y0)) y3 <- future_.mapply(word, dots = dots, MoreArgs = list()) stopifnot(all.equal(y3, y2)) } message("- Subsetting (Issue #17) ...") X <- as.Date("2018-06-01") y0 <- mapply(FUN = identity, X, SIMPLIFY = FALSE) y1 <- future_mapply(FUN = identity, X, SIMPLIFY = FALSE) stopifnot(identical(y1, y0)) dots <- list(X) y2 <- .mapply(FUN = identity, dots = dots, MoreArgs = MoreArgs) stopifnot(identical(y2, y0)) y3 <- future_.mapply(FUN = identity, dots = dots, MoreArgs = MoreArgs) stopifnot(identical(y3, y2)) message("- Non-recycling of MoreArgs (Issue #51) ...") y0 <- base::mapply( function(x, y) y, x = 1:2, MoreArgs = list(y = 3:4) ) y1 <- future.apply::future_mapply( function(x, y) y, x = 1:2, MoreArgs = list(y = 3:4), future.seed = FALSE ) stopifnot(identical(y1, y0)) y2 <- future.apply::future_mapply( function(x, y) y, x = 1:2, MoreArgs = list(y = 3:4), future.seed = TRUE ) stopifnot(identical(y2, y0)) dots <- list(x = 1:2) MoreArgs <- list(y = 3:4) y3 <- .mapply(function(x, y) y, dots = dots, MoreArgs = MoreArgs) y4 <- future_.mapply(function(x, y) y, dots = dots, MoreArgs = MoreArgs) stopifnot(identical(y4, y3)) message("- Recycle arguments to same length ...") y0 <- mapply(rep, 1:4, 2:1) y1 <- future_mapply(rep, 1:4, 2:1) stopifnot(identical(y1, y0)) message("- Parallel RNG ...") y_rng_1 <- future_mapply(stats::runif, n = 1:4, max = 2:5, MoreArgs = list(min = 1), future.seed = 0xBEEF) print(y_rng_1) stopifnot(all.equal(y_rng_1, y_rng_0)) message("- future_Map() ...") xs <- replicate(5, stats::runif(10), simplify = FALSE) ws <- replicate(5, stats::rpois(10, 5) + 1, simplify = FALSE) y0 <- Map(weighted.mean, xs, ws) y1 <- future_Map(stats::weighted.mean, xs, ws) stopifnot(all.equal(y1, y0)) message("- future_mapply() - 'max-or-0-if' recycling rule ...") ## R (>= 4.2.0): mapply() & Map() follow usual "max-or-0-if" recycling rule ## and keeps returning a named list in the "empty" case. truth <- list() if (getRversion() >= "4.2.0") { y0 <- mapply(`+`, 1:3, NULL) stopifnot(identical(y0, truth)) } y <- future_mapply(`+`, 1:3, NULL) stopifnot(identical(y, truth)) truth <- setNames(list(), character()) if (getRversion() >= "4.2.0") { y0 <- mapply(paste, character(), NULL) stopifnot(identical(y0, truth)) } y <- future_mapply(paste, character(), NULL) stopifnot(identical(y, truth)) if (getRversion() >= "4.2.0") { y0 <- mapply(paste, character(), letters) stopifnot(identical(y0, truth)) } y <- future_mapply(paste, character(), letters) stopifnot(identical(y, truth)) if (getRversion() >= "4.2.0") { y0 <- mapply(paste, "A", character()) stopifnot(identical(y0, truth)) } y <- future_mapply(paste, "A", character()) stopifnot(identical(y, truth)) if (getRversion() >= "4.2.0") { y0 <- mapply(paste, character(), letters) stopifnot(identical(y0, truth)) } y <- future_mapply(paste, character(), letters) stopifnot(identical(y, truth)) if (getRversion() >= "4.2.0") { y0 <- mapply(paste, character(), NULL) stopifnot(identical(y0, truth)) } y <- future_mapply(paste, character(), NULL) stopifnot(identical(y, truth)) if (getRversion() >= "4.2.0") { y0 <- mapply(paste, character(), letters) stopifnot(identical(y0, truth)) } y <- future_mapply(paste, character(), letters) stopifnot(identical(y, truth)) if (getRversion() >= "4.2.0") { y0 <- mapply(paste, "A", character()) stopifnot(identical(y0, truth)) } y <- future_mapply(paste, "A", character()) stopifnot(identical(y, truth)) if (getRversion() >= "4.2.0") { y0 <- mapply(paste, character(), letters) stopifnot(identical(y0, truth)) } y <- future_mapply(paste, character(), letters) stopifnot(identical(y, truth)) ## Gives an error in R-devel (2021-11-26 r81252) if (getRversion() >= "4.2.0" && FALSE) { y0 <- mapply(paste, c(a = "A"), character()) stopifnot(identical(y0, truth)) } y <- future_mapply(paste, c(a = "A"), character()) stopifnot(identical(y, truth)) ## R (>= 4.2.0): Map() now recycles similar to basic Ops: truth <- as.list(1 + 1:3) if (getRversion() >= "4.2.0") { y0 <- Map(`+`, 1, 1:3) stopifnot(identical(y0, truth)) } y <- future_Map(`+`, 1, 1:3) stopifnot(identical(y, truth)) truth <- as.list(numeric() + 1:3) if (getRversion() >= "4.2.0") { y0 <- Map(`+`, numeric(), 1:3) stopifnot(identical(y0, truth)) } y <- future_Map(`+`, numeric(), 1:3) stopifnot(identical(y, truth)) message("- future_mapply(x, ...) where x[[i]] subsets via S3 method ...") x <- structure(list(a = 1, b = 2), class = "Foo") `[[.Foo` <- function(x, ...) 0 y0 <- mapply(x, FUN = identity) stopifnot(identical(y0, c(a = 0, b = 0))) y1 <- future_mapply(x, FUN = identity) if (getOption("future.apply.chunkWith", "[[") == "[") { stopifnot(identical(y1, unlist(x))) } else { stopifnot(identical(y1, y0)) } plan(sequential) message(sprintf("*** strategy = %s ... done", sQuote(strategy))) } ## for (strategy in ...) message("- Empty input [non parallel] ...") y0 <- mapply(search) y1 <- future_mapply(search) stopifnot(identical(y1, y0)) y0 <- mapply(list, integer(0L)) y1 <- future_mapply(list, integer(0L)) stopifnot(identical(y1, y0)) message("*** future_mapply() - special cases ...") X <- list() names(X) <- character(0L) y <- future_mapply(FUN = identity, X) stopifnot(length(y) == 0L, !is.null(names(y)), identical(y, X)) y <- future_mapply(FUN = identity, X, X) stopifnot(length(y) == 0L, !is.null(names(y)), identical(y, X)) message("*** future_mapply() - special cases ... DONE") message("*** future_mapply() ... DONE") ================================================ FILE: inst/testme/test-future_replicate.R ================================================ library(future.apply) message("*** future_replicate() ...") for (strategy in supportedStrategies()) { message(sprintf("*** strategy = %s ...", sQuote(strategy))) plan(strategy) y0 <- replicate(5L, sample(10L, size = 1L)) y1 <- future_replicate(5L, sample(10L, size = 1L)) stopifnot(length(y0) == length(y1)) set.seed(0xBEEF) y1 <- future_replicate(5L, sample(10L, size = 1L)) set.seed(0xBEEF) y2 <- future_replicate(5L, sample(10L, size = 1L)) stopifnot(all.equal(y2, y1)) y3 <- future_replicate(5L, sample(10L, size = 1L), future.seed = 0xBEEF) y4 <- future_replicate(5L, sample(10L, size = 1L), future.seed = 0xBEEF) stopifnot(all.equal(y4, y3)) message("- example(replicate) ...") foo <- function(x = 1, y = 2) c(x, y) bar0 <- function(n, x) replicate(n, foo(x = x)) y0 <- bar0(5, x = 3) bar1 <- function(n, x) future_replicate(n, foo(x = x)) y1 <- bar1(5, x = 3) stopifnot(all.equal(y1, y0)) plan(sequential) message(sprintf("*** strategy = %s ... done", sQuote(strategy))) } ## for (strategy in ...) message("*** future_replicate() ... DONE") ================================================ FILE: inst/testme/test-future_sapply.R ================================================ #' @tags future_sapply #' @tags sequential multisession multicore library(future.apply) message("*** future_sapply() ...") xs <- list( A = c(a = 1, b = 2, c = 3), B = c(a = 1:2, b = 2:3, c = 3:4), C = letters[1:3], D = structure(10 * 5:8, names = LETTERS[1:4]) ) FUNS <- list( a = identity, b = as.matrix, c = function(x, y = 2 * 1:5) outer(rep(x, length.out = 3L), y) ) for (strategy in supportedStrategies()) { message(sprintf("*** strategy = %s ...", sQuote(strategy))) plan(strategy) for (x in xs) { FUNS_x <- FUNS if (!is.numeric(x)) FUNS_x[["c"]] <- NULL for (USE.NAMES in list(FALSE, TRUE)) { for (simplify in list(FALSE, TRUE, "array")) { for (FUN in FUNS_x) { y0 <- sapply(x, FUN = FUN, USE.NAMES = USE.NAMES, simplify = simplify) y1 <- future_sapply(x, FUN = FUN, USE.NAMES = USE.NAMES, simplify = simplify) str(list(y0 = y0, y1 = y1)) stopifnot(identical(y1, y0)) if (identical(simplify, FALSE)) { y2 <- lapply(x, FUN = FUN) str(list(y0 = y0, y2 = y2)) stopifnot(identical(unname(y2), unname(y0))) } } } } } y0 <- sapply(1:3, FUN = "sqrt") y1 <- future_sapply(1:3, FUN = "sqrt") stopifnot(identical(y1, y0)) ## https://github.com/futureverse/future.apply/issues/61 # compute <- function(a, x_vec) a + x_vec # call_compute <- function(..., x_vec = 1:2){ # compute_with_dots <- function(x) compute(..., x_vec = x) # future_sapply(x_vec, FUN = compute_with_dots) # } # y <- call_compute(0L) # print(y) # stopifnot(identical(y, 1:2)) plan(sequential) message(sprintf("*** strategy = %s ... done", sQuote(strategy))) } ## for (strategy in ...) message("*** future_sapply() ... DONE") ================================================ FILE: inst/testme/test-future_tapply.R ================================================ #' @tags future_tapply #' @tags sequential multisession multicore library(future.apply) library("datasets") ## warpbreaks, iris options(future.debug = FALSE) message("*** future_tapply() ...") for (strategy in supportedStrategies()[1]) { message(sprintf("*** strategy = %s ...", sQuote(strategy))) plan(strategy) message("- From example(tapply) ...") message(" - Example #1") library("stats") ## rbinom() groups <- as.factor(stats::rbinom(32, n = 5, prob = 0.4)) t <- table(groups) print(t) y0 <- tapply(groups, INDEX = groups, FUN = length) print(y0) y1 <- future_tapply(groups, INDEX = groups, FUN = length) print(y1) stopifnot(all.equal(y1, y0)) y2 <- future_tapply(groups, INDEX = groups, FUN = "length") print(y2) stopifnot(all.equal(y2, y0)) message(" - Example #2") ## contingency table from data.frame : array with named dimnames y0 <- tapply(warpbreaks$breaks, INDEX = warpbreaks[,-1], FUN = sum) print(y0) y1 <- future_tapply(warpbreaks$breaks, INDEX = warpbreaks[,-1], FUN = sum) print(y1) stopifnot(all.equal(y1, y0)) message(" - Example #3") y0 <- tapply(warpbreaks$breaks, warpbreaks[, 3, drop = FALSE], sum) print(y0) y1 <- future_tapply(warpbreaks$breaks, warpbreaks[, 3, drop = FALSE], sum) print(y1) stopifnot(all.equal(y1, y0)) message(" - Example #4") n <- 17 fac <- factor(rep_len(1:3, n), levels = 1:5) t <- table(fac) y0 <- tapply(1:n, fac, sum) print(y0) y1 <- future_tapply(1:n, fac, sum) print(y1) stopifnot(all.equal(y1, y0)) message(" - Example #5") if ("default" %in% names(formals(tapply))) { y0 <- tapply(1:n, fac, sum, default = 0) # maybe more desirable print(y0) y1 <- future_tapply(1:n, fac, sum, default = 0) # maybe more desirable print(y1) stopifnot(all.equal(y1, y0)) } message(" - Example #6") y0 <- tapply(1:n, fac, sum, simplify = FALSE) print(y0) y1 <- future_tapply(1:n, fac, sum, simplify = FALSE) print(y1) stopifnot(all.equal(y1, y0)) message(" - Example #7") y0 <- tapply(1:n, fac, range) print(y0) y1 <- future_tapply(1:n, fac, range) print(y1) stopifnot(all.equal(y1, y0)) message(" - Example #8") y0 <- tapply(1:n, fac, quantile) print(y0) y1 <- future_tapply(1:n, fac, quantile) print(y1) stopifnot(all.equal(y1, y0)) message(" - Example #9") y0 <- tapply(1:n, fac, length) ## NA's print(y0) y1 <- future_tapply(1:n, fac, length) ## NA's print(y1) stopifnot(all.equal(y1, y0)) message(" - Example #10") if ("default" %in% names(formals(tapply))) { y0 <- tapply(1:n, fac, length, default = 0) # == table(fac) print(y0) y1 <- future_tapply(1:n, fac, length, default = 0) # == table(fac) print(y1) stopifnot(all.equal(y1, y0)) } message(" - Example #11") ## example of ... argument: find quarterly means y0 <- tapply(presidents, cycle(presidents), mean, na.rm = TRUE) print(y0) y1 <- future_tapply(presidents, cycle(presidents), mean, na.rm = TRUE) print(y1) stopifnot(all.equal(y1, y0)) message(" - Example #12") ind <- list(c(1, 2, 2), c("A", "A", "B")) t <- table(ind) print(t) y0 <- tapply(1:3, ind) #-> the split vector print(y0) y1 <- future_tapply(1:3, ind) #-> the split vector print(y1) stopifnot(all.equal(y1, y0)) message(" - Example #13") y0 <- tapply(1:3, ind, sum) print(y0) y1 <- future_tapply(1:3, ind, sum) print(y1) stopifnot(all.equal(y1, y0)) ## Some assertions (not held by all patch propsals): message(" - Example #14") nq <- names(quantile(1:5)) y_truth <- c(1L, 2L, 4L) stopifnot(identical(tapply(1:3, ind), y_truth)) stopifnot(identical(future_tapply(1:3, ind), y_truth)) message(" - Example #15") y_truth <- matrix(c(1L, 2L, NA, 3L), nrow = 2L, dimnames = list(c("1", "2"), c("A", "B"))) stopifnot(identical(tapply(1:3, ind, sum), y_truth)) stopifnot(identical(future_tapply(1:3, ind, sum), y_truth)) message(" - Example #16") y_truth <- array(list( `2` = structure(c(2, 5.75, 9.5, 13.25, 17), .Names = nq), `3` = structure(c(3, 6, 9, 12, 15), .Names = nq), `4` = NULL, `5` = NULL), dim = 4L, dimnames = list(as.character(2:5))) stopifnot(identical(tapply(1:n, fac, quantile)[-1], y_truth)) stopifnot(identical(future_tapply(1:n, fac, quantile)[-1], y_truth)) if (getRversion() >= "4.3.0") { data <- iris[, c("Sepal.Length", "Sepal.Width")] y_truth <- tapply(data, INDEX = iris$Species, FUN = sum) y <- future_tapply(data, INDEX = iris$Species, FUN = sum) stopifnot(identical(y, y_truth)) y_truth2 <- tapply(data, INDEX = ~ iris$Species + iris$Petal.Width, FUN = sum) y2 <- future_tapply(data, INDEX = ~ iris$Species + iris$Petal.Width, FUN = sum) stopifnot(identical(y2, y_truth2)) } plan(sequential) message(sprintf("*** strategy = %s ... done", sQuote(strategy))) } ## for (strategy in ...) message("*** exceptions ...") ## Error: 'INDEX' is of length zero res <- tryCatch({ y <- future_tapply(1L, INDEX = list()) }, error = identity) stopifnot(inherits(res, "error")) ## Error: total number of levels >= 2^31 res <- tryCatch({ y <- future_tapply(1:216, INDEX = rep(list(1:216), times = 4L)) }, error = identity) stopifnot(inherits(res, "error")) ## Error: arguments must have same length res <- tryCatch({ y <- future_tapply(1L, INDEX = list(1:2)) }, error = identity) stopifnot(inherits(res, "error")) message("*** future_tapply() ... DONE") ================================================ FILE: inst/testme/test-future_vapply.R ================================================ #' @tags future_vapply #' @tags detritus-files #' @tags sequential multisession multicore library(future.apply) message("*** future_vapply() ...") for (strategy in supportedStrategies()) { message(sprintf("*** strategy = %s ...", sQuote(strategy))) plan(strategy) x <- NULL fun <- is.factor fun_name <- "is.factor" fun_value <- logical(1L) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) y2 <- future_vapply(x, FUN = fun_name, FUN.VALUE = fun_value) str(y2) stopifnot(all.equal(y2, y0)) x <- list() fun <- is.numeric fun_value <- logical(1L) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) x <- integer() fun <- identity fun_value <- fun(integer(1L)) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) df <- data.frame(x = 1:10, y = letters[1:10], stringsAsFactors=FALSE) fun <- class fun_value <- character(1L) y0 <- vapply(df, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(df, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) x <- 1:10 fun <- function(x) double(0L) fun_value <- fun(double(1L)) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) fun <- function(x) integer(0L) fun_value <- fun(double(1L)) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) fun <- sqrt fun_value <- fun(double(1L)) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) fun <- function(x) c(x, x^2) fun_value <- fun(double(1L)) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) fun <- function(x) matrix(x, nrow = 2L, ncol = 2L) fun_value <- fun(integer(1L)) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) fun <- function(x) matrix(x, nrow = 2L, ncol = 2L) fun_value <- fun(double(1L)) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) ## Ditto with dimnames on FUN.VALUE fun <- function(x) { matrix(x, nrow = 2L, ncol = 2L, dimnames = list(c("a", "b"), c("A", "B"))) } fun_value <- fun(double(1L)) y0 <- vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y0) y1 <- future_vapply(x, FUN = fun, FUN.VALUE = fun_value) str(y1) stopifnot(all.equal(y1, y0)) message("- From example(vapply) ...") x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE, FALSE, FALSE, TRUE)) y0 <- vapply(x, FUN = quantile, FUN.VALUE = double(5L)) y1 <- future_vapply(x, FUN = quantile, FUN.VALUE = double(5L)) str(y1) stopifnot(all.equal(y1, y0)) i39 <- sapply(3:9, seq) ys0 <- sapply(i39, fivenum) ys1 <- future_sapply(i39, fivenum) stopifnot(all.equal(ys1, ys0)) yv0 <- vapply(i39, fivenum, c(Min. = 0, "1st Qu." = 0, Median = 0, "3rd Qu." = 0, Max. = 0)) yv1 <- future_vapply(i39, fivenum, c(Min. = 0, "1st Qu." = 0, Median = 0, "3rd Qu." = 0, Max. = 0)) str(yv1) stopifnot(all.equal(yv1, yv0)) v <- structure(10*(5:8), names = LETTERS[1:4]) f <- function(x, y) outer(rep(x, length.out = 3L), y) ys0 <- sapply(v, f, y = 2*(1:5), simplify = "array") ys1 <- future_sapply(v, f, y = 2*(1:5), simplify = "array") stopifnot(all.equal(ys1, ys0)) fv <- outer(1:3, 1:5) y <- 2*(1:5) yv0 <- vapply(v, f, fv, y = y) yv1 <- future_vapply(v, f, fv, y = y) str(yv1) stopifnot(all.equal(yv1, yv0)) y0 <- vapply(mtcars, FUN = is.numeric, FUN.VALUE = logical(1L)) y1 <- future_vapply(mtcars, FUN = is.numeric, FUN.VALUE = logical(1L)) str(y1) stopifnot(all.equal(y1, y0)) message("- future_vapply(x, ...) where length(x) != length(as.list(x)) ...") x <- structure(list(a = 1, b = 2), class = "Foo") as.list.Foo <- function(x, ...) c(x, c = 3) y0 <- vapply(x, FUN = length, FUN.VALUE = -1L) y1 <- future_vapply(x, FUN = length, FUN.VALUE = -1L) stopifnot(identical(y1, y0)) message("- exceptions ...") res <- tryCatch({ y0 <- vapply(1:3, FUN = identity, FUN.VALUE = c(3, 3)) }, error = identity) stopifnot(inherits(res, "error")) res <- tryCatch({ y1 <- future_vapply(1:3, FUN = identity, FUN.VALUE = c(3, 3)) }, error = identity) stopifnot(inherits(res, "error")) plan(sequential) message(sprintf("*** strategy = %s ... done", sQuote(strategy))) } ## for (strategy in ...) message("*** future_vapply() ... DONE") ================================================ FILE: inst/testme/test-globals,tricky2.R ================================================ #' @tags future_apply #' @tags globals #' @tags detritus-files #' @tags sequential multisession multicore if (packageVersion("future") > "1.49.0" && isTRUE(getOption("future.globals.keepWhere"))) { library(future.apply) options(future.debug = FALSE) foo <- function(..., FUN = function(...) list(...)) { args <- list(...) future_lapply(1L, FUN = function(x) { do.call(FUN, args = c(list(x), args)) }) } bar <- function(..., fun = function(...) list(...)) { future_lapply(1L, FUN = function(x) fun(x, ...)) } yaa <- function(..., FUN = function(...) list(...)) { future_lapply(1L, FUN = function(x) { do.call(FUN, args = c(list(x), ...)) }) } for (strategy in supportedStrategies()) { message(sprintf("- plan('%s') ...", strategy)) plan(strategy) x1 <- foo() y1 <- bar() stopifnot(identical(y1, x1)) z1 <- yaa() stopifnot(identical(z1, x1)) x2 <- foo(a = 2) y2 <- bar(a = 2) z2 <- yaa(a = 2) stopifnot(identical(y2, x2)) stopifnot(identical(z2, x2)) message(sprintf("- plan('%s') ... done", strategy)) } } ## if (packageVersion("future") > ...) ================================================ FILE: inst/testme/test-globals,tricky_recursive.R ================================================ #' @tags future_apply #' @tags globals #' @tags sequential multisession multicore library(future.apply) ## Test adopted from http://stackoverflow.com/questions/42561088/nested-do-call-within-a-foreach-dopar-environment-cant-find-function-passed-w options(future.debug = FALSE) message("*** Tricky globals requiring recursive search ...") my_add <- function(a, b) a + b call_my_add <- function(a, b) { do.call(my_add, args = list(a = a, b = b)) } call_my_add_caller <- function(a, b, FUN = call_my_add) { do.call(FUN, args = list(a = a, b = b)) } main_lapply <- function(x = 1:2, caller = call_my_add_caller, args = list(FUN = call_my_add)) { lapply(x, FUN = function(i) { do.call(caller, args = c(list(a = i, b = i+1L), args)) }) } main_lapply_no_FUN <- function(x = 1:2, caller = call_my_add_caller, args = list(FUN = call_my_add)) { lapply(x, FUN = function(i) { do.call(caller, args = list(a = i, b = i+1L)) }) } main_future_lapply <- function(x = 1:2, caller = call_my_add_caller, args = list(FUN = call_my_add)) { future_lapply(x, FUN = function(i) { do.call(caller, args = c(list(a = i, b = i + 1L), args)) }) } main_future_lapply_no_FUN <- function(x = 1:2, caller = call_my_add_caller, args = list(FUN = call_my_add)) { future_lapply(x, FUN = function(i) { do.call(caller, args = list(a = i, b = i + 1L)) }) } x0 <- y0 <- z0 <- NULL for (strategy in supportedStrategies()) { message(sprintf("*** strategy = %s ...", sQuote(strategy))) plan(strategy) z <- main_lapply() str(list(z = z)) if (is.null(z0)) z0 <- z stopifnot(identical(z, z0)) z2 <- main_lapply_no_FUN() str(list(z2 = z2)) stopifnot(identical(z2, z0)) z3 <- main_future_lapply() str(list(z3 = z3)) stopifnot(identical(z3, z0)) z4 <- main_future_lapply_no_FUN() str(list(z4 = z4)) stopifnot(identical(z4, z0)) message(sprintf("*** strategy = %s ... DONE", sQuote(strategy))) } message("*** Tricky globals requiring recursive search ... DONE") ================================================ FILE: inst/testme/test-options,nested.R ================================================ #' @tags future_lapply #' @tags sequential multisession multicore library(future.apply) message("*** Options in nested parallelization ...") options(future.debug = FALSE) options(future.apply.debug = FALSE) options(future.globals.maxSize = 2.50 * 1024^2) for (cores in 1:availCores) { message(sprintf("Testing with %d cores ...", cores)) options(mc.cores = cores) strategies <- supportedStrategies(cores) for (strategy1 in strategies) { for (strategy2 in strategies) { message(sprintf("- plan(list('%s', '%s')) ...", strategy1, strategy2)) plan(list(outer = strategy1, inner = strategy2)) v <- future_lapply(1:2, FUN = function(x) { outer <- data.frame( label = "outer", idx = x, pid = Sys.getpid(), maxSize = getOption("future.globals.maxSize", NA_real_) ) inner <- future_lapply(3:4, FUN = function(x) { data.frame( label = "inner", idx = x, pid = Sys.getpid(), maxSize = getOption("future.globals.maxSize", NA_real_)) }) inner <- do.call(rbind, inner) rbind(outer, inner) }) v <- do.call(rbind, v) print(v) stopifnot(!anyNA(v$maxSize)) } ## for (strategy2 ...) } ## for (strategy1 ...) } ## for (cores in ...) message("*** Options in nested parallelization ... done") ================================================ FILE: inst/testme/test-rng.R ================================================ #' @tags rng loadNamespace("future.apply") message("*** RNG ...") set_random_seed(seed = NULL) seed <- get_random_seed() stopifnot(is.null(seed)) set_random_seed(seed = 42L) seed <- get_random_seed() stopifnot(identical(seed, 42L)) res <- tryCatch({ seed <- as_lecyer_cmrg_seed(seed = FALSE) }, error = identity) print(res) stopifnot(inherits(res, "error")) seed <- as_lecyer_cmrg_seed(seed = 42L) str(seed) stopifnot(is_lecyer_cmrg_seed(seed)) set_random_seed(seed = seed) stopifnot(identical(get_random_seed(), seed)) seed2 <- as_lecyer_cmrg_seed(seed = TRUE) str(seed2) stopifnot(identical(seed2, seed)) seed3 <- as_lecyer_cmrg_seed(seed = seed) str(seed3) stopifnot(identical(seed3, seed)) ## A random seed seed4 <- as_lecyer_cmrg_seed(seed = NA) str(seed4) stopifnot(is_lecyer_cmrg_seed(seed4)) message(" - make_rng_seeds ...") seeds <- make_rng_seeds(2L, seed = NULL) stopifnot(is.null(seeds)) seeds <- make_rng_seeds(2L, seed = FALSE) stopifnot(is.null(seeds)) seeds <- make_rng_seeds(0L, seed = 42L) stopifnot(length(seeds) == 0L, identical(seeds, list())) seeds <- make_rng_seeds(2L, seed = TRUE) stopifnot(length(seeds) == 2L, all(sapply(seeds, FUN = is_lecyer_cmrg_seed))) seeds <- make_rng_seeds(3L, seed = 42L) stopifnot(length(seeds) == 3L, all(sapply(seeds, FUN = is_lecyer_cmrg_seed))) seeds <- make_rng_seeds(1L, seed = 42L) stopifnot(length(seeds) == 1L, all(sapply(seeds, FUN = is_lecyer_cmrg_seed))) seeds0 <- lapply(1:3, FUN = as_lecyer_cmrg_seed) seeds <- make_rng_seeds(length(seeds0), seed = seeds0) stopifnot(length(seeds) == length(seeds0), all(sapply(seeds, FUN = is_lecyer_cmrg_seed))) message(" - exceptions ...") ## Invalid L'Ecuyer seed seed_invalid <- seed + 1L res <- tryCatch({ seed <- as_lecyer_cmrg_seed(seed = seed_invalid) }, error = identity) print(res) stopifnot(inherits(res, "error")) ## Invalid seed res <- tryCatch({ seed <- as_lecyer_cmrg_seed(seed = 1:2) }, error = identity) print(res) stopifnot(inherits(res, "error")) ## Invalid length seeds0 <- lapply(1:2, FUN = as_lecyer_cmrg_seed) res <- tryCatch({ seeds <- make_rng_seeds(1L, seed = seeds0) }, error = identity) print(res) stopifnot(inherits(res, "error")) ## Seeds of different kinds seeds0 <- lapply(1:2, FUN = as_lecyer_cmrg_seed) seeds0[[1]] <- seeds0[[1]][-1] res <- tryCatch({ seeds <- make_rng_seeds(2L, seed = seeds0) }, error = identity) print(res) stopifnot(inherits(res, "error")) ## List of scalar seeds? res <- tryCatch({ seeds <- make_rng_seeds(1L, seed = list(42L)) }, error = identity) print(res) stopifnot(inherits(res, "error")) ## Not seeds at all? seeds0 <- lapply(1:2, FUN = as_lecyer_cmrg_seed) seeds0[[1]] <- letters[1:7] res <- tryCatch({ seeds <- make_rng_seeds(2L, seed = seeds0) }, error = identity) print(res) stopifnot(inherits(res, "error")) ## Invalid seeds? seeds0 <- lapply(1:2, FUN = as_lecyer_cmrg_seed) seeds0 <- lapply(seeds0, FUN = rev) res <- tryCatch({ seeds <- make_rng_seeds(2L, seed = seeds0) }, error = identity) print(res) stopifnot(inherits(res, "error")) message(" - replicated RNG draws") library(future.apply) seed_org <- next_random_seed() set.seed(42) ## Draw two random number from 1:100 one after the other seed_before <- get_random_seed() kind_before <- RNGkind() x <- sample.int(100L, size = 5L) y <- sample.int(100L, size = 5L) seed_after <- get_random_seed() kind_after <- RNGkind() print(c(x, y)) ## Draw two random number from 1:100 at once set_random_seed(seed_before) kind_before2 <- RNGkind() z <- sample.int(100L, size = 10L) seed_after2 <- get_random_seed() kind_after2 <- RNGkind() print(z) ## The RNG state is the same after the second ... ## run as after the first, two-step, approach stopifnot(identical(seed_after2, seed_after)) stopifnot(identical(kind_before2, kind_before)) stopifnot(identical(kind_after2, kind_after)) ## .... and the exact same set of random numbers where ## drawn [only true in R (>= 4.0.0)] if (getRversion() >= "4.0.0") { stopifnot(identical(z, c(x, y))) } else { stopifnot(identical(z[seq_along(x)], x)) } set_random_seed(seed_org) stopifnot(identical(get_random_seed(), seed_org)) message("*** RNG ... DONE") ================================================ FILE: inst/testme/test-stdout.R ================================================ #' @tags future_lapply future_mapply #' @tags sequential multisession multicore library(future.apply) message("*** future_*apply() and 'future.stdout' ...") options(future.debug = TRUE) truth <- list() out <- utils::capture.output({ y <- lapply(1:0, FUN = function(x) { print(x) }) }) truth[["lapply"]] <- list(value = y, stdout = out) out <- utils::capture.output({ y <- mapply(1:0, 0:1, FUN = function(x, y) { print(list(x = x, y = y)) }) }) truth[["mapply"]] <- list(value = y, stdout = out) for (cores in 1:availCores) { message(sprintf(" - Testing with %d cores ...", cores)) options(mc.cores = cores) for (strategy in supportedStrategies(cores)) { message(sprintf("* plan('%s') ...", strategy)) plan(strategy) for (fun in names(truth)) { for (stdout in c(FALSE, TRUE, NA)) { message(sprintf("* future_%s(x, ..., future.stdout = %s) ...", fun, stdout)) out <- utils::capture.output({ if (fun == "lapply") { y <- future_lapply(1:0, FUN = function(x) { Sys.sleep(x / 2) ## make futures resolve out of order print(x) }, future.stdout = stdout) } else if (fun == "mapply") { y <- future_mapply(1:0, 0:1, FUN = function(x, y) { Sys.sleep(x / 2) ## make futures resolve out of order print(list(x = x, y = y)) }, future.stdout = stdout) } }) stopifnot(identical(y, truth[[fun]]$value)) if (isTRUE(stdout)) { stopifnot(identical(out, truth[[fun]]$stdout)) } else if (is.na(stdout)) { } else { stopifnot(nchar(out) == 0) } message(sprintf("* future_%s(x, ..., future.stdout = %s) ... DONE", fun, stdout)) } ## for (stdout ...) } ## for (fun ...) message(sprintf("* plan('%s') ... DONE", strategy)) } message(sprintf(" - Testing with %d cores ... DONE", cores)) } message("*** future_*apply() and 'future.stdout' ... DONE") ================================================ FILE: inst/testme/test-utils.R ================================================ loadNamespace("future.apply") stop_if_not <- future.apply:::stop_if_not message("*** utils ...") message("*** hpaste() ...") # Some vectors x <- 1:6 y <- 10:1 z <- LETTERS[x] # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # Abbreviation of output vector # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - printf("x = %s.\n", hpaste(x)) ## x = 1, 2, 3, ..., 6. printf("x = %s.\n", hpaste(x, maxHead = 2)) ## x = 1, 2, ..., 6. printf("x = %s.\n", hpaste(x, maxHead = 3)) # Default ## x = 1, 2, 3, ..., 6. # It will never output 1, 2, 3, 4, ..., 6 printf("x = %s.\n", hpaste(x, maxHead = 4)) ## x = 1, 2, 3, 4, 5 and 6. # Showing the tail printf("x = %s.\n", hpaste(x, maxHead = 1, maxTail = 2)) ## x = 1, ..., 5, 6. # Turning off abbreviation printf("y = %s.\n", hpaste(y, maxHead = Inf)) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 ## ...or simply printf("y = %s.\n", paste(y, collapse = ", ")) ## y = 10, 9, 8, 7, 6, 5, 4, 3, 2, 1 # Change last separator printf("x = %s.\n", hpaste(x, lastCollapse = " and ")) ## x = 1, 2, 3, 4, 5 and 6. # No collapse stopifnot(all(hpaste(x, collapse = NULL) == x)) # Empty input stopifnot(identical(hpaste(character(0)), character(0))) message("*** hpaste() ...") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # debug() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - message("*** mdebug() ...") mdebug("Hello #", 1) mdebugf("Hello #%d", 1) options(future.debug = TRUE) mdebug("Hello #", 2) mdebugf("Hello #%d", 2) options(future.debug = FALSE) mdebug("Hello #", 3) mdebugf("Hello #%d", 3) message("*** mdebug() ... DONE") # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # import_from() # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - message("*** import_from() ...") obj <- import_from("non-existing-fcn", default = NA, package = "future") stopifnot(identical(obj, NA)) res <- tryCatch({ obj <- import_from("non-existing-fcn", package = "future") }, error = identity) print(res) stopifnot(inherits(res, "simpleError")) message("*** import_from() ... DONE") message("*** stop_if_not() ...") stop_if_not(TRUE) stop_if_not(TRUE, TRUE) res <- tryCatch({ stop_if_not(FALSE) }, error = identity) stopifnot(inherits(res, "simpleError")) res <- tryCatch({ stop_if_not(list(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE)) }, error = identity) stopifnot(inherits(res, "simpleError")) message("*** stop_if_not() ... DONE") message("*** assert_values2() ...") assert_values2 <- future.apply:::assert_values2 assert_values2(nX = 2L, values2 = as.list(1:2)) res <- tryCatch({ assert_values2(nX = 1L, values = as.list(1:2), values2 = as.list(1:2), fcn = "tests", debug = TRUE) }, error = identity) stopifnot(inherits(res, "FutureError")) message("*** assert_values2() ... DONE") message("*** utils ... DONE") ================================================ FILE: man/fold.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/fold.R \name{fold} \alias{fold} \title{Efficient Fold, Reduce, Accumulate, Combine of a Vector} \usage{ fold(x, f, left = TRUE, unname = TRUE, threshold = 1000L) } \arguments{ \item{x}{A vector.} \item{f}{A binary function, i.e. a function take takes two arguments.} \item{left}{If \code{TRUE}, vector is combined from the left (the first element), otherwise the right (the last element).} \item{unname}{If \code{TRUE}, function \code{f} is called as \code{f(unname(y), x[[ii]])}, otherwise as \code{f(y, x[[ii]])}, which may introduce name \code{"y"}.} \item{threshold}{An integer (>= 2) specifying the length where the recursive divide-and-conquer call will stop and incremental building of the partial value is performed. Using \code{threshold = +Inf} will disable recursive folding.} } \value{ A vector. } \description{ Efficient Fold, Reduce, Accumulate, Combine of a Vector } \details{ In order for recursive folding to give the same results as non-recursive folding, binary function \code{f} must be \emph{associative} with itself, i.e. \code{f(f(x[[1]], x[[2]]), x[[3]])} equals \code{f(x[[1]], f(x[[2]]), x[[3]])}. This function is a more efficient (memory and speed) of \code{\link[base:Reduce]{Reduce(f, x, right = !left, accumulate = FALSE)}}, especially when \code{x} is long. } \keyword{internal} ================================================ FILE: man/future.apply.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/future.apply-package.R \docType{package} \name{future.apply} \alias{future.apply} \alias{future.apply-package} \title{future.apply: Apply Function to Elements in Parallel using Futures} \description{ The \pkg{future.apply} package provides parallel implementations of common "apply" functions provided by base \R. The parallel processing is performed via the \pkg{future} ecosystem, which provides a large number of parallel backends, e.g. on the local machine, a remote cluster, and a high-performance compute cluster. } \details{ Currently implemented functions are: \itemize{ \item \code{\link[=future_apply]{future_apply()}}: a parallel version of \link[base:apply]{apply()} \item \code{\link[=future_by]{future_by()}}: a parallel version of \link[base:by]{by()} \item \code{\link[=future_eapply]{future_eapply()}}: a parallel version of \link[base:lapply]{eapply()} \item \code{\link[=future_lapply]{future_lapply()}}: a parallel version of \link[base:lapply]{lapply()} \item \code{\link[=future_mapply]{future_mapply()}}: a parallel version of \link[base:mapply]{mapply()} \item \code{\link[=future_sapply]{future_sapply()}}: a parallel version of \link[base:lapply]{sapply()} \item \code{\link[=future_tapply]{future_tapply()}}: a parallel version of \link[base:tapply]{tapply()} \item \code{\link[=future_vapply]{future_vapply()}}: a parallel version of \link[base:lapply]{vapply()} \item \code{\link[=future_Map]{future_Map()}}: a parallel version of \link[=Map]{Map()} \item \code{\link[=future_replicate]{future_replicate()}}: a parallel version of \link[base:lapply]{replicate()} \item \code{\link[=future_.mapply]{future_.mapply()}}: a parallel version of \link[base:mapply]{.mapply()} } Reproducibility is part of the core design, which means that perfect, parallel random number generation (RNG) is supported regardless of the amount of chunking, type of load balancing, and future backend being used. Since these \verb{future_*()} functions have the same arguments as the corresponding base \R function, start using them is often as simple as renaming the function in the code. For example, after attaching the package: \if{html}{\out{
}}\preformatted{library(future.apply) }\if{html}{\out{
}} code such as: \if{html}{\out{
}}\preformatted{x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE,FALSE,FALSE,TRUE)) y <- lapply(x, quantile, probs = 1:3/4) }\if{html}{\out{
}} can be updated to: \if{html}{\out{
}}\preformatted{y <- future_lapply(x, quantile, probs = 1:3/4) }\if{html}{\out{
}} The default settings in the \pkg{future} framework is to process code \emph{sequentially}. To run the above in parallel on the local machine (on any operating system), use: \if{html}{\out{
}}\preformatted{plan(multisession) }\if{html}{\out{
}} first. That's it! To go back to sequential processing, use \code{plan(sequential)}. If you have access to multiple machines on your local network, use: \if{html}{\out{
}}\preformatted{plan(cluster, workers = c("n1", "n2", "n2", "n3")) }\if{html}{\out{
}} This will set up four workers, one on \code{n1} and \code{n3}, and two on \code{n2}. If you have SSH access to some remote machines, use: \if{html}{\out{
}}\preformatted{plan(cluster, workers = c("m1.myserver.org", "m2.myserver.org)) }\if{html}{\out{
}} See the \pkg{future} package and \code{\link[future:plan]{future::plan()}} for more examples. The \pkg{future.batchtools} package provides support for high-performance compute (HPC) cluster schedulers such as SGE, Slurm, and TORQUE / PBS. For example, \itemize{ \item \code{plan(batchtools_slurm)}: Process via a Slurm scheduler job queue. \item \code{plan(batchtools_torque)}: Process via a TORQUE / PBS scheduler job queue. } This builds on top of the queuing framework that the \pkg{batchtools} package provides. For more details on backend configuration, please see the \pkg{future.batchtools} and \pkg{batchtools} packages. These are just a few examples of parallel/distributed backend for the future ecosystem. For more alternatives, see the 'Reverse dependencies' section on the \href{https://cran.r-project.org/package=future}{future CRAN package page}. } \seealso{ Useful links: \itemize{ \item \url{https://future.apply.futureverse.org} \item \url{https://github.com/futureverse/future.apply} \item Report bugs at \url{https://github.com/futureverse/future.apply/issues} } } \author{ Henrik Bengtsson, except for the implementations of \code{future_apply()}, \code{future_Map()}, \code{future_replicate()}, \code{future_sapply()}, and \code{future_tapply()}, which are adopted from the source code of the corresponding base \R functions, which are licensed under GPL (>= 2) with 'The R Core Team' as the copyright holder. Because of these dependencies, the license of this package is GPL (>= 2). } \keyword{iteration} \keyword{manip} \keyword{programming} ================================================ FILE: man/future.apply.options.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/options.R \name{future.apply.options} \alias{future.apply.options} \alias{future.apply.debug} \alias{R_FUTURE_APPLY_DEBUG} \title{Options used for future.apply} \description{ Below are the \R options and environment variables that are used by the \pkg{future.apply} package and packages enhancing it.\cr \cr \emph{WARNING: Note that the names and the default values of these options may change in future versions of the package. Please use with care until further notice.} } \details{ For settings specific to the \pkg{future} package, see \link[future:zzz-future.options]{future::future.options} page. } \section{Options for debugging future.apply}{ \describe{ \item{\option{future.apply.debug}:}{(logical) If \code{TRUE}, extensive debug messages are generated. (Default: \code{FALSE})} } } \section{Environment variables that set R options}{ All of the above \R \option{future.apply.*} options can be set by corresponding environment variable \env{R_FUTURE_APPLY_*} \emph{when the \pkg{future.apply} package is loaded}. For example, if \code{R_FUTURE_APPLY_DEBUG=TRUE}, then option \option{future.apply.debug} is set to \code{TRUE} (logical). } \examples{ \dontrun{ options(future.apply.debug = TRUE) } } \seealso{ To set \R options or environment variables when \R starts (even before the \pkg{future} package is loaded), see the \link[base]{Startup} help page. The \href{https://cran.r-project.org/package=startup}{\pkg{startup}} package provides a friendly mechanism for configuring \R's startup process. } ================================================ FILE: man/future_apply.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/future_apply.R \name{future_apply} \alias{future_apply} \title{Apply Functions Over Array Margins via Futures} \usage{ future_apply( X, MARGIN, FUN, ..., simplify = TRUE, future.envir = parent.frame(), future.stdout = TRUE, future.conditions = "condition", future.globals = TRUE, future.packages = NULL, future.seed = FALSE, future.scheduling = 1, future.chunk.size = NULL, future.label = "future_apply-\%d" ) } \arguments{ \item{X}{an array, including a matrix.} \item{MARGIN}{A vector giving the subscripts which the function will be applied over. For example, for a matrix \code{1} indicates rows, \code{2} indicates columns, \code{c(1, 2)} indicates rows and columns. Where \code{X} has named dimnames, it can be a character vector selecting dimension names.} \item{FUN}{A function taking at least one argument.} \item{simplify}{a logical indicating whether results should be simplified if possible.} \item{future.envir}{An \link{environment} passed as argument \code{envir} to \code{\link[future:future]{future::future()}} as-is.} \item{future.stdout}{If \code{TRUE} (default), then the standard output of the underlying futures is captured, and re-outputted as soon as possible. If \code{FALSE}, any output is silenced (by sinking it to the null device as it is outputted). If \code{NA} (not recommended), output is \emph{not} intercepted.} \item{future.conditions}{A character string of conditions classes to be captured and relayed. The default is the same as the \code{condition} argument of \code{\link[future:Future-class]{future::Future()}}. To not intercept conditions, use \code{conditions = character(0L)}. Errors are always relayed.} \item{future.globals}{A logical, a character vector, or a named list for controlling how globals are handled. For details, see below section.} \item{future.packages}{(optional) a character vector specifying packages to be attached in the R environment evaluating the future.} \item{future.seed}{A logical or an integer (of length one or seven), or a list of \code{length(X)} with pre-generated random seeds. For details, see below section.} \item{future.scheduling}{Average number of futures ("chunks") per worker. If \code{0.0}, then a single future is used to process all elements of \code{X}. If \code{1.0} or \code{TRUE}, then one future per worker is used. If \code{2.0}, then each worker will process two futures (if there are enough elements in \code{X}). If \code{Inf} or \code{FALSE}, then one future per element of \code{X} is used. Only used if \code{future.chunk.size} is \code{NULL}.} \item{future.chunk.size}{The average number of elements per future ("chunk"). If \code{Inf}, then all elements are processed in a single future. If \code{NULL}, then argument \code{future.scheduling} is used.} \item{future.label}{If a character string, then each future is assigned a label \code{sprintf(future.label, chunk_idx)}. If TRUE, then the same as \code{future.label = "future_lapply-\%d"}. If FALSE, no labels are assigned.} \item{\ldots}{(optional) Additional arguments passed to \code{FUN()}, except \verb{future.*} arguments, which are passed on to \code{\link[=future_lapply]{future_lapply()}} used internally.} } \value{ Returns a vector or array or list of values obtained by applying a function to margins of an array or matrix. See \code{\link[base:apply]{base::apply()}} for details. } \description{ \code{future_apply()} implements \code{\link[base:apply]{base::apply()}} using future with perfect replication of results, regardless of future backend used. It returns a vector or array or list of values obtained by applying a function to margins of an array or matrix. } \examples{ ## --------------------------------------------------------- ## apply() ## --------------------------------------------------------- X <- matrix(c(1:4, 1, 6:8), nrow = 2L) Y0 <- apply(X, MARGIN = 1L, FUN = table) Y1 <- future_apply(X, MARGIN = 1L, FUN = table) print(Y1) stopifnot(all.equal(Y1, Y0, check.attributes = FALSE)) ## FIXME Y0 <- apply(X, MARGIN = 1L, FUN = stats::quantile) Y1 <- future_apply(X, MARGIN = 1L, FUN = stats::quantile) print(Y1) stopifnot(all.equal(Y1, Y0)) ## --------------------------------------------------------- ## Parallel Random Number Generation ## --------------------------------------------------------- \donttest{ ## Regardless of the future plan, the number of workers, and ## where they are, the random numbers produced are identical X <- matrix(c(1:4, 1, 6:8), nrow = 2L) plan(multisession) set.seed(0xBEEF) Y1 <- future_apply(X, MARGIN = 1L, FUN = sample, future.seed = TRUE) print(Y1) plan(sequential) set.seed(0xBEEF) Y2 <- future_apply(X, MARGIN = 1L, FUN = sample, future.seed = TRUE) print(Y2) stopifnot(all.equal(Y1, Y2)) } \dontshow{ ## R CMD check: make sure any open connections are closed afterward if (!inherits(plan(), "sequential")) plan(sequential) } } \author{ The implementation of \code{future_apply()} is adopted from the source code of the corresponding base \R function, which is licensed under GPL (>= 2) with 'The R Core Team' as the copyright holder. } ================================================ FILE: man/future_by.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/future_by.R \name{future_by} \alias{future_by} \title{Apply a Function to a Data Frame Split by Factors via Futures} \usage{ future_by( data, INDICES, FUN, ..., simplify = TRUE, future.envir = parent.frame() ) } \arguments{ \item{data}{An \R object, normally a data frame, possibly a matrix.} \item{INDICES}{A factor or a list of factors, each of length \code{nrow(data)}.} \item{FUN}{a function to be applied to (usually data-frame) subsets of \code{data}.} \item{simplify}{logical: see \code{\link[base:tapply]{base::tapply()}}.} \item{future.envir}{An \link{environment} passed as argument \code{envir} to \code{\link[future:future]{future::future()}} as-is.} \item{\ldots}{Additional arguments pass to \code{\link[=future_lapply]{future_lapply()}} and then to \code{FUN()}.} } \value{ An object of class "by", giving the results for each subset. This is always a list if simplify is false, otherwise a list or array (see \code{\link[base:tapply]{base::tapply()}}). See also \code{\link[base:by]{base::by()}} for details. } \description{ Apply a Function to a Data Frame Split by Factors via Futures } \details{ Internally, \code{data} is grouped by \code{INDICES} into a list of \code{data} subset elements which is then processed by \code{\link[=future_lapply]{future_lapply()}}. When the groups differ significantly in size, the processing time may differ significantly between the groups. To correct for processing-time imbalances, adjust the amount of chunking via arguments \code{future.scheduling} and \code{future.chunk.size}. } \section{Note on 'stringsAsFactors'}{ The \code{future_by()} is modeled as closely as possible to the behavior of \code{base::by()}. Both functions have "default" S3 methods that calls \code{data <- as.data.frame(data)} internally. This call may in turn call an S3 method for \code{as.data.frame()} that coerces strings to factors or not depending on whether it has a \code{stringsAsFactors} argument and what its default is. For example, the S3 method of \code{as.data.frame()} for lists changed its (effective) default from \code{stringsAsFactors = TRUE} to \code{stringsAsFactors = TRUE} in R 4.0.0. } \examples{ ## --------------------------------------------------------- ## by() ## --------------------------------------------------------- library(datasets) ## warpbreaks library(stats) ## lm() y0 <- by(warpbreaks, warpbreaks[,"tension"], function(x) lm(breaks ~ wool, data = x)) plan(multisession) y1 <- future_by(warpbreaks, warpbreaks[,"tension"], function(x) lm(breaks ~ wool, data = x)) plan(sequential) y2 <- future_by(warpbreaks, warpbreaks[,"tension"], function(x) lm(breaks ~ wool, data = x)) } ================================================ FILE: man/future_kernapply.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/future_kernapply.R \name{future_kernapply} \alias{future_kernapply} \alias{future_kernapply.default} \alias{future_kernapply.ts} \title{Apply Smoothing Kernel in Parallel} \usage{ future_kernapply(x, ...) \method{future_kernapply}{default}(x, k, circular = FALSE, ...) \method{future_kernapply}{ts}(x, k, circular = FALSE, ...) } \arguments{ \item{x}{an input vector, matrix, time series or kernel to be smoothed.} \item{...}{arguments passed to or from other methods.} \item{k}{smoothing \code{"tskernel"} object.} \item{circular}{a logical indicating whether the input sequence to be smoothed is treated as circular, i.e., periodic.} } \value{ See \code{\link[stats:kernapply]{stats::kernapply()}} for details. } \description{ \code{future_kernapply()} is a futurized version of \code{\link[stats:kernapply]{stats::kernapply()}}, i.e. it computes, in parallel, the convolution between an input sequence and a specific kernel. Parallelization takes place over columns when \code{x} is a matrix, including a \code{ts} matrix. } \examples{ library(datasets) library(stats) X <- EuStockMarkets[, 1:2] k <- kernel("daniell", 50) # a long moving average X_smooth <- future_kernapply(X, k = k) } ================================================ FILE: man/future_lapply.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/future_eapply.R, R/future_lapply.R, % R/future_replicate.R, R/future_sapply.R, R/future_tapply.R, % R/future_vapply.R \name{future_eapply} \alias{future_eapply} \alias{future_lapply} \alias{future_replicate} \alias{future_sapply} \alias{future_tapply} \alias{future_vapply} \title{Apply a Function over a List or Vector via Futures} \usage{ future_eapply( env, FUN, ..., all.names = FALSE, USE.NAMES = TRUE, future.envir = parent.frame(), future.label = "future_eapply-\%d" ) future_lapply( X, FUN, ..., future.envir = parent.frame(), future.stdout = TRUE, future.conditions = "condition", future.globals = TRUE, future.packages = NULL, future.seed = FALSE, future.scheduling = 1, future.chunk.size = NULL, future.label = "future_lapply-\%d" ) future_replicate( n, expr, simplify = "array", future.seed = TRUE, ..., future.envir = parent.frame(), future.label = "future_replicate-\%d" ) future_sapply( X, FUN, ..., simplify = TRUE, USE.NAMES = TRUE, future.envir = parent.frame(), future.label = "future_sapply-\%d" ) future_tapply( X, INDEX, FUN = NULL, ..., default = NA, simplify = TRUE, future.envir = parent.frame(), future.label = "future_tapply-\%d" ) future_vapply( X, FUN, FUN.VALUE, ..., USE.NAMES = TRUE, future.envir = parent.frame(), future.label = "future_vapply-\%d" ) } \arguments{ \item{env}{An \R environment.} \item{FUN}{A function taking at least one argument.} \item{all.names}{If \code{TRUE}, the function will also be applied to variables that start with a period (\code{.}), otherwise not. See \code{\link[base:eapply]{base::eapply()}} for details.} \item{USE.NAMES}{See \code{\link[base:lapply]{base::sapply()}}.} \item{future.envir}{An \link{environment} passed as argument \code{envir} to \code{\link[future:future]{future::future()}} as-is.} \item{future.label}{If a character string, then each future is assigned a label \code{sprintf(future.label, chunk_idx)}. If TRUE, then the same as \code{future.label = "future_lapply-\%d"}. If FALSE, no labels are assigned.} \item{X}{An \R object for which a \code{\link[base]{split}} method exists. Typically vector-like, allowing subsetting with \code{\link[base]{[}}, or a data frame.} \item{future.stdout}{If \code{TRUE} (default), then the standard output of the underlying futures is captured, and re-outputted as soon as possible. If \code{FALSE}, any output is silenced (by sinking it to the null device as it is outputted). If \code{NA} (not recommended), output is \emph{not} intercepted.} \item{future.conditions}{A character string of conditions classes to be captured and relayed. The default is the same as the \code{condition} argument of \code{\link[future:Future-class]{future::Future()}}. To not intercept conditions, use \code{conditions = character(0L)}. Errors are always relayed.} \item{future.globals}{A logical, a character vector, or a named list for controlling how globals are handled. For details, see below section.} \item{future.packages}{(optional) a character vector specifying packages to be attached in the R environment evaluating the future.} \item{future.seed}{A logical or an integer (of length one or seven), or a list of \code{length(X)} with pre-generated random seeds. For details, see below section.} \item{future.scheduling}{Average number of futures ("chunks") per worker. If \code{0.0}, then a single future is used to process all elements of \code{X}. If \code{1.0} or \code{TRUE}, then one future per worker is used. If \code{2.0}, then each worker will process two futures (if there are enough elements in \code{X}). If \code{Inf} or \code{FALSE}, then one future per element of \code{X} is used. Only used if \code{future.chunk.size} is \code{NULL}.} \item{future.chunk.size}{The average number of elements per future ("chunk"). If \code{Inf}, then all elements are processed in a single future. If \code{NULL}, then argument \code{future.scheduling} is used.} \item{n}{The number of replicates.} \item{expr}{An \R expression to evaluate repeatedly.} \item{simplify}{See \code{\link[base:lapply]{base::sapply()}} and \code{\link[base:tapply]{base::tapply()}}, respectively.} \item{INDEX}{A list of one or more factors, each of same length as \code{X}. The elements are coerced to \code{\link[base]{factor}}s by \code{\link[base:as.factor]{as.factor()}}. Can also be a formula, which is useful if \code{X} is a data frame; see the \code{f} argument in \code{\link[base:split]{split()}} for interpretation.} \item{default}{See \code{\link[base:tapply]{base::tapply()}}.} \item{FUN.VALUE}{A template for the required return value from each \code{FUN(X[ii], ...)}. Types may be promoted to a higher type within the ordering logical < integer < double < complex, but not demoted. See \code{\link[base:lapply]{base::vapply()}} for details.} \item{\ldots}{(optional) Additional arguments passed to \code{FUN()}. For \code{future_*apply()} functions and \code{replicate()}, any \verb{future.*} arguments part of \ldots are passed on to \code{future_lapply()} used internally. Importantly, if this is called inside another function which also declares \ldots arguments, do not forget to explicitly pass such \ldots arguments down to the \code{future_*apply()} function too, which will then pass them on to \code{FUN()}. See below for an example.} } \value{ A named (unless \code{USE.NAMES = FALSE}) list. See \code{\link[base:eapply]{base::eapply()}} for details. For \code{future_lapply()}, a list with same length and names as \code{X}. See \code{\link[base:lapply]{base::lapply()}} for details. \code{future_replicate()} is a wrapper around \code{future_sapply()} and return simplified object according to the \code{simplify} argument. See \code{\link[base:lapply]{base::replicate()}} for details. Since \code{future_replicate()} usually involves random number generation (RNG), it uses \code{future.seed = TRUE} by default in order produce sound random numbers regardless of future backend and number of background workers used. For \code{future_sapply()}, a vector with same length and names as \code{X}. See \code{\link[base:lapply]{base::sapply()}} for details. \code{future_tapply()} returns an array with mode \code{"list"}, unless \code{simplify = TRUE} (default) \emph{and} \code{FUN} returns a scalar, in which case the mode of the array is the same as the returned scalars. See \code{\link[base:tapply]{base::tapply()}} for details. For \code{future_vapply()}, a vector with same length and names as \code{X}. See \code{\link[base:lapply]{base::vapply()}} for details. } \description{ \code{future_lapply()} implements \code{\link[base:lapply]{base::lapply()}} using futures with perfect replication of results, regardless of future backend used. Analogously, this is true for all the other \code{future_nnn()} functions. } \section{Global variables}{ Argument \code{future.globals} may be used to control how globals should be handled similarly to how the \code{globals} argument is used with \code{future()}. Since all function calls use the same set of globals, this function can do any gathering of globals upfront (once), which is more efficient than if it would be done for each future independently. If \code{TRUE} (default), then globals are automatically identified and gathered. If a character vector of names is specified, then those globals are gathered. If a named list, then those globals are used as is. In all cases, \code{FUN} and any \ldots arguments are automatically passed as globals to each future created as they are always needed. } \section{Reproducible random number generation (RNG)}{ Unless \code{future.seed} is \code{FALSE} or \code{NULL}, this function guarantees to generate the exact same sequence of random numbers \emph{given the same initial seed / RNG state} - this regardless of type of futures, scheduling ("chunking") strategy, and number of workers. RNG reproducibility is achieved by pregenerating the random seeds for all iterations (over \code{X}) by using parallel RNG streams. In each iteration, these seeds are set before calling \code{FUN(X[[ii]], ...)}. \emph{Note, for large \code{length(X)} this may introduce a large overhead.} If \code{future.seed = TRUE}, then \code{\link[base:Random]{.Random.seed}} is used if it holds a parallel RNG seed, otherwise one is created randomly. If \code{future.seed = FALSE}, it is expected that none of the \code{FUN(X[[ii]], ...)} function calls use random number generation. If they do, then an informative warning or error is produced depending on settings. See \code{\link[future:future]{future::future()}} for more details. Using \code{future.seed = NULL}, is like \code{future.seed = FALSE} but without the check whether random numbers were generated or not. As input, \code{future.seed} may also take a fixed initial seed (integer), either as a full parallel RNG seed, or as a seed generating such a full parallel seed. This seed will be used to generated \code{length(X)} parallel RNG streams. In addition to the above, it is possible to specify a pre-generated sequence of RNG seeds as a list such that \code{length(future.seed) == length(X)} and where each element is an integer seed vector that can be assigned to \code{\link[base:Random]{.Random.seed}}. One approach to generate a set of valid RNG seeds based on fixed initial seed (here \code{42L}) is: \if{html}{\out{
}}\preformatted{seeds <- future_lapply(seq_along(X), FUN = function(x) .Random.seed, future.chunk.size = Inf, future.seed = 42L) }\if{html}{\out{
}} \strong{Note that \code{as.list(seq_along(X))} is \emph{not} a valid set of such \code{.Random.seed} values.} In all cases but \code{future.seed = FALSE} and \code{NULL}, the RNG state of the calling R processes after this function returns is guaranteed to be "forwarded one step" from the RNG state that was before the call and in the same way regardless of \code{future.seed}, \code{future.scheduling} and future strategy used. This is done in order to guarantee that an \R script calling \code{future_lapply()} multiple times should be numerically reproducible given the same initial seed. } \section{Load balancing ("chunking")}{ Whether load balancing ("chunking") should take place or not can be controlled by specifying either argument \verb{future.scheduling = } or \verb{future.chunk.size = }. The value \code{future.chunk.size} specifies the average number of elements processed per future ("chunks"). If \code{+Inf}, then all elements are processed in a single future (one worker). If \code{NULL}, then argument \code{future.scheduling} is used. The value \code{future.scheduling} specifies the average number of futures ("chunks") that each worker processes. If \code{0.0}, then a single future is used to process all iterations; none of the other workers are not used. If \code{1.0} or \code{TRUE}, then one future per worker is used. If \code{2.0}, then each worker will process two futures (if there are enough iterations). If \code{+Inf} or \code{FALSE}, then one future per iteration is used. The default value is \code{scheduling = 1.0}. } \section{Control processing order of elements}{ Attribute \code{ordering} of \code{future.chunk.size} or \code{future.scheduling} can be used to control the ordering the elements are iterated over, which only affects the processing order and \emph{not} the order values are returned. This attribute can take the following values: \itemize{ \item index vector - a numeric vector of length \code{length(X)} \item function - a function taking one argument which is called as \code{ordering(length(X))} and which must return an index vector of length \code{length(X)}, e.g. \code{function(n) rev(seq_len(n))} for reverse ordering. \item \code{"random"} - this will randomize the ordering via random index vector \code{sample.int(length(X))}. } For example, \code{future.scheduling = structure(TRUE, ordering = "random")}. \emph{Note}, when elements are processed out of order, then captured standard output and conditions are relayed in that order as well. } \examples{ ## --------------------------------------------------------- ## lapply(), sapply(), tapply() ## --------------------------------------------------------- x <- list(a = 1:10, beta = exp(-3:3), logic = c(TRUE, FALSE, FALSE, TRUE)) y0 <- lapply(x, FUN = quantile, probs = 1:3/4) y1 <- future_lapply(x, FUN = quantile, probs = 1:3/4) print(y1) stopifnot(all.equal(y1, y0)) y0 <- sapply(x, FUN = quantile) y1 <- future_sapply(x, FUN = quantile) print(y1) stopifnot(all.equal(y1, y0)) y0 <- vapply(x, FUN = quantile, FUN.VALUE = double(5L)) y1 <- future_vapply(x, FUN = quantile, FUN.VALUE = double(5L)) print(y1) stopifnot(all.equal(y1, y0)) ## --------------------------------------------------------- ## Parallel Random Number Generation ## --------------------------------------------------------- \donttest{ ## Regardless of the future plan, the number of workers, and ## where they are, the random numbers produced are identical plan(multisession) set.seed(0xBEEF) y1 <- future_lapply(1:5, FUN = rnorm, future.seed = TRUE) str(y1) plan(sequential) set.seed(0xBEEF) y2 <- future_lapply(1:5, FUN = rnorm, future.seed = TRUE) str(y2) stopifnot(all.equal(y1, y2)) } ## --------------------------------------------------------- ## Process chunks of data.frame rows in parallel ## --------------------------------------------------------- iris <- datasets::iris chunks <- split(iris, seq(1, nrow(iris), length.out = 3L)) y0 <- lapply(chunks, FUN = function(iris) sum(iris$Sepal.Length)) y0 <- do.call(sum, y0) y1 <- future_lapply(chunks, FUN = function(iris) sum(iris$Sepal.Length)) y1 <- do.call(sum, y1) print(y1) stopifnot(all.equal(y1, y0)) ## --------------------------------------------------------- ## Remember to pass down '...' arguments ## --------------------------------------------------------- ## It is important that we don't use '...' as a global variable, ## as attempted in the following not_okay_fcn() bad_fcn <- function(X, ...) { y <- future_lapply(X, FUN = function(x) { mean(x, ...) ## here '...' is a global variable }) y } ## Instead, make sure to pass '...' via arguments all the way through good_fcn <- function(X, ...) { ## outer '...' y <- future_lapply(X, FUN = function(x, ...) { mean(x, ...) ## here '...' is an argument of FUN() }, ...) ## pass outer '...' to FUN() y } \dontshow{ ## R CMD check: make sure any open connections are closed afterward if (!inherits(plan(), "sequential")) plan(sequential) } } \author{ The implementations of \code{future_replicate()}, \code{future_sapply()}, and \code{future_tapply()} are adopted from the source code of the corresponding base \R functions, which are licensed under GPL (>= 2) with 'The R Core Team' as the copyright holder. } \keyword{iteration} \keyword{manip} \keyword{programming} ================================================ FILE: man/future_mapply.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/future_Filter.R, R/future_Map.R, % R/future_mapply.R \name{future_Filter} \alias{future_Filter} \alias{future_Map} \alias{future_mapply} \alias{future_.mapply} \title{Apply a Function to Multiple List or Vector Arguments} \usage{ future_Filter(f, x, ...) future_Map( f, ..., future.envir = parent.frame(), future.label = "future_Map-\%d" ) future_mapply( FUN, ..., MoreArgs = NULL, SIMPLIFY = TRUE, USE.NAMES = TRUE, future.envir = parent.frame(), future.stdout = TRUE, future.conditions = "condition", future.globals = TRUE, future.packages = NULL, future.seed = FALSE, future.scheduling = 1, future.chunk.size = NULL, future.label = "future_mapply-\%d" ) future_.mapply(FUN, dots, MoreArgs, ..., future.label = "future_.mapply-\%d") } \arguments{ \item{f}{A function of the arity \eqn{k} if \code{future_Map()} is called with \eqn{k} arguments.} \item{x}{A vector-like object to iterate over.} \item{future.envir}{An \link{environment} passed as argument \code{envir} to \code{\link[future:future]{future::future()}} as-is.} \item{future.label}{If a character string, then each future is assigned a label \code{sprintf(future.label, chunk_idx)}. If TRUE, then the same as \code{future.label = "future_lapply-\%d"}. If FALSE, no labels are assigned.} \item{FUN}{A function to apply, found via \code{\link[base:match.fun]{base::match.fun()}}.} \item{MoreArgs}{A list of other arguments to \code{FUN}.} \item{SIMPLIFY}{A logical or character string; attempt to reduce the result to a vector, matrix or higher dimensional array; see the simplify argument of \code{\link[base:lapply]{base::sapply()}}.} \item{USE.NAMES}{A logical; use names if the first \ldots argument has names, or if it is a character vector, use that character vector as the names.} \item{future.stdout}{If \code{TRUE} (default), then the standard output of the underlying futures is captured, and re-outputted as soon as possible. If \code{FALSE}, any output is silenced (by sinking it to the null device as it is outputted). If \code{NA} (not recommended), output is \emph{not} intercepted.} \item{future.conditions}{A character string of conditions classes to be captured and relayed. The default is the same as the \code{condition} argument of \code{\link[future:Future-class]{future::Future()}}. To not intercept conditions, use \code{conditions = character(0L)}. Errors are always relayed.} \item{future.globals}{A logical, a character vector, or a named list for controlling how globals are handled. For details, see \code{\link[=future_lapply]{future_lapply()}}.} \item{future.packages}{(optional) a character vector specifying packages to be attached in the R environment evaluating the future.} \item{future.seed}{A logical or an integer (of length one or seven), or a list of \code{max(lengths(list(...)))} with pre-generated random seeds. For details, see \code{\link[=future_lapply]{future_lapply()}}.} \item{future.scheduling}{Average number of futures ("chunks") per worker. If \code{0.0}, then a single future is used to process all elements of \code{X}. If \code{1.0} or \code{TRUE}, then one future per worker is used. If \code{2.0}, then each worker will process two futures (if there are enough elements in \code{X}). If \code{Inf} or \code{FALSE}, then one future per element of \code{X} is used. Only used if \code{future.chunk.size} is \code{NULL}.} \item{future.chunk.size}{The average number of elements per future ("chunk"). If \code{Inf}, then all elements are processed in a single future. If \code{NULL}, then argument \code{future.scheduling} is used.} \item{dots}{A list of arguments to vectorize over (vectors or lists of strictly positive length, or all of zero length).} \item{\ldots}{Arguments to vectorize over, will be recycled to common length, or zero if one of them is of length zero.} } \value{ See \link[=Filter]{base::Filter()} for details. \code{future_Map()} is a simple wrapper to \code{future_mapply()} which does not attempt to simplify the result. See \link[=Map]{base::Map()} for details. \code{future_mapply()} returns a list, or for \code{SIMPLIFY = TRUE}, a vector, array or list. See \code{\link[base:mapply]{base::mapply()}} for details. \code{future_.mapply()} returns a list. See \code{\link[base:mapply]{base::.mapply()}} for details. } \description{ \code{future_mapply()} implements \code{\link[base:mapply]{base::mapply()}} using futures with perfect replication of results, regardless of future backend used. Analogously to \code{mapply()}, \code{future_mapply()} is a multivariate version of \code{future_sapply()}. It applies \code{FUN} to the first elements of each \ldots argument, the second elements, the third elements, and so on. Arguments are recycled if necessary. } \details{ Note that \code{\link[base:mapply]{base::.mapply()}}, which \code{future_.mapply()} is modeled after is listed as an "internal" function in \R despite being exported. } \examples{ ## --------------------------------------------------------- ## Filter() ## --------------------------------------------------------- is_even <- function(x) { x \%\% 2 == 0 } x <- sample.int(100, size = 1000, replace = TRUE) y <- future_Filter(is_even, x) ## --------------------------------------------------------- ## mapply() ## --------------------------------------------------------- y0 <- mapply(rep, 1:4, 4:1) y1 <- future_mapply(rep, 1:4, 4:1) stopifnot(identical(y1, y0)) y0 <- mapply(rep, times = 1:4, x = 4:1) y1 <- future_mapply(rep, times = 1:4, x = 4:1) stopifnot(identical(y1, y0)) y0 <- mapply(rep, times = 1:4, MoreArgs = list(x = 42)) y1 <- future_mapply(rep, times = 1:4, MoreArgs = list(x = 42)) stopifnot(identical(y1, y0)) y0 <- mapply(function(x, y) seq_len(x) + y, c(a = 1, b = 2, c = 3), # names from first c(A = 10, B = 0, C = -10)) y1 <- future_mapply(function(x, y) seq_len(x) + y, c(a = 1, b = 2, c = 3), # names from first c(A = 10, B = 0, C = -10)) stopifnot(identical(y1, y0)) word <- function(C, k) paste(rep.int(C, k), collapse = "") y0 <- mapply(word, LETTERS[1:6], 6:1, SIMPLIFY = FALSE) y1 <- future_mapply(word, LETTERS[1:6], 6:1, SIMPLIFY = FALSE) stopifnot(identical(y1, y0)) ## --------------------------------------------------------- ## Parallel Random Number Generation ## --------------------------------------------------------- \donttest{ ## Regardless of the future plan, the number of workers, and ## where they are, the random numbers produced are identical plan(multisession) set.seed(0xBEEF) y1 <- future_mapply(stats::runif, n = 1:4, max = 2:5, MoreArgs = list(min = 1), future.seed = TRUE) print(y1) plan(sequential) set.seed(0xBEEF) y2 <- future_mapply(stats::runif, n = 1:4, max = 2:5, MoreArgs = list(min = 1), future.seed = TRUE) print(y2) stopifnot(all.equal(y1, y2)) } \dontshow{ ## R CMD check: make sure any open connections are closed afterward if (!inherits(plan(), "sequential")) plan(sequential) } } \author{ The implementation of \code{future_Filter()} is adopted from the source code of the corresponding base \R function \code{Filter()}, which is licensed under GPL (>= 2) with 'The R Core Team' as the copyright holder. The implementation of \code{future_Map()} is adopted from the source code of the corresponding base \R function \code{Map()}, which is licensed under GPL (>= 2) with 'The R Core Team' as the copyright holder. } \keyword{iteration} \keyword{manip} \keyword{programming} ================================================ FILE: man/makeChunks.Rd ================================================ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/makeChunks.R \name{makeChunks} \alias{makeChunks} \title{Create Chunks of Index Vectors} \usage{ makeChunks( nbrOfElements, nbrOfWorkers, future.scheduling = 1, future.chunk.size = NULL ) } \arguments{ \item{nbrOfElements}{(integer) Total number of elements to iterate over.} \item{nbrOfWorkers}{(integer) Number of workers available.} \item{future.scheduling}{(numeric) A strictly positive scalar. Only used if argument \code{future.chunk.size} is \code{NULL}.} \item{future.chunk.size}{(numeric) The maximum number of elements per chunk, or \code{NULL}. If \code{NULL}, then the chunk sizes are given by the \code{future.scheduling} argument.} } \value{ A list of chunks, where each chunk is an integer vector of unique indices \code{[1, nbrOfElements]}. The union of all chunks holds \code{nbrOfElements} elements and equals \code{1:nbrOfElements}. If \code{nbrOfElements == 0}, then an empty list is returned. } \description{ \emph{This is an internal function.} } \section{Control processing order of elements}{ Attribute \code{ordering} of \code{future.chunk.size} or \code{future.scheduling} can be used to control the ordering the elements are iterated over, which only affects the processing order \emph{not} the order values are returned. This attribute can take the following values: \itemize{ \item index vector - a numeric vector of length \code{nbrOfElements} specifying how elements are remapped \item function - a function taking one argument which is called as \code{ordering(nbrOfElements)} and which must return an index vector of length \code{nbrOfElements}, e.g. \code{function(n) rev(seq_len(n))} for reverse ordering. \item \code{"random"} - this will randomize the ordering via random index vector \code{sample.int(nbrOfElements)}. } } \keyword{internal} ================================================ FILE: pkgdown/_pkgdown.yml ================================================ url: https://future.apply.futureverse.org home: links: - text: Roadmap/Milestones href: https://github.com/futureverse/future.apply/milestones - text: The Futureverse Project href: https://www.futureverse.org/ - text: Futureverse User Forum href: https://github.com/futureverse/future/discussions navbar: structure: right: [search, futureverse, pkgs, cran, github, lightswitch] components: futureverse: icon: fas fa-home href: https://www.futureverse.org/ pkgs: text: Packages menu: - text: doFuture (map-reduce) href: https://doFuture.futureverse.org - text: furrr (map-reduce) href: https://furrr.futureverse.org - text: future href: https://future.futureverse.org - text: future.apply (map-reduce) href: https://future.apply.futureverse.org - text: future.batchtools (backend) href: https://future.batchtools.futureverse.org - text: future.callr (backend) href: https://future.callr.futureverse.org - text: future.mirai (backend) href: https://future.mirai.futureverse.org - text: future.tests href: https://future.tests.futureverse.org - text: futurize (map-reduce) href: https://futurize.futureverse.org - text: globals href: https://globals.futureverse.org - text: listenv href: https://listenv.futureverse.org - text: parallelly href: https://parallelly.futureverse.org - text: progressr href: https://progressr.futureverse.org - text: future.p2p (experimental) href: https://future.p2p.futureverse.org - text: future.tools (experimental) href: https://future.tools.futureverse.org - text: marshal (experimental) href: https://marshal.futureverse.org cran: icon: fab fa-r-project href: https://cloud.r-project.org/package=future.apply search: exclude: ['README_ja.md'] template: params: docsearch: api_key: aa6e02fc501886fb0f7c91ac4e300456 index_name: futureverse algoliaOptions: { 'facetFilters': ['project:future.apply'] } ganalytics: G-SB3EQSD9FR bootstrap: 5 light-switch: true ================================================ FILE: pkgdown/_pkgdown.yml.rsp ================================================ <% pkgs_mapreduce <- c("futurize", "future.apply", "doFuture", "furrr") pkgs_backend <- c("future.batchtools", "future.callr", "future.mirai") pkgs <- c("globals", "listenv", "parallelly", "future", "future.tests", "progressr", pkgs_mapreduce, pkgs_backend) pkgs_extra <- c("future.p2p", "future.tools", "marshal") pkgs <- c(sort(pkgs), pkgs_extra) urls <- sprintf("https://%s.futureverse.org", pkgs) names(urls) <- pkgs file <- file.path(c(".", ".."), "DESCRIPTION") file <- file[utils::file_test("-f", file)] pkg <- read.dcf(file)[,"Package"] %> url: https://<%= pkg %>.futureverse.org home: links: - text: Roadmap/Milestones href: https://github.com/<%= gsub("(^.*:|[.]git$)", "", subset(gert::git_remote_list(), name == "origin")$url) %>/milestones - text: The Futureverse Project href: https://www.futureverse.org/ - text: Futureverse User Forum href: https://github.com/futureverse/future/discussions navbar: structure: right: [search, futureverse, pkgs, cran, github, lightswitch] components: futureverse: icon: fas fa-home href: https://www.futureverse.org/ pkgs: text: Packages menu: <% for (name in names(urls)) { %> - text: <%= name %> <% if (name %in% pkgs_extra) { %>(experimental)<% } else if (name %in% pkgs_backend) { %>(backend)<% } else if (name %in% pkgs_mapreduce) { %>(map-reduce)<% } %> href: <%= urls[name] %> <% } %> cran: icon: fab fa-r-project href: https://cloud.r-project.org/package=<%= pkg %> search: exclude: ['README_ja.md'] template: params: docsearch: api_key: aa6e02fc501886fb0f7c91ac4e300456 index_name: futureverse algoliaOptions: { 'facetFilters': ['project:<%= pkg %>'] } ganalytics: G-SB3EQSD9FR bootstrap: 5 light-switch: true ================================================ FILE: revdep/README.md ================================================ # Platform |field |value | |:--------|:-----------------------------------------------------------| |version |R version 4.5.2 (2025-10-31) | |os |Rocky Linux 8.10 (Green Obsidian) | |system |x86_64, linux-gnu | |ui |X11 | |language |en | |collate |en_US.UTF-8 | |ctype |en_US.UTF-8 | |tz |America/Los_Angeles | |date |2026-02-19 | |pandoc |3.8.3 @ /software/c4/cbi/software/pandoc-3.8.3/bin/pandoc | |quarto |1.8.26 @ /software/c4/cbi/software/quarto-1.8.26/bin/quarto | # Dependencies |package |old |new |Δ | |:------------|:------|:-----------|:--| |future.apply |1.20.1 |1.20.1-9006 |* | |codetools |0.2-20 |0.2-20 | | |digest |0.6.39 |0.6.39 | | |future |1.69.0 |1.69.0 | | |globals |0.19.0 |0.19.0 | | |listenv |0.10.0 |0.10.0 | | |parallelly |1.46.1 |1.46.1 | | # Revdeps ## All (259) |package |version |error |warning |note | |:-------------------------|:------------|:-----|:-------|:----| |aae.pop |0.2.0 | | | | |[adestr](problems.md#adestr)|1.0.0 | | |1 | |AgePopDenom |1.2.3 | | | | |AIPW |0.6.9.2 | | | | |altdoc |0.7.1 | | | | |ao |1.2.2 | | | | |ARCHISSUR |0.0.1 | | | | |arkdb |0.0.19 | | | | |aroma.cn |1.7.1 | | | | |BAMBI |2.3.6 | | | | |BayesianMCPMod |1.2.0 | | | | |bayesics |2.0.2 | | | | |bayesSSM |0.7.1 | | | | |bbknnR |2.0.2 | | | | |bcmaps |2.2.1 | | | | |BEKKs |1.4.6 | | | | |bidser |0.2.0 | | | | |bifrost |0.1.3 | | | | |bigDM |0.5.7 | | | | |bigPLSR |0.7.2 | | | | |bioLeak |0.2.0 | | | | |bivarhr |0.1.5 | | | | |blavaan |0.5-10 | | | | |bolasso |0.4.0 | | | | |brms |2.23.0 | | | | |bsitar |0.3.2 | | | | |bspcov |1.0.3 | | | | |calmr |0.8.1 | | | | |canaper |1.0.1 | | | | |cellGeometry |0.5.7 | | | | |chopin |0.9.9 | | | | |CimpleG |1.0.1 | | | | |clickR |0.9.45 | | | | |[ClustIRR](problems.md#clustirr)|1.8.0 | | |2 | |codalm |0.1.3 | | | | |collinear |3.0.0 | | | | |conformalInference.fd |1.1.1 | | | | |conformalInference.multi |1.1.2 | | | | |couplr |1.0.10 | | | | |[cSEM](problems.md#csem) |0.6.1 | | |1 | |[ctsem](problems.md#ctsem)|3.10.6 | |2 | | |cvCovEst |1.2.2 | | | | |DAISIE |4.6.0 | | | | |datefixR |2.0.0 | | | | |DeclareDesign |1.1.0 | | | | |deseats |1.1.1 | | | | |detectXOR |0.1.0 | | | | |dipsaus |0.3.3 | | | | |[disk.frame](problems.md#diskframe)|0.8.3 | | |1 | |distantia |2.0.2 | | | | |doFuture |1.2.0 | | | | |DQAstats |0.3.9 | | | | |DRPT |1.1 | | | | |drtmle |1.1.2 | | | | |dsos |0.1.2 | | | | |DTEAssurance |1.1.0 | | | | |e2tree |0.2.0 | | | | |EconCausal |1.0.2 | | | | |eCV |0.0.2 | | | | |[EFAtools](problems.md#efatools)|0.6.1 | | |1 | |EGAnet |2.4.0 | | | | |EpiNow2 |1.8.0 | | | | |[fabletools](problems.md#fabletools)|0.6.1 |1 | | | |fastbioclim |0.3.0 | | | | |FastJM |1.5.3 | | | | |fdacluster |0.4.2 | | | | |FDOTT |0.1.0 | | | | |fect |2.1.0 | | | | |ferrn |0.3.0 | | | | |fitlandr |0.1.1 | | | | |flassomsm |0.1.0 | | | | |[FracFixR](problems.md#fracfixr)|1.0.0 |1 | | | |fundiversity |1.1.1 | | | | |future.batchtools |0.21.0 | | | | |future.callr |0.10.2 | | | | |future.mirai |0.10.1 | | | | |futureverse |0.2.0 | | | | |futurize |0.1.0 | | | | |fwb |0.5.1 | | | | |gammaFuncModel |6.0 | | | | |genBaRcode |1.2.8 | | | | |geocmeans |0.3.4 | | | | |geohabnet |2.2 | | | | |GeometricMorphometricsMix |0.6.0.1 | | | | |geomeTriD |1.4.1 | | | | |GeoModels |2.2.2 | | | | |gooseR |0.1.2 | | | | |GPCsign |0.1.1 | | | | |gsDesignTune |0.1.0 | | | | |gstat |2.1-5 | | | | |gWQS |3.0.5 | | | | |haldensify |0.2.8 | | | | |hbamr |2.4.5 | | | | |[hero](problems.md#hero) |0.6 | | |1 | |hydroloom |1.1.1 | | | | |iml |0.11.4 | | | | |important |0.2.1 | | | | |incubate |1.3.0 | | | | |iNEXT.beta3D |1.0.2 | | | | |inlinedocs |2023.9.4 | | | | |ino |1.2.0 | | | | |[InPAS](problems.md#inpas)|2.18.1 | | |3 | |InterpolateR |1.4-3 | | | | |isopam |3.3 | | | | |ivd |1.0.0 | | | | |[ivmte](problems.md#ivmte)|1.4.0 | | |1 | |IVPP |1.1.1 | | | | |jackknifeR |2.0.0 | | | | |JANE |2.1.0 | | | | |jpinfect |2023.2026.02 | | | | |[kappaGold](problems.md#kappagold)|0.4.0 | | |1 | |kernelboot |0.1.10 | | | | |keyATM |0.5.5 | | | | |kmeRtone |1.0 | | | | |LandComp |0.0.5 | | | | |lava |1.8.2 | | | | |[lavDiag](problems.md#lavdiag)|0.1.0 |1 | | | |LexFindR |1.1.0 | | | | |lgr |0.5.2 | | | | |lightr |1.9.0 | | | | |LipidMS |3.1.2 | | | | |LLMR |0.6.3 | | | | |LTFGRS |1.0.1 | | | | |LTFHPlus |2.2.0 | | | | |[MAI](problems.md#mai) |1.16.0 | | |1 | |malariaAtlas |1.6.4 | | | | |MAMS |3.0.3 | | | | |marginaleffects |0.32.0 | | | | |mcmcensemble |3.2.0 | | | | |mcp |0.3.4 | | | | |MDCcure |0.1.0 | | | | |merTools |0.6.4 | | | | |MetaHD |0.1.4 | | | | |metasnf |2.1.2 | | | | |[mikropml](problems.md#mikropml)|1.7.0 | | |1 | |missSBM |1.0.5 | | | | |mlr3 |1.4.0 | | | | |mlr3db |0.7.0 | | | | |mlr3summary |0.1.2 | | | | |modelsummary |2.6.0 | | | | |modeltuning |0.1.3 | | | | |modernBoot |0.1.1 | | | | |mongolstats |0.1.1 | | | | |mrgsim.parallel |0.3.0 | | | | |mrIML |2.2.0 | | | | |mtarm |0.1.8 | | | | |multivarious |0.3.1 | | | | |nestedcv |0.8.0 | | | | |NetSimR |0.1.5 | | | | |neuroim2 |0.8.5 | | | | |nhdplusTools |1.4.2 | | | | |[nixtlar](problems.md#nixtlar)|0.6.2 | | |1 | |NMAR |0.1.2 | | | | |normref |0.0.0.1 | | | | |oeli |0.7.5 | | | | |opImputation |0.6 | | | | |optic |1.0.1 | | | | |optimLanduse |1.2.1 | | | | |origami |1.0.7 | | | | |outliers.ts.oga |1.1.2 | | | | |[OutSeekR](problems.md#outseekr)|1.1.0 | | |1 | |[PAMpal](problems.md#pampal)|1.4.4 | |1 | | |[PAMscapes](problems.md#pamscapes)|0.15.0 | |1 | | |[pavo](problems.md#pavo) |2.9.0 | |1 | | |pbapply |1.7-4 | | | | |PeakSegDisk |2024.10.1 | | | | |penaltyLearning |2024.9.3 | | | | |[pgxRpi](problems.md#pgxrpi)|1.6.0 | | |1 | |phylolm |2.6.5 | | | | |phylopath |1.3.1 | | | | |phyr |1.1.3 | | | | |PLNmodels |1.2.2 | | | | |polle |1.6.2 | | | | |portvine |1.0.3 | | | | |powergrid |0.5.0 | | | | |[powRICLPM](problems.md#powriclpm)|0.2.1 | | |1 | |progressr |0.18.0 | | | | |[qape](problems.md#qape) |2.1 | | |1 | |QBMS |2.0.0 | | | | |qbrms |1.0.1 | | | | |[QDNAseq](problems.md#qdnaseq)|1.46.0 | |1 | | |qgcomp |2.18.7 | | | | |qgcompint |1.0.2 | | | | |rangeMapper |2.0.3 | | | | |ravepipeline |0.0.3 | | | | |rBiasCorrection |0.3.5 | | | | |readsdr |0.3.0 | | | | |readyomics |0.2.0 | | | | |[receptiviti](problems.md#receptiviti)|0.2.1 |1 | | | |recforest |1.0.2 | | | | |refineR |2.0.0 | | | | |restriktor |0.6-30 | | | | |rgeomorphon |0.3.0 | | | | |robotstxt |0.7.15 | | | | |rSDR |1.0.3.0 | | | | |[rsi](problems.md#rsi) |0.3.2 | | |1 | |Rsolnp |2.0.1 | | | | |RTransferEntropy |0.2.21 | | | | |s3fs |0.1.7 | | | | |S3VS |1.0 | | | | |scDiffCom |1.2.0 | | | | |SCGLR |3.1.0 | | | | |scStability |1.0.3 | | | | |sctransform |0.4.3 | | | | |SDModels |2.0.2 | | | | |sdmTMB |1.0.0 | | | | |SelectBoost.beta |0.4.5 | | | | |SelectBoost.gamlss |0.2.2 | | | | |semtree |0.9.23 | | | | |sentopics |0.7.6 | | | | |seqHMM |2.1.0 | | | | |SEQTaRget |1.3.6 | | | | |Seurat |5.4.0 | | | | |SeuratObject |5.3.0 | | | | |SFHNV |0.1.0 | | | | |shapr |1.0.8 | | | | |sharp |1.4.8 | | | | |Signac |1.16.0 | | | | |[signeR](problems.md#signer)|2.12.0 | | |3 | |SimDesign |2.23 | | | | |simglm |0.8.9 | | | | |sims |0.0.4 | | | | |smoots |1.1.4 | | | | |sNPLS |1.0.27 | | | | |socialSim |0.1.8 | | | | |[solitude](problems.md#solitude)|1.1.3 | | |1 | |spaMM |4.6.1 | | | | |spatialwarnings |3.1.1 | | | | |[sperrorest](problems.md#sperrorest)|3.0.5 | | |1 | |spNetwork |0.4.4.7 | | | | |spStack |1.1.2 | | | | |squat |0.5.0 | | | | |stars |0.7-1 | | | | |stenographer |1.0.0 | | | | |steps |1.3.0 | | | | |[stppSim](problems.md#stppsim)|1.3.4 | |1 | | |supercells |1.0.0 | | | | |svycoxme |1.0.0 | | | | |svytest |1.1.0 | | | | |targeted |0.7.1 | | | | |TaxaNorm |2.4 | | | | |tidySEM |0.2.10 | | | | |Tivy |0.1.1 | | | | |[tramvs](problems.md#tramvs)|0.0-8 | |1 | | |TreeMineR |1.0.3 | | | | |tsdistributions |1.0.3 | | | | |[tsgarch](problems.md#tsgarch)|1.0.3 | | |1 | |tsissm |1.0.2 | | | | |tsmarch |1.0.0 | | | | |tune |2.0.1 | | | | |[txshift](problems.md#txshift)|0.3.8 | | |1 | |vital |2.0.3 | | | | |wildmeta |0.3.2 | | | | |winputall |1.0.1 | | | | |wizaRdry |0.6.4 | | | | |wqspt |1.0.2 | | | | |xegaPopulation |1.0.0.12 | | | | |xplainfi |1.0.0 | | | | |ycevo |0.3.0 | | | | ================================================ FILE: revdep/cran.md ================================================ ## revdepcheck results We checked 259 reverse dependencies (252 from CRAN + 7 from Bioconductor), comparing R CMD check results across CRAN and dev versions of this package. * We saw 0 new problems * We failed to check 0 packages ================================================ FILE: revdep/failures.md ================================================ *Wow, no problems at all. :)* ================================================ FILE: revdep/notes.md ================================================ # Notes ## Setup ```r > options(Ncpus = 6L) > install.packages("remotes") > remotes::install_github("r-lib/revdepcheck") ``` ```sh ## Used by R itself $ revdep/run.R --preinstall RCurl XML ``` ## Pre-installation In order to run these checks successfully on a machine _without internet access_, make sure to first populate the 'crancache' cache by pre-installing all packages to be tested plus a few more. ```sh $ module load jags; revdep/run.R --preinstall runjags $ module load hdf5; revdep/run.R --preinstall hdf5r $ module load geos; revdep/run.R --preinstall lwgeom $ scl enable devtoolset-4 "revdep/run.R --preinstall blavaan" $ scl enable devtoolset-4 "revdep/run.R --preinstall xgboost" $ scl enable devtoolset-4 "revdep/run.R --preinstall rstanarm" # WORKAROUND: https://github.com/pacificclimate/Rudunits2/issues/25 $ Rscript -e "crancache::install_packages('udunits2', configure.args='--with-udunits2-include=/usr/include/udunits2')" ## Update current crancache $ revdep/run.R --preinstall-update ## All packages to be tested $ revdep/run.R --preinstall-children ``` Is this why I'm getting the following error when install the 'stars' package on CentOS 7? ```sh ldconfig -p | grep geos libgeos_c.so.1 (libc6,x86-64) => /lib64/libgeos_c.so.1 libgeos_c.so (libc6,x86-64) => /lib64/libgeos_c.so libgeos-3.4.2.so (libc6,x86-64) => /lib64/libgeos-3.4.2.so ``` ```r $ R R version 4.0.0 alpha (2020-04-03 r78148) Copyright (C) 2020 The R Foundation for Statistical Computing Platform: x86_64-pc-linux-gnu (64-bit) ... > packageVersion("lwgeom") [1] ‘0.2.1’ > install.packages("stars") Installing package into ‘/wynton/home/cbi/hb/R/x86_64-pc-linux-gnu-library/4.0-CBI’ (as ‘lib’ is unspecified) * installing *source* package ‘stars’ ... ** package ‘stars’ successfully unpacked and MD5 sums checked ** using staged installation ** R ** demo ** inst ** byte-compile and prepare package for lazy loading Error in dyn.load(file, DLLpath = DLLpath, ...) : unable to load shared object '/wynton/home/cbi/hb/R/x86_64-pc-linux-gnu-library/4.0-CBI/lwgeom/libs/lwgeom.so': /wynton/home/cbi/hb/R/x86_64-pc-linux-gnu-library/4.0-CBI/lwgeom/libs/lwgeom.so: undefined symbol: GEOSClipByRect Calls: ... asNamespace -> loadNamespace -> library.dynam -> dyn.load ** help *** installing help indices ** building package indices ** installing vignettes ** testing if installed package can be loaded from temporary location Error: package or namespace load failed for ‘stars’ in dyn.load(file, DLLpath = DLLpath, ...): unable to load shared object '/wynton/home/cbi/hb/R/x86_64-pc-linux-gnu-library/4.0-CBI/lwgeom/libs/lwgeom.so': /wynton/home/cbi/hb/R/x86_64-pc-linux-gnu-library/4.0-CBI/lwgeom/libs/lwgeom.so: undefined symbol: GEOSClipByRect Error: loading failed ** testing if installed package can be loaded from final location Error: package or namespace load failed for ‘stars’ in dyn.load(file, DLLpath = DLLpath, ...): unable to load shared object '/wynton/home/cbi/hb/R/x86_64-pc-linux-gnu-library/4.0-CBI/lwgeom/libs/lwgeom.so': /wynton/home/cbi/hb/R/x86_64-pc-linux-gnu-library/4.0-CBI/lwgeom/libs/lwgeom.so: undefined symbol: GEOSClipByRect Error: loading failed ``` ================================================ FILE: revdep/problems.md ================================================ # adestr (1.0.0) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "adestr")` for more info ## In both * checking DESCRIPTION meta-information ... NOTE ``` Missing dependency on R >= 4.1.0 because package code uses the pipe |> or function shorthand \(...) syntax added in R 4.1.0. File(s) using such syntax: ‘IntervalEstimator-class.Rd’ ‘PValue-class.Rd’ ‘PointEstimator-class.Rd’ ‘analyze.R’ ‘estimators.R’ ‘evaluate_estimator.R’ ‘fisher_information.R’ ‘integrate_over_sample_space.R’ ‘mle_distribution.R’ ‘n2c2_helpers.R’ ‘plot.R’ ‘print.R’ ‘reference_implementation.R’ ``` # ClustIRR (1.8.0) * GitHub: * Email: Run `revdepcheck::revdep_details(, "ClustIRR")` for more info ## In both * checking DESCRIPTION meta-information ... NOTE ``` Package listed in more than one of Depends, Imports, Suggests, Enhances: ‘ggplot2’ A package should be listed in only one of these fields. ``` * checking R code for possible problems ... NOTE ``` get_ag_gene_hits: no visible binding for global variable ‘cells’ get_ag_gene_hits: no visible binding for global variable ‘clones’ get_ag_gene_hits: no visible binding for global variable ‘community’ get_ag_gene_hits: no visible binding for global variable ‘ag’ get_ag_species_hits: no visible binding for global variable ‘cells’ get_ag_species_hits: no visible binding for global variable ‘clones’ get_ag_species_hits: no visible binding for global variable ‘community’ get_ag_species_hits: no visible binding for global variable ‘ag’ get_beta_violin: no visible binding for global variable ‘spec’ get_beta_violin: no visible binding for global variable ‘size’ get_honeycombs: no visible binding for global variable ‘x_adj’ get_honeycombs: no visible binding for global variable ‘y_adj’ get_honeycombs: no visible binding for global variable ‘..count..’ Undefined global functions or variables: ..count.. ag cells clones community size spec x_adj y_adj ``` # cSEM (0.6.1) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "cSEM")` for more info ## In both * checking dependencies in R code ... NOTE ``` Namespace in Imports field not imported from: ‘Rdpack’ All declared Imports should be used. ``` # ctsem (3.10.6) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "ctsem")` for more info ## In both * checking whether package ‘ctsem’ can be installed ... WARNING ``` Found the following significant warnings: Warning: namespace ‘colorspace’ is not available and has been replaced See ‘/scratch/henrik/revdep/future.apply/checks/ctsem/new/ctsem.Rcheck/00install.out’ for details. ``` * checking re-building of vignette outputs ... WARNING ``` ... ... --- re-building ‘hierarchicalmanual.rnw’ using knitr_notangle Warning in texi2dvi(file = file, pdf = TRUE, clean = clean, quiet = quiet, : texi2dvi script/program not available, using emulation Error: processing vignette 'hierarchicalmanual.rnw' failed with diagnostics: unable to run pdflatex on 'hierarchicalmanual.tex' LaTeX errors: ! LaTeX Error: File `apacite.sty' not found. Type X to quit or to proceed, or enter new name. (Default extension: sty) ! Emergency stop. l.62 \bibliographystyle {apacite} % Set bibliography style^^M ! ==> Fatal error occurred, no output PDF file produced! --- failed re-building ‘hierarchicalmanual.rnw’ SUMMARY: processing the following file failed: ‘hierarchicalmanual.rnw’ Error: Vignette re-building failed. Execution halted ``` # disk.frame (0.8.3) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "disk.frame")` for more info ## In both * checking Rd files ... NOTE ``` checkRd: (-1) csv_to_disk.frame.Rd:56: Lost braces; missing escapes or markup? 56 | strings, and you are encouraged to use {fasttime} to convert the strings to | ^ checkRd: (-1) purrr_as_mapper.Rd:10: Lost braces; missing escapes or markup? 10 | \item{.f}{a normal function or purrr syntax function i.e. `~{ ...code...}`} | ^ ``` # EFAtools (0.6.1) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "EFAtools")` for more info ## In both * checking dependencies in R code ... NOTE ``` Namespace in Imports field not imported from: ‘progress’ All declared Imports should be used. ``` # fabletools (0.6.1) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "fabletools")` for more info ## In both * checking examples ... ERROR ``` ... 2 Adelaide South Australia Holiday 157. 27.1 3 Adelaide South Australia Other 56.6 17.3 4 Adelaide South Australia Visiting 205. 32.5 5 Adelaide Hills South Australia Business 2.66 4.30 6 Adelaide Hills South Australia Holiday 10.5 6.37 7 Adelaide Hills South Australia Other 1.40 1.65 8 Adelaide Hills South Australia Visiting 14.2 10.7 9 Alice Springs Northern Territory Business 14.6 7.20 10 Alice Springs Northern Territory Holiday 31.9 18.1 # ℹ 294 more rows > > # Search and use useful features with `feature_set()`. > > ## Don't show: > if (requireNamespace("feasts", quietly = TRUE)) withAutoprint({ # examplesIf + ## End(Don't show) + library(feasts) + ## Don't show: + }) # examplesIf > ## End(Don't show) > tourism %>% + features(Trips, features = feature_set(tags = "autocorrelation")) Error in .l[[1]] : subscript out of bounds Calls: %>% ... features.tbl_ts -> features_impl -> map -> lapply -> FUN -> transpose Execution halted ``` # FracFixR (1.0.0) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "FracFixR")` for more info ## In both * checking re-building of vignette outputs ... ERROR ``` ... ▆ 1. ├─FracFixR::FracFixR(MatrixCounts = counts, Annotation = annotation) 2. │ └─future::plan(...) 3. │ └─future (local) plan_set(...) 4. │ └─future:::plan_init(stack[[1]], debug = debug) 5. │ └─future:::makeFutureBackend(evaluator, debug = debug) 6. │ └─base::do.call(factory, args = args, envir = envir) 7. └─future (local) ``(workers = 255) 8. └─future::ClusterFutureBackend(...) 9. └─clusterRegistry$startCluster(...) 10. └─future (local) makeCluster(workers, ...) 11. ├─base::do.call(makeClusterPSOCK, args = args, quote = TRUE) 12. └─parallelly (local) ``(base::quote(255L), rscript_libs = base::quote(``)) 13. └─parallelly:::checkNumberOfLocalWorkers(workers) ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Error: processing vignette 'FracFixR-intro.Rmd' failed with diagnostics: Attempting to set up 255 localhost parallel workers with only 5 CPU cores available for this R process (per 'N/A'), which could result in a 5100% load. The hard limit is set to 300%. Overusing the CPUs has negative impact on the current R process, but also on all other processes of yours and others running on the same machine. See help("parallelly.maxWorkers.localhost", package = "parallelly") for further explanations and how to override the hard limit that triggered this error. By the way, was parallel::detectCores() used, because the number of workers (255) equals detectCores() - 1? If so, please use parallelly::availableCores() instead --- failed re-building ‘FracFixR-intro.Rmd’ SUMMARY: processing the following file failed: ‘FracFixR-intro.Rmd’ Error: Vignette re-building failed. Execution halted ``` # hero (0.6) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "hero")` for more info ## In both * checking Rd files ... NOTE ``` checkRd: (-1) hero.Rd:67-68: Lost braces 67 | then \code{\link[pbapply]{pblapply}} is used. If code{package == | ^ checkRd: (-1) hero.Rd:69: Lost braces 69 | code{package == "Rmpi"}, then \code{\link[Rmpi]{mpi.applyLB}} is used.} | ^ ``` # InPAS (2.18.1) * Email: Run `revdepcheck::revdep_details(, "InPAS")` for more info ## In both * checking dependencies in R code ... NOTE ``` There are ::: calls to the package's namespace in its code. A package almost never needs to use ::: for its own objects: ‘adjust_distalCPs’ ‘adjust_proximalCPs’ ‘adjust_proximalCPsByNBC’ ‘adjust_proximalCPsByPWM’ ‘calculate_mse’ ‘find_valleyBySpline’ ‘get_PAscore’ ‘get_PAscore2’ ‘remove_convergentUTR3s’ ‘search_distalCPs’ ‘search_proximalCPs’ ``` * checking Rd metadata ... NOTE ``` Invalid package aliases in Rd file 'InPAS.Rd': ‘-package’ ``` * checking Rd \usage sections ... NOTE ``` Documented arguments not in \usage in Rd file 'get_UTR3TotalCov.Rd': ‘gcCompensationensation’ Functions with \usage entries need to have the appropriate \alias entries, and all their arguments documented. The \usage entries must correspond to syntactically valid R code. See chapter ‘Writing R documentation files’ in the ‘Writing R Extensions’ manual. ``` # ivmte (1.4.0) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "ivmte")` for more info ## In both * checking Rd files ... NOTE ``` checkRd: (-1) sTsls.Rd:17: Lost braces; missing escapes or markup? 17 | \item{pi}{the matrix E[XZ']E[ZZ']^{-1}} | ^ checkRd: (-1) sTslsSplines.Rd:20: Lost braces; missing escapes or markup? 20 | \item{pi}{matrix, corresponds to E[XZ']E[ZZ']^{-1}, the first stage | ^ ``` # kappaGold (0.4.0) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "kappaGold")` for more info ## In both * checking DESCRIPTION meta-information ... NOTE ``` Missing dependency on R >= 4.1.0 because package code uses the pipe |> or function shorthand \(...) syntax added in R 4.1.0. File(s) using such syntax: ‘kappa_inference.R’ ``` # lavDiag (0.1.0) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "lavDiag")` for more info ## In both * checking tests ... ``` ... 6. │ └─furrr:::furrr_template(...) 7. │ ├─future::nbrOfWorkers() 8. │ └─future:::nbrOfWorkers.NULL() 9. │ └─future::plan("backend") 10. │ └─future:::plan_init(strategy, debug = debug) 11. │ └─future:::makeFutureBackend(evaluator, debug = debug) 12. │ └─base::do.call(factory, args = args, envir = envir) 13. └─future (local) ``(workers = 255L) 14. └─future::ClusterFutureBackend(...) 15. └─clusterRegistry$startCluster(...) 16. └─future (local) makeCluster(workers, ...) 17. ├─base::do.call(makeClusterPSOCK, args = args, quote = TRUE) 18. └─parallelly (local) ``(base::quote(255L), rscript_libs = base::quote(``)) 19. └─parallelly:::checkNumberOfLocalWorkers(workers) ── Error ('test-prepare.R:12:3'): prepare merges branches for mixed model ────── Error in `prepare(fit, length.out = 15)`: Neither continuous nor ordinal branch succeeded - check model/functions. Backtrace: ▆ 1. └─lavDiag::prepare(fit, length.out = 15) at test-prepare.R:12:3 2. └─rlang::abort("Neither continuous nor ordinal branch succeeded - check model/functions.") [ FAIL 3 | WARN 25 | SKIP 1 | PASS 28 ] Error: ! Test failures. Execution halted ``` # MAI (1.16.0) * GitHub: * Email: Run `revdepcheck::revdep_details(, "MAI")` for more info ## In both * checking top-level files ... NOTE ``` File LICENSE is not mentioned in the DESCRIPTION file. ``` # mikropml (1.7.0) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "mikropml")` for more info ## In both * checking dependencies in R code ... NOTE ``` Namespace in Imports field not imported from: ‘methods’ All declared Imports should be used. ``` # nixtlar (0.6.2) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "nixtlar")` for more info ## In both * checking DESCRIPTION meta-information ... NOTE ``` Missing dependency on R >= 4.1.0 because package code uses the pipe |> or function shorthand \(...) syntax added in R 4.1.0. File(s) using such syntax: ‘get_model_params.R’ ‘level_from_quantiles.R’ ‘make_request.R’ ‘nixtla_client_cross_validation.R’ ‘nixtla_client_detect_anomalies.R’ ‘nixtla_client_forecast.R’ ‘nixtla_client_historic.R’ ‘nixtla_client_plot.R’ ‘nixtla_validate_api_key.R’ ‘validate_exogenous.R’ ``` # OutSeekR (1.1.0) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "OutSeekR")` for more info ## In both * checking dependencies in R code ... NOTE ``` Namespaces in Imports field not imported from: ‘future’ ‘truncnorm’ All declared Imports should be used. ``` # PAMpal (1.4.4) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "PAMpal")` for more info ## In both * checking whether package ‘PAMpal’ can be installed ... WARNING ``` Found the following significant warnings: Warning: no DISPLAY variable so Tk is not available See ‘/scratch/henrik/revdep/future.apply/checks/PAMpal/new/PAMpal.Rcheck/00install.out’ for details. ``` # PAMscapes (0.15.0) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "PAMscapes")` for more info ## In both * checking whether package ‘PAMscapes’ can be installed ... WARNING ``` Found the following significant warnings: Warning: no DISPLAY variable so Tk is not available See ‘/scratch/henrik/revdep/future.apply/checks/PAMscapes/new/PAMscapes.Rcheck/00install.out’ for details. ``` # pavo (2.9.0) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "pavo")` for more info ## In both * checking whether package ‘pavo’ can be installed ... WARNING ``` Found the following significant warnings: Warning: no DISPLAY variable so Tk is not available See ‘/scratch/henrik/revdep/future.apply/checks/pavo/new/pavo.Rcheck/00install.out’ for details. ``` # pgxRpi (1.6.0) * GitHub: * Email: Run `revdepcheck::revdep_details(, "pgxRpi")` for more info ## In both * checking R code for possible problems ... NOTE ``` pgxSegprocess: no visible binding for global variable ‘followup_state_id’ Undefined global functions or variables: followup_state_id ``` # powRICLPM (0.2.1) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "powRICLPM")` for more info ## In both * checking DESCRIPTION meta-information ... NOTE ``` Missing dependency on R >= 4.1.0 because package code uses the pipe |> or function shorthand \(...) syntax added in R 4.1.0. File(s) using such syntax: ‘save.R’ ``` # qape (2.1) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "qape")` for more info ## In both * checking Rd files ... NOTE ``` checkRd: (-1) srswrRe.Rd:10: Lost braces 10 | \item{listRanef}{{\emph{ranef(model)}} object where {\emph{model}} is an { \emph{lmer}} object.} | ^ ``` # QDNAseq (1.46.0) * GitHub: * Email: Run `revdepcheck::revdep_details(, "QDNAseq")` for more info ## In both * checking re-building of vignette outputs ... WARNING ``` ... Total time:0minutes Warning in texi2dvi(file = file, pdf = TRUE, clean = clean, quiet = quiet, : texi2dvi script/program not available, using emulation Error: processing vignette 'QDNAseq.Rnw' failed with diagnostics: unable to run pdflatex on 'QDNAseq.tex' LaTeX errors: ! LaTeX Error: File `nowidow.sty' not found. Type X to quit or to proceed, or enter new name. (Default extension: sty) ! Emergency stop. l.197 \RequirePackage {parnotes}^^M ! ==> Fatal error occurred, no output PDF file produced! --- failed re-building ‘QDNAseq.Rnw’ SUMMARY: processing the following file failed: ‘QDNAseq.Rnw’ Error: Vignette re-building failed. Execution halted ``` # receptiviti (0.2.1) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "receptiviti")` for more info ## In both * checking tests ... ``` ... ══ Skipped tests (4) ═══════════════════════════════════════════════════════════ • no API key (4): 'test-receptiviti.R:78:1', 'test-receptiviti_frameworks.R:1:1', 'test-receptiviti_norming.R:12:1', 'test-receptiviti_status.R:13:1' ══ Failed tests ════════════════════════════════════════════════════════════════ ── Error ('test-receptiviti.R:9:3'): invalid inputs are caught ───────────────── Error: Invalid header received from client. Backtrace: ▆ 1. ├─testthat::expect_error(...) at test-receptiviti.R:9:3 2. │ └─testthat:::expect_condition_matching_(...) 3. │ └─testthat:::quasi_capture(...) 4. │ ├─testthat (local) .capture(...) 5. │ │ └─base::withCallingHandlers(...) 6. │ └─rlang::eval_bare(quo_get_expr(.quo), quo_get_env(.quo)) 7. └─receptiviti::receptiviti(...) 8. └─receptiviti:::manage_request(...) [ FAIL 1 | WARN 0 | SKIP 4 | PASS 5 ] Error: ! Test failures. Execution halted ``` # rsi (0.3.2) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "rsi")` for more info ## In both * checking DESCRIPTION meta-information ... NOTE ``` Missing dependency on R >= 4.1.0 because package code uses the pipe |> or function shorthand \(...) syntax added in R 4.1.0. File(s) using such syntax: ‘calculate_indices.Rd’ ‘get_stac_data.R’ ‘get_stac_data.Rd’ ‘landsat_mask_function.Rd’ ``` # signeR (2.12.0) * GitHub: * Email: Run `revdepcheck::revdep_details(, "signeR")` for more info ## In both * checking C++ specification ... NOTE ``` Specified C++14: please drop specification unless essential ``` * checking R code for possible problems ... NOTE ``` ... ‘Samples’ ExposureClassify,ANY-character: no visible binding for global variable ‘Col’ ExposureClassify,ANY-character: no visible binding for global variable ‘Frequency’ ExposureClassify,ANY-character: no visible binding for global variable ‘Row’ ExposureClassifyCV,ANY-character: no visible binding for global variable ‘Col’ ExposureClassifyCV,ANY-character: no visible binding for global variable ‘Frequency’ ExposureClassifyCV,ANY-character: no visible binding for global variable ‘Row’ ExposureCorrelation,SignExp-numeric: no visible binding for global variable ‘Feature’ ExposureCorrelation,SignExp-numeric: no visible binding for global variable ‘exposure’ ExposureCorrelation,matrix-numeric: no visible binding for global variable ‘Feature’ ExposureCorrelation,matrix-numeric: no visible binding for global variable ‘exposure’ Undefined global functions or variables: . Col Feature Frequency Reference_Allele Row Samples Signatures Tumor_Seq_Allele1 Tumor_Seq_Allele2 Variant_Type conf.high conf.low estimate exposure fc p.value project sig sig_test term ``` * checking Rd files ... NOTE ``` prepare_Rd: cosmic_data.Rd:91-93: Dropping empty section \details prepare_Rd: cosmic_data.Rd:98-100: Dropping empty section \references prepare_Rd: cosmic_data.Rd:101-102: Dropping empty section \examples prepare_Rd: tcga_similarities.Rd:96-98: Dropping empty section \details prepare_Rd: tcga_similarities.Rd:99-101: Dropping empty section \source prepare_Rd: tcga_similarities.Rd:102-104: Dropping empty section \references prepare_Rd: tcga_similarities.Rd:105-106: Dropping empty section \examples prepare_Rd: tcga_tumors.Rd:18-20: Dropping empty section \details prepare_Rd: tcga_tumors.Rd:21-23: Dropping empty section \source prepare_Rd: tcga_tumors.Rd:24-26: Dropping empty section \references prepare_Rd: tcga_tumors.Rd:27-28: Dropping empty section \examples ``` # solitude (1.1.3) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "solitude")` for more info ## In both * checking dependencies in R code ... NOTE ``` Namespaces in Imports field not imported from: ‘R6’ ‘lgr’ All declared Imports should be used. ``` # sperrorest (3.0.5) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "sperrorest")` for more info ## In both * checking Rd files ... NOTE ``` ... | ^ checkRd: (-1) partition_kmeans.Rd:41: Lost braces; missing escapes or markup? 41 | if \code{TRUE} (used internally by other {sperrorest} functions), return a | ^ checkRd: (-1) partition_tiles.Rd:78: Lost braces; missing escapes or markup? 78 | if \code{TRUE} (used internally by other {sperrorest} functions), return a | ^ checkRd: (-1) sperrorest.Rd:55: Lost braces; missing escapes or markup? 55 | \code{formula} and \code{data} argument, which are provided by {sperrorest})} | ^ checkRd: (-1) sperrorest.Rd:63: Lost braces; missing escapes or markup? 63 | {sperrorest}).} | ^ checkRd: (-1) sperrorest.Rd:135: Lost braces; missing escapes or markup? 135 | A list (object of class {sperrorest}) with (up to) six components: | ^ checkRd: (-1) sperrorest.Rd:148: Lost braces; missing escapes or markup? 148 | information about the {sperrorest} package version | ^ checkRd: (-1) summary.sperroresterror.Rd:5: Lost braces; missing escapes or markup? 5 | \title{Summarize error statistics obtained by {sperrorest}} | ^ checkRd: (-1) summary.sperrorestimportance.Rd:5: Lost braces; missing escapes or markup? 5 | \title{Summarize variable importance statistics obtained by {sperrorest}} | ^ ``` # stppSim (1.3.4) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "stppSim")` for more info ## In both * checking whether package ‘stppSim’ can be installed ... WARNING ``` Found the following significant warnings: Warning: no DISPLAY variable so Tk is not available See ‘/scratch/henrik/revdep/future.apply/checks/stppSim/new/stppSim.Rcheck/00install.out’ for details. ``` # tramvs (0.0-8) * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "tramvs")` for more info ## In both * checking re-building of vignette outputs ... WARNING ``` ... ... --- re-building ‘tramvs.Rnw’ using knitr Warning in texi2dvi(file = file, pdf = TRUE, clean = clean, quiet = quiet, : texi2dvi script/program not available, using emulation Error: processing vignette 'tramvs.Rnw' failed with diagnostics: unable to run pdflatex on 'tramvs.tex' LaTeX errors: ! LaTeX Error: File `wrapfig.sty' not found. Type X to quit or to proceed, or enter new name. (Default extension: sty) ! Emergency stop. l.68 \usepackage {float}^^M ! ==> Fatal error occurred, no output PDF file produced! --- failed re-building ‘tramvs.Rnw’ SUMMARY: processing the following file failed: ‘tramvs.Rnw’ Error: Vignette re-building failed. Execution halted ``` # tsgarch (1.0.3) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "tsgarch")` for more info ## In both * checking DESCRIPTION meta-information ... NOTE ``` Missing dependency on R >= 4.1.0 because package code uses the pipe |> or function shorthand \(...) syntax added in R 4.1.0. File(s) using such syntax: ‘benchmark.R’ ‘print.R’ ``` # txshift (0.3.8) * GitHub: * Email: * GitHub mirror: Run `revdepcheck::revdep_details(, "txshift")` for more info ## In both * checking Rd files ... NOTE ``` checkRd: (-1) est_g_exp.Rd:55: Lost braces; missing escapes or markup? 55 | {A - delta}, {A + delta}, and {A + 2 * delta}). | ^ checkRd: (-1) est_g_exp.Rd:55: Lost braces; missing escapes or markup? 55 | {A - delta}, {A + delta}, and {A + 2 * delta}). | ^ checkRd: (-1) est_g_exp.Rd:55: Lost braces; missing escapes or markup? 55 | {A - delta}, {A + delta}, and {A + 2 * delta}). | ^ ``` ================================================ FILE: revdep/revdepcheck.Renviron ================================================ ## Environment variables set by revdepcheck.extras::run() R_REVDEPCHECK_TIMEOUT=${R_REVDEPCHECK_TIMEOUT:-180} TAR_SKIP_CLUSTERMQ=${TAR_SKIP_CLUSTERMQ-true} ## Allow for at least two workers R_PARALLELLY_AVAILABLECORES_FALLBACK=2 ## Allow for at most 5 cores ## Needed for parallelly (< 1.46.0), which will return ## detectCores() when check vignettes R_PARALLELLY_AVAILABLECORES_MAX=5 ## Allow for at most 8 threads OMP_NUM_THREADS=8 OPENBLAS_NUM_THREADS=8 MKL_NUM_THREADS=8 GOTO_NUM_THREADS=8 ## Turn on more checks #NOT_CRAN=true R_FUTURE_PLAN_EARLYSIGNAL=defunct R_FUTURE_FUTURE_EARLYSIGNAL=defunct R_FUTURE_FUTURE_LOCAL=defunct R_FUTURE_FUTURE_GC=defunct R_FUTURE_RESOLVED_RUN=defunct ================================================ FILE: revdep/revdepcheck.init.sh ================================================ #! /usr/bin/env bash ## Missing or outdated LaTeX packages if (FALSE) { tinytex::install_tinytex(force = TRUE) message("TeX root: ", tinytex::tinytex_root()) tinytex::tlmgr_update() tinytex::tlmgr_install("nowidow") # QDNAseq tinytex::tlmgr_install("wrapfig") # tramvs tinytex::tlmgr_install("apacite") # ctsem } ## Add packages to check revdep/run.R --add-children ## Drop packages no longer on CRAN (2026-02-19) revdep/run.R --rm forecastML ## Drop packages failing on Bioconductor (2026-02-19) revdep/run.R --rm MineICA ## Too many cores because of detectCores() # NSLOTS=4 revdep/run.R --add FracFixR lavDiag ================================================ FILE: revdep/run.R ================================================ #!/usr/bin/env Rscript precheck <- function() { ## WORKAROUND: Remove checked pkgs that use file links, which otherwise ## produce warnings which are promoted to errors by revdepcheck. unlink("revdep/checks/aroma.affymetrix", recursive = TRUE) } revdepcheck.extras::run() ================================================ FILE: revdep/run.pbs ================================================ #!/bin/bash ## Example: qsub -l nodes=1:ppn=24 -l vmem=30gb revdep/run.pbs #PBS -j oe # Join STDERR and STDOUT cd "$PBS_O_WORKDIR" module load r Rscript revdep/run.R ================================================ FILE: revdep/run.sge ================================================ #!/bin/bash ## Example: qsub -pe smp 24 -l h_rt=08:00:00 revdep/run.sge #$ -S /bin/bash #$ -R yes # SGE host reservation, highly recommended #$ -cwd # Current working directory #$ -j y # Join STDERR and STDOUT #$ -l mem_free=3G # On average 4 GiB of RAM per core (=a package check) #$ -m bea # email when job (b)egins, (e)nds, or (a)borts # # Pass on R-specific environment variables, iff set: ##$ -v _R_CHECK_LENGTH_1_CONDITION_ ##$ -v _R_CHECK_LENGTH_1_LOGIC2_ ##$ -v R_STARTUP_DEBUG ## SPECIAL: On Wynton HPC if [[ $SGE_CLUSTER_NAME == *wynton* ]]; then module load CBI module load r ## Some packages need a more modern version of gcc, e.g. 'balvaan' module load scl-devtoolset/4 ## Some packages require non-default system libraries module load gdal geos gsl hdf5 jags ## Install all packages to toward $TMPDIR, if revdep/library doesn't already exist. ## This will avoid some of the slowness on the global file system #if [[ ! -d revdep/library ]]; then # tmpdir=$(mktemp -d) # ln -fs "$tmpdir" revdep/library # [[ -d revdep/library ]] || { >&2 echo "ERROR: Failed to link revdep/library/ to $tmpdir"; exit 1; } #fi ## To check in on revdep/library/ on the running host (see below), submit a job like: ## echo "ls -lR revdep/library/" | qsub -cwd -j yes -l hostname= ## Assert that revdep/library is on $TMPDIR #if [[ ! "$(readlink revdep/library)" = $TMPDIR* ]]; then # >&2 echo "ERROR: revdep/library/ already exists but is not on $TMPDIR" # exit 1 #fi fi echo "HOSTNAME: $HOSTNAME" ls -l revdep/ Rscript --version Rscript -e ".libPaths()" Rscript revdep/run.R ================================================ FILE: tests/incl/end.R ================================================ ## Undo future strategy future::plan(oplan) ## Undo options ## (a) Added added <- setdiff(names(options()), names(oopts0)) opts <- vector("list", length = length(added)) names(opts) <- added options(opts) ## (b) Modified options(oopts) ## (c) Assert that everything was undone stopifnot(all.equal(options(), oopts0)) ## Undo system environment variables ## (a) Added cenvs <- Sys.getenv() added <- setdiff(names(cenvs), names(oenvs0)) for (name in added) Sys.unsetenv(name) ## (b) Missing missing <- setdiff(names(oenvs0), names(cenvs)) if (length(missing) > 0) { values <- oenvs0[missing] do.call(Sys.setenv, as.list(values)) ## WORKAROUND: Most platforms allow setting an environment variable to ## "", but Windows does not and there Sys.setenv(FOO = "") unsets FOO. if (.Platform$OS.type == "windows") { drop <- missing[!nzchar(values)] if (length(drop) > 0) { oenvs0 <- oenvs0[setdiff(names(oenvs0), drop)] ## In case Sys.setenv() supports empty string in the future Sys.unsetenv(drop) } } } ## (c) Modified? for (name in intersect(names(cenvs), names(oenvs0))) { ## WORKAROUND: On Linux Wine, base::Sys.getenv() may ## return elements with empty names. /HB 2016-10-06 if (nchar(name) == 0) next if (!identical(cenvs[[name]], oenvs0[[name]])) { do.call(Sys.setenv, as.list(oenvs0[name])) ## WORKAROUND: Most platforms allow setting an environment variable to ## "", but Windows does not and there Sys.setenv(FOO = "") unsets FOO. if (.Platform$OS.type == "windows" && !nzchar(oenvs0[[name]])) { oenvs0 <- oenvs0[setdiff(names(oenvs0), name)] ## In case Sys.setenv() supports empty string in the future Sys.unsetenv(name) } } } ## (d) Assert that everything was undone stopifnot(identical(Sys.getenv(), oenvs0)) ## Undo variables rm(list = c(setdiff(ls(), ovars))) ## Travis CI specific: Explicit garbage collection because it ## looks like Travis CI might run out of memory during 'covr' ## testing and we now have so many tests. /HB 2017-01-11 if ("covr" %in% loadedNamespaces()) gc() ================================================ FILE: tests/incl/start,load-only.R ================================================ ## Record original state ovars <- ls() oenvs <- oenvs0 <- Sys.getenv() oopts0 <- options() covr_testing <- ("covr" %in% loadedNamespaces()) on_solaris <- grepl("^solaris", R.version$os) ## Default options oopts <- options( warn = 1L, mc.cores = 2L, future.debug = TRUE, ## Reset the following during testing in case ## they are set on the test system future.availableCores.system = NULL, future.availableCores.fallback = NULL ) ## Reset the following during testing in case ## they are set on the test system oenvs2 <- Sys.unsetenv(c( "R_FUTURE_AVAILABLECORES_SYSTEM", "R_FUTURE_AVAILABLECORES_FALLBACK", ## SGE "NSLOTS", "PE_HOSTFILE", ## Slurm "SLURM_CPUS_PER_TASK", ## TORQUE / PBS "PBS_NUM_PPN", "PBS_NODEFILE", "PBS_NP", "PBS_NUM_NODES" )) oplan <- future::plan() ## Use eager futures by default future::plan("sequential") ## Private future.apply functions fold <- future.apply:::fold hpaste <- future.apply:::hpaste mdebug <- future.apply:::mdebug mdebugf <- future.apply:::mdebugf import_from <- future.apply:::import_from get_random_seed <- future.apply:::get_random_seed set_random_seed <- future.apply:::set_random_seed next_random_seed <- future.apply:::next_random_seed as_lecyer_cmrg_seed <- future.apply:::as_lecyer_cmrg_seed is_lecyer_cmrg_seed <- future.apply:::is_lecyer_cmrg_seed make_rng_seeds <- future.apply:::make_rng_seeds ## Local functions for test scripts printf <- function(...) cat(sprintf(...)) mstr <- function(...) message(paste(capture.output(str(...)), collapse = "\n")) attachLocally <- function(x, envir = parent.frame()) { for (name in names(x)) { assign(name, value = x[[name]], envir = envir) } } supportedStrategies <- function(cores = 1L, excl = c("cluster"), ...) { strategies <- future:::supportedStrategies(...) strategies <- setdiff(strategies, excl) if (cores > 1) { strategies <- setdiff(strategies, c("sequential", "uniprocess")) } strategies } availCores <- min(2L, future::availableCores()) ================================================ FILE: tests/test-fold.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-fold.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("fold") ================================================ FILE: tests/test-future_Filter.R ================================================ #! /usr/bin/env Rscript ## 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") ================================================ FILE: tests/test-future_apply.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_apply.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_apply") ================================================ FILE: tests/test-future_by.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_by.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_by") ================================================ FILE: tests/test-future_eapply.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_eapply.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_eapply") ================================================ FILE: tests/test-future_kernapply.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_kernapply.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_kernapply") ================================================ FILE: tests/test-future_lapply,RNG.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_lapply,RNG.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_lapply,RNG") ================================================ FILE: tests/test-future_lapply,globals.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_lapply,globals.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_lapply,globals") ================================================ FILE: tests/test-future_lapply.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_lapply.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_lapply") ================================================ FILE: tests/test-future_mapply,globals.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_mapply,globals.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_mapply,globals") ================================================ FILE: tests/test-future_mapply.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_mapply.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_mapply") ================================================ FILE: tests/test-future_replicate.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_replicate.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_replicate") ================================================ FILE: tests/test-future_sapply.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_sapply.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_sapply") ================================================ FILE: tests/test-future_tapply.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_tapply.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_tapply") ================================================ FILE: tests/test-future_vapply.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-future_vapply.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("future_vapply") ================================================ FILE: tests/test-globals,tricky2.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-globals,tricky2.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("globals,tricky2") ================================================ FILE: tests/test-globals,tricky_recursive.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-globals,tricky_recursive.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("globals,tricky_recursive") ================================================ FILE: tests/test-options,nested.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-options,nested.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("options,nested") ================================================ FILE: tests/test-rng.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-rng.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("rng") ================================================ FILE: tests/test-stdout.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-stdout.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("stdout") ================================================ FILE: tests/test-utils.R ================================================ #! /usr/bin/env Rscript ## This runs testme test script inst/testme/test-utils.R ## Don't edit - it was autogenerated by inst/testme/deploy.R future.apply:::testme("utils") ================================================ FILE: vignettes/future.apply-1-overview.md.rsp ================================================ <%@meta language="R-vignette" content="-------------------------------- %\VignetteIndexEntry{A Future for R: Apply Function to Elements in Parallel} %\VignetteAuthor{Henrik Bengtsson} %\VignetteKeyword{R} %\VignetteKeyword{package} %\VignetteKeyword{vignette} %\VignetteKeyword{future} %\VignetteKeyword{lazy evaluation} %\VignetteKeyword{synchronous} %\VignetteKeyword{asynchronous} %\VignetteKeyword{parallel} %\VignetteKeyword{cluster} %\VignetteEngine{R.rsp::rsp} %\VignetteTangle{FALSE} --------------------------------------------------------------------"%> # A Future for R: Apply Function to Elements in Parallel ## Introduction The purpose of this package is to provide worry-free parallel alternatives to base-R "apply" functions, e.g. `apply()`, `lapply()`, and `vapply()`. The goal is that one should be able to replace any of these in the core with its futurized equivalent and things will just work. For example, instead of doing: ```r library(datasets) library(stats) y <- lapply(mtcars, FUN = mean, trim = 0.10) ``` one can do: ```r library(future.apply) plan(multisession) ## Run in parallel on local computer library(datasets) library(stats) y <- future_lapply(mtcars, FUN = mean, trim = 0.10) ``` Reproducibility is part of the core design, which means that perfect, parallel random number generation (RNG) is supported regardless of the amount of chunking, type of load balancing, and future backend being used. To enable parallel RNG, use argument `future.seed = TRUE`. ## Role Where does the **[future.apply]** package fit in the software stack? You can think of it as a sibling to **[foreach]**, **[furrr]**, **[BiocParallel]**, **[plyr]**, etc. Just as **parallel** provides `parLapply()`, **foreach** provides `foreach()`, **BiocParallel** provides `bplapply()`, and **plyr** provides `llply()`, **future.apply** provides `future_lapply()`. Below is a table summarizing this idea:
Package Functions Backends
future.apply

 Future-versions of common goto *apply() functions available in base R (of the base and stats packages):
future_apply(), future_by(), future_eapply(), future_Filter(), future_lapply(), future_kernapply(), future_Map(), future_mapply(), future_.mapply(), future_replicate(), future_sapply(), future_tapply(), and future_vapply().
The following function is not implemented:
future_rapply()
 All future backends
parallel mclapply(), mcmapply(), clusterMap(), parApply(), parLapply(), parSapply(), ... Built-in and conditional on operating system
foreach foreach(), times() All future backends via doFuture
furrr future_imap(), future_map(), future_pmap(), future_map2(), ... All future backends
BiocParallel Bioconductor's parallel mappers:
bpaggregate(), bpiterate(), bplapply(), and bpvec() 		All future backends via doFuture (because it supports foreach) or via BiocParallel.FutureParam (direct BiocParallelParam support; prototype)
plyr **ply(..., .parallel = TRUE) functions:
aaply(), ddply(), dlply(), llply(), ... 		All future backends via doFuture (because it uses foreach internally)
Note that, except for the built-in **parallel** package, none of these higher-level APIs implement their own parallel backends, but they rather enhance existing ones. The **foreach** framework leverages backends such as **[doParallel]**, **[doMC]** and **[doFuture]**, and the **future.apply** framework leverages the **[future]** ecosystem and therefore backends such as built-in **parallel**, **[future.callr]**, and **[future.batchtools]**. By separating `future_lapply()` and friends from the **[future]** package, it helps clarifying the purpose of the **future** package, which is to define and provide the core Future API, which higher-level parallel APIs can build on and for which any futurized parallel backends can be plugged into. The API and identity of the **future.apply** package will be kept close to the `*apply()` functions in base R. In other words, it will _neither_ keep growing nor be expanded with new, more powerful apply-like functions beyond those core ones in base R. Such extended functionality should be part of a separate package. [batchtools]: https://cran.r-project.org/package=batchtools [BiocParallel]: https://bioconductor.org/packages/BiocParallel/ [doFuture]: https://cran.r-project.org/package=doFuture [doMC]: https://cran.r-project.org/package=doMC [doParallel]: https://cran.r-project.org/package=doParallel [foreach]: https://cran.r-project.org/package=foreach [future]: https://cran.r-project.org/package=future [future.apply]: https://cran.r-project.org/package=future.apply [future.batchtools]: https://cran.r-project.org/package=future.batchtools [future.callr]: https://cran.r-project.org/package=future.callr [furrr]: https://cran.r-project.org/package=furrr [plyr]: https://cran.r-project.org/package=plyr