Try to fix grumpy CRAN checks on old-rel, which predates the sort_by(…

…) function added in 4.4.0
bschneidr · Dec 30, 2024 · 33174c0 · 33174c0
1 parent e303514
commit 33174c0
Show file tree

Hide file tree

Showing 3 changed files with 32 additions and 0 deletions.
diff --git a/R/as_jackknife_design.R b/R/as_jackknife_design.R
@@ -332,6 +332,16 @@ as_random_group_jackknife_design.survey.design <- function(
   ) |> as.numeric()
 
   # Order the data by varstrat, then stratum, then sort variable, then by PSU
+  if (packageVersion("base") <= "4.4.0") {
+    sort_by <- function(x, y, ...) {
+        if (inherits(y, "formula")) 
+            y <- .formula2varlist(y, x)
+        if (!is.list(y)) 
+            y <- list(y)
+        o <- do.call(order, c(unname(y), list(...)))
+        x[o, , drop = FALSE]
+    }
+  }
   design_vars <- design_vars |> sort_by(
     ~ VAR_STRAT + STRATUM + SORT_VAR + RAND_PSU_ID
   )

diff --git a/R/successive-difference-replication.R b/R/successive-difference-replication.R
@@ -459,6 +459,17 @@ as_sdr_design.survey.design <- function(
       SORT_VARIABLE = compressed_design_structure$design$variables[[sort_variable]]
     )
 
+    if (packageVersion("base") <= "4.4.0") {
+      sort_by <- function(x, y, ...) {
+          if (inherits(y, "formula")) 
+              y <- .formula2varlist(y, x)
+          if (!is.list(y)) 
+              y <- list(y)
+          o <- do.call(order, c(unname(y), list(...)))
+          x[o, , drop = FALSE]
+      }
+    }
+
     sort_data <- sort_data |> sort_by(~ PSU_STRATUM + SORT_VARIABLE)
     sort_data[['SORT_ORDER']] <- seq_len(nrow(sort_data))
     sort_data <- sort_data |> sort_by(~ ORIG_ORDER)

diff --git a/tests/testthat/test-successive-difference-replication.R b/tests/testthat/test-successive-difference-replication.R
@@ -7,6 +7,17 @@ suppressWarnings({
 
 set.seed(2014)
 
+if (packageVersion("base") <= "4.4.0") {
+  sort_by <- function(x, y, ...) {
+      if (inherits(y, "formula")) 
+          y <- .formula2varlist(y, x)
+      if (!is.list(y)) 
+          y <- list(y)
+      o <- do.call(order, c(unname(y), list(...)))
+      x[o, , drop = FALSE]
+  }
+}
+
 # Tests for row assignment methods ----
 
 test_that(