Merge pull request #12 from CDCgov/ep-aging

Add vital dynamics, update network fitting and validation scripts

Author: Emily-Po

.github/workflows/testing.yaml

@@ -29,4 +29,5 @@ jobs:
     - uses: r-lib/actions/check-r-package@v2
       with:
         working-directory: ${{ matrix.r_package }}
+        args: 'c("--no-manual", "--as-cran", "--no-build-vignettes")'
         error-on: '"error"'

.gitignore

@@ -1,6 +1,7 @@
 #####
 
 # Specific to this repo
+archive/
 data/surveys
 data/*.rds
 

.lintr

@@ -1,4 +1,4 @@
 linters: linters_with_defaults(object_usage_linter = NULL,
                                line_length_linter(length = 120L),
-                               object_name_linter(styles = c("snake_case", "symbols", "camelCase")))
+                               object_name_linter(styles = c("snake_case", "symbols", "camelCase", "dotted.case")))
 encoding: "UTF-8"

.pre-commit-config.yaml

@@ -2,7 +2,7 @@ repos:
 #####
 # Basic file cleanliness
 -   repo: https://github.com/pre-commit/pre-commit-hooks
-    rev: v4.5.0
+    rev: v5.0.0
     hooks:
     -   id: check-added-large-files
     -   id: check-yaml
@@ -13,31 +13,31 @@ repos:
 #####
 # Python
 -   repo: https://github.com/psf/black
-    rev: 23.10.0
+    rev: 25.1.0
     hooks:
     -   id: black
         args: ['--line-length', '79']
 -   repo: https://github.com/PyCQA/isort
-    rev: 5.12.0
+    rev: 6.0.1
     hooks:
     -   id: isort
         args: ['--profile', 'black',
                '--line-length', '79']
 - repo: https://github.com/astral-sh/ruff-pre-commit
-  rev: v0.1.0
+  rev: v0.11.8
   hooks:
     - id: ruff
 #####
 # R
 -   repo: https://github.com/lorenzwalthert/precommit
-    rev: v0.4.2
+    rev: v0.4.3.9009
     hooks:
     -   id: style-files
     -   id: lintr
 
 # Secrets
 -   repo: https://github.com/Yelp/detect-secrets
-    rev: v1.4.0
+    rev: v1.5.0
     hooks:
     -   id: detect-secrets
         args: ['--baseline', '.secrets.baseline']

data/nsfg_scripts/01_clean_nsfg_2017_2019.R

@@ -368,10 +368,18 @@ d <- d |> mutate(
 ## Age Group (& 50 yr old adj) ------- #############
 # make all 50-year olds 49.9 (they were 49 at screener interview,)
 d <- d |>
-  mutate(age = ifelse(age == 50, 49.9, age))
-
-# make age groups
-d$age_group <- cut(round(d$age), 7)
+  mutate(
+    age = ifelse(age == 50, 49.9, age),
+    age_group = dplyr::case_when(
+      age < 20 ~ 1,
+      age >= 20 & age < 25 ~ 2,
+      age >= 25 & age < 30 ~ 3,
+      age >= 30 & age < 35 ~ 4,
+      age >= 35 & age < 40 ~ 5,
+      age >= 40 & age < 45 ~ 6,
+      age >= 45 ~ 7
+    )
+  )
 
 d <- d |> ungroup()
 
@@ -571,9 +579,18 @@ m <- m |> mutate(
 
 # Age Group --------- ################
 m <- m |>
-  mutate(age = ifelse(age == 50, 49.9, age))
-
-m$age_group <- cut(round(m$age), 7)
+  mutate(
+    age = ifelse(age == 50, 49.9, age),
+    age_group = dplyr::case_when(
+      age < 20 ~ 1,
+      age >= 20 & age < 25 ~ 2,
+      age >= 25 & age < 30 ~ 3,
+      age >= 30 & age < 35 ~ 4,
+      age >= 35 & age < 40 ~ 5,
+      age >= 40 & age < 45 ~ 6,
+      age >= 45 ~ 7
+    )
+  )
 
 m <- m |> ungroup()
 

data/nsfg_scripts/02_convert_data_to_long.R

@@ -4,7 +4,6 @@
 # and inst partners
 
 # nolint start
-
 source(here::here("data", "nsfg_scripts", "egodata_functions.R"))
 
 w <- readRDS(here::here("data", "nsfg_wide.rds"))
@@ -20,11 +19,11 @@ ego_vars <- c(
   "p_cond_month", "condom_use", "condom_use2"
 )
 
-egos <- w |> select(all_of(ego_vars))
+egos <- w |> dplyr::select(dplyr::all_of(ego_vars))
 
 # define alter variables in wide data
 alter_vars <- c(
-  "ego", "weight", "race", "age_group", "age", "female", # ego chars
+  "ego", "weight", "race", "age_group", "age", "female", "secu", "sest", # ego chars
   "once1", "rel1", "page1", "curr1", "partdur1", "prace1",
   "once2", "rel2", "page2", "curr2", "partdur2", "prace2",
   "once3", "rel3", "page3", "curr3", "partdur3", "prace3"
@@ -83,8 +82,17 @@ a3$alter_age[agemiss] <- predict(partner_age_glm, newdata = testdat, type = "res
 
 a4 <- a3 |>
   dplyr::mutate(alter_age = ifelse(alter_age == 50, 49.9, alter_age)) |>
-  dplyr::mutate(alter_age = ifelse(alter_age > 50, NA, alter_age)) |>
   dplyr::mutate(alter_age = ifelse(alter_age < 15, 15, alter_age)) |>
+  dplyr::mutate(olderpartner = ifelse(alter_age > 50, 1, 0)) |>
+  dplyr::mutate(alter_age_group = dplyr::case_when(
+    alter_age < 20 ~ 1,
+    alter_age >= 20 & alter_age < 25 ~ 2,
+    alter_age >= 25 & alter_age < 30 ~ 3,
+    alter_age >= 30 & alter_age < 35 ~ 4,
+    alter_age >= 35 & alter_age < 40 ~ 5,
+    alter_age >= 40 & alter_age < 45 ~ 6,
+    alter_age >= 45 ~ 7
+  )) |>
   dplyr::mutate( # race cat
     alter_race = ifelse(alter_race == 1, "H",
       ifelse(alter_race == 2, "W",
@@ -95,7 +103,7 @@ a4 <- a3 |>
     )
   )
 
-a4$alter_age_group <- cut(round(a4$alter_age), 7)
+dat_oldpartners <- a4 |> dplyr::filter(olderpartner == 1)
 
 a5 <- a4 |>
   dplyr::mutate(
@@ -117,10 +125,21 @@ a5 <- a4 |>
 
 
 # finally, remove any remaining rows with NA reponses in key variables
+# and remove any row with alter_age > 50
 a6 <- a5 |>
-  dplyr::filter(!is.na(alter_age), !is.na(rel2), !is.na(alter_race))
+  dplyr::filter(!is.na(alter_age), !is.na(rel2), !is.na(alter_race), alter_age < 50)
 
 # save out
 saveRDS(a6, here::here("data", "nsfg_long.rds"))
 
+# correct degree terms in wide data based on older partners, add older partner flag
+egos_main_olderpartner <- dat_oldpartners$ego[dat_oldpartners$rel2 == "Marriage/Cohab"]
+egos_cas_olderpartner <- dat_oldpartners$ego[dat_oldpartners$rel2 == "Casual/Other"]
+
+w$deg_main[w$ego %in% egos_main_olderpartner] <- 0
+w$deg_casual[w$ego %in% egos_cas_olderpartner] <- 0
+w$olderpartner <- 0
+w$olderpartner[w$ego %in% egos_main_olderpartner] <- 1 # we really only care about mains bc casual parts are short
+
+saveRDS(w, here::here("data", "nsfg_wide.rds"))
 # nolint end

epimodel-sti/DESCRIPTION

@@ -18,9 +18,11 @@ Imports:
     networkDynamic (>= 0.11.3),
     statnet.common,
     progressr,
+    tibble,
     dplyr,
     networkLite (>= 1.0.1),
     collections,
+    rlang
 Suggests:
     quarto,
     testthat (>= 3.0.0),
@@ -32,3 +34,4 @@ Encoding: UTF-8
 Config/testthat/edition: 3
 Roxygen: list(markdown = TRUE)
 LazyData: true
+LazyDataCompression: xz

epimodel-sti/NAMESPACE

@@ -7,22 +7,36 @@ export(calc_cross_network)
 export(calc_edges)
 export(calc_joint_nodefactor)
 export(calc_nodecov_age)
+export(calc_nodematch)
 export(calc_single_attr_nodefactor)
 export(calc_targets)
 export(check_conditions)
 export(check_targets)
-export(control_mgen)
 export(generate_init_network)
 export(get_nw_attr_vecs)
-export(init_mgen)
 export(initialize_mgen)
 export(inst_correction)
 export(matrix_symmetrical)
-export(param_mgen)
+export(mgen_infection)
+export(mod_aging)
 export(progression_mgen)
-export(resim_nets_mgen)
-export(resimnet_updates)
+export(resimnet_updates_sti)
 export(testing_mgen)
 export(trackers_mgen)
-export(transmit_mgen)
 export(tx_mgen)
+importFrom(EpiModel,append_attr)
+importFrom(EpiModel,append_core_attr)
+importFrom(EpiModel,apportion_lr)
+importFrom(EpiModel,discord_edgelist)
+importFrom(EpiModel,get_attr)
+importFrom(EpiModel,get_edgelist)
+importFrom(EpiModel,get_epi)
+importFrom(EpiModel,get_param)
+importFrom(EpiModel,set_attr)
+importFrom(EpiModel,set_epi)
+importFrom(EpiModel,set_transmat)
+importFrom(network,"%v%")
+importFrom(network,list.vertex.attributes)
+importFrom(rlang,.data)
+importFrom(stats,rbinom)
+importFrom(stats,rpois)