Replicating analysis from Muntner et al, 2022
replicate_hypertension_2022.RmdThis article shows how cardioStatsUSA can replicate
results from a prior study in the Hypertension journal. The
results can be replicated with our shiny application or with code.
Replicate with shiny application
The video below shows how Table S2 can be replicated using our web application.
Replicate with code
The code in this section does exactly what the videos above do, and provides a glimpse of the R code that is used on the back-end of the shiny application.
Who is included in this test
For these tests, we include the same cohort as Muntner et al. Full
details on the inclusion criteria are given in the paper, but here all
that we need to do is subset the data to include rows where
svy_subpop_htn is equal to 1 and limit the survey cycles to
those used in the paper.
nhanes_subpop_htn <- nhanes_data %>%
.[svy_subpop_htn == 1] %>%
.[svy_year %in% c("2009-2010",
"2011-2012",
"2013-2014",
"2015-2016",
"2017-2020")]after these exclusions, 30630 participants are
included.
Age adjustment
We use direct standardization with the same standard weights as in Munter et al.
standard_weights <- c(13.5, 45.3, 23.3, 17.8)In most cases, we use nhanes_summarize() or
nhanes_visualize() when generating results with
cardioStatsUSA. Here, we use the nhanes_design
family of functions. NHANES design functions are lower level functions
that support nhanes_summarize and
nhanes_visualize. Full details on this family can be found
at the help page for [nhanes_design].
Replicating Table S2
To reproduce Table S2 from Muntner et al, we use the ds
design object to estimate the proportion of adults with BP control
according to the JNC7 BP guidelines.
shiny_answers_table_s2_overall <- ds %>%
nhanes_design_summarize(outcome_stats = 'percentage',
simplify_output = TRUE) %>%
.[bp_control_140_90=='Yes'] %>%
.[, group := "Overall"]
shiny_answers_table_s2_groups <- lapply(
c('demo_age_cat', 'demo_gender'),
function(.variable){
ds %>%
nhanes_design_update(group_variable = .variable) %>%
nhanes_design_summarize(outcome_stats = 'percentage',
simplify_output = TRUE) %>%
.[bp_control_140_90=='Yes'] %>%
setnames(old = .variable, new = 'group')
}
)Now we can put all of our answers together
est_cols <- c('estimate', 'ci_lower', 'ci_upper')
shiny_answers_table_s2 <- list(shiny_answers_table_s2_overall) %>%
c(shiny_answers_table_s2_groups) %>%
rbindlist(fill = TRUE) %>%
as.data.table() %>%
.[, .(svy_year, group, estimate, ci_lower, ci_upper)] %>%
.[, (est_cols) := lapply(.SD, round, digits = 1), .SDcols = est_cols]We also need to get the data from Muntner et al to make sure our answers match their answers.
table_s2 <- cardioStatsUSA::muntner_hypertension_2022_table_s2 %>%
.[, variable := NULL]Now put everything together and test that all of our answers match
test_results <- list(
hypertension = table_s2,
shiny = shiny_answers_table_s2
) %>%
rbindlist(idcol = 'source') %>%
dcast(svy_year + group ~ source, value.var = est_cols)take a look at the merged results, you can see estimate_shiny matches estimate_hypertension in all cells shown.
test_results
#> Key: <svy_year, group>
#> svy_year group estimate_hypertension estimate_shiny
#> <fctr> <fctr> <num> <num>
#> 1: 2009-2010 Overall 53.5 53.5
#> 2: 2009-2010 18 to 44 35.5 35.5
#> 3: 2009-2010 45 to 64 57.1 57.1
#> 4: 2009-2010 65 to 74 59.2 59.2
#> 5: 2009-2010 75+ 50.3 50.3
#> 6: 2009-2010 Women 57.3 57.3
#> 7: 2009-2010 Men 50.7 50.7
#> 8: 2011-2012 Overall 52.2 52.2
#> 9: 2011-2012 18 to 44 42.2 42.2
#> 10: 2011-2012 45 to 64 56.2 56.2
#> 11: 2011-2012 65 to 74 57.8 57.8
#> 12: 2011-2012 75+ 42.0 42.0
#> 13: 2011-2012 Women 55.2 55.2
#> 14: 2011-2012 Men 50.2 50.2
#> 15: 2013-2014 Overall 54.1 54.1
#> 16: 2013-2014 18 to 44 44.6 44.6
#> 17: 2013-2014 45 to 64 57.0 57.0
#> 18: 2013-2014 65 to 74 59.2 59.2
#> 19: 2013-2014 75+ 47.4 47.4
#> 20: 2013-2014 Women 57.4 57.4
#> 21: 2013-2014 Men 52.1 52.1
#> 22: 2015-2016 Overall 48.6 48.6
#> 23: 2015-2016 18 to 44 40.0 40.0
#> 24: 2015-2016 45 to 64 53.7 53.7
#> 25: 2015-2016 65 to 74 51.5 51.5
#> 26: 2015-2016 75+ 38.2 38.2
#> 27: 2015-2016 Women 52.9 52.9
#> 28: 2015-2016 Men 46.0 46.0
#> 29: 2017-2020 Overall 48.2 48.2
#> 30: 2017-2020 18 to 44 40.3 40.3
#> 31: 2017-2020 45 to 64 52.0 52.0
#> 32: 2017-2020 65 to 74 54.2 54.2
#> 33: 2017-2020 75+ 36.8 36.9
#> 34: 2017-2020 Women 47.9 47.9
#> 35: 2017-2020 Men 49.0 49.0
#> svy_year group estimate_hypertension estimate_shiny
#> ci_lower_hypertension ci_lower_shiny ci_upper_hypertension ci_upper_shiny
#> <num> <num> <num> <num>
#> 1: 50.2 50.2 56.7 56.7
#> 2: 26.8 27.0 44.2 44.1
#> 3: 52.6 52.6 62.0 61.6
#> 4: 54.6 54.7 63.7 63.6
#> 5: 44.1 44.1 56.5 56.4
#> 6: 53.2 53.2 61.4 61.4
#> 7: 47.3 47.3 54.1 54.1
#> 8: 47.7 47.7 56.7 56.6
#> 9: 31.5 31.7 52.9 52.8
#> 10: 49.6 49.7 62.9 62.8
#> 11: 51.1 51.2 64.5 64.4
#> 12: 33.4 33.5 50.6 50.4
#> 13: 49.2 49.3 61.2 61.1
#> 14: 46.0 46.1 54.4 54.3
#> 15: 48.9 49.0 59.3 59.2
#> 16: 38.2 38.3 50.9 50.8
#> 17: 49.8 49.9 64.2 64.1
#> 18: 54.7 54.7 63.6 63.6
#> 19: 38.6 38.8 56.1 56.0
#> 20: 52.3 52.3 62.5 62.5
#> 21: 45.5 45.6 58.8 58.7
#> 22: 44.4 44.5 52.7 52.7
#> 23: 33.9 34.0 46.1 46.0
#> 24: 48.1 48.2 59.2 59.2
#> 25: 44.4 44.5 58.5 58.4
#> 26: 31.7 31.8 44.8 44.7
#> 27: 47.8 47.9 58.0 58.0
#> 28: 41.1 41.1 51.0 50.9
#> 29: 45.7 45.7 50.8 50.8
#> 30: 30.7 30.8 49.9 49.8
#> 31: 47.9 47.9 56.2 56.1
#> 32: 49.3 49.4 59.0 59.0
#> 33: 32.5 32.5 41.3 41.2
#> 34: 44.7 44.7 51.2 51.2
#> 35: 44.8 44.9 53.3 53.2
#> ci_lower_hypertension ci_lower_shiny ci_upper_hypertension ci_upper_shinyIn some cases, we have minor differences due to rounding and/or minor differences due to a small differences in the study cohorts. To ensure all of these differences are small enough, we set a 0.005% tolerance for differences in the Shiny app versus the paper.
tolerance <- 0.005
test_that(
desc = "shiny app matches Table S2 of Hypertension paper",
code = {
expect_equal(test_results$estimate_hypertension,
test_results$estimate_shiny,
tolerance = tolerance)
expect_equal(test_results$ci_lower_hypertension,
test_results$ci_lower_shiny,
tolerance = tolerance)
expect_equal(test_results$ci_upper_hypertension,
test_results$ci_upper_shiny,
tolerance = tolerance)
}
)
#> Test passedMake your own results
You can find the online application where customized graphs can be made here: https://bcjaeger.shinyapps.io/nhanesShinyBP/