From 7a29b1376b2a09da07fae093b1e03b7d3840f1a6 Mon Sep 17 00:00:00 2001 From: gowerc Date: Mon, 27 Jan 2025 09:42:32 +0000 Subject: [PATCH] Removed R4.1 features --- NEWS.md | 1 + R/analyse.R | 6 +++--- R/lsmeans.R | 21 +++++++++++---------- tests/testthat/test-longData.R | 4 ++-- tests/testthat/test-lsmeans.R | 8 ++++---- tests/testthat/test-pool.R | 5 +++-- 6 files changed, 24 insertions(+), 21 deletions(-) diff --git a/NEWS.md b/NEWS.md index 0070e591b..d93c6ac47 100644 --- a/NEWS.md +++ b/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 diff --git a/R/analyse.R b/R/analyse.R index 8c14db88d..45db3d14e 100644 --- a/R/analyse.R +++ b/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))] diff --git a/R/lsmeans.R b/R/lsmeans.R index 2bd473f88..9ae12784a 100644 --- a/R/lsmeans.R +++ b/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) } diff --git a/tests/testthat/test-longData.R b/tests/testthat/test-longData.R index 482e922a9..5a758517a 100644 --- a/tests/testthat/test-longData.R +++ b/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) diff --git a/tests/testthat/test-lsmeans.R b/tests/testthat/test-lsmeans.R index 2617bee73..0d40cd8ee 100644 --- a/tests/testthat/test-lsmeans.R +++ b/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) diff --git a/tests/testthat/test-pool.R b/tests/testthat/test-pool.R index 69b8f943c..9bd3a6e2b 100644 --- a/tests/testthat/test-pool.R +++ b/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