Estimate risk of cardiovascular events using the American Heart Association (AHA) Predicting Risk of cardiovascular disease EVENTs (PREVENT) equations, with optional comparison to their de facto predecessor, the Pooled Cohort Equations (PCEs) from the AHA and American College of Cardiology (ACC)

estimate_risk(
  age,
  sex,
  sbp,
  bp_tx,
  total_c,
  hdl_c,
  statin,
  dm,
  smoking,
  egfr,
  bmi,
  hba1c = NULL,
  uacr = NULL,
  zip = NULL,
  model = NULL,
  time = "both",
  chol_unit = "mg/dL",
  optional_strict = FALSE,
  quiet = is.data.frame(use_dat),
  collapse = is.data.frame(use_dat),
  use_dat = NULL,
  add_to_dat = is.data.frame(use_dat),
  progress = is.data.frame(use_dat)
)

est_risk(
  age,
  sex,
  sbp,
  bp_tx,
  total_c,
  hdl_c,
  statin,
  dm,
  smoking,
  egfr,
  bmi,
  hba1c = NULL,
  uacr = NULL,
  zip = NULL,
  model = NULL,
  time = "both",
  chol_unit = "mg/dL",
  optional_strict = FALSE,
  quiet = is.data.frame(use_dat),
  collapse = is.data.frame(use_dat),
  use_dat = NULL,
  add_to_dat = is.data.frame(use_dat),
  progress = is.data.frame(use_dat)
)

# Example with all required predictor variables (example from Table S25
# in the supplemental PDF appendix of the PREVENT equations article)
#
# Optional predictor variables are all omitted (and thus take their default).
# `model` is also omitted (and thus takes its default, with the function
# selecting # the model based on the algorithm specified in the "Details"
# section).
# `time` is also omitted (and thus takes its default, with the function 
# returning estimates for both 10- and 30-year risk as specified in the 
# "Value" section).
#
# Expect the base model to run given absence of optional predictor variables
res <- estimate_risk(
  age = 50, 
  sex = "female",    # or "f"
  sbp = 160, 
  bp_tx = TRUE,      # or 1
  total_c = 200,     # default unit is "mg/dL"
  hdl_c = 45,        # default unit is "mg/dL"
  statin = FALSE,    # or 0
  dm = TRUE,         # or 1
  smoking = FALSE,   # or 0
  egfr = 90,
  bmi = 35
)
#> PREVENT estimates are from: Base model.

# Based on Table S25, expect the 10-year risk for `total_cvd` to be 0.147,
# and based on the supplemental Excel file, also expect:
# 10-year risks: `ascvd`, 0.092; `heart_failure`, 0.081; 
# `chd`, 0.044; `stroke`, 0.054
# 30-year risks: `total_cvd`, 0.53; `ascvd`, 0.354; `heart_failure`, 0.39;
# `chd`, 0.198; `stroke`, 0.221
res
#> $risk_est_10yr
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>         
#> 1     0.147 0.092         0.081 0.044  0.054 base          10 NA            
#> 
#> $risk_est_30yr
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>         
#> 1      0.53 0.354          0.39 0.198  0.221 base          30 NA            
#> 
 
# Example with HbA1c 
# (also changing required predictor variables & limiting to 10-year results)
estimate_risk(
  age = 66, 
  sex = "male",      # or "m"
  sbp = 148, 
  bp_tx = FALSE,     
  total_c = 188,     
  hdl_c = 52,        
  statin = TRUE,    
  dm = TRUE,         
  smoking = TRUE,   
  egfr = 67,
  bmi = 30,
  hba1c = 7.5,
  time = "10yr"      # only 10-year results will show
)
#> PREVENT estimates are from: Base model adding HbA1c.
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>         
#> 1     0.231 0.142         0.149 0.082  0.071 hba1c         10 NA            

# Example with UACR (limited to 30-year results)
estimate_risk(
  age = 66, 
  sex = "female",   
  sbp = 148, 
  bp_tx = FALSE,     
  total_c = 188,     
  hdl_c = 52,        
  statin = TRUE,    
  dm = TRUE,         
  smoking = TRUE,   
  egfr = 67,
  bmi = 30,
  uacr = 750,
  time = "30yr"      # only 30-year results will show    
)
#> PREVENT estimates are from: Base model adding UACR.
#> Warning: Estimating 30-year risk in people > 59 years of age is questionable
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems    
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>             
#> 1     0.562 0.366         0.448 0.243    0.2 uacr          30 Warning: Estimati…
 
# The remaining examples will all be limited to 10-year results unless
# otherwise specified  
 
