Accept T/F for .progress argument of nlapply

jefferis · jefferis · commit 2da55fa22766 · 2021-05-08T17:31:54.000+01:00
* and complain otherwise
diff --git a/R/neuronlist.R b/R/neuronlist.R
@@ -384,8 +384,9 @@ as.data.frame.neuronlist<-function(x, row.names = names(x), optional = FALSE, ..
 #'   Progress bar section for details) The default value of \code{"auto"} shows
 #'   a progress bar in interactive use after 2s. The default value can be
 #'   overridden for the current session by setting the value of
-#'   \code{options(nat.progressbar)} (see examples).
-#'
+#'   \code{options(nat.progressbar)} (see examples). Values of \code{T} and
+#'   \code{F} are aliases for 'text' and 'none', respectively.
+#'   
 #' @section Progress bar: There are currently two supported approaches to
 #'   defining progress bars for \code{nlapply}. The default (when
 #'   \code{progress="auto"}) now uses a progress bar built using
@@ -472,11 +473,16 @@ as.data.frame.neuronlist<-function(x, row.names = names(x), optional = FALSE, ..
 #' }
 nlapply<-function (X, FUN, ..., subset=NULL, OmitFailures=NA, 
                    .progress=getOption('nat.progress', default='auto')){
-  if(.progress=='auto') {
+  if(isTRUE(.progress=='auto')) {
     .progress = ifelse(interactive(), "natprogress", "none")
-  } else if(.progress=='traditional') {
+  } else if(isTRUE(.progress=='traditional')) {
     .progress = ifelse(length(X)>=10 && interactive(), "text", "none")
-  } 
+  } else if(isTRUE(.progress)) {
+    .progress <- 'text'
+  } else if(isFALSE(.progress)) {
+    .progress <- 'none'
+  }
+  checkmate::assert_character(.progress, any.missing = F, len = 1L)
   cl=if(is.neuronlist(X) && !inherits(X, c('neuronlistfh','neuronlistz')))
     class(X) 
   else c("neuronlist", 'list')
@@ -547,7 +553,14 @@ nmapply<-function(FUN, X, ..., MoreArgs = NULL, SIMPLIFY = FALSE,
   }
   FUN2=FUN
   
-  if(.progress=='auto') .progress=ifelse(interactive(), 'text', 'none')
+  if(isTRUE(.progress=='auto')) {
+    .progress = ifelse(interactive(), "text", "none")
+  } else if(isTRUE(.progress)) {
+    .progress <- 'text'
+  } else if(isFALSE(.progress)) {
+    .progress <- 'none'
+  }
+  checkmate::assert_character(.progress, any.missing = F, len = 1L)
   
   if(.progress!='none'){
     p <- progress_natprogress()
diff --git a/tests/testthat/test-neuronlist.R b/tests/testthat/test-neuronlist.R
@@ -108,11 +108,16 @@ test_that("nlapply can omit failures",{
   # this time with subset and omit failures
   expect_equal(length(dotprops(kcs3, k=5, subset=1:2, OmitFailures=TRUE)), 3)
   expect_equal(length(dotprops(kcs3, k=5, subset=c(1,3), OmitFailures=TRUE)), 2)
+  
+  expect_output(dotprops(kcs3, k=5, OmitFailures=TRUE, .progress=T))
+  expect_silent(dotprops(kcs3, k=5, OmitFailures=TRUE, .progress=F))
+  expect_error(dotprops(kcs3, k=5, OmitFailures=TRUE, .progress=NA))
 })
 
 test_that("nmapply with identity function returns its arguments",{
   kcs3=kcs20[1:3]
   expect_equal(nmapply(function(x) x, kcs3), kcs3)
+  expect_silent(nmapply(function(x) x, kcs3, .progress=F))
 })
 
 test_that("nmapply can vectorise more than one argument",{
