# Quantitative Bias Analysis for Epidemiologic Data

#### 2017-11-13

Quantitative bias analysis allows to estimate nonrandom errors in epidemiologic studies, assessing the magnitude and direction of biases, and quantifying their uncertainties. Every study has some random error due to its limited sample size, and is susceptible to systematic errors as well, from selection bias to the presence of (un)known confounders or information bias (measurement error, including misclassification). Bias analysis methods were compiled by Lash et al. in their book “Applying Quantitative Bias Analysis to Epidemiologic Data”. This package implements the various bias analyses from that book, which are also available (for some) as a spreadsheet or a SAS macro. This vignette provides some examples on how to use the package.

(Note: A Shiny app is available for some functions, at https://dhaine.shinyapps.io/episensr_shiny/.)

## Selection Bias

We will use a case-control study by Stang et al. on the relation between mobile phone use and uveal melanoma. The observed odds ratio for the association between regular mobile phone use vs. no mobile phone use with uveal melanoma incidence is 0.71 [95% CI 0.51-0.97]. But there was a substantial difference in participation rates between cases and controls (94% vs 55%, respectively) and so selection bias could have an impact on the association estimate. The 2X2 table for this study is the following:

Regular use No use
Cases 136 107
Controls 297 165

We use the function selection as shown below.

library(episensr)

stang <- selection(matrix(c(136, 107, 297, 165),
dimnames = list(c("UM+", "UM-"), c("Mobile+", "Mobile-")),
nrow = 2, byrow = TRUE),
bias_parms = c(.94, .85, .64, .25))
stang
## --Observed data--
##          Outcome: UM+
##        Comparing: Mobile+ vs. Mobile-
##
##     Mobile+ Mobile-
## UM+     136     107
## UM-     297     165
##
##                                        2.5%     97.5%
## Observed Relative Risk: 0.7984287 0.6518303 0.9779975
##    Observed Odds Ratio: 0.7061267 0.5143958 0.9693215
## ---
##
## Selection Bias Corrected Relative Risk: 1.483780
##    Selection Bias Corrected Odds Ratio: 1.634608

The various episensr functions return an object which is a list containing the input and output variables. You can check it out with str().

The 2X2 table is provided as a matrix and selection probabilities given with the argument bias_parms, a vector with the 4 probabilities (guided by the participation rates in cases and controls) in the following order: among cases exposed, among cases unexposed, among noncases exposed, and among noncases unexposed. The output shows the observed 2X2 table and the observed odds ratio (and relative risk), followed by the corrected ones.

## Uncontrolled Confounders

We will use data from a cross-sectional study by Tyndall et al. on the association between male circumcision and the risk of acquiring HIV, which might be confounded by religion. The code to account for unmeasured or unknown confounders is the following, where the 2X2 table is given as a matrix. We choose a risk ratio implementation, provide a vector defining the risk ratio associating the confounder with the disease, and the prevalence of the confounder, religion, among the exposed and the unexposed.

confounders(matrix(c(105, 85, 527, 93),
dimnames = list(c("HIV+", "HIV-"), c("Circ+", "Circ-")),
nrow = 2, byrow = TRUE),
type = "RR",
bias_parms = c(.63, .8, .05))
## --Observed data--
##          Outcome: HIV+
##        Comparing: Circ+ vs. Circ-
##
##      Circ+ Circ-
## HIV+   105    85
## HIV-   527    93
##
##                                             2.5%     97.5%
##         Crude Relative Risk: 0.3479151 0.2757026 0.4390417
## Relative Risk, Confounder +: 0.4850550
## Relative Risk, Confounder -: 0.4850550
## ---
## Standardized Morbidity Ratio: 0.4850550   0.7172695
##              Mantel-Haenszel: 0.4850550   0.7172695

The output gives the crude 2X2 table, the crude relative risk and confounder specific measures of association between exposure and outcome, and the relationship adjusted for the unknown confounder, using a standardized morbidity ratio (SMR) or a Mantel-Haenszel (MH) estimate of the risk ratio.

## Probabilistic Sensitivity Analysis for Exposure Misclassification

We use a study on the effect of smoking during pregnancy on breast cancer risk by Fink & Lash, where we assume nondifferential misclassification of the exposure, smoking, with probability density functions for sensitivities (Se) and specificities (Sp) among cases and noncases equal to uniform distributions with a minimum of 0.7 and a maximum of 0.95 for sensitivities (0.9 and 0.99 respectively for specificities). We choose to correct for exposure misclassification with the argument type = exposure. We ask for 50000 replications (default is 1000). Don’t be shy with the number of iterations, episensr is fast.

The Se and Sp for cases (seca, spca) are given as a list with its first element referring to the type of distribution (choice between constant, uniform, triangular, trapezoidal, logit-logistic, and logit-normal) and the second element giving the distribution parameters (min and max for uniform distribution). By avoiding to provide information on the noncases (seexp, spexp), we are referring to a nondifferential misclassification.

set.seed(123)
smoke.nd <- probsens(matrix(c(215, 1449, 668, 4296),
dimnames = list(c("BC+", "BC-"), c("Smoke+", "Smoke-")),
nrow = 2, byrow = TRUE),
type = "exposure",
reps = 50000,
seca.parms = list("uniform", c(.7, .95)),
spca.parms = list("uniform", c(.9, .99)))
smoke.nd
## --Observed data--
##          Outcome: BC+
##        Comparing: Smoke+ vs. Smoke-
##
##     Smoke+ Smoke-
## BC+    215   1449
## BC-    668   4296
##
##                                         2.5%     97.5%
##  Observed Relative Risk: 0.9653825 0.8523766 1.0933704
##     Observed Odds Ratio: 0.9542406 0.8092461 1.1252141
## ---
##                                                  Median 2.5th percentile
##            Relative Risk -- systematic error: 0.9431650        0.8817325
##               Odds Ratio -- systematic error: 0.9253996        0.8478414
## Relative Risk -- systematic and random error: 0.9359816        0.8175818
##    Odds Ratio -- systematic and random error: 0.9162763        0.7664183
##                                               97.5th percentile
##            Relative Risk -- systematic error:         0.9612154
##               Odds Ratio -- systematic error:         0.9487841
## Relative Risk -- systematic and random error:         1.0690389
##    Odds Ratio -- systematic and random error:         1.0923026

The output gives the 2X2 table, the observed measures of association, and the corrected measures of association.

We saved the probsens analysis in a new object smoke.nd. We can see its elements with the function str():

str(smoke.nd)
## List of 4
##  $obs.data : num [1:2, 1:2] 215 668 1449 4296 ## ..- attr(*, "dimnames")=List of 2 ## .. ..$ : chr [1:2] "BC+" "BC-"
##   .. ..$: chr [1:2] "Smoke+" "Smoke-" ##$ obs.measures: num [1:2, 1:3] 0.965 0.954 0.852 0.809 1.093 ...
##   ..- attr(*, "dimnames")=List of 2
##   .. ..$: chr [1:2] " Observed Relative Risk:" " Observed Odds Ratio:" ## .. ..$ : chr [1:3] " " "2.5%" "97.5%"
##  $adj.measures: num [1:4, 1:3] 0.943 0.925 0.936 0.916 0.882 ... ## ..- attr(*, "dimnames")=List of 2 ## .. ..$ : chr [1:4] "           Relative Risk -- systematic error:" "              Odds Ratio -- systematic error:" "Relative Risk -- systematic and random error:" "   Odds Ratio -- systematic and random error:"
##   .. ..$: chr [1:3] "Median" "2.5th percentile" "97.5th percentile" ##$ sim.df      :'data.frame':    50000 obs. of  12 variables:
##   ..$seca : num [1:50000] 0.772 0.897 0.802 0.921 0.935 ... ## ..$ seexp  : num [1:50000] 0.772 0.897 0.802 0.921 0.935 ...
##   ..$spca : num [1:50000] 0.919 0.94 0.912 0.943 0.965 ... ## ..$ spexp  : num [1:50000] 0.919 0.94 0.912 0.943 0.965 ...
##   ..$A1 : num [1:50000] 117 137 95 139 174 ... ## ..$ B1     : num [1:50000] 1547 1527 1569 1525 1490 ...
##   ..$C1 : num [1:50000] 386 442 321 446 548 ... ## ..$ D1     : num [1:50000] 4578 4522 4643 4518 4416 ...
##   ..$corr.RR: num [1:50000] 0.918 0.94 0.905 0.943 0.954 ... ## ..$ corr.OR: num [1:50000] 0.893 0.922 0.877 0.925 0.94 ...
##   ..$tot.RR : num [1:50000] 0.903 1.067 0.854 1.056 0.999 ... ## ..$ tot.OR : num [1:50000] 0.873 1.09 0.812 1.075 0.999 ...
##  - attr(*, "class")= chr [1:2] "episensr" "list"

smoke.nd is a list of 4 elements where different information on the analysis done are saved. We have smoke.nd$obs.data where we have the observed 2X2 table, smoke.nd$obs.measures (the observed measures of association), smoke.nd$adj.measures (the adjusted measures of association), and smoke.nd$sim.df, a data frame with the simulated variables from each replication, like the Se and Sp, the 4 cells of the adjusted 2X2 table, and the adjusted measures. We can plot the Se prior distribution (and not forgetting to discard the draws that led to negative adjustments).

hist(smoke.nd$sim.df[!is.na(smoke.nd$sim.df$corr.RR), ]$seca,
breaks = seq(0.65, 1, 0.01),
col = "lightgreen",
main = NULL,
xlab = "Sensitivity for Cases")

## Probabilistic Sensitivity Analysis for Uncontrolled Confounding

Let’s illustrate this function with this example from Modern Epidemiology by Rothman, Greenland & Lash, where the association between occupational resins exposure and lung cancer mortality is studied, together with the presence of an unmeasured potential confounder, smoking (Greenland et al., 1994).

Resins exposed Resins unexposed
Cases 45 94
Controls 257 945

Prior probability distributions are given to each bias parameters. Prevalences of smoking in those exposed to resins, and of smoking in those unexposed to resins receive prior distributions that are uniform between 0.40 and 0.70. Prior distribution for the odds ratio associating smoking with lung cancer mortality is log-normal with 95% limits of 5 and 15. The mean of this distribution is [ln(15) + ln(5)] / 2 = 2.159, and its standard deviation is [ln(15) - ln(5)] / 3.92 = 0.28.

set.seed(123)
probsens.conf(matrix(c(45, 94, 257, 945),
dimnames = list(c("Cases+", "Cases-"), c("Res+", "Res-")),
nrow = 2, byrow = TRUE),
reps = 50000,
prev.exp = list("uniform", c(.4, .7)),
prev.nexp = list("uniform", c(.4, .7)),
risk = list("log-normal", c(2.159, .28)))
## --Observed data--
##          Outcome: Cases+
##        Comparing: Res+ vs. Res-
##
##        Res+ Res-
## Cases+   45   94
## Cases-  257  945
##
##                                      2.5%    97.5%
## Observed Relative Risk: 1.646999 1.182429 2.294094
##    Observed Odds Ratio: 1.760286 1.202457 2.576898
## ---
##                                            Median 2.5th percentile
##            RR (SMR) -- systematic error: 1.591116         1.197359
## RR (SMR) -- systematic and random error: 1.586537         1.025504
##            OR (SMR) -- systematic error: 1.761771         1.246469
## OR (SMR) -- systematic and random error: 1.758665         1.050075
##                                          97.5th percentile
##            RR (SMR) -- systematic error:          2.098129
## RR (SMR) -- systematic and random error:          2.459242
##            OR (SMR) -- systematic error:          2.485622
## OR (SMR) -- systematic and random error:          2.956335

The median adjusted OR is 1.76 [1.25,2.49].

## Bootstrapping

Selection and misclassification bias models can be bootstrapped in order to get confidence interval on the adjusted association parameter. We can use the ICU dataset from Hosmer and Lemeshow Applied Logistic Regression textbook as an example. The replicates that give negative cells in the adjusted 2X2 table are silently ignored and the number of effective bootstrap replicates is provided in the output. Ten thousands bootstrap samples are a good number for testing everything runs smoothly. But again, don’t be afraid of running more, like 100,000 bootstrap samples.

library(aplore3)  # to get ICU data
data(icu)

## First run the model
misclass_eval <- misclassification(icu$sta, icu$inf,
type = "exposure",
bias_parms = c(.75, .85, .9, .95))
misclass_eval
## --Observed data--
##          Outcome: Died
##        Comparing: Yes vs. No
##
##        exposed
## case    Yes  No
##   Died   24  16
##   Lived  60 100
##
##                                      2.5%    97.5%
## Observed Relative Risk: 2.071429 1.175157 3.651272
##    Observed Odds Ratio: 2.500000 1.230418 5.079573
## ---
##                                                                2.5%
## Misclassification Bias Corrected Relative Risk:  3.627845
##    Misclassification Bias Corrected Odds Ratio:  4.871795  1.235506
##                                                     97.5%
## Misclassification Bias Corrected Relative Risk:
##    Misclassification Bias Corrected Odds Ratio: 19.210258
## Then bootstrap it
set.seed(123)
misclass_boot <- boot.bias(misclass_eval, R = 10000)
misclass_boot
## 95 % confidence interval of the bias adjusted measures:
##    RR: 1.012453 11.50197
##    OR: 1.140324 18.58507
## ---
##  Based on 9595 bootstrap replicates

Bootstrap replicates can also be plotted, with the confidence interval shown as dotted lines.

plot(misclass_boot, "rr")