add tests, coverage, better cache control

Author: jtanevski

.Rbuildignore

@@ -9,3 +9,4 @@
 ^LICENSE$
 ^.*\.Rproj$
 ^\.Rproj\.user$
+^codecov\.yml$

.github/workflows/check-bioc.yml

@@ -34,8 +34,8 @@ name: R4.1-bioc3.13
 ## Note that you can always run a GHA test without the cache by using the word
 ## "/nocache" in the commit message.
 env:
-  has_testthat: 'false'
-  run_covr: 'false'
+  has_testthat: 'true'
+  run_covr: 'true'
   run_pkgdown: 'true'
   has_RUnit: 'false'
   cache-version: 'cache-v1'

DESCRIPTION

@@ -1,7 +1,7 @@
 Package: mistyR
 Type: Package
 Title: Multiview Intercellular SpaTial modeling framework
-Version: 0.99.10
+Version: 0.99.11
 Authors@R: c(
     person(given = "Jovan",
            family = "Tanevski",
@@ -39,8 +39,19 @@ VignetteBuilder: knitr
 Imports: assertthat, caret, deldir, digest, distances, dplyr, filelock, 
     furrr (>= 0.2.0), ggplot2, MASS, purrr, ranger, readr, rlang, rlist, 
     R.utils, stats, stringr, tibble, tidyr, withr
-Suggests: BiocStyle, future, igraph, knitr, Matrix, progeny, rmarkdown, 
-    sctransform, SingleCellExperiment, SpatialExperiment, SummarizedExperiment,
+Suggests: 
+    covr,
+    BiocStyle,
+    future,
+    igraph,
+    knitr,
+    Matrix,
+    progeny,
+    rmarkdown,
+    sctransform,
+    SingleCellExperiment,
+    SpatialExperiment,
+    SummarizedExperiment,
     testthat (>= 3.0.0)
 RoxygenNote: 7.1.1
 Config/testthat/edition: 3

NEWS.md

@@ -1,7 +1,8 @@
-# mistyR 0.99.10
+# mistyR 0.99.11
 
 - Fixed a bug in Nystrom approximation for creating paraview.
-- Added tests for view composition.
+- Added a suite of tests with high coverage.
+- Cleaner cache control.
 
 # mistyR 0.99.9
 

R/misty.R

@@ -74,6 +74,8 @@ run_misty <- function(views, results.folder = "results", seed = 42,
     dir.create(normalized.results.folder, recursive = TRUE)
   }
 
+  on.exit(sweep_cache())
+
   view.abbrev <- views %>%
     rlist::list.remove(c("misty.uniqueid")) %>%
     purrr::map_chr(~ .x[["abbrev"]])
@@ -100,7 +102,7 @@ run_misty <- function(views, results.folder = "results", seed = 42,
     normalized.results.folder, .Platform$file.sep,
     "coefficients.txt.lock"
   )
-  on.exit(file.remove(coef.lock))
+  on.exit(file.remove(coef.lock), add = TRUE)
 
   if (!append) {
     current.lock <- filelock::lock(coef.lock)
@@ -188,15 +190,19 @@ run_misty <- function(views, results.folder = "results", seed = 42,
       dplyr::mutate_if(~ sum(. < 0) > 0, ~ pmax(., 0))
     performance.summary <- c(
       performance.estimate %>% colMeans(),
-      tryCatch(stats::t.test(performance.estimate %>% dplyr::pull(.data$intra.RMSE),
-        performance.estimate %>% dplyr::pull(.data$multi.RMSE),
-        alternative = "greater"
+      tryCatch(stats::t.test(performance.estimate %>%
+        dplyr::pull(.data$intra.RMSE),
+      performance.estimate %>%
+        dplyr::pull(.data$multi.RMSE),
+      alternative = "greater"
       )$p.value, error = function(e) {
         1
       }),
-      tryCatch(stats::t.test(performance.estimate %>% dplyr::pull(.data$intra.R2),
-        performance.estimate %>% dplyr::pull(.data$multi.R2),
-        alternative = "less"
+      tryCatch(stats::t.test(performance.estimate %>%
+        dplyr::pull(.data$intra.R2),
+      performance.estimate %>%
+        dplyr::pull(.data$multi.R2),
+      alternative = "less"
       )$p.value, error = function(e) {
         1
       })
@@ -211,18 +217,5 @@ run_misty <- function(views, results.folder = "results", seed = 42,
     return(target)
   }, .progress = TRUE, .options = furrr::furrr_options(seed = TRUE))
 
-  if (!cached) {
-    cache.location <- R.utils::getAbsolutePath(paste0(
-      ".misty.temp", .Platform$file.sep,
-      views[["misty.uniqueid"]]
-    ))
-    if (length(list.files(cache.location)) == 0) {
-      clear_cache(views[["misty.uniqueid"]])
-    }
-    if (length(list.files(R.utils::getAbsolutePath(".misty.temp"))) == 0) {
-      clear_cache()
-    }
-  }
-
   return(normalized.results.folder)
 }

R/models.R

@@ -17,17 +17,16 @@
 #'
 #' @return A list containing the trained meta-model, a list of trained
 #' view-specific models and performance estimates.
-#' 
+#'
 #' @noRd
 build_model <- function(views, target, seed = 42, cv.folds = 10, cached = FALSE,
                         ...) {
-
   cache.location <- R.utils::getAbsolutePath(paste0(
     ".misty.temp", .Platform$file.sep,
     views[["misty.uniqueid"]]
   ))
 
-  if (!dir.exists(cache.location)) {
+  if (cached && !dir.exists(cache.location)) {
     dir.create(cache.location, recursive = TRUE, showWarnings = TRUE)
   }
 
@@ -90,8 +89,10 @@ build_model <- function(views, target, seed = 42, cv.folds = 10, cached = FALSE,
   )
 
   # cv performance estimate
-  test.folds <- withr::with_seed(seed, 
-                                 caret::createFolds(target.vector, k = cv.folds))
+  test.folds <- withr::with_seed(
+    seed,
+    caret::createFolds(target.vector, k = cv.folds)
+  )
 
   intra.view.only <-
     model.views[["intraview"]]$predictions %>%

R/utils.R

@@ -1,39 +1,6 @@
 # mistyR utility functions
 # Copyright (c) 2020 Jovan Tanevski <[email protected]>
 
-#' Clear cached objects
-#'
-#' Purge the cache or clear the cached objects for a single sample.
-#'
-#' The cached objects are removed from disk and cannot be retrieved. Whenever
-#' possible specifying an \code{id} is reccomended. If \code{id = NULL} all
-#' contents of the folder \file{.misty.temp} will be removed.
-#'
-#' @param id the unique id of the sample.
-#'
-#' @return None (\code{NULL})
-#'
-#' @examples
-#' clear_cache("b98ad35f4e671871cba35f2155228612")
-#'
-#' clear_cache()
-#' @export
-clear_cache <- function(id = NULL) {
-  cache.folder <- R.utils::getAbsolutePath(".misty.temp")
-  if (is.null(id)) {
-    if (!unlink(cache.folder, recursive = TRUE) == 0) {
-      warning("Failed to clear cache.")
-    }
-  } else {
-    if (!unlink(paste0(
-      cache.folder, .Platform$file.sep, id
-    ), recursive = TRUE) == 0) {
-      warning("Failed to clear cache.")
-    }
-  }
-}
-
-
 #' Collect and aggregate results
 #'
 #' Collect and aggregate performance, contribution and importance estimations
@@ -187,7 +154,8 @@ collect_results <- function(folders) {
             dplyr::filter(sample == !!sample, view == paste0("p.", !!view)) %>%
             dplyr::mutate(value = 1 - .data$value)
 
-          # importances are standardized for each target an multiplied by 1-pval(view)
+          # importances are standardized for each target 
+          # and multiplied by 1-pval(view)
           all.importances %>%
             purrr::imap_dfc(~
             tibble::tibble(feature = features, zero.imp = 0) %>%
@@ -249,7 +217,8 @@ aggregate_results_subset <- function(misty.results, folders) {
 
   normalized.folders <- R.utils::getAbsolutePath(folders)
   # check if folders are in names of misty.results
-  assertthat::assert_that(all(normalized.folders %in% names(misty.results$importances)),
+  assertthat::assert_that(all(normalized.folders %in% 
+                                names(misty.results$importances)),
     msg = "The provided results list doesn't contain information about some of
     the requested result folders. Consider using collect_results()."
   )
@@ -271,3 +240,56 @@ aggregate_results_subset <- function(misty.results, folders) {
 
   return(misty.results)
 }
+
+#' Clear cached objects
+#'
+#' Purge the cache or clear the cached objects for a single sample.
+#'
+#' The cached objects are removed from disk and cannot be retrieved. Whenever
+#' possible specifying an \code{id} is reccomended. If \code{id = NULL} all
+#' contents of the folder \file{.misty.temp} will be removed.
+#'
+#' @param id the unique id of the sample.
+#'
+#' @return None (\code{NULL})
+#'
+#' @examples
+#' clear_cache("b98ad35f4e671871cba35f2155228612")
+#'
+#' clear_cache()
+#' @export
+clear_cache <- function(id = NULL) {
+  cache.folder <- R.utils::getAbsolutePath(".misty.temp")
+  if (is.null(id)) {
+    if (!unlink(cache.folder, recursive = TRUE) == 0) {
+      warning("Failed to clear cache.")
+    }
+  } else {
+    if (!unlink(paste0(
+      cache.folder, .Platform$file.sep, id
+    ), recursive = TRUE) == 0) {
+      warning("Failed to clear cache.")
+    }
+  }
+}
+
+#' Removes empty cache folders.
+#'
+#' @return None (\code{NULL})
+#'
+#' @noRd
+sweep_cache <- function() {
+  cache.folder <- R.utils::getAbsolutePath(".misty.temp")
+  if (dir.exists(cache.folder)) {
+    list.files(cache.folder, full.names = TRUE) %>%
+      purrr::walk(function(path) {
+        if (length(list.files(path)) == 0) {
+          unlink(path, recursive = TRUE)
+        }
+      })
+
+    if (length(list.files(cache.folder, full.names = TRUE)) == 0) {
+      clear_cache()
+    }
+  }
+}