# Example with SDI with valid zip code with SDI data available
estimate_risk(
  age = 66, 
  sex = "female",     
  sbp = 148, 
  bp_tx = FALSE,     
  total_c = 188,     
  hdl_c = 52,        
  statin = TRUE,    
  dm = TRUE,         
  smoking = TRUE,   
  egfr = 67,
  bmi = 30,
  zip = "59043",   # Lame Deer, MT (selected randomly)
  time = 10        # Note numeric 10 (not "10yr"),
                   # just to show the option of entering this way
)
#> PREVENT estimates are from: Base model adding SDI.
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>         
#> 1     0.217 0.139         0.138  0.08  0.074 sdi           10 NA            

# Example with SDI with valid zip code without SDI data available
# (base model will be used)
estimate_risk(
  age = 66, 
  sex = "male",     
  sbp = 148, 
  bp_tx = FALSE,     
  total_c = 188,     
  hdl_c = 52,        
  statin = TRUE,    
  dm = TRUE,         
  smoking = TRUE,   
  egfr = 67,
  bmi = 30,
  zip = "00738",   # Fajardo, PR
  time = 10
)
#> SDI is not available for this zip code.
#> PREVENT estimates are from: Base model.
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>         
#> 1     0.224 0.142         0.138 0.083  0.072 base          10 NA            

# Example with full model (even though zip does not have available SDI, full 
# model used given availability of HbA1c and UACR; because zip is valid,
# column `input_problems` will be NA)
estimate_risk(
  age = 66, 
  sex = "female",     
  sbp = 148, 
  bp_tx = FALSE,     
  total_c = 188,     
  hdl_c = 52,        
  statin = TRUE,    
  dm = TRUE,         
  smoking = TRUE,   
  egfr = 67,
  bmi = 30,
  hba1c = 9,
  uacr = 75,
  zip = "00738",   
  time = "10yr"
)
#> SDI is not available for this zip code.
#> PREVENT estimates are from: Base model adding HbA1c, SDI, and UACR (also referred to as the full model).
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>         
#> 1     0.288 0.178         0.218 0.117  0.087 full          10 NA            

# Example with full model (zip has SDI data available, UACR is valid, but
# HbA1c is not; column `input_problems` will specify problem with `hba1c`,
# but full model will still run given availability of the other two optional
# predictor variables)
estimate_risk(
  age = 66, 
  sex = "male",     
  sbp = 148, 
  bp_tx = FALSE,     
  total_c = 188,     
  hdl_c = 52,        
  statin = TRUE,    
  dm = TRUE,         
  smoking = TRUE,   
  egfr = 67,
  bmi = 30,
  hba1c = 20,
  uacr = 75,
  zip = "59043",   
  time = "10yr"
)
#> Please check the following optional variables: 
#> * `hba1c` entered as 20, but must be between 4.5 and 15 (so set to NULL)
#> PREVENT estimates are from: Base model adding HbA1c, SDI, and UACR (also referred to as the full model).
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems    
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>             
#> 1     0.235 0.147         0.153 0.087  0.072 full          10 `hba1c` entered a…

# Example of using the convenience functions `calc_bmi()` and `calc_egfr()`
res_convenience_fxs <- estimate_risk(
  age = 50, 
  sex = "female",    
  sbp = 130, 
  bp_tx = TRUE,      
  total_c = 200,     
  hdl_c = 45,        
  statin = FALSE,    
  dm = TRUE,         
  smoking = FALSE,   
  egfr = calc_egfr(1), # units unspecified, so treated as 1 mg/dL; eGFR = 69
  bmi = calc_bmi(70, 150, "metric"), # weight in kg, height in cm; BMI = 31.1
  time = "10yr",
  quiet = TRUE
)

res_direct_entry <- estimate_risk(
  age = 50, 
  sex = "female",    
  sbp = 130, 
  bp_tx = TRUE,      
  total_c = 200,     
  hdl_c = 45,        
  statin = FALSE,    
  dm = TRUE,         
  smoking = FALSE,   
  egfr = 69,
  bmi = 31.1,
  time = "10yr",
  quiet = TRUE
)

identical(res_convenience_fxs, res_direct_entry)
#> [1] TRUE

# Example of using `model` argument to compare results from PREVENT equations
# to both versions of the PCEs
estimate_risk(
  age = 50, 
  sex = "female",    
  sbp = 130, 
  bp_tx = TRUE,      
  total_c = 200,     
  hdl_c = 45,        
  statin = FALSE,    
  dm = TRUE,         
  smoking = FALSE,   
  egfr = 90,
  bmi = 35,
  hba1c = 8,
  uacr = 30,
  time = "10yr",
  model = list(other_models = "pce_both", race_eth = "Black")
  # Note omission of element `main_model` within the list is okay, and the
  # element will then be treated as NULL (and thus model selection here
  # will be "full" given availability of valid HbA1c and UACR)
)
#> PREVENT estimates are from: Base model adding HbA1c, SDI, and UACR (also referred to as the full model).
#> # A tibble: 3 × 8
#>   total_cvd ascvd heart_failure    chd stroke model    over_years input_problems
#>       <dbl> <dbl>         <dbl>  <dbl>  <dbl> <chr>         <dbl> <chr>         
#> 1     0.105 0.059         0.065  0.032   0.03 full             10 NA            
#> 2    NA     0.112        NA     NA      NA    pce_orig         10 NA            
#> 3    NA     0.068        NA     NA      NA    pce_rev          10 NA            

