Removed R4.1 features

NEWS.md

@@ -3,6 +3,7 @@
 # rbmi Development Version
 
 * Fixed bug where `lsmeans(.weights = "proportional_em")` would error if there was only a single categorical variable in the dataset. (#412)
+* Removed native pipes `|>` and lambda functions `\(x)` from code base to ensure package is backwards compatible with older versions of R. (#474)
 
 # rbmi 1.3.1
 

R/analyse.R

@@ -259,7 +259,7 @@ analyse <- function(
     indexes <- seq_along(imputations$imputations)
     indexes_split <- split(indexes, (indexes %% number_of_cores) + 1)
 
-    results <- par_lapply(
+    results_list <- par_lapply(
         cl,
         function(indicies, ...) {
             inner_fun <- function(idx, ...) {
@@ -274,8 +274,8 @@ analyse <- function(
         },
         indexes_split,
         ...
-    ) |>
-        unlist(recursive = FALSE, use.names = FALSE)
+    )
+    results <- unlist(results_list, recursive = FALSE, use.names = FALSE)
 
     # Re-order to ensure results are returned in same order as imputations
     results <- results[order(unlist(indexes_split, use.names = FALSE))]

R/lsmeans.R

@@ -239,22 +239,23 @@ ls_design_proportional <- function(data, frm, fix) {
     all_combinations <- expand.grid(collection)
     design_matrix <- model.matrix(frm2, all_combinations)
 
-    categorical_vars <- dat2 |>
-        vapply(\(x) is.character(x) || is.factor(x), logical(1)) |>
-        which() |>
-        names()
+    categorical_vars_fl <- vapply(
+        dat2,
+        function(x) is.character(x) || is.factor(x), logical(1)
+    )
+    categorical_vars <- names(which(categorical_vars_fl))
 
-    wgts <- dat2[, categorical_vars[[1]]] |>
-        aggregate(
-            as.list(dat2[, categorical_vars, drop = FALSE]),
-            length
-        )
+    wgts <- aggregate(
+        dat2[, categorical_vars[[1]]],
+        as.list(dat2[, categorical_vars, drop = FALSE]),
+        length
+    )
     assert_that(
         all.equal(wgts[, categorical_vars], all_combinations[, categorical_vars])
     )
 
     wgts_scaled <- wgts[["x"]] / sum(wgts[["x"]])
 
-    design <- apply(design_matrix, 2, \(x) sum(x * wgts_scaled))
+    design <- apply(design_matrix, 2, function(x) sum(x * wgts_scaled))
     return(design)
 }

tests/testthat/test-longData.R

@@ -1161,8 +1161,8 @@ test_that("Missing data_ices are handled correctly", {
         pt = factor(c("A", "B", "C"), levels = c("A", "B", "C")),
         vis = factor(c("V2", "V2", "V2"), levels = c("V1", "V2", "V3")),
         strat = c("JR", "MAR", "JR")
-    ) |>
-        dplyr::filter(pt == "NOT A PT")
+    )
+    dat_ice <- dplyr::filter(dat_ice, pt == "NOT A PT")
 
     longdata <- longDataConstructor$new(dat, vars)
 

tests/testthat/test-lsmeans.R

@@ -116,10 +116,8 @@ test_that("LSmeans(proportional) returns equivalent results to 'counterfactual'"
         v2 = rnorm(n),
         v3 = rnorm(n),
         c1 = sample(c("A", "B"), size = n, replace = TRUE, prob = c(0.8, 0.2)),
-        c2 = sample(c("Y", "X"), size = n, replace = TRUE, prob = c(0.6, 0.4)) |>
-            factor(levels = c("Y", "X")),
-        c3 = sample(c("L", "K", "J"), size = n, replace = TRUE, prob = c(0.2, 0.5, 0.3)) |>
-            factor(levels = c("L", "K", "J")),
+        c2 = sample(c("Y", "X"), size = n, replace = TRUE, prob = c(0.6, 0.4)),
+        c3 = sample(c("L", "K", "J"), size = n, replace = TRUE, prob = c(0.2, 0.5, 0.3)),
         error = rnorm(n, 0, 4),
         outcome = 30 +
             5 * v1 +
@@ -137,6 +135,8 @@ test_that("LSmeans(proportional) returns equivalent results to 'counterfactual'"
             16 * (c3 == "J") +
             error
     )
+    dat$c2 <- factor(dat$c2, levels = c("Y", "X"))
+    dat$c3 <- factor(dat$c3, levels = c("L", "K", "J"))
     mod <- lm(outcome ~ (v1 * v2 * v3) + (c1 * c2) + (v1 * c1) + c3, data = dat)
 
 

tests/testthat/test-pool.R

@@ -419,7 +419,7 @@ test_that("pool BMLMI estimates", {
 
     data[1:ceiling(n / 5)] <- NA # 20% missing values
     boot_data <- lapply(seq.int(B), function(x) sample(data, size = n, replace = TRUE))
-    vals <- lapply(
+    vals_list <- lapply(
         boot_data,
         function(x) {
             lapply(seq.int(D), function(y) {
@@ -429,7 +429,8 @@ test_that("pool BMLMI estimates", {
                 return(x)
             })
         }
-    ) |> unlist(recursive = FALSE)
+    )
+    vals <- unlist(vals_list, recursive = FALSE)
 
 
     ########  BMLMI