Replicating analysis from Muntner et al, 2020
replicate_jama_2020.RmdThis article shows how cardioStatsUSA can replicate
results from a prior study in the Journal of the American Medical
Association. The results can be replicated with our shiny
application or with code.
Replicate with shiny application
The video below shows how Table 2 can be replicated using our web application.
The video below shows how eTable 1 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.
nhanes_subpop_htn <- nhanes_data[svy_subpop_htn == 1]after these exclusions, 56017 participants are
included.
Age adjustment
We use direct standardization with the same standard weights as in Munter et al.
standard_weights <- c(15.5, 45.4, 21.5, 17.7)NHANES design objects
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]. For this analysis, we create three
designs:
- an initial design that encapsulates the two others:
ds_init <- nhanes_design(
data = nhanes_subpop_htn,
key = nhanes_key,
outcome_variable = 'bp_control_140_90'
)- a design for non-pregnant adults with hypertension
ds_all <- ds_init %>%
nhanes_design_subset(
svy_subpop_htn == 1 &
(demo_pregnant == 'No' | is.na(demo_pregnant)) &
htn_jnc7 == 'Yes'
) %>%
nhanes_design_standardize(standard_weights = standard_weights)- a design for non-pregnant adults with hypertension who reported using antihypertensive medication
ds_meds <- ds_init %>%
nhanes_design_subset(
(demo_pregnant == 'No' | is.na(demo_pregnant)) &
htn_jnc7 == 'Yes' &
bp_med_use == 'Yes'
) %>%
nhanes_design_standardize(standard_weights = standard_weights)Replicating eTable 1
To reproduce eTable 1 from Muntner et al, we use the
ds_meds design object to estimate the proportion of adults
with BP control according to the JNC7 BP guidelines.
shiny_answers_etable_1_overall <- ds_meds %>%
nhanes_design_summarize(outcome_stats = 'percentage',
simplify_output = TRUE) %>%
.[bp_control_140_90=='Yes'] %>%
.[, group := "Overall"]
shiny_answers_etable_1_by_age <- ds_meds %>%
nhanes_design_update(group_variable = 'demo_age_cat') %>%
nhanes_design_summarize(outcome_stats = 'percentage',
simplify_output = TRUE) %>%
.[bp_control_140_90=='Yes'] %>%
.[, group := as.character(demo_age_cat)]
shiny_answers_etable_1_by_sex <- ds_meds %>%
nhanes_design_update(group_variable = 'demo_gender') %>%
nhanes_design_summarize(outcome_stats = 'percentage',
simplify_output = TRUE) %>%
.[bp_control_140_90=='Yes'] %>%
.[, group := as.character(demo_gender)]
shiny_answers_etable_1_by_race <- ds_meds %>%
nhanes_design_update(group_variable = 'demo_race') %>%
nhanes_design_summarize(outcome_stats = 'percentage',
simplify_output = TRUE) %>%
.[bp_control_140_90=='Yes'] %>%
.[, group := as.character(demo_race)] %>%
.[group != 'Other']Now we can put all of our answers together
# names of columns that contain model estimates
est_cols <- c('estimate', 'ci_lower', 'ci_upper')
# names of columns to include for comparison to Muntner et al
muntner_cols <- c('svy_year', 'group', 'estimate', 'ci_lower', 'ci_upper')
shiny_answers_etable_1 <- list(
shiny_answers_etable_1_overall,
shiny_answers_etable_1_by_age,
shiny_answers_etable_1_by_sex,
shiny_answers_etable_1_by_race
) %>%
rbindlist(fill = TRUE) %>%
.[, (est_cols) := lapply(.SD, round, digits = 1), .SDcols = est_cols] %>%
.[, .SD, .SDcols = muntner_cols]
shiny_answers_etable_1
#> svy_year group estimate ci_lower ci_upper
#> <fctr> <char> <num> <num> <num>
#> 1: 1999-2000 Overall 53.4 49.0 57.9
#> 2: 2001-2002 Overall 58.6 56.0 61.2
#> 3: 2003-2004 Overall 62.1 57.9 66.2
#> 4: 2005-2006 Overall 65.5 62.0 69.0
#> 5: 2007-2008 Overall 68.3 65.9 70.7
#> ---
#> 100: 2015-2016 Hispanic 65.0 58.8 71.1
#> 101: 2017-2020 Non-Hispanic White 72.1 68.8 75.3
#> 102: 2017-2020 Non-Hispanic Black 52.6 47.3 57.9
#> 103: 2017-2020 Non-Hispanic Asian 63.6 57.0 70.1
#> 104: 2017-2020 Hispanic 62.3 56.9 67.7We also need to get the data from Muntner et al to make sure our answers match their answers.
Now put everything together and test that all of our answers match
test_results <- list(
jama = jama_etable_1,
shiny = shiny_answers_etable_1
) %>%
rbindlist(idcol = 'source') %>%
.[!svy_year %in% c('2017-2018', '2017-2020')] %>%
dcast(formula = svy_year + group ~ source, value.var = est_cols)take a look at the merged results, you can see estimate_shiny matches estimate_jama in all cells shown.
test_results
#> Key: <svy_year, group>
#> svy_year group estimate_jama estimate_shiny ci_lower_jama
#> <fctr> <char> <num> <num> <num>
#> 1: 1999-2000 18 to 44 66.1 66.1 54.7
#> 2: 1999-2000 45 to 64 60.6 60.6 55.1
#> 3: 1999-2000 65 to 74 50.0 50.0 43.2
#> 4: 1999-2000 75+ 28.1 28.1 22.0
#> 5: 1999-2000 Hispanic 48.8 48.8 39.3
#> 6: 1999-2000 Men 59.2 59.2 51.3
#> 7: 1999-2000 Non-Hispanic Black 44.3 44.3 37.1
#> 8: 1999-2000 Non-Hispanic White 57.3 57.3 51.9
#> 9: 1999-2000 Overall 53.4 53.4 49.0
#> 10: 1999-2000 Women 49.6 49.6 44.6
#> 11: 2001-2002 18 to 44 70.8 70.8 60.4
#> 12: 2001-2002 45 to 64 63.3 63.3 58.6
#> 13: 2001-2002 65 to 74 49.8 49.8 43.1
#> 14: 2001-2002 75+ 46.5 46.5 36.9
#> 15: 2001-2002 Hispanic 61.7 61.7 51.0
#> 16: 2001-2002 Men 61.3 61.3 55.8
#> 17: 2001-2002 Non-Hispanic Black 48.6 48.6 45.7
#> 18: 2001-2002 Non-Hispanic White 61.3 61.3 57.2
#> 19: 2001-2002 Overall 58.6 58.6 56.0
#> 20: 2001-2002 Women 57.5 57.5 53.8
#> 21: 2003-2004 18 to 44 81.7 81.7 73.2
#> 22: 2003-2004 45 to 64 63.9 63.9 58.6
#> 23: 2003-2004 65 to 74 58.7 58.7 51.9
#> 24: 2003-2004 75+ 44.1 44.1 38.2
#> 25: 2003-2004 Hispanic 54.5 54.5 40.9
#> 26: 2003-2004 Men 65.5 65.5 60.6
#> 27: 2003-2004 Non-Hispanic Black 55.6 55.6 49.0
#> 28: 2003-2004 Non-Hispanic White 65.1 65.1 60.6
#> 29: 2003-2004 Overall 62.1 62.1 57.9
#> 30: 2003-2004 Women 59.4 59.4 54.2
#> 31: 2005-2006 18 to 44 77.2 77.2 67.1
#> 32: 2005-2006 45 to 64 68.8 68.8 63.1
#> 33: 2005-2006 65 to 74 58.8 58.8 53.7
#> 34: 2005-2006 75+ 55.0 55.0 48.3
#> 35: 2005-2006 Hispanic 64.2 64.2 57.1
#> 36: 2005-2006 Men 68.4 68.4 62.7
#> 37: 2005-2006 Non-Hispanic Black 57.9 57.9 51.9
#> 38: 2005-2006 Non-Hispanic White 67.1 67.1 62.9
#> 39: 2005-2006 Overall 65.5 65.5 62.0
#> 40: 2005-2006 Women 63.8 63.8 60.0
#> 41: 2007-2008 18 to 44 83.7 83.7 78.6
#> 42: 2007-2008 45 to 64 69.8 69.8 65.5
#> 43: 2007-2008 65 to 74 66.1 66.1 62.2
#> 44: 2007-2008 75+ 53.9 53.9 48.5
#> 45: 2007-2008 Hispanic 64.3 64.3 57.7
#> 46: 2007-2008 Men 69.4 69.4 66.2
#> 47: 2007-2008 Non-Hispanic Black 61.1 61.1 56.7
#> 48: 2007-2008 Non-Hispanic White 71.0 71.0 68.3
#> 49: 2007-2008 Overall 68.3 68.3 65.9
#> 50: 2007-2008 Women 67.5 67.5 64.7
#> 51: 2009-2010 18 to 44 65.5 65.5 56.0
#> 52: 2009-2010 45 to 64 73.4 73.4 69.6
#> 53: 2009-2010 65 to 74 71.5 71.5 67.5
#> 54: 2009-2010 75+ 61.7 61.7 55.8
#> 55: 2009-2010 Hispanic 58.1 58.1 52.3
#> 56: 2009-2010 Men 68.4 68.4 64.5
#> 57: 2009-2010 Non-Hispanic Black 60.1 60.1 56.0
#> 58: 2009-2010 Non-Hispanic White 73.4 73.4 70.7
#> 59: 2009-2010 Overall 69.7 69.7 67.4
#> 60: 2009-2010 Women 71.4 71.4 68.7
#> 61: 2011-2012 18 to 44 83.3 83.3 74.2
#> 62: 2011-2012 45 to 64 74.6 74.6 70.6
#> 63: 2011-2012 65 to 74 68.6 68.6 62.0
#> 64: 2011-2012 75+ 49.9 49.9 41.7
#> 65: 2011-2012 Hispanic 65.4 65.4 59.5
#> 66: 2011-2012 Men 71.1 71.1 67.1
#> 67: 2011-2012 Non-Hispanic Asian 72.5 72.5 62.3
#> 68: 2011-2012 Non-Hispanic Black 64.2 64.2 58.9
#> 69: 2011-2012 Non-Hispanic White 72.3 72.3 68.5
#> 70: 2011-2012 Overall 70.3 70.3 66.8
#> 71: 2011-2012 Women 70.2 70.2 65.6
#> 72: 2013-2014 18 to 44 81.0 81.0 76.0
#> 73: 2013-2014 45 to 64 75.2 75.2 69.7
#> 74: 2013-2014 65 to 74 70.6 70.6 66.4
#> 75: 2013-2014 75+ 58.5 58.5 50.4
#> 76: 2013-2014 Hispanic 68.9 68.9 61.8
#> 77: 2013-2014 Men 72.6 72.6 67.5
#> 78: 2013-2014 Non-Hispanic Asian 63.8 63.8 57.2
#> 79: 2013-2014 Non-Hispanic Black 60.4 60.4 54.4
#> 80: 2013-2014 Non-Hispanic White 75.4 75.4 70.4
#> 81: 2013-2014 Overall 72.2 72.2 68.6
#> 82: 2013-2014 Women 72.4 72.4 68.1
#> 83: 2015-2016 18 to 44 70.9 70.9 63.2
#> 84: 2015-2016 45 to 64 74.0 74.0 68.1
#> 85: 2015-2016 65 to 74 64.4 64.4 56.7
#> 86: 2015-2016 75+ 47.7 47.7 39.2
#> 87: 2015-2016 Hispanic 65.0 65.0 58.8
#> 88: 2015-2016 Men 66.5 66.5 61.1
#> 89: 2015-2016 Non-Hispanic Asian 54.1 54.1 43.8
#> 90: 2015-2016 Non-Hispanic Black 58.1 58.1 53.0
#> 91: 2015-2016 Non-Hispanic White 70.4 70.4 65.6
#> 92: 2015-2016 Overall 66.8 66.8 63.0
#> 93: 2015-2016 Women 67.9 67.9 63.9
#> svy_year group estimate_jama estimate_shiny ci_lower_jama
#> ci_lower_shiny ci_upper_jama ci_upper_shiny
#> <num> <num> <num>
#> 1: 54.8 77.5 77.4
#> 2: 55.1 66.1 66.0
#> 3: 43.3 56.9 56.8
#> 4: 22.0 34.3 34.2
#> 5: 39.4 58.3 58.2
#> 6: 51.3 67.1 67.0
#> 7: 37.2 51.5 51.5
#> 8: 51.9 62.8 62.7
#> 9: 49.0 57.9 57.9
#> 10: 44.7 54.5 54.5
#> 11: 60.5 81.1 81.0
#> 12: 58.6 68.1 68.0
#> 13: 43.1 56.5 56.4
#> 14: 37.0 56.2 56.1
#> 15: 51.1 72.4 72.3
#> 16: 55.9 66.8 66.7
#> 17: 45.7 51.6 51.6
#> 18: 57.2 65.4 65.4
#> 19: 56.0 61.2 61.2
#> 20: 53.8 61.1 61.1
#> 21: 73.2 90.2 90.2
#> 22: 58.7 69.2 69.2
#> 23: 51.9 65.5 65.4
#> 24: 38.2 50.1 50.1
#> 25: 41.0 68.1 68.0
#> 26: 60.6 70.3 70.3
#> 27: 49.0 62.2 62.1
#> 28: 60.6 69.6 69.6
#> 29: 57.9 66.2 66.2
#> 30: 54.2 64.6 64.5
#> 31: 67.2 87.4 87.3
#> 32: 63.2 74.5 74.4
#> 33: 53.7 63.9 63.9
#> 34: 48.3 61.7 61.7
#> 35: 57.1 71.4 71.4
#> 36: 62.7 74.1 74.1
#> 37: 52.0 63.9 63.9
#> 38: 63.0 71.2 71.2
#> 39: 62.0 69.0 69.0
#> 40: 60.0 67.6 67.6
#> 41: 78.6 88.7 88.7
#> 42: 65.5 74.1 74.0
#> 43: 62.2 70.0 69.9
#> 44: 48.6 59.2 59.2
#> 45: 57.7 70.9 70.8
#> 46: 66.2 72.6 72.6
#> 47: 56.7 65.6 65.5
#> 48: 68.4 73.7 73.6
#> 49: 65.9 70.8 70.7
#> 50: 64.8 70.3 70.3
#> 51: 56.1 74.9 74.9
#> 52: 69.6 77.3 77.2
#> 53: 67.6 75.6 75.5
#> 54: 55.8 67.6 67.6
#> 55: 52.1 64.1 64.1
#> 56: 64.5 72.3 72.3
#> 57: 56.0 64.1 64.1
#> 58: 70.7 76.1 76.1
#> 59: 67.4 72.1 72.1
#> 60: 68.8 74.0 74.0
#> 61: 74.3 92.4 92.3
#> 62: 70.7 78.5 78.5
#> 63: 62.1 75.2 75.1
#> 64: 41.8 58.1 58.1
#> 65: 59.6 71.2 71.2
#> 66: 67.1 75.1 75.1
#> 67: 62.5 82.6 82.4
#> 68: 59.0 69.4 69.4
#> 69: 68.5 76.2 76.2
#> 70: 66.8 73.8 73.7
#> 71: 65.6 74.7 74.7
#> 72: 76.1 85.9 85.9
#> 73: 69.8 80.7 80.7
#> 74: 66.4 74.7 74.7
#> 75: 50.5 66.7 66.6
#> 76: 61.9 75.9 75.9
#> 77: 67.6 77.8 77.7
#> 78: 57.3 70.5 70.4
#> 79: 54.4 66.5 66.4
#> 80: 70.5 80.4 80.3
#> 81: 68.6 75.8 75.7
#> 82: 68.1 76.7 76.7
#> 83: 63.3 78.6 78.5
#> 84: 68.1 79.9 79.9
#> 85: 56.7 72.2 72.1
#> 86: 39.3 56.2 56.1
#> 87: 58.8 71.2 71.1
#> 88: 61.2 71.8 71.8
#> 89: 44.1 64.4 64.2
#> 90: 53.0 63.2 63.2
#> 91: 65.6 75.2 75.2
#> 92: 63.0 70.6 70.6
#> 93: 63.9 71.9 71.8
#> ci_lower_shiny ci_upper_jama ci_upper_shinyIn some cases, we have differences in estimates due to rounding and/or minor differences in the way CI boundaries are computed in R versus stata. To ensure all of these differences are small enough, we allow a 0.005% and a 0.01% difference in the point estimates and CI boundaries, respectively, for our test of equality. I.e., |A-B|/ B < 0.005 for point estimates and |A-B|/ B < 0.01 for upper and lower CI estimates, where A is from our web application and B is the corresponding estimate from Muntner et al.
est_diff_tolerance <- 0.005
ci_diff_tolerance <- 0.01
test_that(
desc = "shiny app matches eTable 1 of JAMA paper",
code = {
expect_equal(test_results$estimate_jama,
test_results$estimate_shiny,
tolerance = est_diff_tolerance)
expect_equal(test_results$ci_lower_jama,
test_results$ci_lower_shiny,
tolerance = ci_diff_tolerance)
expect_equal(test_results$ci_upper_jama,
test_results$ci_upper_shiny,
tolerance = ci_diff_tolerance)
}
)
#> Test passedsuccess!
Replicating Table 2
The process for this table is similar. The values from Muntner et al’s Table 2 are saved in a data frame:
jama_table_2 <- cardioStatsUSA::muntner_jama_2020_table_2
jama_table_2
#> svy_year group estimate ci_lower ci_upper
#> <char> <char> <num> <num> <num>
#> 1: 1999-2000 lt_120_80 9.2 7.4 10.9
#> 2: 2001-2002 lt_120_80 12.5 10.0 15.0
#> 3: 2003-2004 lt_120_80 13.1 11.2 14.9
#> 4: 2005-2006 lt_120_80 14.9 12.8 17.0
#> 5: 2007-2008 lt_120_80 18.2 15.8 20.6
#> 6: 2009-2010 lt_120_80 21.4 19.4 23.4
#> 7: 2011-2012 lt_120_80 18.4 14.7 22.1
#> 8: 2013-2014 lt_120_80 20.2 16.8 23.6
#> 9: 2015-2016 lt_120_80 17.2 13.5 20.9
#> 10: 2017-2018 lt_120_80 15.8 12.9 18.6
#> 11: 1999-2000 gt_120_lt_80 6.5 5.3 7.6
#> 12: 2001-2002 gt_120_lt_80 7.1 5.7 8.5
#> 13: 2003-2004 gt_120_lt_80 9.6 8.0 11.3
#> 14: 2005-2006 gt_120_lt_80 10.7 8.5 12.8
#> 15: 2007-2008 gt_120_lt_80 12.3 10.0 14.5
#> 16: 2009-2010 gt_120_lt_80 12.5 10.9 14.0
#> 17: 2011-2012 gt_120_lt_80 15.8 13.8 17.8
#> 18: 2013-2014 gt_120_lt_80 14.6 12.5 16.7
#> 19: 2015-2016 gt_120_lt_80 14.3 11.6 16.9
#> 20: 2017-2018 gt_120_lt_80 11.3 9.4 13.2
#> 21: 1999-2000 gt_130_80 16.2 12.4 19.9
#> 22: 2001-2002 gt_130_80 15.3 13.0 17.5
#> 23: 2003-2004 gt_130_80 17.1 14.6 19.7
#> 24: 2005-2006 gt_130_80 18.3 14.8 21.8
#> 25: 2007-2008 gt_130_80 18.0 15.5 20.6
#> 26: 2009-2010 gt_130_80 19.2 17.3 21.0
#> 27: 2011-2012 gt_130_80 17.7 16.4 18.9
#> 28: 2013-2014 gt_130_80 19.1 15.3 22.8
#> 29: 2015-2016 gt_130_80 16.9 14.0 19.7
#> 30: 2017-2018 gt_130_80 16.7 15.0 18.3
#> 31: 1999-2000 gt_140_90 48.2 44.3 52.1
#> 32: 2001-2002 gt_140_90 44.8 41.8 47.7
#> 33: 2003-2004 gt_140_90 42.4 38.2 46.6
#> 34: 2005-2006 gt_140_90 41.5 38.8 44.2
#> 35: 2007-2008 gt_140_90 39.3 36.3 42.4
#> 36: 2009-2010 gt_140_90 36.7 33.3 40.0
#> 37: 2011-2012 gt_140_90 35.7 31.7 39.7
#> 38: 2013-2014 gt_140_90 35.1 31.0 39.2
#> 39: 2015-2016 gt_140_90 40.1 36.8 43.4
#> 40: 2017-2018 gt_140_90 41.7 38.6 44.8
#> 41: 1999-2000 gt_160_100 20.0 16.5 23.6
#> 42: 2001-2002 gt_160_100 20.4 17.2 23.5
#> 43: 2003-2004 gt_160_100 17.8 15.4 20.2
#> 44: 2005-2006 gt_160_100 14.6 12.4 16.9
#> 45: 2007-2008 gt_160_100 12.2 10.7 13.7
#> 46: 2009-2010 gt_160_100 10.3 8.7 12.0
#> 47: 2011-2012 gt_160_100 12.4 9.6 15.2
#> 48: 2013-2014 gt_160_100 11.1 9.3 12.9
#> 49: 2015-2016 gt_160_100 11.5 9.9 13.2
#> 50: 2017-2018 gt_160_100 14.6 11.7 17.5
#> svy_year group estimate ci_lower ci_upperOur answers are generated with the design object created earlier.
shiny_answers_table_2 <- ds_all %>%
nhanes_design_update(outcome_variable = 'bp_cat_meds_excluded') %>%
nhanes_design_summarize(outcome_stats = 'percentage',
simplify_output = TRUE) %>%
as.data.table() %>%
.[,
# just recoding this variable to match JAMA group variable
group := factor(
bp_cat_meds_excluded,
labels = c(
"lt_120_80",
"gt_120_lt_80",
"gt_130_80",
"gt_140_90",
"gt_160_100"
)
)] %>%
# select the same names as JAMA table
.[, .(svy_year, group, estimate, ci_lower, ci_upper)] %>%
# round to 1 decimal place (matching rounding in JAMA table)
.[, estimate := round(estimate, digits = 1)] %>%
.[, ci_lower := round(ci_lower, digits = 1)] %>%
.[, ci_upper := round(ci_upper, digits = 1)]Now we merge the results from our code with the JAMA data:
test_results <- list(jama = jama_table_2,
shiny = shiny_answers_table_2) %>%
rbindlist(idcol = 'source') %>%
.[svy_year != '2017-2018' & svy_year != '2017-2020'] %>%
dcast(svy_year + group ~ source, value.var = c('estimate',
'ci_lower',
'ci_upper'))
test_results
#> Key: <svy_year, group>
#> svy_year group estimate_jama estimate_shiny ci_lower_jama
#> <fctr> <fctr> <num> <num> <num>
#> 1: 1999-2000 lt_120_80 9.2 9.2 7.4
#> 2: 1999-2000 gt_120_lt_80 6.5 6.5 5.3
#> 3: 1999-2000 gt_130_80 16.2 16.2 12.4
#> 4: 1999-2000 gt_140_90 48.2 48.2 44.3
#> 5: 1999-2000 gt_160_100 20.0 20.0 16.5
#> 6: 2001-2002 lt_120_80 12.5 12.5 10.0
#> 7: 2001-2002 gt_120_lt_80 7.1 7.1 5.7
#> 8: 2001-2002 gt_130_80 15.3 15.3 13.0
#> 9: 2001-2002 gt_140_90 44.8 44.8 41.8
#> 10: 2001-2002 gt_160_100 20.4 20.3 17.2
#> 11: 2003-2004 lt_120_80 13.1 13.1 11.2
#> 12: 2003-2004 gt_120_lt_80 9.6 9.6 8.0
#> 13: 2003-2004 gt_130_80 17.1 17.1 14.6
#> 14: 2003-2004 gt_140_90 42.4 42.4 38.2
#> 15: 2003-2004 gt_160_100 17.8 17.8 15.4
#> 16: 2005-2006 lt_120_80 14.9 14.9 12.8
#> 17: 2005-2006 gt_120_lt_80 10.7 10.7 8.5
#> 18: 2005-2006 gt_130_80 18.3 18.3 14.8
#> 19: 2005-2006 gt_140_90 41.5 41.5 38.8
#> 20: 2005-2006 gt_160_100 14.6 14.6 12.4
#> 21: 2007-2008 lt_120_80 18.2 18.2 15.8
#> 22: 2007-2008 gt_120_lt_80 12.3 12.3 10.0
#> 23: 2007-2008 gt_130_80 18.0 18.0 15.5
#> 24: 2007-2008 gt_140_90 39.3 39.3 36.3
#> 25: 2007-2008 gt_160_100 12.2 12.2 10.7
#> 26: 2009-2010 lt_120_80 21.4 21.4 19.4
#> 27: 2009-2010 gt_120_lt_80 12.5 12.5 10.9
#> 28: 2009-2010 gt_130_80 19.2 19.2 17.3
#> 29: 2009-2010 gt_140_90 36.7 36.7 33.3
#> 30: 2009-2010 gt_160_100 10.3 10.3 8.7
#> 31: 2011-2012 lt_120_80 18.4 18.4 14.7
#> 32: 2011-2012 gt_120_lt_80 15.8 15.8 13.8
#> 33: 2011-2012 gt_130_80 17.7 17.7 16.4
#> 34: 2011-2012 gt_140_90 35.7 35.7 31.7
#> 35: 2011-2012 gt_160_100 12.4 12.4 9.6
#> 36: 2013-2014 lt_120_80 20.2 20.2 16.8
#> 37: 2013-2014 gt_120_lt_80 14.6 14.6 12.5
#> 38: 2013-2014 gt_130_80 19.1 19.1 15.3
#> 39: 2013-2014 gt_140_90 35.1 35.1 31.0
#> 40: 2013-2014 gt_160_100 11.1 11.1 9.3
#> 41: 2015-2016 lt_120_80 17.2 17.2 13.5
#> 42: 2015-2016 gt_120_lt_80 14.3 14.3 11.6
#> 43: 2015-2016 gt_130_80 16.9 16.9 14.0
#> 44: 2015-2016 gt_140_90 40.1 40.1 36.8
#> 45: 2015-2016 gt_160_100 11.5 11.5 9.9
#> svy_year group estimate_jama estimate_shiny ci_lower_jama
#> ci_lower_shiny ci_upper_jama ci_upper_shiny
#> <num> <num> <num>
#> 1: 7.4 10.9 10.9
#> 2: 5.3 7.6 7.6
#> 3: 12.5 19.9 19.8
#> 4: 44.3 52.1 52.1
#> 5: 16.5 23.6 23.5
#> 6: 10.0 15.0 15.0
#> 7: 5.7 8.5 8.6
#> 8: 13.1 17.5 17.5
#> 9: 41.9 47.7 47.8
#> 10: 17.1 23.5 23.4
#> 11: 11.3 14.9 14.8
#> 12: 8.0 11.3 11.3
#> 13: 14.7 19.7 19.6
#> 14: 38.2 46.6 46.5
#> 15: 15.4 20.2 20.2
#> 16: 12.8 17.0 17.0
#> 17: 8.6 12.8 12.8
#> 18: 14.8 21.8 21.8
#> 19: 38.9 44.2 44.2
#> 20: 12.4 16.9 16.8
#> 21: 15.8 20.6 20.6
#> 22: 10.0 14.5 14.5
#> 23: 15.5 20.6 20.6
#> 24: 36.3 42.4 42.4
#> 25: 10.7 13.7 13.6
#> 26: 19.4 23.4 23.4
#> 27: 10.9 14.0 14.0
#> 28: 17.4 21.0 21.0
#> 29: 33.4 40.0 39.9
#> 30: 8.7 12.0 12.0
#> 31: 14.7 22.1 22.1
#> 32: 13.9 17.8 17.8
#> 33: 16.4 18.9 18.9
#> 34: 31.7 39.7 39.6
#> 35: 9.7 15.2 15.2
#> 36: 16.8 23.6 23.6
#> 37: 12.5 16.7 16.7
#> 38: 15.4 22.8 22.7
#> 39: 31.1 39.2 39.1
#> 40: 9.3 12.9 12.8
#> 41: 13.6 20.9 20.9
#> 42: 11.6 16.9 16.9
#> 43: 14.0 19.7 19.7
#> 44: 36.8 43.4 43.4
#> 45: 9.9 13.2 13.2
#> ci_lower_shiny ci_upper_jama ci_upper_shinyLast, we assert the expectation that all of our answers match the corresponding value in the JAMA table.
test_that(
desc = "shiny app matches Table 2 of JAMA paper",
code = {
expect_equal(test_results$estimate_jama,
test_results$estimate_shiny,
tolerance = est_diff_tolerance)
expect_equal(test_results$ci_lower_jama,
test_results$ci_lower_shiny,
tolerance = ci_diff_tolerance)
expect_equal(test_results$ci_upper_jama,
test_results$ci_upper_shiny,
tolerance = ci_diff_tolerance)
}
)
#> Test passedMake your own results
You can find the online application where customized graphs can be made here: https://bcjaeger.shinyapps.io/nhanesShinyBP/