# Essentially a repeat of example immediately above, but now will specify
# `main_model` as "hba1c" and limit `other_models` to the revised PCEs
estimate_risk(
  age = 50, 
  sex = "female",    
  sbp = 130, 
  bp_tx = TRUE,      
  total_c = 200,     
  hdl_c = 45,        
  statin = FALSE,    
  dm = TRUE,         
  smoking = FALSE,   
  egfr = 90,
  bmi = 35,
  hba1c = 8,
  uacr = 30,
  time = "10yr",
  model = list(main_model = "hba1c", other_models = "pce_rev", race_eth = "Black")
)
#> PREVENT estimates are from: Base model adding HbA1c.
#> # A tibble: 2 × 8
#>   total_cvd ascvd heart_failure   chd stroke model   over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>        <dbl> <chr>         
#> 1     0.094 0.054         0.059  0.03  0.027 hba1c           10 NA            
#> 2    NA     0.068        NA     NA    NA     pce_rev         10 NA            

# Because the PCEs only give 10-year estimates, if a user specifies an 
# interest in a 30-year time horizon but also expresses interest in 
# comparison with the the PCEs, a 10-year time horizon must be added for the
# PCEs, but this will not automatically result in estimation of 10-year risk
# for the PREVENT equations.
estimate_risk(
  age = 50, 
  sex = "female",    
  sbp = 130, 
  bp_tx = TRUE,      
  total_c = 200,     
  hdl_c = 45,        
  statin = FALSE,    
  dm = TRUE,         
  smoking = FALSE,   
  egfr = 90,
  bmi = 35,
  time = "30yr",
  model = list(other_models = "pce_both", race_eth = "Black")
)
#> PREVENT estimates are from: Base model.
#> $risk_est_10yr
#> # A tibble: 2 × 8
#>   total_cvd ascvd heart_failure   chd stroke model    over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>         <dbl> <chr>         
#> 1        NA 0.112            NA    NA     NA pce_orig         10 NA            
#> 2        NA 0.068            NA    NA     NA pce_rev          10 NA            
#> 
#> $risk_est_30yr
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>         
#> 1      0.41 0.246         0.297 0.141  0.137 base          30 NA            
#> 

# Repeat of above, but setting `collapse = TRUE`
res_collapsed <- estimate_risk(
  age = 50, 
  sex = "female",    
  sbp = 130, 
  bp_tx = TRUE,      
  total_c = 200,     
  hdl_c = 45,        
  statin = FALSE,    
  dm = TRUE,         
  smoking = FALSE,   
  egfr = 90,
  bmi = 35,
  time = "30yr",
  model = list(other_models = "pce_both", race_eth = "Black"),
  collapse = TRUE
)
#> PREVENT estimates are from: Base model.

res_collapsed
#> # A tibble: 3 × 8
#>   total_cvd ascvd heart_failure    chd stroke model    over_years input_problems
#>       <dbl> <dbl>         <dbl>  <dbl>  <dbl> <chr>         <dbl> <chr>         
#> 1     NA    0.112        NA     NA     NA     pce_orig         10 NA            
#> 2     NA    0.068        NA     NA     NA     pce_rev          10 NA            
#> 3      0.41 0.246         0.297  0.141  0.137 base             30 NA            

# Can also accomplish this after the fact, as documented in "Combining output 
# into a single data frame" within the "Value" section
res_uncollapsed <- estimate_risk(
  age = 50, 
  sex = "female",    
  sbp = 130, 
  bp_tx = TRUE,      
  total_c = 200,     
  hdl_c = 45,        
  statin = FALSE,    
  dm = TRUE,         
  smoking = FALSE,   
  egfr = 90,
  bmi = 35,
  time = "30yr",
  model = list(other_models = "pce_both", race_eth = "Black")
)
#> PREVENT estimates are from: Base model.

all.equal(
  do.call(rbind, res_uncollapsed), 
  res_collapsed, 
  check.attributes = FALSE
)
#> [1] TRUE
# Can also accomplish with `dplyr` and `data.table`, as detailed in the
# "Combining output into a single data frame" subsection of the "Value" 
# section


# Passing a data frame to argument `use_dat`
if(interactive()) {
  vignette("using-data-frame")
}
 
