Improvements: conditional testing.

Author: SebKrantz

tests/testthat/test-fHDbetween-fHDwithin-HDB-HDW.R

@@ -125,7 +125,9 @@ if(identical(Sys.getenv("LOCAL"), "TRUE"))
 
 tol <- if(identical(Sys.getenv("LOCAL"), "TRUE")) 1e-5 else 1e-4
 
-if(requireNamespace("fixest", quietly = TRUE)) {
+has_fixest <- tryCatch(requireNamespace("fixest", quietly = TRUE), error = function(e) FALSE)
+
+if(has_fixest) {
 demean <- fixest::demean # eval(parse(text = paste0("fixest", ":", ":", "demean")))
 
 # lfe is back on CRAN: This now also seems to produce a warning !!!!!!!
@@ -229,7 +231,7 @@ test_that("fhdwithin with only continuous variables performs like baseresid (def
   expect_equal(fhdwithin(mtcNA, mtcars, variable.wise = TRUE), fhdwithin(mtcNA, m, variable.wise = TRUE), tolerance = tol)
 })
 
-if(requireNamespace("fixest", quietly = TRUE)) {
+if(has_fixest) {
 
 data <- wlddev
 data$year <- qF(data$year)

tests/testthat/test-fmutate.R

@@ -156,11 +156,11 @@ test_that("fsummarise works like dplyr::summarise with across and simple usage",
 
   expect_true(all_obj_equal(fsummarise(wld, across(is.numeric, bsum, na.rm = TRUE)),
                             fsummarise(wld, across(is.numeric, fsum)) %>% dapply(unattrib, drop = FALSE),
-                            dplyr::summarise(wld, dplyr::across(where(is.numeric), bsum, na.rm = TRUE))))
+                            dplyr::summarise(wld, dplyr::across(where(is.numeric), \(x) bsum(x, na.rm = TRUE)))))
 
   expect_true(all_obj_equal(fsummarise(mtc, across(NULL, bsum, na.rm = TRUE)),
                             fsummarise(mtc, across(NULL, fsum)),
-                            dplyr::summarise(mtc, dplyr::across(everything(), bsum, na.rm = TRUE))))
+                            dplyr::summarise(mtc, dplyr::across(everything(), \(x) bsum(x, na.rm = TRUE)))))
 
   expect_equal(fsummarise(mtc, across(cyl:vs, bsum)),
                fsummarise(mtc, cyl = bsum(cyl), across(disp:qsec, fsum), vs = fsum(vs)))
@@ -189,15 +189,16 @@ test_that("fsummarise works like dplyr::summarise with across and simple usage",
   # Passing additional arguments
   expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, bsum, na.rm = FALSE)),
                             fsummarise(mtc, across(cyl:drat, fsum, na.rm = FALSE)),
-                            dplyr::summarise(mtc, dplyr::across(cyl:drat, bsum, na.rm = FALSE))))
+                            dplyr::summarise(mtc, dplyr::across(cyl:drat, \(x) bsum(x, na.rm = FALSE)))))
 
   expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, weighted.mean, w = wt)),
                             fsummarise(mtc, across(cyl:drat, fmean, w = wt)),
-                            dplyr::summarise(mtc, dplyr::across(cyl:drat, weighted.mean, w = wt))))
+                            dplyr::summarise(mtc, dplyr::across(cyl:drat, \(x) weighted.mean(x, w = wt)))))
 
   expect_true(all_obj_equal(fsummarise(mtc, across(cyl:drat, list(mean = weighted.mean, sum = fsum), w = wt)),
                             fsummarise(mtc, across(cyl:drat, list(mean = fmean, sum = fsum), w = wt)),
-                            dplyr::summarise(mtc, dplyr::across(cyl:drat, list(mean = weighted.mean, sum = fsum), w = wt))))
+                            dplyr::summarise(mtc, dplyr::across(cyl:drat, list(mean = \(x) weighted.mean(x, w = wt),
+                                                                               sum = \(x) fsum(x, w = wt))))))
 
   # Simple programming use
   flist <- list(bsum, list(bmean = bmean, bsum = bsum), list(bmean, bsum)) # c("bmean", "bsum"), c(mean = "fmean", sum = "fsum")
@@ -225,11 +226,11 @@ test_that("fsummarise works like dplyr::summarise with across and grouped usage"
 
   expect_true(all_obj_equal(fsummarise(gwld, across(is.numeric, bsum, na.rm = TRUE)) %>% setLabels(NULL),
                             fsummarise(gwld, across(is.numeric, fsum)) %>% replace_NA() %>% setLabels(NULL),
-                            dplyr::summarise(gwld, dplyr::across(where(is.numeric), bsum, na.rm = TRUE))))
+                            dplyr::summarise(gwld, dplyr::across(where(is.numeric), \(x) bsum(x, na.rm = TRUE)))))
 
   expect_true(all_obj_equal(fsummarise(gmtc, across(NULL, bsum, na.rm = TRUE)) %>% setLabels(NULL),
                             fsummarise(gmtc, across(NULL, fsum)) %>% setLabels(NULL),
-                            dplyr::summarise(gmtc, dplyr::across(everything(), bsum, na.rm = TRUE), .groups = "drop")))
+                            dplyr::summarise(gmtc, dplyr::across(everything(), \(x) bsum(x, na.rm = TRUE)), .groups = "drop")))
 
   expect_equal(fsummarise(gmtc, across(NULL, bsum, na.rm = TRUE), keep.group_vars = FALSE),
                fsummarise(gmtc, across(NULL, bsum, na.rm = TRUE)) %>% slt(-cyl,-vs,-am))
