Merge pull request #27 from openpharma/26-release-rbmiutils-015

26 release rbmiutils 015

Author: bailliem

DESCRIPTION

@@ -1,6 +1,6 @@
 Package: rbmiUtils
 Title: Utility Functions to Support and Extend the 'rbmi' Package 
-Version: 0.1.4.9000
+Version: 0.1.6.9000
 Authors@R: c( 
     person("Mark", "Baillie", email = "bailliem@gmail.com", role = c("aut", "cre", "cph"),
            comment = c(ORCID = "0000-0002-5618-0667")),

NEWS.md

@@ -1,5 +1,9 @@
 # rbmiUtils (development version)
 
+# rbmiUtils 0.1.6
+
+* Added additional tests for all utility functions. 
+
 # rbmiUtils 0.1.4
 
 * First release 

README.md

@@ -7,7 +7,7 @@
 
 [![Lifecycle:
 experimental](https://img.shields.io/badge/lifecycle-experimental-orange.svg)](https://lifecycle.r-lib.org/articles/stages.html#experimental)
-[![CRAN status](https://www.r-pkg.org/badges/version/rbmiUtils)](https://CRAN.R-project.org/package=rbmiUtils)
+![CRAN status](https://www.r-pkg.org/badges/version/rbmiUtils)
 [![R-CMD-check](https://github.com/openpharma/rbmiUtils/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/openpharma/rbmiUtils/actions/workflows/R-CMD-check.yaml)
 [![test-coverage](https://github.com/openpharma/rbmiUtils/actions/workflows/test-coverage.yaml/badge.svg)](https://github.com/openpharma/rbmiUtils/actions/workflows/test-coverage.yaml)
 <!-- badges: end -->
@@ -28,8 +28,8 @@ result tidying, and imputed data handling.
 
 ## Installation
 
-You can install the development version of `rbmiUtils` from cran or
-GitHub:
+You can install the package from cran or the development version of
+`rbmiUtils` from GitHub:
 
 | Type        | Source | Command                                           |
 |-------------|--------|---------------------------------------------------|

cran-comments.md

@@ -2,14 +2,10 @@
 
 0 errors | 0 warnings | 0 notes
 
-* This is a new release.
+* This is a minor update.
 
-This is a re-submission after initial review comments to be addressed. 
+In this update, additional tests have been added to cover utility functions
+internal to the package and improve coverage. 
 
-Fixes addressed include:
-* Description file. 'rbmi' in title and description now in single quotes. 
-* Description update spelling out rbmi: reference based multiple imputation to provide context. 
-* The example in gcomp_responder_multi.Rd has replaced \dontrun with \donttest. The example takes approx 8-9seconds to run. 
-* A complete running example has been added to get_imputed_data.Rd removing the commented example. \donttest has been added to the example takes over 10seconds to run. 
-
-Thank you for your time and patience,
+* test-analysis_utils.R has been added to provide test coverage for all 
+the analysis utility functions

inst/WORDLIST

@@ -1,14 +1,15 @@
 ADMI
 ANCOVA
+CMD
 CRIT
 FLN
 HC
 Lifecycle
 Lukas
 ORCID
 Responder
-WIP
 beeca
+cran
 dervive
 interpretability
 modularly

tests/testthat/test-analysis_utils.R

@@ -3,15 +3,15 @@ testthat::test_that("extract_covariates2 splits, trims, dedups, and handles NULL
 
   x <- c("A:B", " C*D ", "E", "E", "F : G")
   out <- extract_covariates2(x)
-  expect_true(all(c("A","B","C","D","E","F","G") %in% out))
+  expect_true(all(c("A", "B", "C", "D", "E", "F", "G") %in% out))
   expect_equal(length(out), length(unique(out)))
 
   # No operators, order preserved after trim
-  expect_equal(extract_covariates2(c("AGE"," SEX ")), c("AGE","SEX"))
+  expect_equal(extract_covariates2(c("AGE", " SEX ")), c("AGE", "SEX"))
 })
 
 testthat::test_that("as_simple_formula2 builds intended formula; empty covars behavior is robust", {
-  frm <- as_simple_formula2("Y", c("A","B:C","D*E"))
+  frm <- as_simple_formula2("Y", c("A", "B:C", "D*E"))
   # Compare while ignoring whitespace around operators (especially `*`)
   expect_identical(gsub("\\s+", "", deparse(frm)), "Y~1+A+B:C+D*E")
   expect_identical(environment(frm), globalenv())
@@ -36,24 +36,42 @@ testthat::test_that("gcomp_responder runs, drops visit from model terms, returns
   testthat::skip_if_not_installed("beeca")
   set.seed(1)
   dat <- data.frame(
-    Y   = rbinom(160, 1, 0.45),
-    TRT = factor(sample(c("Placebo","Drug"), 160, TRUE), levels = c("Placebo","Drug")),
-    BASE= rnorm(160),
-    VIS = sample(c("W4","W8"), 160, TRUE)
+    Y = rbinom(160, 1, 0.45),
+    TRT = factor(
+      sample(c("Placebo", "Drug"), 160, TRUE),
+      levels = c("Placebo", "Drug")
+    ),
+    BASE = rnorm(160),
+    VIS = sample(c("W4", "W8"), 160, TRUE)
+  )
+  vars <- list(
+    outcome = "Y",
+    group = "TRT",
+    covariates = c("BASE", "TRT:BASE", "VIS"),
+    visit = "VIS"
   )
-  vars <- list(outcome = "Y", group = "TRT",
-               covariates = c("BASE","TRT:BASE","VIS"), visit = "VIS")
 
   out <- gcomp_responder(
-    data = dat, vars = vars,
+    data = dat,
+    vars = vars,
     reference_levels = "Placebo",
-    var_method = "Ge", type = "HC0", contrast = "diff"
+    var_method = "Ge",
+    type = "HC0",
+    contrast = "diff"
   )
 
   # Ensure VIS was not in the model terms
-  frm <- stats::as.formula(paste0(vars$outcome, " ~ 1 + ",
-                                  paste0(setdiff(unique(c(vars$group, extract_covariates2(vars$covariates))), vars$visit),
-                                         collapse = " + ")))
+  frm <- stats::as.formula(paste0(
+    vars$outcome,
+    " ~ 1 + ",
+    paste0(
+      setdiff(
+        unique(c(vars$group, extract_covariates2(vars$covariates))),
+        vars$visit
+      ),
+      collapse = " + "
+    )
+  ))
   m <- stats::glm(frm, data = dat, family = binomial())
   terms_used <- attr(stats::terms(m), "term.labels")
   expect_false(any(grepl("^VIS$", terms_used)))
@@ -62,7 +80,7 @@ testthat::test_that("gcomp_responder runs, drops visit from model terms, returns
   expect_true(any(grepl("^trt_", names(out))))
   expect_true(any(grepl("^lsm_", names(out))))
   for (nm in names(out)) {
-    expect_true(all(c("est","se","df") %in% names(out[[nm]])))
+    expect_true(all(c("est", "se", "df") %in% names(out[[nm]])))
     expect_type(out[[nm]]$est, "double")
     expect_type(out[[nm]]$se, "double")
     expect_true(is.na(out[[nm]]$df))
@@ -73,68 +91,95 @@ testthat::test_that("gcomp_responder defaults reference to first factor level (s
   testthat::skip_if_not_installed("beeca")
   set.seed(2)
   dat <- data.frame(
-    Y   = rbinom(80, 1, 0.5),
-    TRT = factor(rep(c("Placebo","Drug"), each = 40), levels = c("Placebo","Drug")),
-    BASE= rnorm(80),
+    Y = rbinom(80, 1, 0.5),
+    TRT = factor(
+      rep(c("Placebo", "Drug"), each = 40),
+      levels = c("Placebo", "Drug")
+    ),
+    BASE = rnorm(80),
     VIS = "W4"
   )
-  vars <- list(outcome = "Y", group = "TRT", covariates = c("BASE","VIS"), visit = "VIS")
+  vars <- list(
+    outcome = "Y",
+    group = "TRT",
+    covariates = c("BASE", "VIS"),
+    visit = "VIS"
+  )
 
   # Should not error and should return structured results when reference not supplied
   out <- gcomp_responder(dat, vars)
   expect_true(length(out) > 0)
-  expect_true(all(vapply(out, function(x) all(c("est","se","df") %in% names(x)), logical(1))))
+  expect_true(all(vapply(
+    out,
+    function(x) all(c("est", "se", "df") %in% names(x)),
+    logical(1)
+  )))
 })
 
 testthat::test_that("gcomp_responder validates that group is a factor (if implemented)", {
   testthat::skip_if_not_installed("beeca")
   dat <- data.frame(
     Y = rbinom(10, 1, 0.5),
-    TRT = rep(c("Placebo","Drug"), each = 5),  # character, not factor
+    TRT = rep(c("Placebo", "Drug"), each = 5), # character, not factor
     BASE = rnorm(10),
     VIS = "W4"
   )
   vars <- list(outcome = "Y", group = "TRT", covariates = "BASE", visit = "VIS")
 
   # If validation added, expect a clear error; otherwise allow skip.
-  err <- try(gcomp_responder(dat, vars, reference_levels = "Placebo"), silent = TRUE)
+  err <- try(
+    gcomp_responder(dat, vars, reference_levels = "Placebo"),
+    silent = TRUE
+  )
   if (inherits(err, "try-error")) {
     expect_match(as.character(err), "(?i)factor|categorical")
   } else {
-    testthat::skip("group-factor validation not implemented; skipping assertion.")
+    testthat::skip(
+      "group-factor validation not implemented; skipping assertion."
+    )
   }
 })
 
 testthat::test_that("gcomp_responder errors for invalid reference level (if implemented)", {
   testthat::skip_if_not_installed("beeca")
   dat <- data.frame(
     Y = rbinom(20, 1, 0.5),
-    TRT = factor(rep(c("Placebo","Drug"), each = 10)),
+    TRT = factor(rep(c("Placebo", "Drug"), each = 10)),
     BASE = rnorm(20),
     VIS = "W8"
   )
   vars <- list(outcome = "Y", group = "TRT", covariates = "BASE", visit = "VIS")
 
-  err <- try(gcomp_responder(dat, vars, reference_levels = "ActiveX"), silent = TRUE)
+  err <- try(
+    gcomp_responder(dat, vars, reference_levels = "ActiveX"),
+    silent = TRUE
+  )
   if (inherits(err, "try-error")) {
     expect_match(as.character(err), "(?i)reference.*level|not.*in.*levels")
   } else {
-    testthat::skip("reference-level validation not implemented; skipping assertion.")
+    testthat::skip(
+      "reference-level validation not implemented; skipping assertion."
+    )
   }
 })
 
 testthat::test_that("gcomp_responder validates contrast against allowed set (either here or in beeca)", {
   testthat::skip_if_not_installed("beeca")
   dat <- data.frame(
     Y = rbinom(30, 1, 0.5),
-    TRT = factor(rep(c("Placebo","Drug"), each = 15)),
+    TRT = factor(rep(c("Placebo", "Drug"), each = 15)),
     BASE = rnorm(30),
     VIS = "W8"
   )
   vars <- list(outcome = "Y", group = "TRT", covariates = "BASE", visit = "VIS")
 
   expect_error(
-    gcomp_responder(dat, vars, reference_levels = "Placebo", contrast = "weird"),
+    gcomp_responder(
+      dat,
+      vars,
+      reference_levels = "Placebo",
+      contrast = "weird"
+    ),
     regexp = "(?i)contrast|allowed|supported|'arg' should be one of"
   )
 })
@@ -144,10 +189,18 @@ testthat::test_that("gcomp_responder works with no covariates after extraction (
   set.seed(4)
   dat <- data.frame(
     Y = rbinom(60, 1, 0.45),
-    TRT = factor(sample(c("Placebo","Drug"), 60, TRUE), levels = c("Placebo","Drug")),
+    TRT = factor(
+      sample(c("Placebo", "Drug"), 60, TRUE),
+      levels = c("Placebo", "Drug")
+    ),
     AVISIT = "W12"
   )
-  vars <- list(outcome = "Y", group = "TRT", covariates = NULL, visit = "AVISIT")
+  vars <- list(
+    outcome = "Y",
+    group = "TRT",
+    covariates = NULL,
+    visit = "AVISIT"
+  )
 
   out <- gcomp_responder(dat, vars, reference_levels = "Placebo")
   expect_true(any(grepl("^lsm_", names(out))))
@@ -158,11 +211,19 @@ testthat::test_that("gcomp_responder_multi applies per-visit and suffixes names"
   set.seed(5)
   dat <- data.frame(
     Y = rbinom(50, 1, 0.5),
-    TRT = factor(sample(c("Placebo","Drug"), 50, TRUE), levels = c("Placebo","Drug")),
+    TRT = factor(
+      sample(c("Placebo", "Drug"), 50, TRUE),
+      levels = c("Placebo", "Drug")
+    ),
     BASE = rnorm(50),
-    AVISIT = factor(sample(c("W4","W8"), 50, TRUE)) # unsorted by design
+    AVISIT = factor(sample(c("W4", "W8"), 50, TRUE)) # unsorted by design
+  )
+  vars <- list(
+    outcome = "Y",
+    group = "TRT",
+    covariates = "BASE",
+    visit = "AVISIT"
   )
-  vars <- list(outcome = "Y", group = "TRT", covariates = "BASE", visit = "AVISIT")
 
   out <- gcomp_responder_multi(dat, vars, reference_levels = "Placebo")
 
@@ -174,5 +235,5 @@ testthat::test_that("gcomp_responder_multi applies per-visit and suffixes names"
   }
   # Sanity: entries have est/se/df
   any_nm <- names(out)[1]
-  expect_true(all(c("est","se","df") %in% names(out[[any_nm]])))
+  expect_true(all(c("est", "se", "df") %in% names(out[[any_nm]])))
 })