# Expect table of NAs due to invalid input for `age` and `sbp`, and column
# `input_problems` to contain explanations about problems with `age` and `sbp`
res <- estimate_risk(
  age = 8675309, 
  sex = "female",    
  sbp = 112358, 
  bp_tx = TRUE,      
  total_c = 200,     
  hdl_c = 45,        
  statin = FALSE,    
  dm = TRUE,         
  smoking = FALSE,   
  egfr = 90,
  bmi = 35,
  time = "10yr"     
)
#> Please check the following required variables: 
#> * `age` entered as 8675309, but must be between 30 and 79 for the PREVENT models
#> * `sbp` entered as 112358, but must be between 90 and 180

res
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems    
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>             
#> 1        NA    NA            NA    NA     NA none          NA `age` entered as …

# Quiet version of the above example
res <- estimate_risk(
  age = 8675309, 
  sex = "female",    
  sbp = 112358, 
  bp_tx = TRUE,      
  total_c = 200,     
  hdl_c = 45,        
  statin = FALSE,    
  dm = TRUE,         
  smoking = FALSE,   
  egfr = 90,
  bmi = 35,
  time = "10yr",     
  quiet = TRUE       # Suppresses messages, but not column `input_problems`
)

res
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems    
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>             
#> 1        NA    NA            NA    NA     NA none          NA `age` entered as …

# If only invalid input is for PCEs, PREVENT equations will still run
for(time in c("10yr", "30yr", "both")) {
  cat(paste0("\n", "----- `time = \"", time, "\"` -----", "\n"))
  print(
    estimate_risk(
      age = 38,                  # This age is okay for the PREVENT
      sex = "female",            # equations, but not for the PCEs
      sbp = 144, 
      bp_tx = TRUE,      
      total_c = 200,     
      hdl_c = 45,        
      statin = FALSE,    
      dm = TRUE,         
      smoking = FALSE,   
      egfr = 90,
      bmi = 35,
      time = time,
      model = list(
        other_models = "pce_both", 
        race_eth = NA              # Invalid `race_eth` for PCEs
      ),        
      quiet = TRUE       
    )
  )
}
#> 
#> ----- `time = "10yr"` -----
#> # A tibble: 3 × 8
#>   total_cvd  ascvd heart_failure    chd stroke model over_years input_problems  
#>       <dbl>  <dbl>         <dbl>  <dbl>  <dbl> <chr>      <int> <chr>           
#> 1     0.075  0.046         0.037  0.022  0.027 base          10  NA             
#> 2    NA     NA            NA     NA     NA     none          NA "`race_eth` wit…
#> 3    NA     NA            NA     NA     NA     none          NA "`race_eth` wit…
#> 
#> ----- `time = "30yr"` -----
#> $risk_est_10yr
#> # A tibble: 2 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems    
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>             
#> 1        NA    NA            NA    NA     NA none          NA "`race_eth` withi…
#> 2        NA    NA            NA    NA     NA none          NA "`race_eth` withi…
#> 
#> $risk_est_30yr
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>         
#> 1     0.374  0.23         0.249 0.122  0.134 base          30 NA            
#> 
#> 
#> ----- `time = "both"` -----
#> $risk_est_10yr
#> # A tibble: 3 × 8
#>   total_cvd  ascvd heart_failure    chd stroke model over_years input_problems  
#>       <dbl>  <dbl>         <dbl>  <dbl>  <dbl> <chr>      <int> <chr>           
#> 1     0.075  0.046         0.037  0.022  0.027 base          10  NA             
#> 2    NA     NA            NA     NA     NA     none          NA "`race_eth` wit…
#> 3    NA     NA            NA     NA     NA     none          NA "`race_eth` wit…
#> 
#> $risk_est_30yr
#> # A tibble: 1 × 8
#>   total_cvd ascvd heart_failure   chd stroke model over_years input_problems
#>       <dbl> <dbl>         <dbl> <dbl>  <dbl> <chr>      <int> <chr>         
#> 1     0.374  0.23         0.249 0.122  0.134 base          30 NA            
#> 

# Note `input_problems` column is semicolon-separated, but it is easy to
# print as separate lines with `gsub()` and `cat()`, e.g.:
cat(gsub("; ", "\n", res$input_problems))
#> `age` entered as 8675309, but must be between 30 and 79 for the PREVENT models
#> `sbp` entered as 112358, but must be between 90 and 180
res$input_problems |> gsub(pattern = "; ", replacement = "\n", x = _) |> cat()
#> `age` entered as 8675309, but must be between 30 and 79 for the PREVENT models
#> `sbp` entered as 112358, but must be between 90 and 180
# ... and could, of course, also use the `magrittr` pipe `%>%` if desired