@@ -261,18 +262,21 @@ test_that("fsummarise works like dplyr::summarise with across and grouped usage"
   # Passing additional arguments
   expect_true(all_obj_equal(fsummarise(gwld, across(c("PCGDP", "LIFEEX"), bsum, na.rm = TRUE))  %>% setLabels(NULL),
                             fsummarise(gwld, across(c("PCGDP", "LIFEEX"), fsum, na.rm = TRUE))  %>% setLabels(NULL) %>% replace_NA(),
-                            dplyr::summarise(gwld, dplyr::across(c("PCGDP", "LIFEEX"), bsum, na.rm = TRUE), .groups = "drop")))
+                            dplyr::summarise(gwld, dplyr::across(c("PCGDP", "LIFEEX"), \(x) bsum(x, na.rm = TRUE)), .groups = "drop")))
 
   expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, weighted.mean, w = wt)),
                             fsummarise(gmtc, across(hp:drat, fmean, w = wt)),
-                            dplyr::summarise(gmtc, dplyr::across(hp:drat, weighted.mean, w = wt), .groups = "drop")))
+                            dplyr::summarise(gmtc, dplyr::across(hp:drat, \(x) weighted.mean(x, w = wt)), .groups = "drop")))
 
   expect_equal(fsummarise(gmtc, across(cyl:vs, weighted.mean, w = wt)),
                fsummarise(gmtc, cyl = weighted.mean(cyl, wt), across(disp:qsec, fmean, w = wt), vs = fmean(vs, wt)))
 
   expect_true(all_obj_equal(fsummarise(gmtc, across(hp:drat, list(mean = weighted.mean, sum = fsum), w = wt)),
                             fsummarise(gmtc, across(hp:drat, list(mean = fmean, sum = fsum), w = wt)),
-                            dplyr::summarise(gmtc, dplyr::across(hp:drat, list(mean = weighted.mean, sum = fsum), w = wt), .groups = "drop")))
+                            dplyr::summarise(gmtc,
+                                             dplyr::across(hp:drat, list(mean = \(x) weighted.mean(x, w = wt),
+                                                                        sum = \(x) fsum(x, w = wt))),
+                                             .groups = "drop")))
 
   # Simple programming use
   flist <- list(bsum, list(bmean = bmean, bsum = bsum), list(bmean, bsum)) # c("bmean", "bsum"), c(mean = "fmean", sum = "fsum")
@@ -303,12 +307,14 @@ test_that("fsummarise miscellaneous things", {
     rsplit(mtcars, disp + hp ~ cyl) %>% lapply(pwcorDF) %>% unlist2d("cyl", "var") %>% tfm(cyl = as.numeric(cyl))
   )
 
-  if(identical(Sys.getenv("LOCAL"), "TRUE")) # No tests depending on suggested package (except for major ones).
-  expect_equal(
-    mtcars %>% gby(cyl) %>% smr(acr(disp:hp, pwcorDF, w = wt, .apply = FALSE)),
-    rsplit(mtcars, disp + hp + wt ~ cyl) %>% lapply(function(x) pwcorDF(gv(x, 1:2), w = x$wt)) %>%
-      unlist2d("cyl", "var") %>% tfm(cyl = as.numeric(cyl))
-  )
+  if(identical(Sys.getenv("LOCAL"), "TRUE")) { # No tests depending on suggested package (except for major ones).
+    skip_if_not_installed("weights")
+    expect_equal(
+      mtcars %>% gby(cyl) %>% smr(acr(disp:hp, pwcorDF, w = wt, .apply = FALSE)),
+      rsplit(mtcars, disp + hp + wt ~ cyl) %>% lapply(function(x) pwcorDF(gv(x, 1:2), w = x$wt)) %>%
+        unlist2d("cyl", "var") %>% tfm(cyl = as.numeric(cyl))
+    )
+  }
 
   if(requireNamespace("data.table", quietly = TRUE)) {
   lmest <- function(x) list(Mods = list(lm(disp~., x)))

tests/testthat/test-misc.R

@@ -41,6 +41,8 @@ if(identical(Sys.getenv("NCRAN"), "TRUE")) {
 
 if(identical(Sys.getenv("LOCAL"), "TRUE"))
 test_that("weighted correlations are correct", {
+  skip_if_not_installed("weights")
+  skip_if_not_installed("cluster")
 
   # This is to fool very silly checks on CRAN scanning the code of the tests
   wtd.cors <- eval(parse(text = paste0("weights", ":", ":", "wtd.cors")))