Add use_memoise() helper to change behavior on the fly (x

fixes #71 and #77 --------- Co-authored-by: Hugo Gruson <[email protected]> Co-authored-by: Matthias Grenié <[email protected]>
funecology · Apr 3, 2024 · cc35fc4 · cc35fc4
1 parent d11d749
commit cc35fc4
Show file tree

Hide file tree

Showing 27 changed files with 446 additions and 202 deletions.
diff --git a/.github/workflows/render-readme.yaml b/.github/workflows/render-readme.yaml
diff --git a/.github/workflows/render-rmarkdown.yaml b/.github/workflows/render-rmarkdown.yaml
@@ -0,0 +1,34 @@
+# Workflow derived from https://github.com/r-lib/actions/tree/v2/examples
+# Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help
+on:
+  push:
+    paths:
+      - README.Rmd
+
+name: Render README
+
+jobs:
+  render-rmarkdown:
+    runs-on: ubuntu-latest
+    env:
+      GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }}
+    steps:
+      - name: Checkout repo
+        uses: actions/checkout@v4
+        with:
+          fetch-depth: 0
+
+      - uses: r-lib/actions/setup-pandoc@v2
+
+      - uses: r-lib/actions/setup-r@v2
+
+      - uses: r-lib/actions/setup-renv@v2
+
+      - name: Render Rmarkdown files and Commit Results
+        run: |
+          RMD_PATH=($(git diff --name-only ${{ github.event.before }} ${{ github.sha }} | grep '[.]Rmd$'))
+          Rscript -e 'for (f in commandArgs(TRUE)) if (file.exists(f)) rmarkdown::render(f)' ${RMD_PATH[*]}
+          git config --local user.name "$GITHUB_ACTOR"
+          git config --local user.email "[email protected]"
+          git commit ${RMD_PATH[*]/.Rmd/.md} -m 'Re-build Rmarkdown files' || echo "No changes to commit"
+          git push origin || echo "No changes to commit"
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -23,7 +23,7 @@ Language: en
 Encoding: UTF-8
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Depends: 
     R (>= 2.10)
 Imports:
@@ -36,7 +36,8 @@ Suggests:
     knitr,
     memoise,
     rmarkdown,
-    testthat (>= 3.0.0)
+    testthat (>= 3.0.0),
+    withr
 URL: https://funecology.github.io/fundiversity/, https://github.com/funecology/fundiversity
 BugReports: https://github.com/funecology/fundiversity/issues
 Config/testthat/edition: 3

