diff --git a/.Rbuildignore b/.Rbuildignore index 1fba7c2..587f5c2 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -1,3 +1,6 @@ ^.*\.Rproj$ ^\.Rproj\.user$ .lintr +^CLAUDE\.md$ +^inst/validation/snapshots$ +^\.github$ diff --git a/.github/workflows/R-CMD-check.yaml b/.github/workflows/R-CMD-check.yaml new file mode 100644 index 0000000..b1b45f5 --- /dev/null +++ b/.github/workflows/R-CMD-check.yaml @@ -0,0 +1,62 @@ +# R CMD check on ubuntu-latest / R release. +# +# Single-OS matrix because ARTnet is not CRAN-published — we don't need +# to test against multi-platform portability the way a CRAN package would. +# +# ARTnetData (private, EpiModel/ARTnetData) is declared in Remotes and +# is core to the package's behavior — the whole test suite exercises it. +# Installing it in CI requires a PAT with read access to the private +# EpiModel repos; set up once in repo secrets as `EPIMODEL_PAT`: +# +# 1. Create a fine-grained PAT scoped to EpiModel/ARTnetData and +# EpiModel/EpiModelHIV-p with Contents: Read. +# 2. Add it to Settings → Secrets and variables → Actions as a +# repository secret named EPIMODEL_PAT. +# +# The default GITHUB_TOKEN can't see other org-private repos and will +# fail dependency resolution at setup-r-dependencies. +name: R-CMD-check + +on: + push: + branches: [main] + pull_request: + branches: [main] + workflow_dispatch: + +jobs: + R-CMD-check: + runs-on: ubuntu-latest + + env: + # Use a user-configured PAT that has read access to private EpiModel + # repos (ARTnetData, EpiModelHIV-p). Falls back to GITHUB_TOKEN so + # the workflow file itself is valid on forks without the secret — + # it'll just fail dependency resolution there. + GITHUB_PAT: ${{ secrets.EPIMODEL_PAT || secrets.GITHUB_TOKEN }} + R_KEEP_PKG_SOURCE: yes + + steps: + - uses: actions/checkout@v4 + + - uses: r-lib/actions/setup-pandoc@v2 + + - uses: r-lib/actions/setup-r@v2 + with: + r-version: release + use-public-rspm: true + + - uses: r-lib/actions/setup-r-dependencies@v2 + with: + extra-packages: any::rcmdcheck + needs: check + + - uses: r-lib/actions/check-r-package@v2 + with: + upload-snapshots: true + build_args: 'c("--no-manual","--compact-vignettes=gs+qpdf")' + # Fail CI on WARNING (and anything stricter). This is the + # r-lib/actions current default, but made explicit so a + # silent upstream change won't weaken our CI signal. Also + # matches what the PI asked for in PR #70 review. + error-on: '"warning"' diff --git a/.gitignore b/.gitignore index 73c9330..050561d 100644 --- a/.gitignore +++ b/.gitignore @@ -3,6 +3,7 @@ .RData .Ruserdata .DS_Store +Rplots.pdf vignettes/*.html vignettes/*.R inst/validation/snapshots/*.rds diff --git a/DESCRIPTION b/DESCRIPTION index 92b0378..0b75779 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -16,7 +16,6 @@ Imports: dplyr Suggests: ARTnetData, - EpiModelHIV, knitr, rmarkdown, testthat (>= 3.0.0) @@ -24,7 +23,6 @@ VignetteBuilder: knitr RoxygenNote: 7.3.3 Encoding: UTF-8 Remotes: - github::EpiModel/ARTnetData@main, - github::EpiModel/EpiModelHIV-p + github::EpiModel/ARTnetData@main Roxygen: list(markdown = TRUE) Config/testthat/edition: 3 diff --git a/R/EpiStats.R b/R/EpiStats.R index ef16af6..694ba17 100644 --- a/R/EpiStats.R +++ b/R/EpiStats.R @@ -10,6 +10,11 @@ #' statistics on. If the vector is of length 2+, data from the strata will be combined into #' one analysis. #' @param race If `TRUE`, stratify model estimates by race/ethnic grouping. +#' @param race.level List of race/ethnicity categories from ARTnet to use for stratification. +#' Each list element is a character vector of one or more ARTnet race labels +#' (`"black"`, `"hispanic"`, `"white"`, `"other"`, `"asian"`, `"ai/an"`, `"mult"`, `"nh/pi"`) +#' to collapse into a single model category. Default groups into Black / Hispanic / +#' White-or-Other. Ignored when `race = FALSE`. #' @param age.limits Lower and upper limit of age range to include in model. Minimum of 15 and #' maximum of 100 allowed. Lower limit is inclusive boundary and upper boundary is #' exclusive boundary. diff --git a/R/globals.R b/R/globals.R index 7994245..c1b52b5 100644 --- a/R/globals.R +++ b/R/globals.R @@ -2,6 +2,7 @@ utils::globalVariables(c( "age", "race.cat", + "race.cat.num", "p_race.cat", "AMIS_ID", "survey_year", diff --git a/README.md b/README.md index 0ce1c95..65d1e3c 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,9 @@ ## ARTnet: Model Parameterization with the ARTnet Study Data + +[![R-CMD-check](https://github.com/EpiModel/ARTnet/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/EpiModel/ARTnet/actions/workflows/R-CMD-check.yaml) + + ARTnet is an anonymous cross-sectional web-based survey conducted from 2017 to 2019 of HIV-related risk behaviors, testing, and use of prevention services among men who have sex with men (MSM) in the United States. It recruited MSM who have completed the American Men’s Internet Survey (AMIS) study, and therefore, the dataset contains variables merged from that study as well. Full access to the dataset from ARTnet will allow the researchers to conduct analyses and disseminate results using the data. For further details on the ARTnet Study, you can read the descriptive paper ["Egocentric Sexual Networks of Men Who Have Sex with Men in the United States: Results from the ARTnet Study"](https://www.sciencedirect.com/science/article/pii/S1755436519301409?via%3Dihub) by Weiss et al. in _Epidemics._ See the **ARTnet Scientific Publications** section below for further details. diff --git a/man/build_epistats.Rd b/man/build_epistats.Rd index 1224949..d6ecac0 100644 --- a/man/build_epistats.Rd +++ b/man/build_epistats.Rd @@ -26,6 +26,12 @@ one analysis.} \item{race}{If \code{TRUE}, stratify model estimates by race/ethnic grouping.} +\item{race.level}{List of race/ethnicity categories from ARTnet to use for stratification. +Each list element is a character vector of one or more ARTnet race labels +(\code{"black"}, \code{"hispanic"}, \code{"white"}, \code{"other"}, \code{"asian"}, \code{"ai/an"}, \code{"mult"}, \code{"nh/pi"}) +to collapse into a single model category. Default groups into Black / Hispanic / +White-or-Other. Ignored when \code{race = FALSE}.} + \item{age.limits}{Lower and upper limit of age range to include in model. Minimum of 15 and maximum of 100 allowed. Lower limit is inclusive boundary and upper boundary is exclusive boundary.} diff --git a/tests/testthat/test-parameterizations.R b/tests/testthat/test-parameterizations.R new file mode 100644 index 0000000..d01eb8a --- /dev/null +++ b/tests/testthat/test-parameterizations.R @@ -0,0 +1,214 @@ +# Smoke-test the build_* pipeline across parameterization modes that +# aren't already covered by test-joint-{model,netstats,dyad}.R (which +# all use Atlanta + race = TRUE). Each test_that() block runs the full +# pipeline under a different parameterization and asserts that the +# downstream-facing fields of netstats have the right shape and no NAs +# in places where they'd break EpiModelHIV-Template's ERGM formulas. + +skip_without_artnetdata <- function() { + testthat::skip_if(system.file(package = "ARTnetData") == "", + "ARTnetData not installed") +} + +# Check the public contract that model_{main,casl,ooff}.R in +# EpiModelHIV-Template actually reads from netstats. Keep this in sync +# with inst/validation/netstats_contract.md. +expect_netstats_contract <- function(ns, race = TRUE) { + # Attribute vectors used by initialize.R + for (a in c("age", "sqrt.age", "age.grp", "active.sex", + "race", "deg.casl", "deg.main", "deg.tot", + "risk.grp", "role.class", "diag.status")) { + expect_true(!is.null(ns$attr[[a]]), + info = paste("missing attr:", a)) + } + # Per-layer fields used by model_*.R + for (layer in c("main", "casl", "inst")) { + expect_true(is.numeric(ns[[layer]]$edges) && length(ns[[layer]]$edges) == 1) + expect_true(ns[[layer]]$edges > 0) + expect_true(is.numeric(ns[[layer]]$nodefactor_age.grp)) + expect_false(any(is.na(ns[[layer]]$nodefactor_age.grp))) + if (isTRUE(race)) { + expect_true(is.numeric(ns[[layer]]$nodefactor_race)) + expect_false(any(is.na(ns[[layer]]$nodefactor_race))) + expect_true(is.numeric(ns[[layer]]$nodematch_race_diffF)) + expect_true(length(ns[[layer]]$nodematch_race_diffF) == 1) + } + } + # concurrent exists for main/casl (not inst) + for (layer in c("main", "casl")) { + expect_true(is.numeric(ns[[layer]]$concurrent)) + expect_true(ns[[layer]]$concurrent >= 0) + } + # diss objects for main/casl + expect_s3_class(ns$main$diss.byage, "disscoef") + expect_s3_class(ns$casl$diss.byage, "disscoef") +} + + +# --------------------------------------------------------------------------- +# National (no geographic stratification) +# --------------------------------------------------------------------------- +test_that("no-geog (national) parameterization: build_* pipeline works", { + skip_without_artnetdata() + set.seed(20260419L) + epistats <- build_epistats(race = TRUE, time.unit = 7, + init.hiv.prev = c(0.33, 0.137, 0.084)) + expect_null(epistats$geog.lvl) + + set.seed(20260419L) + np <- build_netparams(epistats, smooth.main.dur = TRUE, method = "existing") + expect_netstats_contract( + build_netstats(epistats, np, expect.mort = 0.000478213, + network.size = 3000, method = "existing") + ) + + # Joint path must also run under no-geog (no geogYN term in formulas). + set.seed(20260419L) + np_j <- build_netparams(epistats, smooth.main.dur = TRUE, method = "joint") + ns_j <- build_netstats(epistats, np_j, expect.mort = 0.000478213, + network.size = 3000, method = "joint") + expect_netstats_contract(ns_j) + # Internal consistency under joint carries through without geog too. + expect_equal(sum(ns_j$main$nodefactor_race), 2 * ns_j$main$edges, + tolerance = 1e-9) +}) + + +# --------------------------------------------------------------------------- +# Sexual cessation (CEA-style: ages 15-100, sexual cessation at 65) +# --------------------------------------------------------------------------- +test_that("sex.cess.mod parameterization: build_* pipeline works", { + skip_without_artnetdata() + set.seed(20260419L) + epistats <- build_epistats( + geog.lvl = "city", geog.cat = "Atlanta", + init.hiv.prev = c(0.33, 0.137, 0.084), + race = TRUE, time.unit = 7, + age.limits = c(15, 100), + age.sexual.cessation = 65 + ) + expect_true(epistats$sex.cess.mod) + + set.seed(20260419L) + np <- build_netparams(epistats, smooth.main.dur = TRUE, method = "existing") + set.seed(20260419L) + ns <- build_netstats(epistats, np, expect.mort = 0.000478213, + network.size = 3000, young.prop = 0.99, + method = "existing") + expect_netstats_contract(ns) + + # active.sex is 0 for the post-cessation age group, 1 otherwise. + expect_true(all(ns$attr$active.sex %in% c(0L, 1L))) + expect_gt(sum(ns$attr$active.sex == 0L), 0) # some inactive nodes exist + expect_gt(sum(ns$attr$active.sex == 1L), 0) # some active nodes exist + + # nodefactor_age.grp[last] should be 0 under sex.cess.mod -- inactive + # nodes contribute no edge endpoints. + last <- length(ns$main$nodefactor_age.grp) + expect_equal(ns$main$nodefactor_age.grp[last], 0) + expect_equal(ns$casl$nodefactor_age.grp[last], 0) + + # Joint path under sex.cess.mod + set.seed(20260419L) + np_j <- build_netparams(epistats, smooth.main.dur = TRUE, method = "joint") + set.seed(20260419L) + ns_j <- build_netstats(epistats, np_j, expect.mort = 0.000478213, + network.size = 3000, young.prop = 0.99, + method = "joint") + expect_netstats_contract(ns_j) + # Internal consistency still holds: inactive egos have pred_deg zeroed, + # so their contribution to nodefactor sums is 0 and the identity holds. + expect_equal(sum(ns_j$main$nodefactor_age.grp), 2 * ns_j$main$edges, + tolerance = 1e-9) +}) + + +# --------------------------------------------------------------------------- +# Non-Atlanta city (smoke test for other geog.cat values) +# --------------------------------------------------------------------------- +test_that("non-Atlanta city parameterization works (New York City)", { + skip_without_artnetdata() + set.seed(20260419L) + epistats <- build_epistats( + geog.lvl = "city", geog.cat = "New York City", + init.hiv.prev = c(0.33, 0.137, 0.084), + race = TRUE, time.unit = 7 + ) + expect_equal(epistats$geog.lvl, "city") + expect_equal(epistats$geog.cat, "New York City") + + set.seed(20260419L) + np <- build_netparams(epistats, smooth.main.dur = TRUE, method = "existing") + set.seed(20260419L) + ns <- build_netstats(epistats, np, expect.mort = 0.000478213, + network.size = 3000, method = "existing") + expect_netstats_contract(ns) +}) + + +# --------------------------------------------------------------------------- +# Custom age.breaks and age.limits +# --------------------------------------------------------------------------- +test_that("custom age.breaks / age.limits parameterization works", { + skip_without_artnetdata() + set.seed(20260419L) + epistats <- build_epistats( + geog.lvl = "state", geog.cat = "GA", + race = TRUE, time.unit = 7, + age.limits = c(20, 50), + age.breaks = c(30, 40) + ) + expect_equal(epistats$age.limits, c(20, 50)) + # age.grps = length(age.breaks) + 1 = 3 groups: (20,30], (30,40], (40,50] + expect_equal(epistats$age.grps, 3) + + set.seed(20260419L) + np <- build_netparams(epistats, smooth.main.dur = TRUE, method = "existing") + set.seed(20260419L) + ns <- build_netstats(epistats, np, expect.mort = 0.000478213, + network.size = 3000, method = "existing") + expect_netstats_contract(ns) + + # nodefactor_age.grp length matches the configured age groups + expect_length(ns$main$nodefactor_age.grp, 3) + expect_length(ns$casl$nodefactor_age.grp, 3) + expect_length(ns$inst$nodefactor_age.grp, 3) + + # Sampled ages fall within the configured limits + expect_true(all(ns$attr$age >= 20 & ns$attr$age < 50)) +}) + + +# --------------------------------------------------------------------------- +# Non-default time.unit (monthly instead of weekly) +# --------------------------------------------------------------------------- +test_that("non-default time.unit parameterization works", { + skip_without_artnetdata() + set.seed(20260419L) + ep_weekly <- build_epistats( + geog.lvl = "city", geog.cat = "Atlanta", + init.hiv.prev = c(0.33, 0.137, 0.084), + race = TRUE, time.unit = 7 + ) + set.seed(20260419L) + ep_monthly <- build_epistats( + geog.lvl = "city", geog.cat = "Atlanta", + init.hiv.prev = c(0.33, 0.137, 0.084), + race = TRUE, time.unit = 30 + ) + expect_equal(ep_weekly$time.unit, 7) + expect_equal(ep_monthly$time.unit, 30) + + set.seed(20260419L) + np_w <- build_netparams(ep_weekly, smooth.main.dur = TRUE, method = "existing") + set.seed(20260419L) + np_m <- build_netparams(ep_monthly, smooth.main.dur = TRUE, method = "existing") + + # md.main is per-respondent mean degree: unit-invariant (just a count) + expect_equal(np_w$main$md.main, np_m$main$md.main, tolerance = 1e-9) + + # md.inst is per-time-unit (annual count / (364 / time.unit)). + # Monthly should be larger than weekly by factor (30 / 7). + expect_equal(np_m$inst$md.inst / np_w$inst$md.inst, 30 / 7, + tolerance = 1e-6) +}) diff --git a/tests/workflows/README.md b/tests/workflows/README.md new file mode 100644 index 0000000..3d21874 --- /dev/null +++ b/tests/workflows/README.md @@ -0,0 +1,25 @@ +# Manual integration workflows + +These scripts exercise the full ARTnet → EpiModelHIV estimation pipeline: +`build_epistats()` → `build_netparams()` → `build_netstats()` → `netest()` → +`netdx()`. They live outside `tests/testthat/` because: + +- Each run takes tens of seconds to minutes (ERGM estimation + diagnostics). +- They require both `ARTnetData` and `EpiModelHIV` installed. +- They produce interactive `print()` / `plot()` output useful for human + inspection but noisy in an automated test harness. + +`devtools::test()` / `test_local()` (and the `tests/testthat.R` runner +invoked by `R CMD check`) only scan `tests/testthat/`, so these scripts +are not run automatically. + +Run them manually after a non-trivial refactor touching `build_netparams()` +or `build_netstats()`: + +```r +source("tests/workflows/workflow-standard.R") +source("tests/workflows/workflow-cea.R") +``` + +Inspect the `netdx` plots and printed diagnostics to confirm the ERGMs +estimate cleanly. diff --git a/tests/testthat/test-workflow-cea.R b/tests/workflows/workflow-cea.R similarity index 100% rename from tests/testthat/test-workflow-cea.R rename to tests/workflows/workflow-cea.R diff --git a/tests/testthat/test-workflow-standard.R b/tests/workflows/workflow-standard.R similarity index 100% rename from tests/testthat/test-workflow-standard.R rename to tests/workflows/workflow-standard.R