diff --git a/R/fd_fdiv.R b/R/fd_fdiv.R
@@ -75,6 +75,12 @@ fd_fdiv <- function(traits, sp_com) {
   site_abundances[site_abundances == 0] <- 1  # Account for site with no species
   sp_com <- sp_com / site_abundances
 
+  convex_hull <- if (use_memoise()) {
+    fd_chull_memoised
+  } else {
+    fd_chull
+  }
+
   # Compute Functional Divergence
   fdiv_site <- future_apply(sp_com, 1, function(sp_site) {
 
@@ -88,7 +94,7 @@ fd_fdiv <- function(traits, sp_com) {
     # Select traits for species actually in site
     sub_traits <- traits[names(sub_site),, drop = FALSE]
 
-    ch <- fd_chull(sub_traits)
+    ch <- convex_hull(sub_traits)
 
     verts <- ch$p[unique(c(ch$hull)),, drop = FALSE]
 

diff --git a/R/fd_fric.R b/R/fd_fric.R
@@ -25,7 +25,7 @@
 #' The computation of this function can be parallelized thanks to
 #' [future::plan()]. To get more information on how to parallelize your
 #' computation please refer to the parallelization vignette with:
-#' `vignette("fundiversity_1-parallel", package = "fundiversity")`
+#' `vignette("fundiversity_1-parallel", package = "fundiversity")`.
 #'
 #' @examples
 #' data(traits_birds)
@@ -34,11 +34,17 @@
 #' @details By default, when loading \pkg{fundiversity}, the functions to
 #' compute convex hulls are
 #' [memoised](https://en.wikipedia.org/wiki/Memoization) through the `memoise`
-#' package if it is installed. To deactivate this behavior you can set the
+#' package if it is installed (their results are cached to avoid recomputing the
+#' same functional volume twice). To deactivate this behavior you can set the
 #' option `fundiversity.memoise` to `FALSE` by running the following line:
 #' `options(fundiversity.memoise = FALSE)`. If you use it interactively it will
 #' only affect your current session. Add it to your script(s) or `.Rprofile`
-#' file to avoid toggling it each time.
+#' file to avoid toggling it each time. By changing the option, the behavior
+#' will automatically change the next time you run the function. **Note**:
+#' memoisation is only available when the `memoise` package has been installed
+#' **and without parallelization**, otherwise `fundiversity` will use unmemoised
+#' versions of the functions. In other words, **memoization and parallelization
+#' are mutually exclusive**.
 #'
 #' @return a data.frame with two columns:
 #' * `site` the names of the sites as the row names of the input `sp_com`,
@@ -105,12 +111,19 @@ fd_fric <- function(traits, sp_com, stand = FALSE) {
 
   max_range <- 1
 
+  convex_hull <- if (use_memoise()) {
+    fd_chull_memoised
+  } else {
+    fd_chull
+  }
+
   if (stand) {
-    max_range <- fd_chull(traits)$vol
+    max_range <- convex_hull(traits)$vol
   }
 
   fric_site <- future_apply(sp_com, 1, function(site_row) {
-    fd_chull(traits[site_row > 0,, drop = FALSE])$vol
+    res <- convex_hull(traits[site_row > 0, , drop = FALSE])
+    return(res$vol)
   }, future.globals = FALSE)
 
   if (any(is.na(fric_site))) {

diff --git a/R/fd_fric_intersect.R b/R/fd_fric_intersect.R
@@ -84,8 +84,20 @@ fd_fric_intersect <- function(traits, sp_com, stand = FALSE) {
 
   max_range <- 1
 
+  convex_hull <- if (use_memoise()) {
+    fd_chull_memoised
+  } else {
+    fd_chull
+  }
+
+  convex_hull_intersect <- if (use_memoise()) {
+    fd_chull_intersect_memoised
+  } else {
+    fd_chull_intersect
+  }
+
   if (stand) {
-    max_range <- fd_chull(traits)$vol
+    max_range <- convex_hull(traits)$vol
   }
 
   # All pairs of sites (not within themselves)
@@ -113,11 +125,11 @@ fd_fric_intersect <- function(traits, sp_com, stand = FALSE) {
       second_row    <- sp_com[site_comb[[2]],, drop = TRUE]
       second_traits <- traits[second_row > 0,, drop = FALSE]
 
-      fd_chull_intersect(first_traits, second_traits)$vol
+      convex_hull_intersect(first_traits, second_traits)$vol
     } else {
       # Self-intersection (equivalent to regular convex hulls)
-      # way more efficient that compute with fd_chull_inters
-      fd_chull(first_traits)$vol
+      # way more efficient than computing with convex_hull_intersect()
+      convex_hull(first_traits)$vol
     }
   }, future.globals = FALSE)
 

diff --git a/R/use_memoise.R b/R/use_memoise.R
@@ -0,0 +1,46 @@
+#' Options for \pkg{fundiversity}
+#'
+#' The memoisation is the convex hull computation in \pkg{fundiversity} is
+#' controlled via the `fundiversity.memoise` option:
+#' - if unset, the default is to use memoisation if \pkg{memoise} was installed
+#'  when \pkg{fundiversity} was loaded, and not to use memoisation otherwise.
+#' - if `options(fundiversity.memoise = TRUE)`, memoisation is used and an error
+#'  is thrown if \pkg{memoise} is not installed.
+#' - if `options(fundiversity.memoise = FALSE)`, memoisation is not used.
+#'
+#' @name fundiversity-options
+NULL
+
+#' @keywords internal
+use_memoise <- function() {
+
+  # Cannot use memoise in parallel settings
+  if (!inherits(future::plan(), "sequential")) {
+    return(FALSE)
+  }
+
+  # explicitly set to TRUE by user
+  if (isTRUE(getOption("fundiversity.memoise"))) {
+    if (exists("fd_chull_memoised")) {
+      return(TRUE)
+    }
+    stop(
+      "memoise is not installed ",
+      "or was installed after fundiversity was loaded. ",
+      "Please install memoise and restart R.",
+      call. = FALSE
+    )
+  }
+  # explicitly set to FALSE by user
+  if (isFALSE(getOption("fundiversity.memoise"))) {
+    return(FALSE)
+  }
+  # unspecified / default
+  # TRUE or FALSE depending on whether memoise was installed when fundiversity
+  # was loaded
+  return(exists("fd_chull_memoised"))
+}
+
+# Added this to make 'testthat::local_mocked_bindings()' work
+# in 'test-use_memoise.R'
+exists <- NULL
diff --git a/R/zzz.R b/R/zzz.R
@@ -1,10 +1,6 @@
-# Diverse utility functions
-
-# Memoized version of fd_chull loaded if package is installed
 .onLoad <- function(libname, pkgname) {
-  if (requireNamespace("memoise", quietly = TRUE) &&
-      isTRUE(getOption("fundiversity.memoise", TRUE))) {
-    fd_chull <<- memoise::memoise(fd_chull)
-    fd_chull_intersect <<- memoise::memoise(fd_chull_intersect)
+  if (requireNamespace("memoise", quietly = TRUE)) {
+    fd_chull_memoised <<- memoise::memoise(fd_chull)
+    fd_chull_intersect_memoised <<- memoise::memoise(fd_chull_intersect)
   }
 }
diff --git a/README.Rmd b/README.Rmd
@@ -101,7 +101,8 @@ future::plan(future::multisession)
 fd_fdiv(traits_birds)
 ```
 
-For more details please refer to the [parallelization vignette](https://funecology.github.io/fundiversity/articles/fundiversity_1-parallel.html) or use `vignette("fundiversity_1-parallel", package = "fundiversity")` within R.
+For more details please refer to the [parallelization vignette](https://funecology.github.io/fundiversity/articles/fundiversity_1-parallel.html) or use `vignette("fundiversity_1-parallel", package = "fundiversity")` within R. **Note**: parallelization and memoization are **mutually exclusive**, when doing computation in parallel, fundiversity falls back on **unmemoised** versions of function.
+
 
 ## Available functional diversity indices
 

diff --git a/README.md b/README.md
@@ -112,7 +112,9 @@ fd_fdiv(traits_birds)
 For more details please refer to the [parallelization
 vignette](https://funecology.github.io/fundiversity/articles/fundiversity_1-parallel.html)
 or use `vignette("fundiversity_1-parallel", package = "fundiversity")`
-within R.
+within R. **Note**: parallelization and memoization are **mutually
+exclusive**, when doing computation in parallel, fundiversity falls back
+on **unmemoised** versions of function.
 
 ## Available functional diversity indices
 
@@ -140,14 +142,14 @@ mention the numerous wrappers around these packages):
 
 | Package Name                                           | Indices included                                                                                                    | Has vignettes | Has tests | On GitHub | On CRAN (last updated)                                     |
 |--------------------------------------------------------|---------------------------------------------------------------------------------------------------------------------|---------------|-----------|-----------|------------------------------------------------------------|
-| [`adiv`](https://github.com/cran/adiv)                 | Functional Entropy, Functional Redundancy                                                                           | ✅            | ❌        | ❌        | ![](https://www.r-pkg.org/badges/last-release/adiv)        |
+| [`adiv`](https://github.com/cran/adiv)                 | Functional Entropy, Functional Redundancy                                                                           | ❌            | ❌        | ❌        | ![](https://www.r-pkg.org/badges/last-release/adiv)        |
 | [`BAT`](https://github.com/cardosopmb/BAT)             | β-diversity indices, Richness, divergence, and evenness with hypervolumes                                           | ❌            | ❌        | ✅        | ![](https://www.r-pkg.org/badges/last-release/BAT)         |
 | [`betapart`](https://github.com/cran/betapart)         | Functional β-diversity                                                                                              | ❌            | ❌        | ❌        | ![](https://www.r-pkg.org/badges/last-release/betapart)    |
 | [`entropart`](https://github.com/EricMarcon/entropart) | Functional Entropy                                                                                                  | ✅            | ✅        | ✅        | ![](https://www.r-pkg.org/badges/last-release/entropart)   |
 | [`FD`](https://github.com/cran/FD)                     | FRic, FDiv, FDis, FEve, Rao’s QE, Functional Group Richness                                                         | ❌            | ❌        | ❌        | ![](https://www.r-pkg.org/badges/last-release/FD)          |
 | [`hilldiv`](https://github.com/anttonalberdi/hilldiv)  | Dendrogram-based Hill numbers for functional diversity                                                              | ❌            | ❌        | ✅        | ![](https://www.r-pkg.org/badges/last-release/hilldiv)     |
 | [`hillR`](https://github.com/daijiang/hillR)           | Functional Diversity Hill Numbers                                                                                   | ❌            | ✅        | ✅        | ![](https://www.r-pkg.org/badges/last-release/hillR)       |
-| [`hypervolume`](https://github.com/cran/hypervolume)   | Hypervolume measure of functional diversity (\~FRic)                                                                | ✅            | ❌        | ✅        | ![](https://www.r-pkg.org/badges/last-release/hypervolume) |
+| [`hypervolume`](https://github.com/cran/hypervolume)   | Hypervolume measure of functional diversity (~FRic)                                                                 | ✅            | ❌        | ✅        | ![](https://www.r-pkg.org/badges/last-release/hypervolume) |
 | [`mFD`](https://github.com/CmlMagneville/mFD)          | Functional α- and β-diversity indices, including FRic, FDiv, FDis, FEve, FIde, FMPD, FNND, FOri, FSpe, Hill Numbers | ✅            | ❌        | ✅        | ![](https://www.r-pkg.org/badges/last-release/mFD)         |
 | [`TPD`](https://github.com/cran/TPD)                   | FRic, FDiv, FEve but for probability distributions                                                                  | ✅            | ❌        | ❌        | ![](https://www.r-pkg.org/badges/last-release/TPD)         |
 | [`vegan`](https://github.com/vegandevs/vegan)          | Only dendrogram-based FD (`treedive()`)                                                                             | ✅            | ✅        | ✅        | ![](https://www.r-pkg.org/badges/last-release/vegan)       |

diff --git a/man/fd_fdis.Rd b/man/fd_fdis.Rd
diff --git a/man/fd_fdiv.Rd b/man/fd_fdiv.Rd
diff --git a/man/fd_feve.Rd b/man/fd_feve.Rd
diff --git a/man/fd_fric.Rd b/man/fd_fric.Rd
diff --git a/man/fd_fric_intersect.Rd b/man/fd_fric_intersect.Rd