├── .github ├── .gitignore └── workflows │ ├── R-CMD-check.yaml │ └── pkgdown.yaml ├── .travis.yml ├── _pkgdown.yml ├── .gitignore ├── LICENSE ├── data ├── exdata_rr.rda └── exdata_continuous.rda ├── tests ├── testthat.R └── testthat │ ├── test-tip-helpers.R │ └── test-obp-helpers.R ├── man ├── figures │ └── logo.png ├── pipe.Rd ├── observed_bias_order.Rd ├── e_value.Rd ├── exdata_rr.Rd ├── exdata_continuous.Rd ├── observed_covariate_e_value.Rd ├── observed_bias_tip.Rd ├── adjust_rr.Rd ├── adjust_rr_with_binary.Rd ├── r_value.Rd ├── tip_rr_with_binary.Rd ├── observed_bias_tbl.Rd ├── adjust_coef.Rd ├── tipr-package.Rd ├── adjust_hr_with_binary.Rd ├── adjust_or_with_binary.Rd ├── adjust_or.Rd ├── adjust_hr.Rd ├── tip_rr.Rd ├── adjust_coef_with_binary.Rd ├── tip_or_with_binary.Rd ├── tip_hr_with_binary.Rd ├── tip_hr.Rd ├── tip_coef.Rd ├── tip_coef_with_r2.Rd ├── adjust_coef_with_r2.Rd ├── tip_or.Rd ├── tip.Rd └── tip_with_binary.Rd ├── cran-comments.md ├── .Rbuildignore ├── inst └── CITATION ├── tipr.Rproj ├── R ├── exdata_rr.R ├── exdata_continuous.R ├── e_value.R ├── observed_bias_order.R ├── tipr-package.R ├── observed_bias_tip.R ├── r_value.R ├── observed_covariate_e_value.R ├── utils.R ├── observed_bias_tbl.R ├── observed-bias-plot-helpers.R ├── adjust_coef_with_r2.R ├── tip_coef_with_r2.R ├── tip_coef.R ├── tip-helpers.R ├── tip.R ├── tip_with_binary.R └── adjust_coefficient.R ├── NAMESPACE ├── LICENSE.md ├── data-raw └── exdata.R ├── DESCRIPTION ├── NEWS.md ├── CODE_OF_CONDUCT.md ├── README.Rmd └── README.md /.github/.gitignore: -------------------------------------------------------------------------------- 1 | *.html 2 | -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: R 2 | cache: packages 3 | sudo: false 4 | -------------------------------------------------------------------------------- /_pkgdown.yml: -------------------------------------------------------------------------------- 1 | url: ~ 2 | template: 3 | bootstrap: 5 4 | 5 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | .Rproj.user* 2 | *.Rhistory 3 | .Rproj.user 4 | docs 5 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | YEAR: 2022 2 | COPYRIGHT HOLDER: Lucy D'Agostino McGowan 3 | -------------------------------------------------------------------------------- /data/exdata_rr.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-causal/tipr/HEAD/data/exdata_rr.rda -------------------------------------------------------------------------------- /tests/testthat.R: -------------------------------------------------------------------------------- 1 | library(testthat) 2 | library(tipr) 3 | 4 | test_check("tipr") 5 | -------------------------------------------------------------------------------- /man/figures/logo.png: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-causal/tipr/HEAD/man/figures/logo.png -------------------------------------------------------------------------------- /data/exdata_continuous.rda: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/r-causal/tipr/HEAD/data/exdata_continuous.rda -------------------------------------------------------------------------------- /cran-comments.md: -------------------------------------------------------------------------------- 1 | ## R CMD check results 2 | 3 | 0 errors | 0 warnings | 0 notes 4 | 5 | ## Reverse dependencies 6 | 7 | There are no reverse dependencies. 8 | 9 | -------------------------------------------------------------------------------- /man/pipe.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/utils.R 3 | \name{\%>\%} 4 | \alias{\%>\%} 5 | \title{Pipe operator} 6 | \usage{ 7 | lhs \%>\% rhs 8 | } 9 | \description{ 10 | Pipe operator 11 | } 12 | \keyword{internal} 13 | -------------------------------------------------------------------------------- /.Rbuildignore: -------------------------------------------------------------------------------- 1 | ^.*\.Rproj$ 2 | ^\.Rproj\.user$ 3 | ^\.travis.yml$ 4 | ^\.Rhistory$ 5 | ^README.Rmd$ 6 | ^cran-comments\.md$ 7 | ^CRAN-RELEASE$ 8 | ^CRAN-SUBMISSION$ 9 | ^paper\.md$ 10 | ^paper\.bib$ 11 | ^_pkgdown\.yml$ 12 | ^docs$ 13 | ^pkgdown$ 14 | ^\.github$ 15 | ^LICENSE\.md$ 16 | ^CODE_OF_CONDUCT\.md$ 17 | ^data-raw$ 18 | -------------------------------------------------------------------------------- /inst/CITATION: -------------------------------------------------------------------------------- 1 | bibentry( 2 | "Article", 3 | title = "tipr: An R package for sensitivity analyses for unmeasured confounders", 4 | author = "Lucy D'Agostino McGowan", 5 | year = 2022, 6 | journal = "Journal of Open Source Software", 7 | volume = 7, 8 | number = 77, 9 | pages = 4495, 10 | doi = "10.21105/joss.04495" 11 | ) 12 | -------------------------------------------------------------------------------- /tipr.Rproj: -------------------------------------------------------------------------------- 1 | Version: 1.0 2 | 3 | RestoreWorkspace: Default 4 | SaveWorkspace: Default 5 | AlwaysSaveHistory: Default 6 | 7 | EnableCodeIndexing: Yes 8 | UseSpacesForTab: Yes 9 | NumSpacesForTab: 2 10 | Encoding: UTF-8 11 | 12 | RnwWeave: knitr 13 | LaTeX: pdfLaTeX 14 | 15 | AutoAppendNewline: Yes 16 | StripTrailingWhitespace: Yes 17 | 18 | BuildType: Package 19 | PackageUseDevtools: Yes 20 | PackageInstallArgs: --no-multiarch --with-keep.source 21 | -------------------------------------------------------------------------------- /R/exdata_rr.R: -------------------------------------------------------------------------------- 1 | #' Example Data (Risk Ratio) 2 | #' 3 | #' A data set simulated with two Normally distributed confounders, one 4 | #' "measured" and one "unmeasured", an exposure, and outcome. The "true" causal 5 | #' effect of the exposure on the outcome, accounting for both the measured 6 | #' and unmeasured confounders, should be 0. 7 | #' 8 | #' @format A data frame with 2,000 rows and 4 columns: 9 | #' * `.unmeasured_confounder`: A simulated unmeasured confounder 10 | #' * `measured_confounder`: A simulated measured confounder 11 | #' * `exposure` 12 | #' * `outcome` 13 | #' 14 | "exdata_rr" 15 | -------------------------------------------------------------------------------- /man/observed_bias_order.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/observed_bias_order.R 3 | \name{observed_bias_order} 4 | \alias{observed_bias_order} 5 | \title{Order observed bias data frame for plotting} 6 | \usage{ 7 | observed_bias_order(d, by) 8 | } 9 | \arguments{ 10 | \item{d}{Observed bias data frame. Must have columns \code{dropped} and \code{type}} 11 | 12 | \item{by}{Character. Variable in \code{d} to order by.} 13 | } 14 | \value{ 15 | Data frame in the correct order 16 | } 17 | \description{ 18 | Order observed bias data frame for plotting 19 | } 20 | -------------------------------------------------------------------------------- /R/exdata_continuous.R: -------------------------------------------------------------------------------- 1 | #' Example Data (Continuous Outcome) 2 | #' 3 | #' A data set simulated with two Normally distributed confounders, one 4 | #' "measured" and one "unmeasured", an exposure, and outcome. The "true" causal 5 | #' effect of the exposure on the outcome, accounting for both the measured 6 | #' and unmeasured confounders, should be 0. 7 | #' 8 | #' @format A data frame with 2,000 rows and 4 columns: 9 | #' * `.unmeasured_confounder`: A simulated unmeasured confounder 10 | #' * `measured_confounder`: A simulated measured confounder 11 | #' * `exposure` 12 | #' * `outcome` 13 | #' 14 | "exdata_continuous" 15 | -------------------------------------------------------------------------------- /R/e_value.R: -------------------------------------------------------------------------------- 1 | #' Calculate an E-value 2 | #' 3 | #' @param effect_observed Numeric positive value. Observed exposure - outcome effect 4 | #' (assumed to be the exponentiated coefficient, so a risk ratio, odds 5 | #' ratio, or hazard ratio). This can be the point estimate, lower confidence 6 | #' bound, or upper confidence bound. 7 | #' 8 | #' @return Numeric value 9 | #' @export 10 | #' 11 | #' @examples 12 | #' e_value(0.9) 13 | #' e_value(1.3) 14 | e_value <- function(effect_observed) { 15 | if (effect_observed <= 1) { 16 | effect_observed <- 1 / effect_observed 17 | } 18 | effect_observed + sqrt(effect_observed * (effect_observed - 1)) 19 | } 20 | -------------------------------------------------------------------------------- /man/e_value.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/e_value.R 3 | \name{e_value} 4 | \alias{e_value} 5 | \title{Calculate an E-value} 6 | \usage{ 7 | e_value(effect_observed) 8 | } 9 | \arguments{ 10 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome effect 11 | (assumed to be the exponentiated coefficient, so a risk ratio, odds 12 | ratio, or hazard ratio). This can be the point estimate, lower confidence 13 | bound, or upper confidence bound.} 14 | } 15 | \value{ 16 | Numeric value 17 | } 18 | \description{ 19 | Calculate an E-value 20 | } 21 | \examples{ 22 | e_value(0.9) 23 | e_value(1.3) 24 | } 25 | -------------------------------------------------------------------------------- /R/observed_bias_order.R: -------------------------------------------------------------------------------- 1 | #' Order observed bias data frame for plotting 2 | #' 3 | #' @param d Observed bias data frame. Must have columns `dropped` and `type` 4 | #' @param by Character. Variable in `d` to order by. 5 | #' 6 | #' @return Data frame in the correct order 7 | #' @export 8 | observed_bias_order <- function(d, by) { 9 | grps_ <- d[d$type == "group" & !grepl("Hypothetical", d$dropped), ] 10 | grps <- which(d$type == "group" & !grepl("Hypothetical", d$dropped)) 11 | grps <- grps[order(grps_[[by]], decreasing = TRUE)] 12 | 13 | hypo_ <- d[d$type == "tip", ] 14 | hypo <- which(d$type == "tip") 15 | hypo <- hypo[order(hypo_[[by]])] 16 | 17 | d <- d[c(hypo, grps, order(d[[by]][d$type == "covariate"], decreasing = TRUE)), ] 18 | d$dropped <- factor(d$dropped, 19 | levels = d$dropped) 20 | d 21 | } 22 | -------------------------------------------------------------------------------- /man/exdata_rr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/exdata_rr.R 3 | \docType{data} 4 | \name{exdata_rr} 5 | \alias{exdata_rr} 6 | \title{Example Data (Risk Ratio)} 7 | \format{ 8 | A data frame with 2,000 rows and 4 columns: 9 | \itemize{ 10 | \item \code{.unmeasured_confounder}: A simulated unmeasured confounder 11 | \item \code{measured_confounder}: A simulated measured confounder 12 | \item \code{exposure} 13 | \item \code{outcome} 14 | } 15 | } 16 | \usage{ 17 | exdata_rr 18 | } 19 | \description{ 20 | A data set simulated with two Normally distributed confounders, one 21 | "measured" and one "unmeasured", an exposure, and outcome. The "true" causal 22 | effect of the exposure on the outcome, accounting for both the measured 23 | and unmeasured confounders, should be 0. 24 | } 25 | \keyword{datasets} 26 | -------------------------------------------------------------------------------- /man/exdata_continuous.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/exdata_continuous.R 3 | \docType{data} 4 | \name{exdata_continuous} 5 | \alias{exdata_continuous} 6 | \title{Example Data (Continuous Outcome)} 7 | \format{ 8 | A data frame with 2,000 rows and 4 columns: 9 | \itemize{ 10 | \item \code{.unmeasured_confounder}: A simulated unmeasured confounder 11 | \item \code{measured_confounder}: A simulated measured confounder 12 | \item \code{exposure} 13 | \item \code{outcome} 14 | } 15 | } 16 | \usage{ 17 | exdata_continuous 18 | } 19 | \description{ 20 | A data set simulated with two Normally distributed confounders, one 21 | "measured" and one "unmeasured", an exposure, and outcome. The "true" causal 22 | effect of the exposure on the outcome, accounting for both the measured 23 | and unmeasured confounders, should be 0. 24 | } 25 | \keyword{datasets} 26 | -------------------------------------------------------------------------------- /man/observed_covariate_e_value.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/observed_covariate_e_value.R 3 | \name{observed_covariate_e_value} 4 | \alias{observed_covariate_e_value} 5 | \title{Calculate the Observed Covariate E-value} 6 | \usage{ 7 | observed_covariate_e_value(lb, ub, lb_adj, ub_adj, transform = NULL) 8 | } 9 | \arguments{ 10 | \item{lb}{Numeric. The lower bound of the full model} 11 | 12 | \item{ub}{Numeric. The upper bound of the full model} 13 | 14 | \item{lb_adj}{Numeric. The lower bound of the adjusted model} 15 | 16 | \item{ub_adj}{Numeric. The upper bound of the adjusted model} 17 | 18 | \item{transform}{Character. If your effect is an odds ratio or hazard ratio, this will 19 | perform the transformation suggested by VanderWeele and Ding. Allowed values are: 20 | \itemize{ 21 | \item "OR" 22 | \item "HR" 23 | }} 24 | } 25 | \value{ 26 | The Observed Covariate E-value 27 | } 28 | \description{ 29 | Calculate the Observed Covariate E-value 30 | } 31 | -------------------------------------------------------------------------------- /R/tipr-package.R: -------------------------------------------------------------------------------- 1 | #' tipr 2 | #' 3 | #' The tipr package. 4 | #' 5 | #' @references 6 | #' 7 | #' D'Agostino McGowan, L, (2022). tipr: An R package for sensitivity analyses 8 | #' for unmeasured confounders. Journal of Open Source Software, 7(77), 4495. 9 | #' 10 | #' D’Agostino McGowan, L. (2022). Sensitivity Analyses for Unmeasured 11 | #' Confounders. Current Epidemiology Reports, 9(4), 361-375. 12 | #' 13 | #' VanderWeele, TJ, and Peng D (2017). Sensitivity Analysis in Observational 14 | #' Research: Introducing the E-Value. Ann Intern Med, 167(4), 268–74. 15 | #' 16 | #' Cinelli, C, & Hazlett, C (2020). Making sense of sensitivity: Extending 17 | #' omitted variable bias. Journal of the Royal Statistical Society: Series B 18 | #' (Statistical Methodology), 82(1), 39–67. 19 | #' 20 | #' Lin, DY, Psaty, BM, & Kronmal, RA. (1998). Assessing the sensitivity 21 | #' of regression results to unmeasured confounders in observational studies. 22 | #' Biometrics, 54(3), 948–963. 23 | #' 24 | #' 25 | #' @importFrom purrr %||% 26 | #' @importFrom purrr %>% 27 | #' @keywords internal 28 | "_PACKAGE" 29 | -------------------------------------------------------------------------------- /NAMESPACE: -------------------------------------------------------------------------------- 1 | # Generated by roxygen2: do not edit by hand 2 | 3 | export("%>%") 4 | export(adjust_coef) 5 | export(adjust_coef_with_binary) 6 | export(adjust_coef_with_continuous) 7 | export(adjust_coef_with_r2) 8 | export(adjust_hr) 9 | export(adjust_hr_with_binary) 10 | export(adjust_hr_with_continuous) 11 | export(adjust_or) 12 | export(adjust_or_with_binary) 13 | export(adjust_or_with_continuous) 14 | export(adjust_rr) 15 | export(adjust_rr_with_binary) 16 | export(adjust_rr_with_continuous) 17 | export(e_value) 18 | export(observed_bias_order) 19 | export(observed_bias_tbl) 20 | export(observed_bias_tip) 21 | export(observed_covariate_e_value) 22 | export(r_value) 23 | export(tip) 24 | export(tip_b) 25 | export(tip_c) 26 | export(tip_coef) 27 | export(tip_coef_with_continuous) 28 | export(tip_coef_with_r2) 29 | export(tip_hr) 30 | export(tip_hr_with_binary) 31 | export(tip_hr_with_continuous) 32 | export(tip_or) 33 | export(tip_or_with_binary) 34 | export(tip_or_with_continuous) 35 | export(tip_rr) 36 | export(tip_rr_with_continuous) 37 | export(tip_with_binary) 38 | export(tip_with_continuous) 39 | importFrom(purrr,"%>%") 40 | importFrom(purrr,"%||%") 41 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | # MIT License 2 | 3 | Copyright (c) 2022 Lucy D'Agostino McGowan 4 | 5 | Permission is hereby granted, free of charge, to any person obtaining a copy 6 | of this software and associated documentation files (the "Software"), to deal 7 | in the Software without restriction, including without limitation the rights 8 | to use, copy, modify, merge, publish, distribute, sublicense, and/or sell 9 | copies of the Software, and to permit persons to whom the Software is 10 | furnished to do so, subject to the following conditions: 11 | 12 | The above copyright notice and this permission notice shall be included in all 13 | copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR 16 | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, 17 | FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE 18 | AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER 19 | LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, 20 | OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE 21 | SOFTWARE. 22 | -------------------------------------------------------------------------------- /R/observed_bias_tip.R: -------------------------------------------------------------------------------- 1 | #' Create a data frame to combine with an observed bias data frame demonstrating a hypothetical unmeasured confounder 2 | #' 3 | #' @param tip Numeric. Value you would like to tip to. 4 | #' @param point_estimate Numeric. Result estimate from the full model. 5 | #' @param lb Numeric. Result lower bound from the full model. 6 | #' @param ub Numeric. Result upper bound from the full model. 7 | #' @param tip_desc Character. A description of the tipping point. 8 | #' 9 | #' @return A data frame with five columns: 10 | #' * `dropped`: the input from `tip_desc` 11 | #' * `type`: Explanation of `dropped`, here `tip` to clarify that this was calculated as a tipping point. 12 | #' * `point_estimate`: the shifted point estimate 13 | #' * `lb`: the shifted lower bound 14 | #' * `ub`: the shifted upper bound 15 | #' @export 16 | #' 17 | observed_bias_tip <- function(tip, point_estimate, lb, ub, tip_desc = "Hypothetical unmeasured confounder") { 18 | shift <- 1 - tip 19 | tibble::tibble( 20 | dropped = tip_desc, 21 | type = "tip", 22 | point_estimate = point_estimate + shift, 23 | lb = lb + shift, 24 | ub = ub + shift 25 | ) 26 | } 27 | -------------------------------------------------------------------------------- /R/r_value.R: -------------------------------------------------------------------------------- 1 | #' Robustness value 2 | #' 3 | #' This function wraps the [`sensemakr::robustness_value()`] function 4 | #' 5 | #' @param effect_observed Numeric. Observed exposure - outcome effect from a 6 | #' regression model. This is the point estimate (beta coefficient) 7 | #' @param se Numeric. Standard error of the `effect_observed` in the previous parameter. 8 | #' @param df Numeric positive value. Residual degrees of freedom for the model 9 | #' used to estimate the observed exposure - outcome effect. This is the total 10 | #' number of observations minus the number of parameters estimated in your 11 | #' model. Often for models estimated with an intercept this is N - k - 1 12 | #' where k is the number of predictors in the model. 13 | #' @param ... Optional arguments passed to the [`sensemakr::robustness_value()`] 14 | #' function. 15 | #' @references Carlos Cinelli, Jeremy Ferwerda and Chad Hazlett (2021). 16 | #' sensemakr: Sensitivity Analysis 17 | #' Tools for Regression Models. R package version 0.1.4. 18 | #' https://CRAN.R-project.org/package=sensemakr 19 | #' 20 | #' @return Numeric. Robustness value 21 | #' @export 22 | #' 23 | #' @examples 24 | #' r_value(0.5, 0.1, 102) 25 | 26 | r_value <- function(effect_observed, se, df, ...) { 27 | as.numeric(sensemakr::robustness_value(effect_observed / se, dof = df, ...)) 28 | } 29 | -------------------------------------------------------------------------------- /man/observed_bias_tip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/observed_bias_tip.R 3 | \name{observed_bias_tip} 4 | \alias{observed_bias_tip} 5 | \title{Create a data frame to combine with an observed bias data frame demonstrating a hypothetical unmeasured confounder} 6 | \usage{ 7 | observed_bias_tip( 8 | tip, 9 | point_estimate, 10 | lb, 11 | ub, 12 | tip_desc = "Hypothetical unmeasured confounder" 13 | ) 14 | } 15 | \arguments{ 16 | \item{tip}{Numeric. Value you would like to tip to.} 17 | 18 | \item{point_estimate}{Numeric. Result estimate from the full model.} 19 | 20 | \item{lb}{Numeric. Result lower bound from the full model.} 21 | 22 | \item{ub}{Numeric. Result upper bound from the full model.} 23 | 24 | \item{tip_desc}{Character. A description of the tipping point.} 25 | } 26 | \value{ 27 | A data frame with five columns: 28 | \itemize{ 29 | \item \code{dropped}: the input from \code{tip_desc} 30 | \item \code{type}: Explanation of \code{dropped}, here \code{tip} to clarify that this was calculated as a tipping point. 31 | \item \code{point_estimate}: the shifted point estimate 32 | \item \code{lb}: the shifted lower bound 33 | \item \code{ub}: the shifted upper bound 34 | } 35 | } 36 | \description{ 37 | Create a data frame to combine with an observed bias data frame demonstrating a hypothetical unmeasured confounder 38 | } 39 | -------------------------------------------------------------------------------- /man/adjust_rr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_coefficient.R 3 | \name{adjust_rr} 4 | \alias{adjust_rr} 5 | \alias{adjust_rr_with_continuous} 6 | \title{Adjust an observed risk ratio for a normally distributed 7 | confounder} 8 | \usage{ 9 | adjust_rr( 10 | effect_observed, 11 | exposure_confounder_effect, 12 | confounder_outcome_effect, 13 | verbose = TRUE 14 | ) 15 | 16 | adjust_rr_with_continuous( 17 | effect_observed, 18 | exposure_confounder_effect, 19 | confounder_outcome_effect, 20 | verbose = TRUE 21 | ) 22 | } 23 | \arguments{ 24 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome risk ratio. 25 | This can be the point estimate, lower confidence bound, or upper 26 | confidence bound.} 27 | 28 | \item{exposure_confounder_effect}{Numeric. Estimated difference in scaled means between the 29 | unmeasured confounder in the exposed population and unexposed population} 30 | 31 | \item{confounder_outcome_effect}{Numeric. Estimated relationship 32 | between the unmeasured confounder and the outcome.} 33 | 34 | \item{verbose}{Logical. Indicates whether to print informative message. 35 | Default: \code{TRUE}} 36 | } 37 | \value{ 38 | Data frame. 39 | } 40 | \description{ 41 | Adjust an observed risk ratio for a normally distributed 42 | confounder 43 | } 44 | \examples{ 45 | adjust_rr(1.2, 0.5, 1.1) 46 | } 47 | -------------------------------------------------------------------------------- /man/adjust_rr_with_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_coefficient.R 3 | \name{adjust_rr_with_binary} 4 | \alias{adjust_rr_with_binary} 5 | \title{Adjust an observed risk ratio with a binary confounder} 6 | \usage{ 7 | adjust_rr_with_binary( 8 | effect_observed, 9 | exposed_confounder_prev, 10 | unexposed_confounder_prev, 11 | confounder_outcome_effect, 12 | verbose = getOption("tipr.verbose", TRUE) 13 | ) 14 | } 15 | \arguments{ 16 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome risk ratio. 17 | This can be the point estimate, lower confidence bound, or upper 18 | confidence bound.} 19 | 20 | \item{exposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 21 | unmeasured confounder in the exposed population} 22 | 23 | \item{unexposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 24 | unmeasured confounder in the unexposed population} 25 | 26 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 27 | between the unmeasured confounder and the outcome} 28 | 29 | \item{verbose}{Logical. Indicates whether to print informative message. 30 | Default: \code{TRUE}} 31 | } 32 | \value{ 33 | Data frame. 34 | } 35 | \description{ 36 | Adjust an observed risk ratio with a binary confounder 37 | } 38 | \examples{ 39 | adjust_rr_with_binary(1.1, 0.5, 0.3, 1.3) 40 | } 41 | -------------------------------------------------------------------------------- /man/r_value.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/r_value.R 3 | \name{r_value} 4 | \alias{r_value} 5 | \title{Robustness value} 6 | \usage{ 7 | r_value(effect_observed, se, df, ...) 8 | } 9 | \arguments{ 10 | \item{effect_observed}{Numeric. Observed exposure - outcome effect from a 11 | regression model. This is the point estimate (beta coefficient)} 12 | 13 | \item{se}{Numeric. Standard error of the \code{effect_observed} in the previous parameter.} 14 | 15 | \item{df}{Numeric positive value. Residual degrees of freedom for the model 16 | used to estimate the observed exposure - outcome effect. This is the total 17 | number of observations minus the number of parameters estimated in your 18 | model. Often for models estimated with an intercept this is N - k - 1 19 | where k is the number of predictors in the model.} 20 | 21 | \item{...}{Optional arguments passed to the \code{\link[sensemakr:robustness_value]{sensemakr::robustness_value()}} 22 | function.} 23 | } 24 | \value{ 25 | Numeric. Robustness value 26 | } 27 | \description{ 28 | This function wraps the \code{\link[sensemakr:robustness_value]{sensemakr::robustness_value()}} function 29 | } 30 | \examples{ 31 | r_value(0.5, 0.1, 102) 32 | } 33 | \references{ 34 | Carlos Cinelli, Jeremy Ferwerda and Chad Hazlett (2021). 35 | sensemakr: Sensitivity Analysis 36 | Tools for Regression Models. R package version 0.1.4. 37 | https://CRAN.R-project.org/package=sensemakr 38 | } 39 | -------------------------------------------------------------------------------- /.github/workflows/R-CMD-check.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/master/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | 9 | name: R-CMD-check 10 | 11 | jobs: 12 | R-CMD-check: 13 | runs-on: ${{ matrix.config.os }} 14 | 15 | name: ${{ matrix.config.os }} (${{ matrix.config.r }}) 16 | 17 | strategy: 18 | fail-fast: false 19 | matrix: 20 | config: 21 | - {os: macOS-latest, r: 'release'} 22 | - {os: windows-latest, r: 'release'} 23 | - {os: ubuntu-latest, r: 'devel', http-user-agent: 'release'} 24 | - {os: ubuntu-latest, r: 'release'} 25 | - {os: ubuntu-latest, r: 'oldrel-1'} 26 | 27 | env: 28 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 29 | R_KEEP_PKG_SOURCE: yes 30 | 31 | steps: 32 | - uses: actions/checkout@v2 33 | 34 | - uses: r-lib/actions/setup-pandoc@v2 35 | 36 | - uses: r-lib/actions/setup-r@v2 37 | with: 38 | r-version: ${{ matrix.config.r }} 39 | http-user-agent: ${{ matrix.config.http-user-agent }} 40 | use-public-rspm: true 41 | 42 | - uses: r-lib/actions/setup-r-dependencies@v2 43 | with: 44 | extra-packages: rcmdcheck 45 | 46 | - uses: r-lib/actions/check-r-package@v2 47 | -------------------------------------------------------------------------------- /data-raw/exdata.R: -------------------------------------------------------------------------------- 1 | library(tidyverse) 2 | 3 | set.seed(930) 4 | 5 | n <- 1000 6 | 7 | ## Continuous outcome ---- 8 | exdata_continuous <- tibble( 9 | .unmeasured_confounder = c(rnorm(n), rnorm(n, 0.5)), 10 | measured_confounder = c(rnorm(n), rnorm(n, 0.5)), 11 | exposure = rep(c(0, 1), each = n), 12 | outcome = measured_confounder + .unmeasured_confounder + rnorm(n * 2) 13 | ) 14 | 15 | 16 | lm(outcome ~ exposure + measured_confounder, data = exdata_continuous) 17 | exdata_continuous %>% 18 | group_by(exposure) %>% 19 | summarise(m = mean(.unmeasured_confounder)) %>% 20 | pivot_wider(names_from = exposure, 21 | values_from = m, 22 | names_prefix = "x_") %>% 23 | summarise(estimate = x_1 - x_0) 24 | 25 | usethis::use_data(exdata_continuous) 26 | 27 | ## Risk ratio ---- 28 | 29 | set.seed(930) 30 | 31 | exdata_rr <- tibble( 32 | .unmeasured_confounder = c(rnorm(n), rnorm(n, 0.5)), 33 | measured_confounder = c(rnorm(n), rnorm(n, 0.5)), 34 | exposure = rep(c(0, 1), each = n), 35 | outcome = rbinom(n * 2, 1, 36 | pmin(exp((-4 + measured_confounder + .unmeasured_confounder)), 1) 37 | ) 38 | ) 39 | 40 | sum(exdata_rr$outcome) 41 | 42 | glm(outcome ~ exposure + measured_confounder, data = exdata_rr, family = poisson(link = "log")) 43 | glm(outcome ~ exposure + measured_confounder + .unmeasured_confounder, data = exdata_rr, family = poisson(link = "log")) 44 | 45 | usethis::use_data(exdata_rr, overwrite = TRUE) 46 | 47 | -------------------------------------------------------------------------------- /.github/workflows/pkgdown.yaml: -------------------------------------------------------------------------------- 1 | # Workflow derived from https://github.com/r-lib/actions/tree/v2/examples 2 | # Need help debugging build failures? Start at https://github.com/r-lib/actions#where-to-find-help 3 | on: 4 | push: 5 | branches: [main, master] 6 | pull_request: 7 | branches: [main, master] 8 | release: 9 | types: [published] 10 | workflow_dispatch: 11 | 12 | name: pkgdown 13 | 14 | jobs: 15 | pkgdown: 16 | runs-on: ubuntu-latest 17 | # Only restrict concurrency for non-PR jobs 18 | concurrency: 19 | group: pkgdown-${{ github.event_name != 'pull_request' || github.run_id }} 20 | env: 21 | GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} 22 | steps: 23 | - uses: actions/checkout@v3 24 | 25 | - uses: r-lib/actions/setup-pandoc@v2 26 | 27 | - uses: r-lib/actions/setup-r@v2 28 | with: 29 | use-public-rspm: true 30 | 31 | - uses: r-lib/actions/setup-r-dependencies@v2 32 | with: 33 | extra-packages: any::pkgdown, local::. 34 | needs: website 35 | 36 | - name: Build site 37 | run: pkgdown::build_site_github_pages(new_process = FALSE, install = FALSE) 38 | shell: Rscript {0} 39 | 40 | - name: Deploy to GitHub pages 🚀 41 | if: github.event_name != 'pull_request' 42 | uses: JamesIves/github-pages-deploy-action@v4.4.1 43 | with: 44 | clean: false 45 | branch: gh-pages 46 | folder: docs 47 | -------------------------------------------------------------------------------- /man/tip_rr_with_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip_with_binary.R 3 | \name{tip_rr_with_binary} 4 | \alias{tip_rr_with_binary} 5 | \title{Tip an observed risk ratio with a binary confounder.} 6 | \usage{ 7 | tip_rr_with_binary( 8 | effect_observed, 9 | exposed_confounder_prev = NULL, 10 | unexposed_confounder_prev = NULL, 11 | confounder_outcome_effect = NULL, 12 | verbose = getOption("tipr.verbose", TRUE) 13 | ) 14 | } 15 | \arguments{ 16 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome risk ratio. 17 | This can be the point estimate, lower confidence bound, or upper 18 | confidence bound.} 19 | 20 | \item{exposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 21 | unmeasured confounder in the exposed population} 22 | 23 | \item{unexposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 24 | unmeasured confounder in the unexposed population} 25 | 26 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 27 | between the unmeasured confounder and the outcome} 28 | 29 | \item{verbose}{Logical. Indicates whether to print informative message. 30 | Default: \code{TRUE}} 31 | } 32 | \description{ 33 | Choose two of the following three to specify, and the third will be estimated: 34 | \itemize{ 35 | \item \code{exposed_confounder_prev} 36 | \item \code{unexposed_confounder_prev} 37 | \item \code{confounder_outcome_effect} 38 | } 39 | 40 | Alternatively, specify all three and the function will return the number of unmeasured 41 | confounders specified needed to tip the analysis. 42 | } 43 | -------------------------------------------------------------------------------- /R/observed_covariate_e_value.R: -------------------------------------------------------------------------------- 1 | #' Calculate the Observed Covariate E-value 2 | #' 3 | #' @param lb Numeric. The lower bound of the full model 4 | #' @param ub Numeric. The upper bound of the full model 5 | #' @param lb_adj Numeric. The lower bound of the adjusted model 6 | #' @param ub_adj Numeric. The upper bound of the adjusted model 7 | #' @param transform Character. If your effect is an odds ratio or hazard ratio, this will 8 | #' perform the transformation suggested by VanderWeele and Ding. Allowed values are: 9 | #' * "OR" 10 | #' * "HR" 11 | #' 12 | #' @return The Observed Covariate E-value 13 | #' @export 14 | observed_covariate_e_value <- function(lb, ub, lb_adj, ub_adj, transform = NULL) { 15 | if (!is.null(transform)) { 16 | if (!transform %in% c("OR", "HR")) { 17 | stop_cli(c( 18 | "x" = "You input `transform`: {transform}\n ", 19 | "i" = "The only valid `transform` inputs are 'HR' and 'OR'." 20 | )) 21 | } 22 | if (transform == "OR") { 23 | lb <- sqrt(lb) 24 | ub <- sqrt(ub) 25 | lb_adj <- sqrt(lb_adj) 26 | ub_adj <- sqrt(ub_adj) 27 | } 28 | if (transform == "HR") { 29 | lb <- hr_transform(lb) 30 | ub <- hr_transform(ub) 31 | lb_adj <- hr_transform(lb_adj) 32 | ub_adj <- hr_transform(ub_adj) 33 | } 34 | } 35 | b <- get_limiting_bound(lb, ub) 36 | b_adj <- get_limiting_bound_adj(b, lb_adj, ub_adj) 37 | if (b < 1) { 38 | b <- 1 / b 39 | b_adj <- 1 / b_adj 40 | } 41 | if (b < b_adj) { 42 | return((b_adj / b) + sqrt((b_adj / b) * ((b_adj / b) - 1))) 43 | } 44 | (b / b_adj) + sqrt((b / b_adj) * ((b / b_adj) - 1)) 45 | } 46 | -------------------------------------------------------------------------------- /man/observed_bias_tbl.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/observed_bias_tbl.R 3 | \name{observed_bias_tbl} 4 | \alias{observed_bias_tbl} 5 | \title{Create a data frame to assist with creating an observed bias plot} 6 | \usage{ 7 | observed_bias_tbl(ps_mod, outcome_mod, drop_list = NULL) 8 | } 9 | \arguments{ 10 | \item{ps_mod}{Model object for the propensity score model} 11 | 12 | \item{outcome_mod}{Model object for the outcome model} 13 | 14 | \item{drop_list}{Named list of covariates or groups of covariates to drop if 15 | \code{NULL}, will default to dropping each covariate one at a time.} 16 | } 17 | \value{ 18 | Data frame with the following columns: 19 | \itemize{ 20 | \item \code{dropped}: The covariate or group of covariates that were dropped 21 | \item \code{type}: Explanation of \code{dropped}, whether it refers to a single covariate (\code{covariate}) or a group of covariates (\code{group}) 22 | \item \code{ps_formula}: The new formula for the updated propensity score model 23 | \item \code{outcome_formula}: The new formula for the updated outcome model 24 | \item \code{ps_model}: The new model object for the updated propensity score model 25 | \item \code{p}: The updated propensity score 26 | } 27 | } 28 | \description{ 29 | Create a data frame to assist with creating an observed bias plot 30 | } 31 | \examples{ 32 | ps_mod <- glm(am ~ mpg + cyl + I(hp^2), data = mtcars) 33 | outcome_mod <- lm(qsec ~ am + hp + disp + wt, data = mtcars) 34 | observed_bias_tbl( 35 | ps_mod, 36 | outcome_mod, 37 | drop_list = list( 38 | group_one = c("mpg", "hp"), 39 | group_two = c("cyl", "wt") 40 | ) 41 | ) 42 | } 43 | -------------------------------------------------------------------------------- /R/utils.R: -------------------------------------------------------------------------------- 1 | #' Pipe operator 2 | #' 3 | #' @name %>% 4 | #' @rdname pipe 5 | #' @keywords internal 6 | #' @export 7 | #' @importFrom purrr %>% 8 | #' @usage lhs \%>\% rhs 9 | NULL 10 | 11 | stop_cli <- function(message, ..., .envir = parent.frame()) { 12 | cli::cli_abort( 13 | message, 14 | ..., 15 | .envir = .envir 16 | ) 17 | } 18 | 19 | warning_cli <- function(message, ..., .envir = parent.frame()) { 20 | cli::cli_warn( 21 | message, 22 | ..., 23 | .envir = .envir 24 | ) 25 | } 26 | 27 | message_cli <- function(message, ..., .envir = parent.frame()) { 28 | cli::cli_inform( 29 | message, 30 | ..., 31 | .envir = .envir 32 | ) 33 | } 34 | 35 | bullets <- function(..., code = TRUE) { 36 | x <- c(...) 37 | if (code) x <- glue::glue("`{x}`") 38 | names(x) <- rep("*", length(x)) 39 | 40 | x 41 | } 42 | 43 | `%||%` <- function(x, y) { 44 | if (is.null(x)) { 45 | y 46 | } else x 47 | } 48 | 49 | check_arguments <- function(what, ...) { 50 | arg_quos <- rlang::enquos(...) 51 | arg_names <- purrr::map_chr(arg_quos, rlang::quo_text) 52 | args <- list(...) 53 | 54 | if (not_enough(args)) { 55 | stop_cli(c( 56 | "x" = "`{what}` requires at least {count_required_args(args)} of the \\ 57 | following arguments specified:", 58 | bullets(arg_names) 59 | )) 60 | } 61 | 62 | invisible(TRUE) 63 | } 64 | 65 | count_required_args <- function(.args) { 66 | length(.args) - 1 67 | } 68 | 69 | count_non_null_args <- function(.args) { 70 | sum(purrr::map_lgl(.args, purrr::negate(is.null))) 71 | } 72 | 73 | not_enough <- function(.args) { 74 | count_non_null_args(.args) < count_required_args(.args) 75 | } 76 | 77 | -------------------------------------------------------------------------------- /man/adjust_coef.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_coefficient.R 3 | \name{adjust_coef} 4 | \alias{adjust_coef} 5 | \alias{adjust_coef_with_continuous} 6 | \title{Adjust an observed regression coefficient for a normally distributed 7 | confounder} 8 | \usage{ 9 | adjust_coef( 10 | effect_observed, 11 | exposure_confounder_effect, 12 | confounder_outcome_effect, 13 | verbose = getOption("tipr.verbose", TRUE) 14 | ) 15 | 16 | adjust_coef_with_continuous( 17 | effect_observed, 18 | exposure_confounder_effect, 19 | confounder_outcome_effect, 20 | verbose = getOption("tipr.verbose", TRUE) 21 | ) 22 | } 23 | \arguments{ 24 | \item{effect_observed}{Numeric. Observed exposure - outcome effect from a regression 25 | model. This can be the beta coefficient, the lower confidence bound of 26 | the beta coefficient, or the upper confidence bound of the beta 27 | coefficient.} 28 | 29 | \item{exposure_confounder_effect}{Numeric. Estimated difference in scaled means between the 30 | unmeasured confounder in the exposed population and unexposed population} 31 | 32 | \item{confounder_outcome_effect}{Numeric. Estimated relationship 33 | between the unmeasured confounder and the outcome.} 34 | 35 | \item{verbose}{Logical. Indicates whether to print informative message. 36 | Default: \code{TRUE}} 37 | } 38 | \value{ 39 | Data frame. 40 | } 41 | \description{ 42 | Adjust an observed regression coefficient for a normally distributed 43 | confounder 44 | } 45 | \examples{ 46 | ## Update an observed coefficient of 0.5 with an unmeasured confounder 47 | ## with a difference in scaled means between exposure groups of 0.2 48 | ## and coefficient of 0.3 49 | adjust_coef(0.5, 0.2, 0.3) 50 | } 51 | -------------------------------------------------------------------------------- /man/tipr-package.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tipr-package.R 3 | \docType{package} 4 | \name{tipr-package} 5 | \alias{tipr} 6 | \alias{tipr-package} 7 | \title{tipr} 8 | \description{ 9 | The tipr package. 10 | } 11 | \references{ 12 | D'Agostino McGowan, L, (2022). tipr: An R package for sensitivity analyses 13 | for unmeasured confounders. Journal of Open Source Software, 7(77), 4495. 14 | 15 | D’Agostino McGowan, L. (2022). Sensitivity Analyses for Unmeasured 16 | Confounders. Current Epidemiology Reports, 9(4), 361-375. 17 | 18 | VanderWeele, TJ, and Peng D (2017). Sensitivity Analysis in Observational 19 | Research: Introducing the E-Value. Ann Intern Med, 167(4), 268–74. 20 | 21 | Cinelli, C, & Hazlett, C (2020). Making sense of sensitivity: Extending 22 | omitted variable bias. Journal of the Royal Statistical Society: Series B 23 | (Statistical Methodology), 82(1), 39–67. 24 | 25 | Lin, DY, Psaty, BM, & Kronmal, RA. (1998). Assessing the sensitivity 26 | of regression results to unmeasured confounders in observational studies. 27 | Biometrics, 54(3), 948–963. 28 | } 29 | \seealso{ 30 | Useful links: 31 | \itemize{ 32 | \item \url{https://r-causal.github.io/tipr/} 33 | \item \url{https://github.com/r-causal/tipr} 34 | \item Report bugs at \url{https://github.com/r-causal/tipr/issues} 35 | } 36 | 37 | } 38 | \author{ 39 | \strong{Maintainer}: Lucy D'Agostino McGowan \email{lucydagostino@gmail.com} (\href{https://orcid.org/0000-0002-6983-2759}{ORCID}) 40 | 41 | Other contributors: 42 | \itemize{ 43 | \item Malcolm Barrett \email{malcolmbarrett@gmail.com} (\href{https://orcid.org/0000-0003-0299-5825}{ORCID}) [contributor] 44 | } 45 | 46 | } 47 | \keyword{internal} 48 | -------------------------------------------------------------------------------- /man/adjust_hr_with_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_coefficient.R 3 | \name{adjust_hr_with_binary} 4 | \alias{adjust_hr_with_binary} 5 | \title{Adjust an observed hazard ratio with a binary confounder} 6 | \usage{ 7 | adjust_hr_with_binary( 8 | effect_observed, 9 | exposed_confounder_prev, 10 | unexposed_confounder_prev, 11 | confounder_outcome_effect, 12 | verbose = getOption("tipr.verbose", TRUE), 13 | hr_correction = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome hazard ratio. 18 | This can be the point estimate, lower confidence bound, or upper 19 | confidence bound.} 20 | 21 | \item{exposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 22 | unmeasured confounder in the exposed population} 23 | 24 | \item{unexposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 25 | unmeasured confounder in the unexposed population} 26 | 27 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 28 | between the unmeasured confounder and the outcome} 29 | 30 | \item{verbose}{Logical. Indicates whether to print informative message. 31 | Default: \code{TRUE}} 32 | 33 | \item{hr_correction}{Logical. Indicates whether to use a correction factor. 34 | The methods used for this function are based on risk ratios. For rare 35 | outcomes, a hazard ratio approximates a risk ratio. For common outcomes, 36 | a correction factor is needed. If you have a common outcome (>15\%), 37 | set this to \code{TRUE}. Default: \code{FALSE}.} 38 | } 39 | \value{ 40 | Data frame. 41 | } 42 | \description{ 43 | Adjust an observed hazard ratio with a binary confounder 44 | } 45 | \examples{ 46 | adjust_hr_with_binary(0.8, 0.1, 0.5, 1.8) 47 | } 48 | -------------------------------------------------------------------------------- /man/adjust_or_with_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_coefficient.R 3 | \name{adjust_or_with_binary} 4 | \alias{adjust_or_with_binary} 5 | \title{Adjust an observed odds ratio with a binary confounder} 6 | \usage{ 7 | adjust_or_with_binary( 8 | effect_observed, 9 | exposed_confounder_prev, 10 | unexposed_confounder_prev, 11 | confounder_outcome_effect, 12 | verbose = getOption("tipr.verbose", TRUE), 13 | or_correction = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome 18 | odds ratio. This can be the point estimate, lower confidence bound, or 19 | upper confidence bound.} 20 | 21 | \item{exposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 22 | unmeasured confounder in the exposed population} 23 | 24 | \item{unexposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 25 | unmeasured confounder in the unexposed population} 26 | 27 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 28 | between the unmeasured confounder and the outcome} 29 | 30 | \item{verbose}{Logical. Indicates whether to print informative message. 31 | Default: \code{TRUE}} 32 | 33 | \item{or_correction}{Logical. Indicates whether to use a correction factor. 34 | The methods used for this function are based on risk ratios. For rare 35 | outcomes, an odds ratio approximates a risk ratio. For common outcomes, 36 | a correction factor is needed. If you have a common outcome (>15\%), 37 | set this to \code{TRUE}. Default: \code{FALSE}.} 38 | } 39 | \value{ 40 | Data frame. 41 | } 42 | \description{ 43 | Adjust an observed odds ratio with a binary confounder 44 | } 45 | \examples{ 46 | adjust_or_with_binary(3, 1, 0, 3) 47 | adjust_or_with_binary(3, 1, 0, 3, or_correction = TRUE) 48 | } 49 | -------------------------------------------------------------------------------- /man/adjust_or.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_coefficient.R 3 | \name{adjust_or} 4 | \alias{adjust_or} 5 | \alias{adjust_or_with_continuous} 6 | \title{Adjust an observed odds ratio for a normally distributed 7 | confounder} 8 | \usage{ 9 | adjust_or( 10 | effect_observed, 11 | exposure_confounder_effect, 12 | confounder_outcome_effect, 13 | verbose = getOption("tipr.verbose", TRUE), 14 | or_correction = FALSE 15 | ) 16 | 17 | adjust_or_with_continuous( 18 | effect_observed, 19 | exposure_confounder_effect, 20 | confounder_outcome_effect, 21 | verbose = getOption("tipr.verbose", TRUE), 22 | or_correction = FALSE 23 | ) 24 | } 25 | \arguments{ 26 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome odds ratio. 27 | This can be the point estimate, lower confidence bound, or upper 28 | confidence bound.} 29 | 30 | \item{exposure_confounder_effect}{Numeric. Estimated difference in scaled means between the 31 | unmeasured confounder in the exposed population and unexposed population} 32 | 33 | \item{confounder_outcome_effect}{Numeric. Estimated relationship 34 | between the unmeasured confounder and the outcome.} 35 | 36 | \item{verbose}{Logical. Indicates whether to print informative message. 37 | Default: \code{TRUE}} 38 | 39 | \item{or_correction}{Logical. Indicates whether to use a correction factor. 40 | The methods used for this function are based on risk ratios. For rare 41 | outcomes, an odds ratio approximates a risk ratio. For common outcomes, 42 | a correction factor is needed. If you have a common outcome (>15\%), 43 | set this to \code{TRUE}. Default: \code{FALSE}.} 44 | } 45 | \value{ 46 | Data frame. 47 | } 48 | \description{ 49 | Adjust an observed odds ratio for a normally distributed 50 | confounder 51 | } 52 | \examples{ 53 | adjust_or(1.2, 0.9, 1.3) 54 | } 55 | -------------------------------------------------------------------------------- /man/adjust_hr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_coefficient.R 3 | \name{adjust_hr} 4 | \alias{adjust_hr} 5 | \alias{adjust_hr_with_continuous} 6 | \title{Adjust an observed hazard ratio for a normally distributed 7 | confounder} 8 | \usage{ 9 | adjust_hr( 10 | effect_observed, 11 | exposure_confounder_effect, 12 | confounder_outcome_effect, 13 | verbose = getOption("tipr.verbose", TRUE), 14 | hr_correction = FALSE 15 | ) 16 | 17 | adjust_hr_with_continuous( 18 | effect_observed, 19 | exposure_confounder_effect, 20 | confounder_outcome_effect, 21 | verbose = getOption("tipr.verbose", TRUE), 22 | hr_correction = FALSE 23 | ) 24 | } 25 | \arguments{ 26 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome hazard ratio. 27 | This can be the point estimate, lower confidence bound, or upper 28 | confidence bound.} 29 | 30 | \item{exposure_confounder_effect}{Numeric. Estimated difference in scaled means between the 31 | unmeasured confounder in the exposed population and unexposed population} 32 | 33 | \item{confounder_outcome_effect}{Numeric. Estimated relationship 34 | between the unmeasured confounder and the outcome.} 35 | 36 | \item{verbose}{Logical. Indicates whether to print informative message. 37 | Default: \code{TRUE}} 38 | 39 | \item{hr_correction}{Logical. Indicates whether to use a correction factor. 40 | The methods used for this function are based on risk ratios. For rare 41 | outcomes, a hazard ratio approximates a risk ratio. For common outcomes, 42 | a correction factor is needed. If you have a common outcome (>15\%), 43 | set this to \code{TRUE}. Default: \code{FALSE}.} 44 | } 45 | \value{ 46 | Data frame. 47 | } 48 | \description{ 49 | Adjust an observed hazard ratio for a normally distributed 50 | confounder 51 | } 52 | \examples{ 53 | adjust_hr(0.9, -0.9, 1.3) 54 | } 55 | -------------------------------------------------------------------------------- /man/tip_rr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip.R 3 | \name{tip_rr} 4 | \alias{tip_rr} 5 | \alias{tip_rr_with_continuous} 6 | \title{Tip an observed risk ratio with a normally distributed confounder.} 7 | \usage{ 8 | tip_rr( 9 | effect_observed, 10 | exposure_confounder_effect = NULL, 11 | confounder_outcome_effect = NULL, 12 | verbose = getOption("tipr.verbose", TRUE) 13 | ) 14 | 15 | tip_rr_with_continuous( 16 | effect_observed, 17 | exposure_confounder_effect = NULL, 18 | confounder_outcome_effect = NULL, 19 | verbose = getOption("tipr.verbose", TRUE) 20 | ) 21 | } 22 | \arguments{ 23 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome 24 | risk ratio. This can be the point estimate, lower confidence bound, 25 | or upper confidence bound.} 26 | 27 | \item{exposure_confounder_effect}{Numeric. Estimated difference in scaled means between the 28 | unmeasured confounder in the exposed population and unexposed population} 29 | 30 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 31 | between the unmeasured confounder and the outcome} 32 | 33 | \item{verbose}{Logical. Indicates whether to print informative message. 34 | Default: \code{TRUE}} 35 | } 36 | \value{ 37 | Data frame. 38 | } 39 | \description{ 40 | choose one of the following, and the other will be estimated: 41 | \itemize{ 42 | \item \code{exposure_confounder_effect} 43 | \item \code{confounder_outcome_effect} 44 | } 45 | } 46 | \examples{ 47 | ## to estimate the relationship between an unmeasured confounder and outcome 48 | ## needed to tip analysis 49 | tip_rr(1.2, exposure_confounder_effect = -2) 50 | 51 | ## to estimate the number of unmeasured confounders specified needed to tip 52 | ## the analysis 53 | tip_rr(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = .99) 54 | 55 | } 56 | -------------------------------------------------------------------------------- /man/adjust_coef_with_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_coefficient.R 3 | \name{adjust_coef_with_binary} 4 | \alias{adjust_coef_with_binary} 5 | \title{Adjust an observed coefficient from a regression model with a binary 6 | confounder} 7 | \usage{ 8 | adjust_coef_with_binary( 9 | effect_observed, 10 | exposed_confounder_prev, 11 | unexposed_confounder_prev, 12 | confounder_outcome_effect, 13 | loglinear = FALSE, 14 | verbose = getOption("tipr.verbose", TRUE) 15 | ) 16 | } 17 | \arguments{ 18 | \item{effect_observed}{Numeric. Observed exposure - outcome effect from a 19 | loglinear model. This can be the beta coefficient, the lower confidence 20 | bound of the beta coefficient, or the upper confidence bound of the beta 21 | coefficient.} 22 | 23 | \item{exposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence 24 | of the unmeasured confounder in the exposed population} 25 | 26 | \item{unexposed_confounder_prev}{Numeric between 0 and 1. Estimated 27 | prevalence of the unmeasured confounder in the unexposed population} 28 | 29 | \item{confounder_outcome_effect}{Numeric. Estimated relationship between the 30 | unmeasured confounder and the outcome.} 31 | 32 | \item{loglinear}{Logical. Calculate the adjusted coefficient from a loglinear 33 | model instead of a linear model (the default). When \code{loglinear = FALSE}, 34 | \code{adjust_coef_with_binary()} is equivalent to \code{adjust_coef()} where 35 | \code{exposure_confounder_effect} is the difference in prevalences.} 36 | 37 | \item{verbose}{Logical. Indicates whether to print informative message. 38 | Default: \code{TRUE}} 39 | } 40 | \value{ 41 | Data frame. 42 | } 43 | \description{ 44 | Adjust an observed coefficient from a regression model with a binary 45 | confounder 46 | } 47 | \examples{ 48 | adjust_coef_with_binary(1.1, 0.5, 0.3, 1.3) 49 | } 50 | -------------------------------------------------------------------------------- /tests/testthat/test-tip-helpers.R: -------------------------------------------------------------------------------- 1 | context("Tip Helpers") 2 | 3 | test_that("get_limiting_bound() errors if not significant", { 4 | expect_error( 5 | get_limiting_bound(lb = .9, ub = 1.1), 6 | "Please input a significant result" 7 | ) 8 | 9 | expect_error( 10 | get_limiting_bound(lb = 1.1, ub = .9), 11 | "Please input a significant result" 12 | ) 13 | 14 | expect_error( 15 | get_limiting_bound(lb = 1, ub = 1.1), 16 | "Please input a significant result" 17 | ) 18 | 19 | expect_error( 20 | get_limiting_bound(lb = 1, ub = 1), 21 | "Please input a significant result" 22 | ) 23 | expect_error( 24 | get_limiting_bound(), 25 | "Please input a dataset `d`" 26 | ) 27 | }) 28 | 29 | test_that("get_limiting_bound() errors if lb or ub < 0", { 30 | expect_error(get_limiting_bound(lb = .9, ub = -1)) 31 | expect_error(get_limiting_bound(lb = -1, ub = .9)) 32 | expect_error(get_limiting_bound(lb = -1, ub = -1)) 33 | }) 34 | 35 | test_that("get_limiting_bound() gives correct bound", { 36 | expect_equivalent(get_limiting_bound(lb = 1.1, ub = 1.2), 1.1) 37 | expect_equivalent(get_limiting_bound(lb = 0.8, ub = 0.9), 0.9) 38 | expect_equivalent(get_limiting_bound(lb = 1.1, ub = 1.1), 1.1) 39 | }) 40 | 41 | test_that("tip_gamma() errors when necessary", { 42 | expect_error( 43 | tip_gamma(p0 = -1, p1 = 1), 44 | "The prevalences entered must be between 0 and 1" 45 | ) 46 | expect_error( 47 | tip_gamma(p0 = 1, p1 = -1), 48 | "The prevalences entered must be between 0 and 1" 49 | ) 50 | }) 51 | 52 | test_that("tip_gamma() returns correct result", { 53 | expect_identical(tip_gamma(p0 = 0, p1 = 1, b = 1.2), 1.2) 54 | expect_identical(tip_gamma(p0 = 0, p1 = 1, b = .8), .8) 55 | expect_identical(tip_gamma(p0 = 1, p1 = 0, b = 1.2), 1 / 1.2) 56 | expect_error( 57 | tip_gamma(p0 = .5, p1 = .2, b = 5), 58 | "there does not exist an unmeasured" 59 | ) 60 | }) 61 | -------------------------------------------------------------------------------- /DESCRIPTION: -------------------------------------------------------------------------------- 1 | Type: Package 2 | Package: tipr 3 | Title: Tipping Point Analyses 4 | Version: 1.0.2.9000 5 | Authors@R: c( 6 | person("Lucy", "D'Agostino McGowan", , "lucydagostino@gmail.com", role = c("aut", "cre"), 7 | comment = c(ORCID = "0000-0002-6983-2759")), 8 | person("Malcolm", "Barrett", , "malcolmbarrett@gmail.com", role = "aut", 9 | comment = c(ORCID = "0000-0003-0299-5825")) 10 | ) 11 | Description: The strength of evidence provided by epidemiological and 12 | observational studies is inherently limited by the potential for 13 | unmeasured confounding. We focus on three key quantities: the 14 | observed bound of the confidence interval closest to the null, the 15 | relationship between an unmeasured confounder and the outcome, for 16 | example a plausible residual effect size for an unmeasured continuous 17 | or binary confounder, and the relationship between an unmeasured 18 | confounder and the exposure, for example a realistic mean difference 19 | or prevalence difference for this hypothetical confounder between 20 | exposure groups. Building on the methods put forth by Cornfield et al. 21 | (1959), Bross (1966), Schlesselman (1978), Rosenbaum & Rubin (1983), 22 | Lin et al. (1998), Lash et al. (2009), Rosenbaum (1986), Cinelli & 23 | Hazlett (2020), VanderWeele & Ding (2017), and Ding & VanderWeele 24 | (2016), we can use these quantities to assess how an unmeasured 25 | confounder may tip our result to insignificance. 26 | License: MIT + file LICENSE 27 | URL: https://r-causal.github.io/tipr/, https://github.com/r-causal/tipr 28 | BugReports: https://github.com/r-causal/tipr/issues 29 | Depends: 30 | R (>= 2.10) 31 | Imports: 32 | cli (>= 3.4.1), 33 | glue, 34 | purrr, 35 | rlang (>= 1.0.6), 36 | sensemakr, 37 | tibble 38 | Suggests: 39 | broom, 40 | dplyr, 41 | MASS, 42 | testthat 43 | Encoding: UTF-8 44 | LazyData: true 45 | Roxygen: list(markdown = TRUE) 46 | RoxygenNote: 7.3.1 47 | -------------------------------------------------------------------------------- /R/observed_bias_tbl.R: -------------------------------------------------------------------------------- 1 | #' Create a data frame to assist with creating an observed bias plot 2 | #' 3 | #' @param ps_mod Model object for the propensity score model 4 | #' @param outcome_mod Model object for the outcome model 5 | #' @param drop_list Named list of covariates or groups of covariates to drop if 6 | #' `NULL`, will default to dropping each covariate one at a time. 7 | #' 8 | #' @return Data frame with the following columns: 9 | #' * `dropped`: The covariate or group of covariates that were dropped 10 | #' * `type`: Explanation of `dropped`, whether it refers to a single covariate (`covariate`) or a group of covariates (`group`) 11 | #' * `ps_formula`: The new formula for the updated propensity score model 12 | #' * `outcome_formula`: The new formula for the updated outcome model 13 | #' * `ps_model`: The new model object for the updated propensity score model 14 | #' * `p`: The updated propensity score 15 | #' @export 16 | #' 17 | #' @examples 18 | #' ps_mod <- glm(am ~ mpg + cyl + I(hp^2), data = mtcars) 19 | #' outcome_mod <- lm(qsec ~ am + hp + disp + wt, data = mtcars) 20 | #' observed_bias_tbl( 21 | #' ps_mod, 22 | #' outcome_mod, 23 | #' drop_list = list( 24 | #' group_one = c("mpg", "hp"), 25 | #' group_two = c("cyl", "wt") 26 | #' ) 27 | #' ) 28 | 29 | observed_bias_tbl <- function(ps_mod, outcome_mod, drop_list = NULL) { 30 | c <- create_covariate_lists(ps_mod, outcome_mod) 31 | 32 | if (is.null(drop_list)) { 33 | drop_list <- create_individual_covariate_list(c) 34 | } 35 | 36 | check_drop_list(drop_list) 37 | outcome <- get_y(outcome_mod) 38 | 39 | g <- drop_tbl(drop_list, c) 40 | d <- add_formula(g, c[["exposure"]], outcome) 41 | 42 | observed_bias_tbl <- tibble::tibble( 43 | dropped = d$dropped, 44 | type = d$type, 45 | ps_formula = d$ps_form, 46 | outcome_formula = d$outcome_form, 47 | ps_model = purrr::map(d$ps_form, ~ stats::update(ps_mod, .x)) 48 | ) 49 | 50 | tibble::add_column( 51 | observed_bias_tbl, 52 | p = purrr::map(observed_bias_tbl$ps_model, 53 | stats::predict, type = "response") 54 | ) 55 | } 56 | -------------------------------------------------------------------------------- /man/tip_or_with_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip_with_binary.R 3 | \name{tip_or_with_binary} 4 | \alias{tip_or_with_binary} 5 | \title{Tip an observed odds ratio with a binary confounder.} 6 | \usage{ 7 | tip_or_with_binary( 8 | effect_observed, 9 | exposed_confounder_prev = NULL, 10 | unexposed_confounder_prev = NULL, 11 | confounder_outcome_effect = NULL, 12 | verbose = getOption("tipr.verbose", TRUE), 13 | or_correction = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome odds ratio. 18 | This can be the point estimate, lower confidence bound, or upper 19 | confidence bound.} 20 | 21 | \item{exposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 22 | unmeasured confounder in the exposed population} 23 | 24 | \item{unexposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 25 | unmeasured confounder in the unexposed population} 26 | 27 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 28 | between the unmeasured confounder and the outcome} 29 | 30 | \item{verbose}{Logical. Indicates whether to print informative message. 31 | Default: \code{TRUE}} 32 | 33 | \item{or_correction}{Logical. Indicates whether to use a correction factor. 34 | The methods used for this function are based on risk ratios. For rare 35 | outcomes, an odds ratio approximates a risk ratio. For common outcomes, 36 | a correction factor is needed. If you have a common outcome (>15\%), 37 | set this to \code{TRUE}. Default: \code{FALSE}.} 38 | } 39 | \value{ 40 | Data frame. 41 | } 42 | \description{ 43 | Choose two of the following three to specify, and the third will be estimated: 44 | \itemize{ 45 | \item \code{exposed_confounder_prev} 46 | \item \code{unexposed_confounder_prev} 47 | \item \code{confounder_outcome_effect} 48 | } 49 | 50 | Alternatively, specify all three and the function will return the number of unmeasured 51 | confounders specified needed to tip the analysis. 52 | } 53 | \examples{ 54 | tip_or_with_binary(0.9, 0.9, 0.1) 55 | } 56 | -------------------------------------------------------------------------------- /man/tip_hr_with_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip_with_binary.R 3 | \name{tip_hr_with_binary} 4 | \alias{tip_hr_with_binary} 5 | \title{Tip an observed hazard ratio with a binary confounder.} 6 | \usage{ 7 | tip_hr_with_binary( 8 | effect_observed, 9 | exposed_confounder_prev = NULL, 10 | unexposed_confounder_prev = NULL, 11 | confounder_outcome_effect = NULL, 12 | verbose = getOption("tipr.verbose", TRUE), 13 | hr_correction = FALSE 14 | ) 15 | } 16 | \arguments{ 17 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome hazard ratio. 18 | This can be the point estimate, lower confidence bound, or upper 19 | confidence bound.} 20 | 21 | \item{exposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 22 | unmeasured confounder in the exposed population} 23 | 24 | \item{unexposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 25 | unmeasured confounder in the unexposed population} 26 | 27 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 28 | between the unmeasured confounder and the outcome} 29 | 30 | \item{verbose}{Logical. Indicates whether to print informative message. 31 | Default: \code{TRUE}} 32 | 33 | \item{hr_correction}{Logical. Indicates whether to use a correction factor. 34 | The methods used for this function are based on risk ratios. For rare 35 | outcomes, a hazard ratio approximates a risk ratio. For common outcomes, 36 | a correction factor is needed. If you have a common outcome (>15\%), 37 | set this to \code{TRUE}. Default: \code{FALSE}.} 38 | } 39 | \value{ 40 | Data frame. 41 | } 42 | \description{ 43 | Choose two of the following three to specify, and the third will be estimated: 44 | \itemize{ 45 | \item \code{exposed_confounder_prev} 46 | \item \code{unexposed_confounder_prev} 47 | \item \code{confounder_outcome_effect} 48 | } 49 | 50 | Alternatively, specify all three and the function will return the number of unmeasured 51 | confounders specified needed to tip the analysis. 52 | } 53 | \examples{ 54 | tip_hr_with_binary(0.9, 0.9, 0.1) 55 | } 56 | -------------------------------------------------------------------------------- /man/tip_hr.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip.R 3 | \name{tip_hr} 4 | \alias{tip_hr} 5 | \alias{tip_hr_with_continuous} 6 | \title{Tip an observed hazard ratio with a normally distributed confounder.} 7 | \usage{ 8 | tip_hr( 9 | effect_observed, 10 | exposure_confounder_effect = NULL, 11 | confounder_outcome_effect = NULL, 12 | verbose = getOption("tipr.verbose", TRUE), 13 | hr_correction = FALSE 14 | ) 15 | 16 | tip_hr_with_continuous( 17 | effect_observed, 18 | exposure_confounder_effect = NULL, 19 | confounder_outcome_effect = NULL, 20 | verbose = getOption("tipr.verbose", TRUE), 21 | hr_correction = FALSE 22 | ) 23 | } 24 | \arguments{ 25 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome hazard ratio. 26 | This can be the point estimate, lower confidence bound, or upper 27 | confidence bound.} 28 | 29 | \item{exposure_confounder_effect}{Numeric. Estimated difference in scaled means between the 30 | unmeasured confounder in the exposed population and unexposed population} 31 | 32 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 33 | between the unmeasured confounder and the outcome} 34 | 35 | \item{verbose}{Logical. Indicates whether to print informative message. 36 | Default: \code{TRUE}} 37 | 38 | \item{hr_correction}{Logical. Indicates whether to use a correction factor. 39 | The methods used for this function are based on risk ratios. For rare 40 | outcomes, a hazard ratio approximates a risk ratio. For common outcomes, 41 | a correction factor is needed. If you have a common outcome (>15\%), 42 | set this to \code{TRUE}. Default: \code{FALSE}.} 43 | } 44 | \value{ 45 | Data frame. 46 | } 47 | \description{ 48 | choose one of the following, and the other will be estimated: 49 | \itemize{ 50 | \item \code{exposure_confounder_effect} 51 | \item \code{confounder_outcome_effect} 52 | } 53 | } 54 | \examples{ 55 | ## to estimate the relationship between an unmeasured confounder and outcome 56 | ## needed to tip analysis 57 | tip_hr(1.2, exposure_confounder_effect = -2) 58 | 59 | ## to estimate the number of unmeasured confounders specified needed to tip 60 | ## the analysis 61 | tip_hr(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = .99) 62 | 63 | } 64 | -------------------------------------------------------------------------------- /man/tip_coef.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip_coef.R 3 | \name{tip_coef} 4 | \alias{tip_coef} 5 | \alias{tip_coef_with_continuous} 6 | \title{Tip a linear model coefficient with a continuous confounder.} 7 | \usage{ 8 | tip_coef( 9 | effect_observed, 10 | exposure_confounder_effect = NULL, 11 | confounder_outcome_effect = NULL, 12 | verbose = getOption("tipr.verbose", TRUE) 13 | ) 14 | 15 | tip_coef_with_continuous( 16 | effect_observed, 17 | exposure_confounder_effect = NULL, 18 | confounder_outcome_effect = NULL, 19 | verbose = getOption("tipr.verbose", TRUE) 20 | ) 21 | } 22 | \arguments{ 23 | \item{effect_observed}{Numeric. Observed exposure - outcome effect from 24 | a regression model. This can be the beta coefficient, the lower 25 | confidence bound of the beta coefficient, or the upper confidence bound 26 | of the beta coefficient.} 27 | 28 | \item{exposure_confounder_effect}{Numeric. Estimated scaled mean difference 29 | between the unmeasured confounder in the exposed population and unexposed 30 | population} 31 | 32 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 33 | between the unmeasured confounder and the outcome} 34 | 35 | \item{verbose}{Logical. Indicates whether to print informative message. 36 | Default: \code{TRUE}} 37 | } 38 | \value{ 39 | Data frame. 40 | } 41 | \description{ 42 | choose one of the following, and the other will be estimated: 43 | \itemize{ 44 | \item \code{exposure_confounder_effect} 45 | \item \code{confounder_outcome_effect} 46 | } 47 | } 48 | \examples{ 49 | ## to estimate the relationship between an unmeasured confounder and outcome 50 | ## needed to tip analysis 51 | tip_coef(1.2, exposure_confounder_effect = -2) 52 | 53 | ## to estimate the number of unmeasured confounders specified needed to tip 54 | ## the analysis 55 | tip_coef(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = -0.05) 56 | 57 | ## Example with broom 58 | if (requireNamespace("broom", quietly = TRUE) && 59 | requireNamespace("dplyr", quietly = TRUE)) { 60 | lm(wt ~ mpg, data = mtcars) \%>\% 61 | broom::tidy(conf.int = TRUE) \%>\% 62 | dplyr::filter(term == "mpg") \%>\% 63 | dplyr::pull(conf.low) \%>\% 64 | tip_coef(confounder_outcome_effect = 2.5) 65 | } 66 | } 67 | -------------------------------------------------------------------------------- /man/tip_coef_with_r2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip_coef_with_r2.R 3 | \name{tip_coef_with_r2} 4 | \alias{tip_coef_with_r2} 5 | \title{Tip a regression coefficient using the partial R2 6 | for an unmeasured confounder-exposure relationship and unmeasured confounder- 7 | outcome relationship} 8 | \usage{ 9 | tip_coef_with_r2( 10 | effect_observed, 11 | se, 12 | df, 13 | confounder_exposure_r2 = NULL, 14 | confounder_outcome_r2 = NULL, 15 | verbose = getOption("tipr.verbose", TRUE), 16 | alpha = 0.05, 17 | tip_bound = FALSE, 18 | ... 19 | ) 20 | } 21 | \arguments{ 22 | \item{effect_observed}{Numeric. Observed exposure - outcome effect from a 23 | regression model. This is the point estimate (beta coefficient)} 24 | 25 | \item{se}{Numeric. Standard error of the \code{effect_observed} in the previous parameter.} 26 | 27 | \item{df}{Numeric positive value. Residual degrees of freedom for the model 28 | used to estimate the observed exposure - outcome effect. This is the total 29 | number of observations minus the number of parameters estimated in your 30 | model. Often for models estimated with an intercept this is N - k - 1 31 | where k is the number of predictors in the model.} 32 | 33 | \item{confounder_exposure_r2}{Numeric value between 0 and 1. The assumed partial R2 of 34 | the unobserved confounder with the exposure given the measured covariates.} 35 | 36 | \item{confounder_outcome_r2}{Numeric value between 0 and 1. The assumed partial R2 of 37 | the unobserved confounder with the outcome given the exposure and 38 | the measured covariates.} 39 | 40 | \item{verbose}{Logical. Indicates whether to print informative message. 41 | Default: \code{TRUE}} 42 | 43 | \item{alpha}{Significance level. Default = \code{0.05}.} 44 | 45 | \item{tip_bound}{Do you want to tip at the bound? Default = \code{FALSE}, will tip at the point estimate} 46 | 47 | \item{...}{Optional arguments passed to the \code{\link[sensemakr:adjusted_estimate]{sensemakr::adjusted_estimate()}} 48 | function.} 49 | } 50 | \value{ 51 | A data frame. 52 | } 53 | \description{ 54 | Choose one of the following, and the other will be estimated: 55 | \itemize{ 56 | \item \code{confounder_exposure_r2} 57 | \item \code{confounder_outcome_r2} 58 | } 59 | } 60 | \examples{ 61 | tip_coef_with_r2(0.5, 0.1, 102, 0.5) 62 | } 63 | -------------------------------------------------------------------------------- /man/adjust_coef_with_r2.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/adjust_coef_with_r2.R 3 | \name{adjust_coef_with_r2} 4 | \alias{adjust_coef_with_r2} 5 | \title{Adjust a regression coefficient using the partial R2 6 | for an unmeasured confounder-exposure relationship and unmeasured confounder- 7 | outcome relationship} 8 | \usage{ 9 | adjust_coef_with_r2( 10 | effect_observed, 11 | se, 12 | df, 13 | confounder_exposure_r2, 14 | confounder_outcome_r2, 15 | verbose = getOption("tipr.verbose", TRUE), 16 | alpha = 0.05, 17 | ... 18 | ) 19 | } 20 | \arguments{ 21 | \item{effect_observed}{Numeric. Observed exposure - outcome effect from a regression 22 | model. This is the point estimate (beta coefficient)} 23 | 24 | \item{se}{Numeric. Standard error of the \code{effect_observed} in the previous parameter.} 25 | 26 | \item{df}{Numeric positive value. Residual degrees of freedom for the model 27 | used to estimate the observed exposure - outcome effect. This is the total 28 | number of observations minus the number of parameters estimated in your 29 | model. Often for models estimated with an intercept this is N - k - 1 30 | where k is the number of predictors in the model.} 31 | 32 | \item{confounder_exposure_r2}{Numeric value between 0 and 1. The assumed partial R2 of 33 | the unobserved confounder with the exposure given the measured covariates.} 34 | 35 | \item{confounder_outcome_r2}{Numeric value between 0 and 1. The assumed partial R2 of 36 | the unobserved confounder with the outcome given the exposure and 37 | the measured covariates.} 38 | 39 | \item{verbose}{Logical. Indicates whether to print informative message. 40 | Default: \code{TRUE}} 41 | 42 | \item{alpha}{Significance level. Default = \code{0.05}.} 43 | 44 | \item{...}{Optional arguments passed to the \code{\link[sensemakr:adjusted_estimate]{sensemakr::adjusted_estimate()}} 45 | function.} 46 | } 47 | \value{ 48 | A data frame. 49 | } 50 | \description{ 51 | This function wraps the \code{\link[sensemakr:adjusted_estimate]{sensemakr::adjusted_estimate()}} and 52 | \code{\link[sensemakr:adjusted_estimate]{sensemakr::adjusted_se()}} functions. 53 | } 54 | \examples{ 55 | adjust_coef_with_r2(0.5, 0.1, 102, 0.05, 0.1) 56 | } 57 | \references{ 58 | Carlos Cinelli, Jeremy Ferwerda and Chad Hazlett (2021). 59 | sensemakr: Sensitivity Analysis 60 | Tools for Regression Models. R package version 0.1.4. 61 | https://CRAN.R-project.org/package=sensemakr 62 | } 63 | -------------------------------------------------------------------------------- /NEWS.md: -------------------------------------------------------------------------------- 1 | # tipr (development version) 2 | 3 | # tipr 1.0.2 4 | 5 | * `adjust_coef_with_binary()` now assumes the coefficient is from a linear model rather than loglinear. Use `loglinear = TRUE` to get the old behavior. (#12, @malcolmbarrett) 6 | * Fixed roxygen issue with package documentation 7 | * Update messaging and errors 8 | 9 | # tipr 1.0.1 10 | 11 | * Fixed bug, functions based on the `adjust_coef_with_binary` function had the old parameter names (`exposed_p` and `unexposed_p`). These were changed to match the other new updates from version 1.0.0 to now be `exposed_confounder_prev` and `unexposed_confounder_prev`. 12 | * Change "relative risk" to "risk ratio" in all documentation. 13 | * Add new JOSS citation 14 | 15 | # tipr 1.0.0 16 | 17 | **Breaking changes**. The names of several arguments were changed for increased clarity: 18 | 19 | * `effect` -> `effect_observed` 20 | * `outcome_association` -> `confounder_outcome_effect` 21 | * `smd` -> `exposure_confounder_effect` 22 | * `exposed_p` -> `exposed_confounder_prev` 23 | * `unexposed_p` -> `unexposed_confounder_prev` 24 | * `exposure_r2` -> `confounder_exposure_r2` 25 | * `outcome_r2` -> `confounder_outcome_r2` 26 | 27 | * Added two new example datasets: `exdata_continuous` and `exdata_rr` 28 | 29 | # tipr 0.4.2 30 | 31 | * Make the output tibble names consistent (`adjusted_effect` -> `effect_adjusted`) 32 | 33 | # tipr 0.4.1 34 | 35 | * Add additional functions that specify `*_with_continuous()` (long form of, the function names, the default unmeasured confounder is Normally distributed) 36 | * Change `tip_lm()` to `tip_coef()`. 37 | 38 | # tipr 0.4.0 39 | 40 | * Changed the name of `lm_tip()` to `tip_lm()` 41 | * The API has been fundamentally updated so that the functions now take a numeric value as a first argument rather than a data frame. 42 | * Added adjust_* functions to allow for specification of all unmeasured confounder qualities without tipping 43 | * Split `tip_*` functions into hazard ratio, odds ratio, and relative risk 44 | * Add R2 parameterization with `tip_coef_with_r2()`, `adjust_coef_with_r2()`, and `r_value()` 45 | 46 | # tipr 0.3.0 47 | 48 | * Added ability to perform sensitivity analyses on linear models via `lm_tip()` 49 | 50 | # tipr 0.2.0 51 | 52 | * Updated several function and parameter names. The main functions are now `tip()` and `tip_with_binary()`. The parameter names are more self-explanatory. 53 | * The API has been fundamentally updated so that the functions now take a data frame as a first argument. 54 | * There is now explicit (but not required) integration with the `broom` package. 55 | 56 | # tipr 0.1.1 57 | 58 | * initial CRAN release 59 | -------------------------------------------------------------------------------- /man/tip_or.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip.R 3 | \name{tip_or} 4 | \alias{tip_or} 5 | \alias{tip_or_with_continuous} 6 | \title{Tip an observed odds ratio with a normally distributed confounder.} 7 | \usage{ 8 | tip_or( 9 | effect_observed, 10 | exposure_confounder_effect = NULL, 11 | confounder_outcome_effect = NULL, 12 | verbose = getOption("tipr.verbose", TRUE), 13 | or_correction = FALSE 14 | ) 15 | 16 | tip_or_with_continuous( 17 | effect_observed, 18 | exposure_confounder_effect = NULL, 19 | confounder_outcome_effect = NULL, 20 | verbose = getOption("tipr.verbose", TRUE), 21 | or_correction = FALSE 22 | ) 23 | } 24 | \arguments{ 25 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome odds ratio. 26 | This can be the point estimate, lower confidence bound, or upper 27 | confidence bound.} 28 | 29 | \item{exposure_confounder_effect}{Numeric. Estimated difference in scaled means between the 30 | unmeasured confounder in the exposed population and unexposed population} 31 | 32 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 33 | between the unmeasured confounder and the outcome} 34 | 35 | \item{verbose}{Logical. Indicates whether to print informative message. 36 | Default: \code{TRUE}} 37 | 38 | \item{or_correction}{Logical. Indicates whether to use a correction factor. 39 | The methods used for this function are based on risk ratios. For rare 40 | outcomes, an odds ratio approximates a risk ratio. For common outcomes, 41 | a correction factor is needed. If you have a common outcome (>15\%), 42 | set this to \code{TRUE}. Default: \code{FALSE}.} 43 | } 44 | \value{ 45 | Data frame. 46 | } 47 | \description{ 48 | choose one of the following, and the other will be estimated: 49 | \itemize{ 50 | \item \code{exposure_confounder_effect} 51 | \item \code{confounder_outcome_effect} 52 | } 53 | } 54 | \examples{ 55 | ## to estimate the relationship between an unmeasured confounder and outcome 56 | ## needed to tip analysis 57 | tip_or(1.2, exposure_confounder_effect = -2) 58 | 59 | ## to estimate the number of unmeasured confounders specified needed to tip 60 | ## the analysis 61 | tip_or(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = .99) 62 | 63 | ## Example with broom 64 | if (requireNamespace("broom", quietly = TRUE) && 65 | requireNamespace("dplyr", quietly = TRUE)) { 66 | glm(am ~ mpg, data = mtcars, family = "binomial") \%>\% 67 | broom::tidy(conf.int = TRUE, exponentiate = TRUE) \%>\% 68 | dplyr::filter(term == "mpg") \%>\% 69 | dplyr::pull(conf.low) \%>\% 70 | tip_or(confounder_outcome_effect = 2.5, or_correction = TRUE) 71 | } 72 | } 73 | -------------------------------------------------------------------------------- /man/tip.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip.R 3 | \name{tip} 4 | \alias{tip} 5 | \alias{tip_with_continuous} 6 | \alias{tip_c} 7 | \title{Tip a result with a normally distributed confounder.} 8 | \usage{ 9 | tip( 10 | effect_observed, 11 | exposure_confounder_effect = NULL, 12 | confounder_outcome_effect = NULL, 13 | verbose = getOption("tipr.verbose", TRUE), 14 | correction_factor = "none" 15 | ) 16 | 17 | tip_with_continuous( 18 | effect_observed, 19 | exposure_confounder_effect = NULL, 20 | confounder_outcome_effect = NULL, 21 | verbose = getOption("tipr.verbose", TRUE), 22 | correction_factor = "none" 23 | ) 24 | 25 | tip_c( 26 | effect_observed, 27 | exposure_confounder_effect = NULL, 28 | confounder_outcome_effect = NULL, 29 | verbose = getOption("tipr.verbose", TRUE), 30 | correction_factor = "none" 31 | ) 32 | } 33 | \arguments{ 34 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome effect 35 | (assumed to be the exponentiated coefficient, so a risk ratio, odds 36 | ratio, or hazard ratio). This can be the point estimate, lower confidence 37 | bound, or upper confidence bound.} 38 | 39 | \item{exposure_confounder_effect}{Numeric. Estimated difference in scaled means between the 40 | unmeasured confounder in the exposed population and unexposed population} 41 | 42 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 43 | between the unmeasured confounder and the outcome} 44 | 45 | \item{verbose}{Logical. Indicates whether to print informative message. 46 | Default: \code{TRUE}} 47 | 48 | \item{correction_factor}{Character string. Options are "none", "hr", "or". 49 | For common outcomes (>15\%), the odds ratio or hazard ratio is not a good 50 | estimate for the risk ratio. In these cases, we can apply a correction 51 | factor. If you are supplying a hazard ratio for a common outcome, set 52 | this to "hr"; if you are supplying an odds ratio for a common outcome, set 53 | this to "or"; if you are supplying a risk ratio or your outcome is rare, 54 | set this to "none" (default).} 55 | } 56 | \value{ 57 | Data frame. 58 | } 59 | \description{ 60 | choose one of the following, and the other will be estimated: 61 | \itemize{ 62 | \item \code{exposure_confounder_effect} 63 | \item \code{confounder_outcome_effect} 64 | } 65 | } 66 | \examples{ 67 | ## to estimate the relationship between an unmeasured confounder and outcome 68 | ## needed to tip analysis 69 | tip(1.2, exposure_confounder_effect = -2) 70 | 71 | ## to estimate the number of unmeasured confounders specified needed to tip 72 | ## the analysis 73 | tip(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = .99) 74 | 75 | ## Example with broom 76 | if (requireNamespace("broom", quietly = TRUE) && 77 | requireNamespace("dplyr", quietly = TRUE)) { 78 | glm(am ~ mpg, data = mtcars, family = "binomial") \%>\% 79 | broom::tidy(conf.int = TRUE, exponentiate = TRUE) \%>\% 80 | dplyr::filter(term == "mpg") \%>\% 81 | dplyr::pull(conf.low) \%>\% 82 | tip(confounder_outcome_effect = 2.5) 83 | } 84 | } 85 | -------------------------------------------------------------------------------- /R/observed-bias-plot-helpers.R: -------------------------------------------------------------------------------- 1 | get_y <- function(m) { 2 | deparse(stats::formula(m)[[2]]) 3 | } 4 | 5 | parse_formula <- function(m) { 6 | as.character( 7 | attr(m$terms, "variables") 8 | )[-c(1,2)] 9 | 10 | } 11 | 12 | create_covariate_lists <- function(ps_mod, outcome_mod) { 13 | exposure <- get_y(ps_mod) 14 | 15 | ps_covariates <- parse_formula(ps_mod) 16 | outcome_covariates <- parse_formula(outcome_mod) 17 | 18 | ps_covariates_clean <- unique(clean_covariate(ps_covariates)) 19 | outcome_covariates_clean <- unique(clean_covariate(outcome_covariates)) 20 | outcome_covariates_clean <- outcome_covariates_clean[ 21 | !(outcome_covariates_clean %in% exposure) 22 | ] 23 | list(exposure = exposure, 24 | ps_covariates = ps_covariates, 25 | ps_covariates_clean = ps_covariates_clean, 26 | outcome_covariates = outcome_covariates, 27 | outcome_covariates_clean = outcome_covariates_clean 28 | ) 29 | } 30 | 31 | drop_one_mod_tbl <- function(cov, names, covariate_lists) { 32 | ps_covariates <- covariate_lists[["ps_covariates"]] 33 | outcome_covariates <- covariate_lists[["outcome_covariates"]] 34 | 35 | cov_ps <- cov[cov %in% covariate_lists[["ps_covariates_clean"]]] 36 | cov_outcome <- cov[cov %in% covariate_lists[["outcome_covariates_clean"]]] 37 | if (all(clean_covariate(ps_covariates) %in% cov_ps)) { 38 | new_ps = 1 39 | } else{ 40 | new_ps = ps_covariates[ 41 | !(clean_covariate(ps_covariates) %in% cov_ps) 42 | ] 43 | } 44 | tibble::tibble( 45 | dropped = names, 46 | new_ps = list(new_ps), 47 | new_outcome = list( 48 | outcome_covariates[ 49 | !(clean_covariate(outcome_covariates) %in% cov_outcome) 50 | ]) 51 | ) 52 | } 53 | 54 | 55 | create_individual_covariate_list <- function(covariate_lists) { 56 | covs <- as.list(unique(c(covariate_lists[["ps_covariates_clean"]], 57 | covariate_lists[["outcome_covariates_clean"]]))) 58 | names(covs) <- covs 59 | covs 60 | } 61 | 62 | drop_tbl <- function(covs, covariate_lists) { 63 | 64 | g <- purrr::map2(covs, names(covs), drop_one_mod_tbl, covariate_lists) 65 | g <- do.call(rbind, g) 66 | g$type <- ifelse(purrr::map(covs, length) == 1, "covariate", "group") 67 | g 68 | } 69 | 70 | 71 | add_formula <- function(d, exposure, outcome) { 72 | tibble::add_column( 73 | d, 74 | ps_form = purrr::map(d$new_ps, build_formula, y = exposure), 75 | outcome_form = purrr::map(d$new_outcome, build_formula, y = outcome) 76 | ) 77 | } 78 | 79 | clean_covariate <- function(x) { 80 | gsub(".*\\(|\\).*|\\^.*|,.*$", "", x) 81 | } 82 | 83 | build_formula <- function(y, x) { 84 | covs <- glue::glue_collapse(x, sep = "+") 85 | stats::as.formula( 86 | glue::glue("{y} ~ {covs}") 87 | ) 88 | } 89 | 90 | check_drop_list <- function(l) { 91 | if (!is.null(l)) { 92 | n <- names(l) 93 | if (length(n) != length(l)) { 94 | stop_cli("`drop_list` must be a named list.") 95 | } 96 | c <- purrr::map_lgl(l, is.character) 97 | if (!all(c)) { 98 | stop_cli("`drop_list` must be a named list of character vectors.") 99 | } 100 | } 101 | } 102 | 103 | 104 | 105 | -------------------------------------------------------------------------------- /man/tip_with_binary.Rd: -------------------------------------------------------------------------------- 1 | % Generated by roxygen2: do not edit by hand 2 | % Please edit documentation in R/tip_with_binary.R 3 | \name{tip_with_binary} 4 | \alias{tip_with_binary} 5 | \alias{tip_b} 6 | \title{Tip a result with a binary confounder.} 7 | \usage{ 8 | tip_with_binary( 9 | effect_observed, 10 | exposed_confounder_prev = NULL, 11 | unexposed_confounder_prev = NULL, 12 | confounder_outcome_effect = NULL, 13 | verbose = getOption("tipr.verbose", TRUE), 14 | correction_factor = "none" 15 | ) 16 | 17 | tip_b( 18 | effect_observed, 19 | exposed_confounder_prev = NULL, 20 | unexposed_confounder_prev = NULL, 21 | confounder_outcome_effect = NULL, 22 | verbose = getOption("tipr.verbose", TRUE), 23 | correction_factor = "none" 24 | ) 25 | } 26 | \arguments{ 27 | \item{effect_observed}{Numeric positive value. Observed exposure - outcome effect 28 | (assumed to be the exponentiated coefficient, so a risk ratio, odds 29 | ratio, or hazard ratio). This can be the point estimate, lower confidence 30 | bound, or upper confidence bound.} 31 | 32 | \item{exposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 33 | unmeasured confounder in the exposed population} 34 | 35 | \item{unexposed_confounder_prev}{Numeric between 0 and 1. Estimated prevalence of the 36 | unmeasured confounder in the unexposed population} 37 | 38 | \item{confounder_outcome_effect}{Numeric positive value. Estimated relationship 39 | between the unmeasured confounder and the outcome} 40 | 41 | \item{verbose}{Logical. Indicates whether to print informative message. 42 | Default: \code{TRUE}} 43 | 44 | \item{correction_factor}{Character string. Options are "none", "hr", "or". 45 | For common outcomes (>15\%), the odds ratio or hazard ratio is not a good 46 | estimate for the risk ratio. In these cases, we can apply a correction 47 | factor. If you are supplying a hazard ratio for a common outcome, set 48 | this to "hr"; if you are supplying an odds ratio for a common outcome, set 49 | this to "or"; if you are supplying a risk ratio or your outcome is rare, 50 | set this to "none" (default).} 51 | } 52 | \description{ 53 | Choose two of the following three to specify, and the third will be estimated: 54 | \itemize{ 55 | \item \code{exposed_confounder_prev} 56 | \item \code{unexposed_confounder_prev} 57 | \item \code{confounder_outcome_effect} 58 | } 59 | 60 | Alternatively, specify all three and the function will return the number of unmeasured 61 | confounders specified needed to tip the analysis. 62 | } 63 | \details{ 64 | \code{\link[=tip_b]{tip_b()}} is an alias for \code{\link[=tip_with_binary]{tip_with_binary()}}. 65 | } 66 | \examples{ 67 | ## to estimate the relationship between an unmeasured confounder and outcome 68 | ## needed to tip analysis 69 | tip_with_binary(1.2, exposed_confounder_prev = 0.5, unexposed_confounder_prev = 0) 70 | 71 | ## to estimate the number of unmeasured confounders specified needed to tip 72 | ## the analysis 73 | tip_with_binary(1.2, 74 | exposed_confounder_prev = 0.5, 75 | unexposed_confounder_prev = 0, 76 | confounder_outcome_effect = 1.1) 77 | 78 | ## Example with broom 79 | if (requireNamespace("broom", quietly = TRUE) && 80 | requireNamespace("dplyr", quietly = TRUE)) { 81 | glm(am ~ mpg, data = mtcars, family = "binomial") \%>\% 82 | broom::tidy(conf.int = TRUE, exponentiate = TRUE) \%>\% 83 | dplyr::filter(term == "mpg") \%>\% 84 | dplyr::pull(conf.low) \%>\% 85 | tip_with_binary(exposed_confounder_prev = 1, confounder_outcome_effect = 1.15) 86 | } 87 | } 88 | -------------------------------------------------------------------------------- /R/adjust_coef_with_r2.R: -------------------------------------------------------------------------------- 1 | #' Adjust a regression coefficient using the partial R2 2 | #' for an unmeasured confounder-exposure relationship and unmeasured confounder- 3 | #' outcome relationship 4 | #' 5 | #' This function wraps the [`sensemakr::adjusted_estimate()`] and 6 | #' [`sensemakr::adjusted_se()`] functions. 7 | #' 8 | #' @param effect_observed Numeric. Observed exposure - outcome effect from a regression 9 | #' model. This is the point estimate (beta coefficient) 10 | #' @param se Numeric. Standard error of the `effect_observed` in the previous parameter. 11 | #' @param df Numeric positive value. Residual degrees of freedom for the model 12 | #' used to estimate the observed exposure - outcome effect. This is the total 13 | #' number of observations minus the number of parameters estimated in your 14 | #' model. Often for models estimated with an intercept this is N - k - 1 15 | #' where k is the number of predictors in the model. 16 | #' @param confounder_exposure_r2 Numeric value between 0 and 1. The assumed partial R2 of 17 | #' the unobserved confounder with the exposure given the measured covariates. 18 | #' @param confounder_outcome_r2 Numeric value between 0 and 1. The assumed partial R2 of 19 | #' the unobserved confounder with the outcome given the exposure and 20 | #' the measured covariates. 21 | #' @param verbose Logical. Indicates whether to print informative message. 22 | #' Default: `TRUE` 23 | #' @param alpha Significance level. Default = `0.05`. 24 | #' @param ... Optional arguments passed to the [`sensemakr::adjusted_estimate()`] 25 | #' function. 26 | #' @references Carlos Cinelli, Jeremy Ferwerda and Chad Hazlett (2021). 27 | #' sensemakr: Sensitivity Analysis 28 | #' Tools for Regression Models. R package version 0.1.4. 29 | #' https://CRAN.R-project.org/package=sensemakr 30 | #' @return A data frame. 31 | #' @export 32 | #' 33 | #' @examples 34 | #' adjust_coef_with_r2(0.5, 0.1, 102, 0.05, 0.1) 35 | adjust_coef_with_r2 <- function(effect_observed, 36 | se, 37 | df, 38 | confounder_exposure_r2, 39 | confounder_outcome_r2, 40 | verbose = getOption("tipr.verbose", TRUE), 41 | alpha = 0.05, 42 | ...) { 43 | effect_adjusted <- sensemakr::adjusted_estimate( 44 | estimate = effect_observed, 45 | se = se, 46 | dof = df, 47 | r2dz.x = confounder_exposure_r2, 48 | r2yz.dx = confounder_outcome_r2, 49 | ... 50 | ) 51 | se_adjusted <- sensemakr::adjusted_se( 52 | estimate = effect_observed, 53 | se = se, 54 | dof = df, 55 | r2dz.x = confounder_exposure_r2, 56 | r2yz.dx = confounder_outcome_r2, 57 | ... 58 | ) 59 | t_star <- stats::qt(alpha / 2, df = df, lower.tail = F) 60 | lb_observed <- effect_observed - t_star * se 61 | ub_observed <- effect_observed + t_star * se 62 | lb_adjusted <- effect_adjusted - t_star * se_adjusted 63 | ub_adjusted <- effect_adjusted + t_star * se_adjusted 64 | #TODO: verbose 65 | 66 | tibble::tibble( 67 | effect_adjusted = effect_adjusted, 68 | lb_adjusted = lb_adjusted, 69 | ub_adjusted = ub_adjusted, 70 | effect_observed = effect_observed, 71 | lb_observed = lb_observed, 72 | ub_observed = ub_observed, 73 | se_observed = se, 74 | df_observed = df, 75 | confounder_exposure_r2 = confounder_exposure_r2, 76 | confounder_outcome_r2 = confounder_outcome_r2 77 | ) 78 | } 79 | -------------------------------------------------------------------------------- /R/tip_coef_with_r2.R: -------------------------------------------------------------------------------- 1 | #' Tip a regression coefficient using the partial R2 2 | #' for an unmeasured confounder-exposure relationship and unmeasured confounder- 3 | #' outcome relationship 4 | #' 5 | #' Choose one of the following, and the other will be estimated: 6 | #' * `confounder_exposure_r2` 7 | #' * `confounder_outcome_r2` 8 | #' 9 | #' @param effect_observed Numeric. Observed exposure - outcome effect from a 10 | #' regression model. This is the point estimate (beta coefficient) 11 | #' @param se Numeric. Standard error of the `effect_observed` in the previous parameter. 12 | #' @param df Numeric positive value. Residual degrees of freedom for the model 13 | #' used to estimate the observed exposure - outcome effect. This is the total 14 | #' number of observations minus the number of parameters estimated in your 15 | #' model. Often for models estimated with an intercept this is N - k - 1 16 | #' where k is the number of predictors in the model. 17 | #' @param confounder_exposure_r2 Numeric value between 0 and 1. The assumed partial R2 of 18 | #' the unobserved confounder with the exposure given the measured covariates. 19 | #' @param confounder_outcome_r2 Numeric value between 0 and 1. The assumed partial R2 of 20 | #' the unobserved confounder with the outcome given the exposure and 21 | #' the measured covariates. 22 | #' @param verbose Logical. Indicates whether to print informative message. 23 | #' Default: `TRUE` 24 | #' @param alpha Significance level. Default = `0.05`. 25 | #' @param tip_bound Do you want to tip at the bound? Default = `FALSE`, will tip at the point estimate 26 | #' @param ... Optional arguments passed to the [`sensemakr::adjusted_estimate()`] 27 | #' function. 28 | #' @return A data frame. 29 | #' @export 30 | #' 31 | #' @examples 32 | #' tip_coef_with_r2(0.5, 0.1, 102, 0.5) 33 | tip_coef_with_r2 <- function(effect_observed, 34 | se, 35 | df, 36 | confounder_exposure_r2 = NULL, 37 | confounder_outcome_r2 = NULL, 38 | verbose = getOption("tipr.verbose", TRUE), 39 | alpha = 0.05, 40 | tip_bound = FALSE, 41 | ...) { 42 | if (is.null(confounder_exposure_r2)) { 43 | if (tip_bound) { 44 | confounder_exposure_r2 <- 45 | tip_exposure_r2_bound(effect_observed, se, df, confounder_outcome_r2, alpha) 46 | } else { 47 | confounder_exposure_r2 <- 48 | tip_exposure_r2(effect_observed, se, df, confounder_outcome_r2) 49 | } 50 | } else if (is.null(confounder_outcome_r2)) { 51 | if (tip_bound) { 52 | confounder_outcome_r2 <- 53 | tip_outcome_r2_bound(effect_observed, se, df, confounder_exposure_r2, alpha) 54 | } else{ 55 | confounder_outcome_r2 <- 56 | tip_outcome_r2(effect_observed, se, df, confounder_exposure_r2) 57 | } 58 | } 59 | o <- adjust_coef_with_r2( 60 | effect_observed = effect_observed, 61 | se = se, 62 | df = df, 63 | confounder_exposure_r2 = confounder_exposure_r2, 64 | confounder_outcome_r2 = confounder_outcome_r2, 65 | verbose = verbose, 66 | alpha = alpha, 67 | ... 68 | ) 69 | if (tip_bound && 70 | (round(o$lb_adjusted, 8) != 0 && round(o$ub_adjusted, 8) != 0)) { 71 | print(o) 72 | o <- adjust_coef_with_r2( 73 | effect_observed = effect_observed, 74 | se = se, 75 | df = df, 76 | confounder_exposure_r2 = confounder_exposure_r2, 77 | confounder_outcome_r2 = 0, 78 | verbose = verbose, 79 | alpha = alpha, 80 | ... 81 | ) 82 | } 83 | return(o) 84 | } 85 | -------------------------------------------------------------------------------- /tests/testthat/test-obp-helpers.R: -------------------------------------------------------------------------------- 1 | context("Observed bias plot helpers") 2 | 3 | ps_mod <- glm(am ~ cyl + hp + I(hp^2), data = mtcars, family = "binomial") 4 | outcome_mod <- lm(mpg ~ am + cyl + disp + wt + I(wt^2), data = mtcars) 5 | 6 | test_that("Check drop list works", { 7 | expect_error(check_drop_list("a"), "`drop_list` must be a named list.") 8 | 9 | expect_error(check_drop_list(list("a")), "`drop_list` must be a named list.") 10 | 11 | expect_error(check_drop_list(list(a = 1)), "`drop_list` must be") 12 | 13 | expect_silent(check_drop_list(list(a = "a"))) 14 | }) 15 | 16 | test_that("We can get y from lm or glm formulas", { 17 | expect_equal(get_y(lm(mpg ~ cyl, data = mtcars)), "mpg") 18 | 19 | expect_equal(get_y(glm(mpg ~ cyl, data = mtcars)), "mpg") 20 | 21 | }) 22 | 23 | test_that("We can get variables from lm or glm formulas", { 24 | expect_equal(parse_formula(lm(mpg ~ cyl, data = mtcars)), "cyl") 25 | 26 | expect_equal(parse_formula(glm(mpg ~ cyl, data = mtcars)), "cyl") 27 | 28 | }) 29 | 30 | test_that("create_covariate_lists pulls the correct covariates", { 31 | c <- create_covariate_lists(ps_mod, outcome_mod) 32 | 33 | expect_equal(c$exposure, "am") 34 | expect_equal(c$ps_covariates, c("cyl", "hp", "I(hp^2)")) 35 | expect_equal(c$ps_covariates_clean, c("cyl", "hp")) 36 | expect_equal(c$outcome_covariates, c("am", "cyl", "disp", "wt", "I(wt^2)")) 37 | expect_equal(c$outcome_covariates_clean, c("cyl", "disp", "wt")) 38 | }) 39 | 40 | test_that("drop_one_mod_tbl effectively creates a tbl for dropped covariate from both models", { 41 | t <- drop_one_mod_tbl("cyl", "cyl", 42 | create_covariate_lists(ps_mod, outcome_mod)) 43 | expect_equal(t$dropped, "cyl") 44 | expect_equal(t$new_ps[[1]], c("hp", "I(hp^2)")) 45 | expect_equal(t$new_outcome[[1]], c("am", "disp", "wt", "I(wt^2)")) 46 | 47 | }) 48 | 49 | test_that("drop_one_mod_tbl effectively creates a tbl for dropped covariate from ps model", { 50 | t <- drop_one_mod_tbl("hp", "hp", create_covariate_lists(ps_mod, outcome_mod)) 51 | expect_equal(t$dropped, "hp") 52 | expect_equal(t$new_ps[[1]], c("cyl")) 53 | expect_equal(t$new_outcome[[1]], c("am", "cyl", "disp", "wt", "I(wt^2)")) 54 | 55 | }) 56 | 57 | test_that("drop_one_mod_tbl effectively creates a tbl for dropped covariate from outcome model", { 58 | t <- drop_one_mod_tbl("disp", "disp", 59 | create_covariate_lists(ps_mod, outcome_mod)) 60 | expect_equal(t$dropped, "disp") 61 | expect_equal(t$new_ps[[1]], c("cyl", "hp", "I(hp^2)")) 62 | expect_equal(t$new_outcome[[1]], c("am", "cyl", "wt", "I(wt^2)")) 63 | }) 64 | 65 | test_that("drop_one_mod_tbl effectively creates a tbl for dropped group of covariates", { 66 | t <- drop_one_mod_tbl(c("disp", "cyl"), "disp and cyl", 67 | create_covariate_lists(ps_mod, outcome_mod)) 68 | expect_equal(t$dropped, "disp and cyl") 69 | expect_equal(t$new_ps[[1]], c("hp", "I(hp^2)")) 70 | expect_equal(t$new_outcome[[1]], c("am", "wt", "I(wt^2)")) 71 | }) 72 | 73 | test_that("drop_one_mod works for dropping all covariates", { 74 | t <- drop_one_mod_tbl(c("hp", "cyl"), "hp and cyl", 75 | create_covariate_lists(ps_mod, outcome_mod)) 76 | expect_equal(t$new_ps[[1]], 1) 77 | }) 78 | 79 | test_that("create_individual_covariate_list effectively creates a list of all covariates modelled", { 80 | c <- create_covariate_lists(ps_mod, outcome_mod) 81 | l <- create_individual_covariate_list(c) 82 | expect_silent(check_drop_list(l)) 83 | expect_length(l, 4) 84 | expect_equal(names(l), unlist(l, use.names = FALSE)) 85 | }) 86 | 87 | test_that("drop_tbl creates the appropriate tbl", { 88 | c <- create_covariate_lists(ps_mod, outcome_mod) 89 | l <- create_individual_covariate_list(c) 90 | covs <- c(list("disp and cyl" = c("disp", "cyl")), l) 91 | t <- drop_tbl(covs, c) 92 | expect_equal(t[1, "type", drop = TRUE], c("disp and cyl" = "group")) 93 | expect_equivalent(t[-1, "type", drop = TRUE], rep("covariate", 4)) 94 | expect_equal(t$new_ps[[1]], t$new_ps[[2]]) 95 | expect_equal(t$new_ps[[4]], t$new_ps[[5]]) 96 | expect_length(t$new_outcome[[3]], 5) 97 | }) 98 | 99 | test_that("build_formula works", { 100 | b <- build_formula("am", c("mpg", "cyl", "I(cyl^2)")) 101 | expect_s3_class(b, "formula") 102 | expect_equal(as.character(b[[2]]), "am") 103 | expect_equal(as.character(b[[3]])[1], "+") 104 | expect_equal(as.character(b[[3]])[2], "mpg + cyl") 105 | expect_equal(as.character(b[[3]])[3], "I(cyl^2)") 106 | }) 107 | 108 | test_that("clean_covariate works", { 109 | expect_equal(clean_covariate("I(hp^2)"), "hp") 110 | expect_equal(clean_covariate("rms::rcs(mpg)"), "mpg") 111 | expect_equal(clean_covariate("rms::rcs(mpg, 3)"), "mpg") 112 | expect_equal(clean_covariate("sqrt(mpg)"), "mpg") 113 | expect_equal(clean_covariate("log(mpg)"), "mpg") 114 | expect_equal(clean_covariate("sqrt(log(mpg))"), "mpg") 115 | expect_equal(clean_covariate("sqrt(log(mpg, 10))"), "mpg") 116 | expect_equal(clean_covariate("log(sqrt(mpg), 10))"), "mpg") 117 | }) 118 | -------------------------------------------------------------------------------- /CODE_OF_CONDUCT.md: -------------------------------------------------------------------------------- 1 | # Contributor Covenant Code of Conduct 2 | 3 | ## Our Pledge 4 | 5 | We as members, contributors, and leaders pledge to make participation in our 6 | community a harassment-free experience for everyone, regardless of age, body 7 | size, visible or invisible disability, ethnicity, sex characteristics, gender 8 | identity and expression, level of experience, education, socio-economic status, 9 | nationality, personal appearance, race, religion, or sexual identity and 10 | orientation. 11 | 12 | We pledge to act and interact in ways that contribute to an open, welcoming, 13 | diverse, inclusive, and healthy community. 14 | 15 | ## Our Standards 16 | 17 | Examples of behavior that contributes to a positive environment for our 18 | community include: 19 | 20 | * Demonstrating empathy and kindness toward other people 21 | * Being respectful of differing opinions, viewpoints, and experiences 22 | * Giving and gracefully accepting constructive feedback 23 | * Accepting responsibility and apologizing to those affected by our mistakes, 24 | and learning from the experience 25 | * Focusing on what is best not just for us as individuals, but for the overall 26 | community 27 | 28 | Examples of unacceptable behavior include: 29 | 30 | * The use of sexualized language or imagery, and sexual attention or 31 | advances of any kind 32 | * Trolling, insulting or derogatory comments, and personal or political attacks 33 | * Public or private harassment 34 | * Publishing others' private information, such as a physical or email 35 | address, without their explicit permission 36 | * Other conduct which could reasonably be considered inappropriate in a 37 | professional setting 38 | 39 | ## Enforcement Responsibilities 40 | 41 | Community leaders are responsible for clarifying and enforcing our standards 42 | of acceptable behavior and will take appropriate and fair corrective action in 43 | response to any behavior that they deem inappropriate, threatening, offensive, 44 | or harmful. 45 | 46 | Community leaders have the right and responsibility to remove, edit, or reject 47 | comments, commits, code, wiki edits, issues, and other contributions that are 48 | not aligned to this Code of Conduct, and will communicate reasons for moderation 49 | decisions when appropriate. 50 | 51 | ## Scope 52 | 53 | This Code of Conduct applies within all community spaces, and also applies 54 | when an individual is officially representing the community in public spaces. 55 | Examples of representing our community include using an official e-mail 56 | address, posting via an official social media account, or acting as an appointed 57 | representative at an online or offline event. 58 | 59 | ## Enforcement 60 | 61 | Instances of abusive, harassing, or otherwise unacceptable behavior may be 62 | reported to the community leaders responsible for enforcement at lucydagostino@gmail.com. 63 | All complaints will be reviewed and investigated promptly and fairly. 64 | 65 | All community leaders are obligated to respect the privacy and security of the 66 | reporter of any incident. 67 | 68 | ## Enforcement Guidelines 69 | 70 | Community leaders will follow these Community Impact Guidelines in determining 71 | the consequences for any action they deem in violation of this Code of Conduct: 72 | 73 | ### 1. Correction 74 | 75 | **Community Impact**: Use of inappropriate language or other behavior deemed 76 | unprofessional or unwelcome in the community. 77 | 78 | **Consequence**: A private, written warning from community leaders, providing 79 | clarity around the nature of the violation and an explanation of why the 80 | behavior was inappropriate. A public apology may be requested. 81 | 82 | ### 2. Warning 83 | 84 | **Community Impact**: A violation through a single incident or series of 85 | actions. 86 | 87 | **Consequence**: A warning with consequences for continued behavior. No 88 | interaction with the people involved, including unsolicited interaction with 89 | those enforcing the Code of Conduct, for a specified period of time. This 90 | includes avoiding interactions in community spaces as well as external channels 91 | like social media. Violating these terms may lead to a temporary or permanent 92 | ban. 93 | 94 | ### 3. Temporary Ban 95 | 96 | **Community Impact**: A serious violation of community standards, including 97 | sustained inappropriate behavior. 98 | 99 | **Consequence**: A temporary ban from any sort of interaction or public 100 | communication with the community for a specified period of time. No public or 101 | private interaction with the people involved, including unsolicited interaction 102 | with those enforcing the Code of Conduct, is allowed during this period. 103 | Violating these terms may lead to a permanent ban. 104 | 105 | ### 4. Permanent Ban 106 | 107 | **Community Impact**: Demonstrating a pattern of violation of community 108 | standards, including sustained inappropriate behavior, harassment of an 109 | individual, or aggression toward or disparagement of classes of individuals. 110 | 111 | **Consequence**: A permanent ban from any sort of public interaction within the 112 | community. 113 | 114 | ## Attribution 115 | 116 | This Code of Conduct is adapted from the [Contributor Covenant][homepage], 117 | version 2.0, 118 | available at . 119 | 120 | Community Impact Guidelines were inspired by [Mozilla's code of conduct 121 | enforcement ladder](https://github.com/mozilla/diversity). 122 | 123 | [homepage]: https://www.contributor-covenant.org 124 | 125 | For answers to common questions about this code of conduct, see the FAQ at 126 | . Translations are available at . 127 | -------------------------------------------------------------------------------- /R/tip_coef.R: -------------------------------------------------------------------------------- 1 | #' Tip a linear model coefficient with a continuous confounder. 2 | #' 3 | #' choose one of the following, and the other will be estimated: 4 | #' * `exposure_confounder_effect` 5 | #' * `confounder_outcome_effect` 6 | #' 7 | #' @param effect_observed Numeric. Observed exposure - outcome effect from 8 | #' a regression model. This can be the beta coefficient, the lower 9 | #' confidence bound of the beta coefficient, or the upper confidence bound 10 | #' of the beta coefficient. 11 | #' @param exposure_confounder_effect Numeric. Estimated scaled mean difference 12 | #' between the unmeasured confounder in the exposed population and unexposed 13 | #' population 14 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 15 | #' between the unmeasured confounder and the outcome 16 | #' @param verbose Logical. Indicates whether to print informative message. 17 | #' Default: `TRUE` 18 | #' 19 | #' @return Data frame. 20 | #' 21 | #' @examples 22 | #' ## to estimate the relationship between an unmeasured confounder and outcome 23 | #' ## needed to tip analysis 24 | #' tip_coef(1.2, exposure_confounder_effect = -2) 25 | #' 26 | #' ## to estimate the number of unmeasured confounders specified needed to tip 27 | #' ## the analysis 28 | #' tip_coef(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = -0.05) 29 | #' 30 | #' ## Example with broom 31 | #' if (requireNamespace("broom", quietly = TRUE) && 32 | #' requireNamespace("dplyr", quietly = TRUE)) { 33 | #' lm(wt ~ mpg, data = mtcars) %>% 34 | #' broom::tidy(conf.int = TRUE) %>% 35 | #' dplyr::filter(term == "mpg") %>% 36 | #' dplyr::pull(conf.low) %>% 37 | #' tip_coef(confounder_outcome_effect = 2.5) 38 | #'} 39 | #' @export 40 | tip_coef <- function(effect_observed, exposure_confounder_effect = NULL, confounder_outcome_effect = NULL, verbose = getOption("tipr.verbose", TRUE)) { 41 | check_arguments( 42 | "tip_coef()", 43 | exposure_confounder_effect, 44 | confounder_outcome_effect 45 | ) 46 | 47 | o <- purrr::map( 48 | effect_observed, 49 | ~ tip_coef_one(.x, 50 | exposure_confounder_effect = exposure_confounder_effect, 51 | confounder_outcome_effect = confounder_outcome_effect, 52 | verbose = verbose 53 | ) 54 | ) 55 | do.call(rbind, o) 56 | } 57 | 58 | tip_coef_one <- function(b, exposure_confounder_effect, confounder_outcome_effect, verbose) { 59 | 60 | n_unmeasured_confounders <- 1 61 | 62 | if (is.null(confounder_outcome_effect)) { 63 | confounder_outcome_effect <- b / exposure_confounder_effect 64 | } else if (is.null(exposure_confounder_effect)) { 65 | exposure_confounder_effect <- b / confounder_outcome_effect 66 | } else { 67 | n_unmeasured_confounders <- b / (exposure_confounder_effect * confounder_outcome_effect) 68 | if (any(n_unmeasured_confounders < 0)) { 69 | if (length(exposure_confounder_effect) > 1) { 70 | exposure_confounder_effects <- exposure_confounder_effect[n_unmeasured_confounders < 0] 71 | } else { 72 | exposure_confounder_effects <- exposure_confounder_effect 73 | } 74 | if (length(confounder_outcome_effect) > 1) { 75 | confounder_outcome_effects <- confounder_outcome_effect[n_unmeasured_confounders < 0] 76 | } else { 77 | confounder_outcome_effects <- confounder_outcome_effect 78 | } 79 | 80 | warning_cli(c( 81 | "!" = "The observed effect {b} would not tip with the unmeasured confounder given:", 82 | "*" = "`exposure_confounder_effect`: {exposure_confounder_effects}", 83 | "*" = "`confounder_outcome_effect`: {confounder_outcome_effects}\n\n" 84 | )) 85 | n_unmeasured_confounders <- max(0, n_unmeasured_confounders) 86 | } 87 | too_small <- 88 | n_unmeasured_confounders < 1 & n_unmeasured_confounders > 0 89 | if (any(too_small)) { 90 | exposure_confounder_effects <- ifelse(length(exposure_confounder_effect) > 1, exposure_confounder_effect[too_small], exposure_confounder_effect) 91 | confounder_outcome_effects <- 92 | ifelse(length(confounder_outcome_effect) > 1, 93 | confounder_outcome_effect[too_small], 94 | confounder_outcome_effect) 95 | warning_cli(c( 96 | "!" = "The observed effect {b} would tip with < 1 of the given unmeasured confounders:", 97 | "*" = "`exposure_confounder_effect`: {exposure_confounder_effects}", 98 | "*" = "`confounder_outcome_effect`: {confounder_outcome_effects}\n\n" 99 | )) 100 | } 101 | } 102 | o <- tibble::tibble( 103 | effect_observed = b, 104 | exposure_confounder_effect = exposure_confounder_effect, 105 | confounder_outcome_effect = confounder_outcome_effect, 106 | n_unmeasured_confounders = n_unmeasured_confounders 107 | ) 108 | if (verbose) { 109 | if (all(o$n_unmeasured_confounders == 0)) { 110 | o_notip <- o[o$n_unmeasured_confounders == 0,] 111 | message_cli(c( 112 | "i" = "The observed effect ({round(o_notip$effect_observed, 2)}) \\ 113 | cannot be tipped by an unmeasured confounder with the \\ 114 | following specifications:", 115 | "*" = "estimated difference in scaled means between the \\ 116 | unmeasured confounder in the exposed population and \\ 117 | unexposed population: {round(o_notip$exposure_confounder_effect, 2)}", 118 | "*" = "estimated relationship between the unmeasured confounder and \\ 119 | the outcome: {round(o_notip$confounder_outcome_effect, 2)}" 120 | )) 121 | } else if (any(o$n_unmeasured_confounders == 0)) { 122 | o_notip <- o[o$n_unmeasured_confounders == 0,] 123 | message_cli(c( 124 | "i" = "The observed effect ({round(o_notip$effect_observed, 2)}) \\ 125 | cannot be tipped by an unmeasured confounder with the \\ 126 | following specifications:", 127 | "*" = "estimated difference in scaled means between the \\ 128 | unmeasured confounder in the exposed population and \\ 129 | unexposed population: {round(o_notip$exposure_confounder_effect, 2)}", 130 | "*" = "estimated relationship between the unmeasured confounder and \\ 131 | the outcome: {round(o_notip$confounder_outcome_effect, 2)}" 132 | )) 133 | 134 | o_tip <- o[o$n_unmeasured_confounders != 0,] 135 | message_cli(c( 136 | "i" = "The observed effect ({round(o_tip$effect_observed, 2)}) WOULD \\ 137 | be tipped by {round(o$n_unmeasured_confounders)} \\ 138 | unmeasured confounder{ifelse(o_tip$n_unmeasured_confounders > 1, 's', '')}\n \\ 139 | with the following specifications:", 140 | "*" = "estimated difference in scaled means between the \\ 141 | unmeasured confounder in the exposed population and \\ 142 | unexposed population: {round(o_tip$exposure_confounder_effect, 2)}", 143 | "*" = "estimated relationship between the unmeasured confounder and \\ 144 | the outcome: {round(o_tip$confounder_outcome_effect, 2)}" 145 | )) 146 | } else { 147 | message_cli(c( 148 | "i" = "The observed effect ({round(o$effect_observed, 2)}) WOULD \\ 149 | be tipped by {round(o$n_unmeasured_confounders)} \\ 150 | unmeasured confounder{ifelse(o$n_unmeasured_confounders > 1, 's', '')}\n \\ 151 | with the following specifications:", 152 | "*" = "estimated difference in scaled means between the \\ 153 | unmeasured confounder\n in the exposed population and \\ 154 | unexposed population: {round(o$exposure_confounder_effect, 2)}", 155 | "*" = "estimated relationship between the unmeasured confounder \\ 156 | and the outcome: {round(o$confounder_outcome_effect, 2)}" 157 | )) 158 | } 159 | } 160 | o 161 | } 162 | 163 | 164 | #' @rdname tip_coef 165 | #' @export 166 | tip_coef_with_continuous <- tip_coef 167 | -------------------------------------------------------------------------------- /README.Rmd: -------------------------------------------------------------------------------- 1 | --- 2 | output: github_document 3 | --- 4 | 5 | 6 | # tipr: R tools for tipping point sensitivity analyses 7 | 8 | 9 | [![R-CMD-check](https://github.com/r-causal/tipr/workflows/R-CMD-check/badge.svg)](https://github.com/r-causal/tipr/actions) 10 | [![DOI](https://joss.theoj.org/papers/10.21105/joss.04495/status.svg)](https://doi.org/10.21105/joss.04495) 11 | 12 | 13 | **Authors:** [Lucy D'Agostino McGowan](https://www.lucymcgowan.com/), [Malcolm Barrett](https://malco.io/)
14 | **License:** [MIT](https://opensource.org/license/mit/) 15 | 16 | 17 | ## Installation 18 | 19 | Install the CRAN version 20 | 21 | ```{r, eval = FALSE} 22 | install.packages("tipr") 23 | ``` 24 | 25 | Or install the development version from GitHub: 26 | 27 | ```{r, eval = FALSE} 28 | # install.packages(devtools) 29 | devtools::install_github("r-causal/tipr") 30 | ``` 31 | 32 | ```{r} 33 | library(tipr) 34 | ``` 35 | 36 | ## Usage 37 | 38 | After fitting your model, you can determine the unmeasured confounder needed to tip your analysis. This unmeasured confounder is determined by two quantities, the relationship between the exposure and the unmeasured confounder (if the unmeasured confounder is continuous, this is indicated with `exposure_confounder_effect`, if binary, with `exposed_confounder_prev` and `unexposed_confounder_prev`), and the relationship between the unmeasured confounder and outcome `confounder_outcome_effect`. Using this `r emo::ji("package")`, we can fix one of these and solve for the other. Alternatively, we can fix both and solve for `n`, that is, how many unmeasured confounders of this magnitude would tip the analysis. 39 | 40 | This package comes with a few example data sets. For this example, we will use `exdata_rr`. This data set was simulated such that there are two confounders, one that was "measured" (and thus usable in the main analysis, this is called `measured_confounder`) and one that is "unmeasured" (we have access to it because this is simulated data, but ordinarily we would not, this variable is called `.unmeasured_confounder`). 41 | 42 | Using the example data `exdata_rr`, we can estimate the exposure-outcome relationship using the measured confounder as follows: 43 | 44 | ```{r} 45 | mod <- glm(outcome ~ exposure + measured_confounder, data = exdata_rr, 46 | family = poisson) 47 | 48 | mod |> 49 | broom::tidy(exponentiate = TRUE, conf.int = TRUE) 50 | ``` 51 | 52 | We see the above example, the exposure-outcome relationship is 1.5 (95% CI: 1.1, 2.1). Note, in practice when estimating the effect of an exposure on a binary outcome using a GLM with the Poisson distribution and log link function, it is important to use a sandwich estimator to appropriately estimate the variability (this can be done in R using the `sandwich` package), which in this case gives a very similar result (95% CI: 1.1, 2.0). 53 | 54 | ## Continuous unmeasured confounder example 55 | 56 | We are interested in a continuous unmeasured confounder, so we will use the `tip_with_continuous()` function. 57 | 58 | Let's assume the unmeasured confounder is normally distributed with a mean of 0.5 in the exposed group and 0 in the unexposed (and unit variance in both), resulting in a mean difference of 0.5 (`exposure_confounder_effect = 0.5`), let's solve for the relationship between the unmeasured confounder and outcome needed to tip the analysis (in this case, we are solving for `confounder_outcome_effect`). 59 | 60 | ```{r} 61 | tip(effect_observed = 1.5, exposure_confounder_effect = 0.5) 62 | ``` 63 | 64 | A hypothetical unobserved continuous confounder a scaled mean difference between exposure groups of `0.5` would need a relationship of at least 2.25 with the outcome to tip this analysis at the point estimate. 65 | 66 | ```{r} 67 | tip(effect_observed = 1.09, exposure_confounder_effect = 0.5) 68 | ``` 69 | 70 | A hypothetical unobserved continuous confounder a scaled mean difference between exposure groups of `0.5` would need a relationship of at least 1.19 with the outcome to tip this analysis at the 5% level, rendering it inconclusive. 71 | 72 | Because this is simulated data, we can see what the *true* unmeasured confounder looked like. First we will calculate the difference in scaled means. 73 | 74 | ```{r} 75 | exdata_rr |> 76 | dplyr::group_by(exposure) |> 77 | dplyr::summarise(m = mean(.unmeasured_confounder / sd(.unmeasured_confounder))) |> 78 | tidyr::pivot_wider(names_from = exposure, 79 | values_from = m, 80 | names_prefix = "u_") |> 81 | dplyr::summarise(estimate = u_1 - u_0) 82 | ``` 83 | 84 | Now we can refit the above model with this unmeasured confounder included. According to our tipping point result, as long as the risk ratio of the unmeasured confounder and outcome in the model is greater than 2.25, the result that we observed will be "tipped" (the point estimate will cross the null). 85 | 86 | ```{r} 87 | mod_true <- glm( 88 | outcome ~ exposure + measured_confounder + .unmeasured_confounder, 89 | data = exdata_rr, 90 | family = poisson) 91 | 92 | mod_true |> 93 | broom::tidy(exponentiate = TRUE, conf.int = TRUE) 94 | ``` 95 | 96 | Notice here the `.unmeasured_confounder` effect is 2.42 (which is greater than the 2.25 we calculated that would be needed to render our result null) and, as expected, the point estimate for the `exposure` has crossed the null (and now is less than 1). 97 | 98 | ## Binary unmeasured confounder example 99 | 100 | Now we are interested in the binary unmeasured confounder, so we will use the `tip_with_binary()` function. 101 | 102 | Let's assume the unmeasured confounder is prevalent in 25% of the exposed population (`exposed_confounder_prev = 0.25`) and in 10% of the unexposed population (`unexposed_confounder_prev = 0.10`) -- let's solve for the relationship between the unmeasured confounder and the outcome needed to tip the analysis (`confounder_outcome_effect`). 103 | 104 | ```{r} 105 | tip_with_binary(effect_observed = 1.09, 106 | exposed_confounder_prev = 0.25, 107 | unexposed_confounder_prev = 0.10) 108 | ``` 109 | 110 | A hypothetical unobserved binary confounder that is prevalent in 10% of the unexposed population and 25% of the exposed population would need to have a relationship with the outcome of 1.64 to tip this analysis at the 5% level, rendering it inconclusive. 111 | 112 | ## Many unmeasured confounders 113 | 114 | Suppose we are concerned that there are many small, independent, continuous, unmeasured confounders present. 115 | 116 | ```{r} 117 | tip(effect_observed = 1.09, 118 | exposure_confounder_effect = 0.25, 119 | confounder_outcome_effect = 1.05) 120 | ``` 121 | 122 | It would take about `7` independent standardized Normal unmeasured confounders with a mean difference between exposure groups of 0.25 and a relationship with the outcome of 1.05 tip the observed analysis at the 5% level, rendering it inconclusive. 123 | 124 | ## Integration with broom 125 | 126 | These functions were created to easily integrate with models tidied using the **broom** package. This is not _necessary_ to use these functions, but a nice feature if you choose to do so. Here is an example of a logistic regression fit with `glm` and tidied with the `tidy` function **broom** that can be directly fed into the `tip()` function. 127 | 128 | ```{r} 129 | if (requireNamespace("broom", quietly = TRUE) && requireNamespace("dplyr", quietly = TRUE)) { 130 | glm(outcome ~ exposure + measured_confounder, data = exdata_rr, 131 | family = poisson) |> 132 | broom::tidy(conf.int = TRUE, exponentiate = TRUE) |> 133 | dplyr::filter(term == "exposure") |> 134 | dplyr::pull(conf.low) |> 135 | tip(confounder_outcome_effect = 2.5) 136 | } 137 | ``` 138 | 139 | ## Code of Conduct 140 | 141 | Please note that the tipr project is released with a [Contributor Code of Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). By contributing to this project, you agree to abide by its terms. 142 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | # tipr: R tools for tipping point sensitivity analyses 5 | 6 | 7 | 8 | [![R-CMD-check](https://github.com/r-causal/tipr/workflows/R-CMD-check/badge.svg)](https://github.com/r-causal/tipr/actions) 9 | [![DOI](https://joss.theoj.org/papers/10.21105/joss.04495/status.svg)](https://doi.org/10.21105/joss.04495) 10 | 11 | 12 | **Authors:** [Lucy D’Agostino McGowan](https://www.lucymcgowan.com/), 13 | [Malcolm Barrett](https://malco.io/)
**License:** 14 | [MIT](https://opensource.org/license/mit/) 15 | 16 | ## Installation 17 | 18 | Install the CRAN version 19 | 20 | ``` r 21 | install.packages("tipr") 22 | ``` 23 | 24 | Or install the development version from GitHub: 25 | 26 | ``` r 27 | # install.packages(devtools) 28 | devtools::install_github("r-causal/tipr") 29 | ``` 30 | 31 | ``` r 32 | library(tipr) 33 | ``` 34 | 35 | ## Usage 36 | 37 | After fitting your model, you can determine the unmeasured confounder 38 | needed to tip your analysis. This unmeasured confounder is determined by 39 | two quantities, the relationship between the exposure and the unmeasured 40 | confounder (if the unmeasured confounder is continuous, this is 41 | indicated with `exposure_confounder_effect`, if binary, with 42 | `exposed_confounder_prev` and `unexposed_confounder_prev`), and the 43 | relationship between the unmeasured confounder and outcome 44 | `confounder_outcome_effect`. Using this 📦, we can fix one of these and 45 | solve for the other. Alternatively, we can fix both and solve for `n`, 46 | that is, how many unmeasured confounders of this magnitude would tip the 47 | analysis. 48 | 49 | This package comes with a few example data sets. For this example, we 50 | will use `exdata_rr`. This data set was simulated such that there are 51 | two confounders, one that was “measured” (and thus usable in the main 52 | analysis, this is called `measured_confounder`) and one that is 53 | “unmeasured” (we have access to it because this is simulated data, but 54 | ordinarily we would not, this variable is called 55 | `.unmeasured_confounder`). 56 | 57 | Using the example data `exdata_rr`, we can estimate the exposure-outcome 58 | relationship using the measured confounder as follows: 59 | 60 | ``` r 61 | mod <- glm(outcome ~ exposure + measured_confounder, data = exdata_rr, 62 | family = poisson) 63 | 64 | mod |> 65 | broom::tidy(exponentiate = TRUE, conf.int = TRUE) 66 | ``` 67 | 68 | ## # A tibble: 3 × 7 69 | ## term estimate std.error statistic p.value conf.low conf.high 70 | ## 71 | ## 1 (Intercept) 0.0366 0.151 -21.9 2.56e-106 0.0269 0.0486 72 | ## 2 exposure 1.49 0.166 2.43 1.52e- 2 1.09 2.08 73 | ## 3 measured_confounder 2.43 0.0754 11.7 7.51e- 32 2.09 2.81 74 | 75 | We see the above example, the exposure-outcome relationship is 1.5 (95% 76 | CI: 1.1, 2.1). Note, in practice when estimating the effect of an 77 | exposure on a binary outcome using a GLM with the Poisson distribution 78 | and log link function, it is important to use a sandwich estimator to 79 | appropriately estimate the variability (this can be done in R using the 80 | `sandwich` package), which in this case gives a very similar result (95% 81 | CI: 1.1, 2.0). 82 | 83 | ## Continuous unmeasured confounder example 84 | 85 | We are interested in a continuous unmeasured confounder, so we will use 86 | the `tip_with_continuous()` function. 87 | 88 | Let’s assume the unmeasured confounder is normally distributed with a 89 | mean of 0.5 in the exposed group and 0 in the unexposed (and unit 90 | variance in both), resulting in a mean difference of 0.5 91 | (`exposure_confounder_effect = 0.5`), let’s solve for the relationship 92 | between the unmeasured confounder and outcome needed to tip the analysis 93 | (in this case, we are solving for `confounder_outcome_effect`). 94 | 95 | ``` r 96 | tip(effect_observed = 1.5, exposure_confounder_effect = 0.5) 97 | ``` 98 | 99 | ## ℹ The observed effect (1.5) WOULD be tipped by 1 unmeasured confounder with the 100 | ## following specifications: 101 | ## • estimated difference in scaled means between the unmeasured confounder in the 102 | ## exposed population and unexposed population: 0.5 103 | ## • estimated relationship between the unmeasured confounder and the outcome: 104 | ## 2.25 105 | 106 | ## # A tibble: 1 × 5 107 | ## effect_adjusted effect_observed exposure_confounder_e…¹ confounder_outcome_e…² 108 | ## 109 | ## 1 1 1.5 0.5 2.25 110 | ## # ℹ abbreviated names: ¹​exposure_confounder_effect, ²​confounder_outcome_effect 111 | ## # ℹ 1 more variable: n_unmeasured_confounders 112 | 113 | A hypothetical unobserved continuous confounder a scaled mean difference 114 | between exposure groups of `0.5` would need a relationship of at least 115 | 2.25 with the outcome to tip this analysis at the point estimate. 116 | 117 | ``` r 118 | tip(effect_observed = 1.09, exposure_confounder_effect = 0.5) 119 | ``` 120 | 121 | ## ℹ The observed effect (1.09) WOULD be tipped by 1 unmeasured confounder with 122 | ## the following specifications: 123 | ## • estimated difference in scaled means between the unmeasured confounder in the 124 | ## exposed population and unexposed population: 0.5 125 | ## • estimated relationship between the unmeasured confounder and the outcome: 126 | ## 1.19 127 | 128 | ## # A tibble: 1 × 5 129 | ## effect_adjusted effect_observed exposure_confounder_e…¹ confounder_outcome_e…² 130 | ## 131 | ## 1 1 1.09 0.5 1.19 132 | ## # ℹ abbreviated names: ¹​exposure_confounder_effect, ²​confounder_outcome_effect 133 | ## # ℹ 1 more variable: n_unmeasured_confounders 134 | 135 | A hypothetical unobserved continuous confounder a scaled mean difference 136 | between exposure groups of `0.5` would need a relationship of at least 137 | 1.19 with the outcome to tip this analysis at the 5% level, rendering it 138 | inconclusive. 139 | 140 | Because this is simulated data, we can see what the *true* unmeasured 141 | confounder looked like. First we will calculate the difference in scaled 142 | means. 143 | 144 | ``` r 145 | exdata_rr |> 146 | dplyr::group_by(exposure) |> 147 | dplyr::summarise(m = mean(.unmeasured_confounder / sd(.unmeasured_confounder))) |> 148 | tidyr::pivot_wider(names_from = exposure, 149 | values_from = m, 150 | names_prefix = "u_") |> 151 | dplyr::summarise(estimate = u_1 - u_0) 152 | ``` 153 | 154 | ## # A tibble: 1 × 1 155 | ## estimate 156 | ## 157 | ## 1 0.494 158 | 159 | Now we can refit the above model with this unmeasured confounder 160 | included. According to our tipping point result, as long as the risk 161 | ratio of the unmeasured confounder and outcome in the model is greater 162 | than 2.25, the result that we observed will be “tipped” (the point 163 | estimate will cross the null). 164 | 165 | ``` r 166 | mod_true <- glm( 167 | outcome ~ exposure + measured_confounder + .unmeasured_confounder, 168 | data = exdata_rr, 169 | family = poisson) 170 | 171 | mod_true |> 172 | broom::tidy(exponentiate = TRUE, conf.int = TRUE) 173 | ``` 174 | 175 | ## # A tibble: 4 × 7 176 | ## term estimate std.error statistic p.value conf.low conf.high 177 | ## 178 | ## 1 (Intercept) 0.0245 0.163 -22.7 1.49e-114 0.0176 0.0334 179 | ## 2 exposure 0.921 0.172 -0.477 6.34e- 1 0.660 1.30 180 | ## 3 measured_confounder 2.44 0.0746 11.9 6.95e- 33 2.11 2.82 181 | ## 4 .unmeasured_confoun… 2.42 0.0742 11.9 1.35e- 32 2.09 2.80 182 | 183 | Notice here the `.unmeasured_confounder` effect is 2.42 (which is 184 | greater than the 2.25 we calculated that would be needed to render our 185 | result null) and, as expected, the point estimate for the `exposure` has 186 | crossed the null (and now is less than 1). 187 | 188 | ## Binary unmeasured confounder example 189 | 190 | Now we are interested in the binary unmeasured confounder, so we will 191 | use the `tip_with_binary()` function. 192 | 193 | Let’s assume the unmeasured confounder is prevalent in 25% of the 194 | exposed population (`exposed_confounder_prev = 0.25`) and in 10% of the 195 | unexposed population (`unexposed_confounder_prev = 0.10`) – let’s solve 196 | for the relationship between the unmeasured confounder and the outcome 197 | needed to tip the analysis (`confounder_outcome_effect`). 198 | 199 | ``` r 200 | tip_with_binary(effect_observed = 1.09, 201 | exposed_confounder_prev = 0.25, 202 | unexposed_confounder_prev = 0.10) 203 | ``` 204 | 205 | ## ℹ The observed effect (1.09) WOULD be tipped by 1 unmeasured confounder with 206 | ## the following specifications: 207 | ## • estimated prevalence of the unmeasured confounder in the exposed population: 208 | ## 0.25 209 | ## • estimated prevalence of the unmeasured confounder in the unexposed 210 | ## population: 0.1 211 | ## • estimated relationship between the unmeasured confounder and the outcome: 212 | ## 1.64 213 | 214 | ## # A tibble: 1 × 6 215 | ## effect_adjusted effect_observed exposed_confounder_prev unexposed_confounder…¹ 216 | ## 217 | ## 1 1 1.09 0.25 0.1 218 | ## # ℹ abbreviated name: ¹​unexposed_confounder_prev 219 | ## # ℹ 2 more variables: confounder_outcome_effect , 220 | ## # n_unmeasured_confounders 221 | 222 | A hypothetical unobserved binary confounder that is prevalent in 10% of 223 | the unexposed population and 25% of the exposed population would need to 224 | have a relationship with the outcome of 1.64 to tip this analysis at the 225 | 5% level, rendering it inconclusive. 226 | 227 | ## Many unmeasured confounders 228 | 229 | Suppose we are concerned that there are many small, independent, 230 | continuous, unmeasured confounders present. 231 | 232 | ``` r 233 | tip(effect_observed = 1.09, 234 | exposure_confounder_effect = 0.25, 235 | confounder_outcome_effect = 1.05) 236 | ``` 237 | 238 | ## ℹ The observed effect (1.09) WOULD be tipped by 7 unmeasured confounders with 239 | ## the following specifications: 240 | ## • estimated difference in scaled means between the unmeasured confounder in the 241 | ## exposed population and unexposed population: 0.25 242 | ## • estimated relationship between the unmeasured confounder and the outcome: 243 | ## 1.05 244 | 245 | ## # A tibble: 1 × 5 246 | ## effect_adjusted effect_observed exposure_confounder_e…¹ confounder_outcome_e…² 247 | ## 248 | ## 1 1 1.09 0.25 1.05 249 | ## # ℹ abbreviated names: ¹​exposure_confounder_effect, ²​confounder_outcome_effect 250 | ## # ℹ 1 more variable: n_unmeasured_confounders 251 | 252 | It would take about `7` independent standardized Normal unmeasured 253 | confounders with a mean difference between exposure groups of 0.25 and a 254 | relationship with the outcome of 1.05 tip the observed analysis at the 255 | 5% level, rendering it inconclusive. 256 | 257 | ## Integration with broom 258 | 259 | These functions were created to easily integrate with models tidied 260 | using the **broom** package. This is not *necessary* to use these 261 | functions, but a nice feature if you choose to do so. Here is an example 262 | of a logistic regression fit with `glm` and tidied with the `tidy` 263 | function **broom** that can be directly fed into the `tip()` function. 264 | 265 | ``` r 266 | if (requireNamespace("broom", quietly = TRUE) && requireNamespace("dplyr", quietly = TRUE)) { 267 | glm(outcome ~ exposure + measured_confounder, data = exdata_rr, 268 | family = poisson) |> 269 | broom::tidy(conf.int = TRUE, exponentiate = TRUE) |> 270 | dplyr::filter(term == "exposure") |> 271 | dplyr::pull(conf.low) |> 272 | tip(confounder_outcome_effect = 2.5) 273 | } 274 | ``` 275 | 276 | ## ℹ The observed effect (1.09) WOULD be tipped by 1 unmeasured confounder with 277 | ## the following specifications: 278 | ## • estimated difference in scaled means between the unmeasured confounder in the 279 | ## exposed population and unexposed population: 0.09 280 | ## • estimated relationship between the unmeasured confounder and the outcome: 2.5 281 | 282 | ## # A tibble: 1 × 5 283 | ## effect_adjusted effect_observed exposure_confounder_e…¹ confounder_outcome_e…² 284 | ## 285 | ## 1 1 1.09 0.0907 2.5 286 | ## # ℹ abbreviated names: ¹​exposure_confounder_effect, ²​confounder_outcome_effect 287 | ## # ℹ 1 more variable: n_unmeasured_confounders 288 | 289 | ## Code of Conduct 290 | 291 | Please note that the tipr project is released with a [Contributor Code 292 | of 293 | Conduct](https://contributor-covenant.org/version/2/0/CODE_OF_CONDUCT.html). 294 | By contributing to this project, you agree to abide by its terms. 295 | -------------------------------------------------------------------------------- /R/tip-helpers.R: -------------------------------------------------------------------------------- 1 | get_limiting_bound <- function(lb = NULL, ub = NULL) { 2 | if (is.null(lb) || is.null(ub)) { 3 | stop_cli(c( 4 | x = "Please input a dataset `d` that contains your observed confidence \\ 5 | interval. Be sure your column names match `lb_name` and `ub_name`" 6 | )) 7 | } 8 | if (lb < 0 || ub < 0) { 9 | stop_cli(c( 10 | "x" = "You input: ({lb}, {ub})\n", 11 | "i" = "We are expecting an odds ratio, hazard ratio, or risk ratio; \\ 12 | therefore, the bounds should not be less than 0." 13 | )) 14 | } 15 | if (lb > 1 && ub > 1) { 16 | return(lb) 17 | } 18 | if (lb < 1 && ub < 1) { 19 | return(ub) 20 | } 21 | stop_cli(c( 22 | "x" = "You input: ({lb}, {ub})\n", 23 | "*" = "Please input a significant result." 24 | )) 25 | } 26 | 27 | get_lm_limiting_bound <- function(lb = NULL, ub = NULL) { 28 | if (is.null(lb) || is.null(ub)) { 29 | stop_cli(c( 30 | x = "Please input a dataset `d` that contains your observed confidence \\ 31 | interval. Be sure your column names match `lb_name` and `ub_name`" 32 | )) 33 | } 34 | 35 | if (lb > 0 && ub > 0) { 36 | return(lb) 37 | } 38 | if (lb < 0 && ub < 0) { 39 | return(ub) 40 | } 41 | 42 | stop_cli(c( 43 | "x" = "You input: ({lb}, {ub})\n", 44 | "*" = "Please input a significant result." 45 | )) 46 | } 47 | 48 | get_limiting_bound_adj <- function(b = NULL, 49 | lb = NULL, 50 | ub = NULL) { 51 | if (is.null(lb) || is.null(ub)) { 52 | stop_cli(c( 53 | x = "Please input a data frame `d` that contains for your observed \\ 54 | confidence interval." 55 | )) 56 | } 57 | if (lb < 0 || ub < 0) { 58 | stop_cli(c( 59 | "x" = "You input: ({lb}, {ub})", 60 | "i" = "We are expecting an odds ratio, hazard ratio, or risk ratio; \\ 61 | therefore, the lower or upper bounds in `d` should not be less than 0." 62 | )) 63 | } 64 | if (b > 1) { 65 | return(lb) 66 | } 67 | if (b < 1) { 68 | return(ub) 69 | } 70 | } 71 | 72 | check_gamma <- function(gamma = NULL) { 73 | if (!is.null(gamma) && gamma < 0) { 74 | stop_cli(c( 75 | "x" = "You input: `outcome_effect`: {gamma}", 76 | "i" = "We are expecting a risk ratio, odds ratio, or hazard ratio; // 77 | therefore `outcome_effect` should not be less than 0." 78 | )) 79 | } 80 | } 81 | 82 | check_effect <- function(x) { 83 | if (x < 0) { 84 | stop_cli(c( 85 | "x" = "You input an observed effect of {x}", 86 | "*" = "We are expecting a risk ratio, odds ratio, or hazard ratio; \\ 87 | therefore your effect should not be less than 0." 88 | )) 89 | } 90 | } 91 | 92 | 93 | 94 | check_prevalences <- function(p0 = NULL, p1 = NULL) { 95 | if (is.null(p0)) { 96 | if (any(p1 < 0 | p1 > 1)) { 97 | stop_cli(c( 98 | "x" = "You input: `exposed_confounder_prev`: {p1}", 99 | "i" = "The prevalences entered must be between 0 and 1." 100 | )) 101 | } 102 | } else if (is.null(p1)) { 103 | if (any(p0 < 0 | p0 > 1)) { 104 | 105 | stop_cli(c( 106 | "x" = "You input: `unexposed_confounder_prev`: {p0}", 107 | "i" = "The prevalences entered must be between 0 and 1." 108 | )) 109 | } 110 | } else if (any(p1 < 0 | p0 < 0 | p1 > 1 | p0 > 1)) { 111 | stop_cli(c( 112 | "x" = "You input: `unexposed_confounder_prev`: {p0}, and \\ 113 | `exposed_confounder_prev`: {p1}", 114 | "i" = "The prevalences entered must be between 0 and 1." 115 | )) 116 | } 117 | } 118 | 119 | tip_gamma <- function(p0 = NULL, 120 | p1 = NULL, 121 | b = NULL) { 122 | 123 | check_prevalences(p0, p1) 124 | 125 | gamma <- ((1 - p1) + b * (p0 - 1)) / (b * p0 - p1) 126 | 127 | if (gamma < 0) { 128 | stop_cli(c( 129 | "x" = "Given these prevalences (`unexposed_confounder_prev`: {p0}, \\ 130 | `exposed_confounder_prev`: {p1}), there does not exist an unmeasured \\ 131 | confounder that could tip this.", 132 | "*" = "Please specifiy a larger prevalence difference \\ 133 | (ie: make `unexposed_confounder_prev` and `exposed_confounder_prev` \\ 134 | farther apart)." 135 | )) 136 | } 137 | as.numeric(gamma) 138 | } 139 | 140 | check_r2 <- function(r2, exposure = FALSE, effect, se, df) { 141 | if (any(r2 < 0) | any(r2 > 1)) { 142 | stop_cli(c( 143 | "x" = "You input `r2`: {r2}", 144 | "i" = "The partial R2 values entered must be between 0 and 1." 145 | )) 146 | } 147 | if (exposure) { 148 | if (any(r2 == 1)) { 149 | stop_cli(c( 150 | "x" = "You input `exposure_r2`: {r2}", 151 | "i" = "This means 100% of the residual variation in the exposure \\ 152 | is explained by the unmeasured confounder, meaning regardless \\ 153 | of the unmeasured confounder - outcome relationship, this \\ 154 | will be tipped." 155 | )) 156 | } 157 | limit <- sensemakr::partial_r2(effect / se, df) 158 | if (any(r2 < limit)) { 159 | stop_cli(c( 160 | "x" = "You input `exposure_r2`: {r2[r2 < limit]}", 161 | "i" = "It is not possible to tip this result with any unmeasured \\ 162 | confounder - outcome relationship. In fact, if your \\ 163 | unmeasured confounder explained 100% of the residual \\ 164 | variation in your outcome, the partial R2 for the unmeasured \\ 165 | confounder - exposure relationship would have to be \\ 166 | {round(limit, 3)} for the exposure - outcome relationship \\ 167 | to be explained away." 168 | )) 169 | } 170 | } 171 | } 172 | tip_exposure_r2 <- function(effect, se, df, outcome_r2) { 173 | if (is.null(outcome_r2)) { 174 | stop_cli(c( 175 | "x" = "Please input at least one of the following:", 176 | "*" = "`exposure_r2`", 177 | "*" = "`outcome_r2`" 178 | )) 179 | } 180 | check_r2(outcome_r2) 181 | 182 | exposure_r2 <- 183 | effect ^ 2 / (effect ^ 2 + se ^ 2 * df * outcome_r2) 184 | if (any(exposure_r2 > 1)) { 185 | stop_cli(c( 186 | "x" = "Given the input `effect`: {effect}, \\ 187 | `outcome_r2`: {outcome_r2[exposure_r2 > 1]}, \\ 188 | there does not exist an unmeasured confounder that could tip this." 189 | )) 190 | } 191 | as.numeric(exposure_r2) 192 | } 193 | tip_exposure_r2_bound <- 194 | function(effect, se, df, outcome_r2, alpha) { 195 | if (is.null(outcome_r2)) { 196 | stop_cli(c( 197 | "x" = "Please input at least one of the following:", 198 | "*" = "`exposure_r2`", 199 | "*" = "`outcome_r2`" 200 | )) 201 | } 202 | check_r2(outcome_r2) 203 | 204 | t_star <- stats::qt(alpha / 2, df = df, lower.tail = F) 205 | lb <- effect - t_star * se 206 | ub <- effect + t_star * se 207 | 208 | y <- outcome_r2 209 | a <- effect 210 | b <- se 211 | c <- df 212 | d <- t_star 213 | exposure_r2 <- 214 | ( 215 | 2 * a ^ 4 - (2 * a ^ 2 * b ^ 2 * d ^ 2 * y) / (1 - c) + (2 * a ^ 2 * b ^ 216 | 2 * d ^ 2) / (1 - c) + 217 | 2 * a ^ 2 * b ^ 2 * c * y + 2 * a ^ 2 * b ^ 2 * d ^ 218 | 2 * y - 2 * a ^ 2 * b ^ 2 * d ^ 2 - 219 | sqrt(( 220 | -2 * a ^ 4 + (2 * a ^ 2 * b ^ 2 * d ^ 2 * y) / (1 - c) - 221 | (2 * a ^ 2 * b ^ 2 * d ^ 2) / (1 - c) - 222 | 2 * a ^ 2 * b ^ 2 * c * y - 2 * a ^ 2 * b ^ 223 | 2 * d ^ 2 * y + 224 | 2 * a ^ 2 * b ^ 2 * d ^ 2 + 2 * b ^ 4 * c * d ^ 225 | 2 * y ^ 2 - 226 | (2 * b ^ 4 * d ^ 2 * y ^ 2) / (1 - c) - 2 * b ^ 227 | 4 * c * d ^ 2 * y + 228 | (2 * b ^ 4 * d ^ 2 * y) / (1 - c) + 2 * b ^ 229 | 4 * d ^ 2 * y ^ 2 - 230 | 2 * b ^ 4 * d ^ 2 * y 231 | ) ^ 2 - 4 * (a ^ 4 + 2 * a ^ 2 * b ^ 2 * c * y + 232 | b ^ 4 * c ^ 233 | 2 * y ^ 2) * 234 | ( 235 | a ^ 4 - (2 * a ^ 2 * b ^ 2 * d ^ 2 * y) / (1 - c) + 236 | (2 * a ^ 2 * b ^ 2 * d ^ 2) / (1 - c) + 237 | 2 * a ^ 2 * b ^ 2 * d ^ 2 * y - 2 * a ^ 238 | 2 * b ^ 2 * d ^ 2 - 239 | (2 * b ^ 4 * d ^ 4 * y ^ 2) / (1 - c) + 240 | (b ^ 4 * d ^ 4 * y ^ 2) / (1 - c) ^ 2 + 241 | (4 * b ^ 4 * d ^ 4 * y) / (1 - c) - 242 | (2 * b ^ 4 * d ^ 4 * y) / (1 - c) ^ 2 - 243 | (2 * b ^ 4 * d ^ 4) / (1 - c) + (b ^ 4 * d ^ 244 | 4) / (1 - c) ^ 2 + 245 | b ^ 4 * d ^ 4 * y ^ 2 - 2 * b ^ 4 * d ^ 246 | 4 * y + b ^ 4 * d ^ 4 247 | ) 248 | ) - 249 | 2 * b ^ 4 * c * d ^ 2 * y ^ 2 + (2 * b ^ 4 * d ^ 250 | 2 * y ^ 2) / (1 - c) + 251 | 2 * b ^ 4 * c * d ^ 2 * y - (2 * b ^ 4 * d ^ 2 * y) / 252 | (1 - c) - 253 | 2 * b ^ 4 * d ^ 2 * y ^ 2 + 2 * b ^ 4 * d ^ 2 * y 254 | ) / 255 | (2 * (a ^ 4 + 2 * a ^ 2 * b ^ 2 * c * y + b ^ 4 * c ^ 2 * y ^ 2)) 256 | if (exposure_r2 > 1) { 257 | stop_cli(c( 258 | "x" = "Given the inputs `effect`: {effect}, `se`: {se}, `df`: {df} \\ 259 | The observed confidence bounds would be {lb}, {ub}. Given the inputs \\ 260 | observed bounds: ({lb}, {ub}), `outcome_r2`: {outcome_r2}, \\ 261 | there does not exist an unmeasured confounder that could tip 262 | the bound." 263 | )) 264 | } 265 | as.numeric(exposure_r2) 266 | } 267 | 268 | 269 | 270 | tip_outcome_r2 <- function(effect, se, df, exposure_r2) { 271 | if (is.null(exposure_r2)) { 272 | stop_cli(c( 273 | "x" = "Please input at least one of the following:", 274 | "*" = "`exposure_r2`", 275 | "*" = "`outcome_r2`" 276 | )) 277 | } 278 | check_r2( 279 | exposure_r2, 280 | exposure = TRUE, 281 | effect = effect, 282 | se = se, 283 | df = df 284 | ) 285 | 286 | outcome_r2 <- 287 | (effect ^ 2 - effect ^ 2 * exposure_r2) / (se ^ 2 * df * exposure_r2) 288 | if (any(outcome_r2 > 1)) { 289 | stop_cli(c( 290 | "x" = "Given the input `effect`: {effect}, \\ 291 | `exposure_r2`: {exposure_r2[outcome_r2 > 1]}, \\ 292 | there does not exist an unmeasured confounder that could tip this." 293 | )) 294 | } 295 | as.numeric(outcome_r2) 296 | } 297 | 298 | tip_outcome_r2_bound <- 299 | function(effect, se, df, exposure_r2, alpha) { 300 | if (is.null(exposure_r2)) { 301 | stop_cli(c( 302 | "x" = "Please input at least one of the following:", 303 | "*" = "`exposure_r2`", 304 | "*" = "`outcome_r2`" 305 | )) 306 | } 307 | check_r2( 308 | exposure_r2, 309 | exposure = TRUE, 310 | effect = effect, 311 | se = se, 312 | df = df 313 | ) 314 | 315 | t_star <- stats::qt(alpha / 2, df = df, lower.tail = F) 316 | lb <- effect - t_star * se 317 | ub <- effect + t_star * se 318 | 319 | y <- exposure_r2 320 | a <- effect 321 | b <- se 322 | c <- df 323 | d <- t_star 324 | 325 | outcome_r2 <- 326 | ( 327 | b ^ 2 * (-c) * ( 328 | 2 * a ^ 2 * c ^ 2 * y ^ 2 - 2 * a ^ 2 * c ^ 2 * y - 2 * a ^ 2 * 329 | c * d ^ 2 * y + 2 * a ^ 2 * c * d ^ 2 - 4 * a ^ 2 * c * y ^ 2 + 330 | 4 * a ^ 2 * c * y + 2 * a ^ 2 * d ^ 2 * y - 2 * a ^ 331 | 2 * d ^ 2 + 332 | 2 * a ^ 2 * y ^ 2 - 2 * a ^ 2 * y - 2 * b ^ 2 * c ^ 2 * d ^ 2 * y - 333 | 2 * b ^ 2 * c * d ^ 4 + 2 * b ^ 2 * c * d ^ 2 * y 334 | ) - 335 | sqrt( 336 | b ^ 4 * c ^ 2 * ( 337 | 2 * a ^ 2 * c ^ 2 * y ^ 2 - 2 * a ^ 2 * c ^ 2 * y - 338 | 2 * a ^ 2 * c * d ^ 2 * y + 2 * a ^ 339 | 2 * c * d ^ 2 - 340 | 4 * a ^ 2 * c * y ^ 2 + 4 * a ^ 2 * c * y + 2 * a ^ 2 * d ^ 2 * y - 341 | 2 * a ^ 2 * d ^ 2 + 2 * a ^ 2 * y ^ 2 - 342 | 2 * a ^ 2 * y - 343 | 2 * b ^ 2 * c ^ 2 * d ^ 2 * y - 2 * b ^ 2 * c * d ^ 4 + 344 | 2 * b ^ 2 * c * d ^ 2 * y 345 | ) ^ 2 - 4 * b ^ 4 * c ^ 2 * 346 | (c ^ 2 * y ^ 2 + 2 * c * d ^ 2 * y - 2 * c * y ^ 2 + 347 | d ^ 4 - 2 * d ^ 2 * y + y ^ 2) * 348 | ( 349 | a ^ 4 * c ^ 2 * y ^ 2 - 2 * a ^ 4 * c ^ 2 * y + a ^ 4 * c ^ 2 - 350 | 2 * a ^ 4 * c * y ^ 2 + 351 | 4 * a ^ 4 * c * y - 2 * a ^ 4 * c + a ^ 4 * y ^ 2 - 352 | 2 * a ^ 4 * y + 353 | a ^ 4 + 2 * a ^ 2 * b ^ 2 * c ^ 2 * d ^ 2 * y - 354 | 2 * a ^ 2 * b ^ 2 * c ^ 2 * d ^ 2 - 355 | 2 * a ^ 2 * b ^ 2 * c * d ^ 2 * y + 356 | 2 * a ^ 2 * b ^ 2 * c * d ^ 2 + 357 | b ^ 4 * c ^ 2 * d ^ 4 358 | ) 359 | ) 360 | ) / (2 * b ^ 4 * c ^ 2 * (c ^ 2 * y ^ 2 + 2 * c * d ^ 2 * y - 361 | 2 * c * y ^ 362 | 2 + d ^ 4 - 2 * d ^ 2 * y + y ^ 2)) 363 | if (outcome_r2 > 1) { 364 | stop_cli(c( 365 | "x" = "Given the inputs `effect`: {effect}, `se`: {se}, `df`: {df}, \\ 366 | The observed confidence bounds would be {lb}, {ub}. Given the inputs \\ 367 | observed bounds: ({lb}, {ub}), `exposure_r2`: {exposure_r2}, \\ 368 | there does not exist an unmeasured confounder that could tip \\ 369 | the bound." 370 | )) 371 | } 372 | as.numeric(outcome_r2) 373 | } 374 | 375 | 376 | 377 | tip_p0 <- function(p1 = NULL, 378 | gamma = NULL, 379 | b = NULL) { 380 | check_prevalences(p1 = p1) 381 | check_gamma(gamma) 382 | 383 | p0 <- (p1 * (gamma - 1) - b + 1) / (b * (gamma - 1)) 384 | 385 | if (p0 > 1 | p0 < 0) { 386 | stop_cli(c( 387 | "x" = "Given these parameters (`exposed_confounder_prev`: {p1}, \\ 388 | `outcome_effect`: {gamma}), \\ 389 | there does not exist an unmeasured confounder that could tip this." 390 | )) 391 | } 392 | as.numeric(p0) 393 | } 394 | 395 | 396 | tip_p1 <- function(p0 = NULL, 397 | gamma = NULL, 398 | b = NULL) { 399 | check_prevalences(p0 = p0) 400 | check_gamma(gamma) 401 | 402 | p1 <- ((b - 1) / (gamma - 1)) + b * p0 403 | 404 | if (p1 > 1 | p1 < 0) { 405 | stop_cli(c( 406 | "x" = "Given these parameters (`unexposed_confounder_prev`: {p0}, \\ 407 | * `outcome_effect`: {gamma}), \\ 408 | there does not exist an unmeasured confounder that could tip this." 409 | )) 410 | } 411 | as.numeric(p1) 412 | } 413 | 414 | tip_n <- function(p0, p1, gamma, b) { 415 | check_prevalences(p0, p1) 416 | check_gamma(gamma) 417 | 418 | n <- 419 | -log(b) / (log(gamma * p0 + (1 - p0)) - log(gamma * p1 + (1 - p1))) 420 | if (n < 0) { 421 | n <- 0 422 | warning_cli("The observed effect {b} would not tip with the unmeasured confounder given.") 423 | } else if (n < 1) { 424 | warning_cli("The observed effect {b} would tip with < 1 of the given unmeasured confounders.") 425 | } 426 | 427 | as.numeric(n) 428 | } 429 | 430 | # e_value <- function(lb, ub) { 431 | # observed_covariate_e_value(lb, ub, 1, 1) 432 | # } 433 | 434 | hr_transform <- function(hr) { 435 | if (is.null(hr)) { 436 | return(NULL) 437 | } 438 | (1 - (0.5 ^ sqrt(hr))) / (1 - (0.5 ^ sqrt(1 / hr))) 439 | } 440 | 441 | or_transform <- function(or) { 442 | if (is.null(or)) { 443 | return(NULL) 444 | } 445 | sqrt(or) 446 | } 447 | -------------------------------------------------------------------------------- /R/tip.R: -------------------------------------------------------------------------------- 1 | #' Tip a result with a normally distributed confounder. 2 | #' 3 | #' choose one of the following, and the other will be estimated: 4 | #' * `exposure_confounder_effect` 5 | #' * `confounder_outcome_effect` 6 | #' 7 | #' @param effect_observed Numeric positive value. Observed exposure - outcome effect 8 | #' (assumed to be the exponentiated coefficient, so a risk ratio, odds 9 | #' ratio, or hazard ratio). This can be the point estimate, lower confidence 10 | #' bound, or upper confidence bound. 11 | #' @param exposure_confounder_effect Numeric. Estimated difference in scaled means between the 12 | #' unmeasured confounder in the exposed population and unexposed population 13 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 14 | #' between the unmeasured confounder and the outcome 15 | #' @param verbose Logical. Indicates whether to print informative message. 16 | #' Default: `TRUE` 17 | #' @param correction_factor Character string. Options are "none", "hr", "or". 18 | #' For common outcomes (>15%), the odds ratio or hazard ratio is not a good 19 | #' estimate for the risk ratio. In these cases, we can apply a correction 20 | #' factor. If you are supplying a hazard ratio for a common outcome, set 21 | #' this to "hr"; if you are supplying an odds ratio for a common outcome, set 22 | #' this to "or"; if you are supplying a risk ratio or your outcome is rare, 23 | #' set this to "none" (default). 24 | #' 25 | #' 26 | #' @return Data frame. 27 | #' 28 | #' @examples 29 | #' ## to estimate the relationship between an unmeasured confounder and outcome 30 | #' ## needed to tip analysis 31 | #' tip(1.2, exposure_confounder_effect = -2) 32 | #' 33 | #' ## to estimate the number of unmeasured confounders specified needed to tip 34 | #' ## the analysis 35 | #' tip(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = .99) 36 | #' 37 | #' ## Example with broom 38 | #' if (requireNamespace("broom", quietly = TRUE) && 39 | #' requireNamespace("dplyr", quietly = TRUE)) { 40 | #' glm(am ~ mpg, data = mtcars, family = "binomial") %>% 41 | #' broom::tidy(conf.int = TRUE, exponentiate = TRUE) %>% 42 | #' dplyr::filter(term == "mpg") %>% 43 | #' dplyr::pull(conf.low) %>% 44 | #' tip(confounder_outcome_effect = 2.5) 45 | #'} 46 | #' @export 47 | tip <- function(effect_observed, exposure_confounder_effect = NULL, confounder_outcome_effect = NULL, 48 | verbose = getOption("tipr.verbose", TRUE), correction_factor = "none") { 49 | 50 | check_arguments( 51 | "tip()", 52 | exposure_confounder_effect, 53 | confounder_outcome_effect 54 | ) 55 | 56 | exposure_confounder_effect <- exposure_confounder_effect %||% list(NULL) 57 | confounder_outcome_effect <- confounder_outcome_effect %||% list(NULL) 58 | 59 | o <- purrr::pmap( 60 | list(b = effect_observed, 61 | exposure_confounder_effect = exposure_confounder_effect, 62 | confounder_outcome_effect = confounder_outcome_effect, 63 | verbose = verbose, 64 | correction_factor = correction_factor), 65 | tip_one 66 | ) 67 | do.call(rbind, o) 68 | } 69 | 70 | tip_one <- function(b, exposure_confounder_effect, confounder_outcome_effect, verbose, correction_factor) { 71 | check_effect(b) 72 | check_gamma(confounder_outcome_effect) 73 | 74 | correction <- "" 75 | if (correction_factor == "hr") { 76 | b <- hr_transform(b) 77 | confounder_outcome_effect <- hr_transform(confounder_outcome_effect) 78 | correction <- 'You opted to use the hazard ratio correction to convert your hazard ratios to approximate risk ratios.\nThis is a good idea if the outcome is common (>15%).' 79 | } 80 | 81 | if (correction_factor == "or") { 82 | b <- or_transform(b) 83 | confounder_outcome_effect <- or_transform(confounder_outcome_effect) 84 | correction <- 'You opted to use the odds ratio correction to convert your odds ratios to approximate risk ratios.\nThis is a good idea if the outcome is common (>15%).' 85 | } 86 | 87 | n_unmeasured_confounders <- 1 88 | 89 | if (is.null(confounder_outcome_effect)) { 90 | confounder_outcome_effect <- b ^ (1 / exposure_confounder_effect) 91 | } else if (is.null(exposure_confounder_effect)) { 92 | exposure_confounder_effect <- log(b) / log(confounder_outcome_effect) 93 | } else { 94 | n_unmeasured_confounders <- 95 | log(b) / (exposure_confounder_effect * log(confounder_outcome_effect)) 96 | if (any(n_unmeasured_confounders < 0)) { 97 | if (length(exposure_confounder_effect) > 1) { 98 | exposure_confounder_effects <- exposure_confounder_effect[n_unmeasured_confounders < 0] 99 | } else { 100 | exposure_confounder_effects <- exposure_confounder_effect 101 | } 102 | if (length(confounder_outcome_effect) > 1) { 103 | confounder_outcome_effects <- confounder_outcome_effect[n_unmeasured_confounders < 0] 104 | } else { 105 | confounder_outcome_effects <- confounder_outcome_effect 106 | } 107 | 108 | warning_cli(c( 109 | "!" = "The observed effect {b} would not tip with the unmeasured \\ 110 | confounder given:", 111 | "*" = "`exposure_confounder_effect`: {exposure_confounder_effects}", 112 | "*" = "`confounder_outcome_effect`: {confounder_outcome_effects}" 113 | )) 114 | n_unmeasured_confounders <- max(0, n_unmeasured_confounders) 115 | } 116 | too_small <- 117 | n_unmeasured_confounders < 1 & n_unmeasured_confounders > 0 118 | if (any(too_small)) { 119 | exposure_confounder_effects <- ifelse(length(exposure_confounder_effect) > 1, exposure_confounder_effect[too_small], exposure_confounder_effect) 120 | confounder_outcome_effects <- 121 | ifelse(length(confounder_outcome_effect) > 1, 122 | confounder_outcome_effect[too_small], 123 | confounder_outcome_effect) 124 | warning_cli(c( 125 | "!" = "The observed effect {b} would tip with < 1 of the given \\ 126 | unmeasured confounders:", 127 | "*" = "`exposure_confounder_effect`: {exposure_confounder_effects}", 128 | "*" = "`confounder_outcome_effect`: {confounder_outcome_effects}" 129 | )) 130 | } 131 | } 132 | o <- tibble::tibble( 133 | effect_adjusted = 1, 134 | effect_observed = b, 135 | exposure_confounder_effect = exposure_confounder_effect, 136 | confounder_outcome_effect = confounder_outcome_effect, 137 | n_unmeasured_confounders = n_unmeasured_confounders 138 | ) 139 | if (verbose) { 140 | if (all(o$n_unmeasured_confounders == 0)) { 141 | o_notip <- o[o$n_unmeasured_confounders == 0,] 142 | message_cli(c( 143 | "i" = "The observed effect ({round(o_notip$effect_observed, 2)}) \\ 144 | cannot be tipped by an unmeasured confounder\nwith the \\ 145 | following specifications:", 146 | "*" = "estimated difference in scaled means between the \\ 147 | unmeasured confounder\n in the exposed population and \\ 148 | unexposed population: {round(o_notip$exposure_confounder_effect, 2)}", 149 | "*" = "estimated relationship between the unmeasured confounder and \\ 150 | the outcome: {round(o_notip$confounder_outcome_effect, 2)}" 151 | )) 152 | 153 | if (correction != "") message_cli(c("i" = correction)) 154 | 155 | } else if (any(o$n_unmeasured_confounders == 0)) { 156 | o_notip <- o[o$n_unmeasured_confounders == 0,] 157 | message_cli(c( 158 | "i" = "The observed effect ({round(o_notip$effect_observed, 2)}) \\ 159 | cannot be tipped by an unmeasured confounder with the \\ 160 | following specifications:", 161 | "*" = "estimated difference in scaled means between the \\ 162 | unmeasured confounder in the exposed population and \\ 163 | unexposed population: {round(o_notip$exposure_confounder_effect, 2)}", 164 | "*" = "estimated relationship between the unmeasured confounder and \\ 165 | the outcome: {round(o_notip$confounder_outcome_effect, 2)}" 166 | )) 167 | 168 | if (correction != "") message_cli(c("i" = correction)) 169 | 170 | o_tip <- o[o$n_unmeasured_confounders != 0,] 171 | message_cli(c( 172 | "i" = "The observed effect ({round(o_tip$effect_observed, 2)}) WOULD \\ 173 | be tipped by {round(o$n_unmeasured_confounders)} \\ 174 | unmeasured confounder{ifelse(o_tip$n_unmeasured_confounders > 1, 's', '')} \\ 175 | with the following specifications:", 176 | "*" = "estimated difference in scaled means between the \\ 177 | unmeasured confounder in the exposed population and \\ 178 | unexposed population: {round(o_tip$exposure_confounder_effect, 2)}", 179 | "*" = "estimated relationship between the unmeasured confounder and \\ 180 | the outcome: {round(o_tip$confounder_outcome_effect, 2)}" 181 | )) 182 | 183 | if (correction != "") message_cli(c("i" = correction)) 184 | 185 | } else { 186 | message_cli(c( 187 | "i" = "The observed effect ({round(o$effect_observed, 2)}) WOULD \\ 188 | be tipped by {round(o$n_unmeasured_confounders)} \\ 189 | unmeasured confounder{ifelse(o$n_unmeasured_confounders > 1, 's', '')} \\ 190 | with the following specifications:", 191 | "*" = "estimated difference in scaled means between the \\ 192 | unmeasured confounder in the exposed population and \\ 193 | unexposed population: {round(o$exposure_confounder_effect, 2)}", 194 | "*" = "estimated relationship between the unmeasured confounder and \\ 195 | the outcome: {round(o$confounder_outcome_effect, 2)}" 196 | )) 197 | 198 | if (correction != "") message_cli(c("i" = correction)) 199 | } 200 | } 201 | o 202 | } 203 | 204 | #' Tip an observed risk ratio with a normally distributed confounder. 205 | #' 206 | #' choose one of the following, and the other will be estimated: 207 | #' * `exposure_confounder_effect` 208 | #' * `confounder_outcome_effect` 209 | #' 210 | #' @param effect_observed Numeric positive value. Observed exposure - outcome 211 | #' risk ratio. This can be the point estimate, lower confidence bound, 212 | #' or upper confidence bound. 213 | #' @param exposure_confounder_effect Numeric. Estimated difference in scaled means between the 214 | #' unmeasured confounder in the exposed population and unexposed population 215 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 216 | #' between the unmeasured confounder and the outcome 217 | #' @param verbose Logical. Indicates whether to print informative message. 218 | #' Default: `TRUE` 219 | #' 220 | #' 221 | #' @return Data frame. 222 | #' 223 | #' @examples 224 | #' ## to estimate the relationship between an unmeasured confounder and outcome 225 | #' ## needed to tip analysis 226 | #' tip_rr(1.2, exposure_confounder_effect = -2) 227 | #' 228 | #' ## to estimate the number of unmeasured confounders specified needed to tip 229 | #' ## the analysis 230 | #' tip_rr(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = .99) 231 | #' 232 | #' @export 233 | tip_rr <- function(effect_observed, exposure_confounder_effect = NULL, confounder_outcome_effect = NULL, verbose = getOption("tipr.verbose", TRUE)) { 234 | check_arguments( 235 | "tip_rr()", 236 | exposure_confounder_effect, 237 | confounder_outcome_effect 238 | ) 239 | 240 | tip( 241 | effect_observed, 242 | exposure_confounder_effect = exposure_confounder_effect, 243 | confounder_outcome_effect = confounder_outcome_effect, 244 | verbose = verbose 245 | ) 246 | } 247 | 248 | 249 | #' Tip an observed hazard ratio with a normally distributed confounder. 250 | #' 251 | #' choose one of the following, and the other will be estimated: 252 | #' * `exposure_confounder_effect` 253 | #' * `confounder_outcome_effect` 254 | #' 255 | #' @param effect_observed Numeric positive value. Observed exposure - outcome hazard ratio. 256 | #' This can be the point estimate, lower confidence bound, or upper 257 | #' confidence bound. 258 | #' @param exposure_confounder_effect Numeric. Estimated difference in scaled means between the 259 | #' unmeasured confounder in the exposed population and unexposed population 260 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 261 | #' between the unmeasured confounder and the outcome 262 | #' @param verbose Logical. Indicates whether to print informative message. 263 | #' Default: `TRUE` 264 | #' @param hr_correction Logical. Indicates whether to use a correction factor. 265 | #' The methods used for this function are based on risk ratios. For rare 266 | #' outcomes, a hazard ratio approximates a risk ratio. For common outcomes, 267 | #' a correction factor is needed. If you have a common outcome (>15%), 268 | #' set this to `TRUE`. Default: `FALSE`. 269 | #' 270 | #' @return Data frame. 271 | #' 272 | #' @examples 273 | #' ## to estimate the relationship between an unmeasured confounder and outcome 274 | #' ## needed to tip analysis 275 | #' tip_hr(1.2, exposure_confounder_effect = -2) 276 | #' 277 | #' ## to estimate the number of unmeasured confounders specified needed to tip 278 | #' ## the analysis 279 | #' tip_hr(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = .99) 280 | #' 281 | #' @export 282 | tip_hr <- function(effect_observed, exposure_confounder_effect = NULL, confounder_outcome_effect = NULL, verbose = getOption("tipr.verbose", TRUE), hr_correction = FALSE) { 283 | check_arguments( 284 | "tip_hr()", 285 | exposure_confounder_effect, 286 | confounder_outcome_effect 287 | ) 288 | correction_factor <- ifelse(hr_correction, "hr", "none") 289 | tip( 290 | effect_observed, 291 | exposure_confounder_effect = exposure_confounder_effect, 292 | confounder_outcome_effect = confounder_outcome_effect, 293 | verbose = verbose, 294 | correction_factor = correction_factor 295 | ) 296 | } 297 | 298 | #' Tip an observed odds ratio with a normally distributed confounder. 299 | #' 300 | #' choose one of the following, and the other will be estimated: 301 | #' * `exposure_confounder_effect` 302 | #' * `confounder_outcome_effect` 303 | #' 304 | #' @param effect_observed Numeric positive value. Observed exposure - outcome odds ratio. 305 | #' This can be the point estimate, lower confidence bound, or upper 306 | #' confidence bound. 307 | #' @param exposure_confounder_effect Numeric. Estimated difference in scaled means between the 308 | #' unmeasured confounder in the exposed population and unexposed population 309 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 310 | #' between the unmeasured confounder and the outcome 311 | #' @param verbose Logical. Indicates whether to print informative message. 312 | #' Default: `TRUE` 313 | #' @param or_correction Logical. Indicates whether to use a correction factor. 314 | #' The methods used for this function are based on risk ratios. For rare 315 | #' outcomes, an odds ratio approximates a risk ratio. For common outcomes, 316 | #' a correction factor is needed. If you have a common outcome (>15%), 317 | #' set this to `TRUE`. Default: `FALSE`. 318 | #' 319 | #' @return Data frame. 320 | #' 321 | #' @examples 322 | #' ## to estimate the relationship between an unmeasured confounder and outcome 323 | #' ## needed to tip analysis 324 | #' tip_or(1.2, exposure_confounder_effect = -2) 325 | #' 326 | #' ## to estimate the number of unmeasured confounders specified needed to tip 327 | #' ## the analysis 328 | #' tip_or(1.2, exposure_confounder_effect = -2, confounder_outcome_effect = .99) 329 | #' 330 | #' ## Example with broom 331 | #' if (requireNamespace("broom", quietly = TRUE) && 332 | #' requireNamespace("dplyr", quietly = TRUE)) { 333 | #' glm(am ~ mpg, data = mtcars, family = "binomial") %>% 334 | #' broom::tidy(conf.int = TRUE, exponentiate = TRUE) %>% 335 | #' dplyr::filter(term == "mpg") %>% 336 | #' dplyr::pull(conf.low) %>% 337 | #' tip_or(confounder_outcome_effect = 2.5, or_correction = TRUE) 338 | #'} 339 | #' @export 340 | tip_or <- function(effect_observed, exposure_confounder_effect = NULL, confounder_outcome_effect = NULL, verbose = getOption("tipr.verbose", TRUE), or_correction = FALSE) { 341 | check_arguments( 342 | "tip_or()", 343 | exposure_confounder_effect, 344 | confounder_outcome_effect 345 | ) 346 | 347 | correction_factor <- ifelse(or_correction, "or", "none") 348 | 349 | tip( 350 | effect_observed, 351 | exposure_confounder_effect = exposure_confounder_effect, 352 | confounder_outcome_effect = confounder_outcome_effect, 353 | verbose = verbose, 354 | correction_factor = correction_factor 355 | ) 356 | } 357 | 358 | #' @rdname tip_rr 359 | #' @export 360 | tip_rr_with_continuous <- tip_rr 361 | 362 | #' @rdname tip_hr 363 | #' @export 364 | tip_hr_with_continuous <- tip_hr 365 | 366 | #' @rdname tip_or 367 | #' @export 368 | tip_or_with_continuous <- tip_or 369 | 370 | #' @rdname tip 371 | #' @export 372 | tip_with_continuous <- tip 373 | 374 | #' @rdname tip 375 | #' @export 376 | tip_c <- tip 377 | -------------------------------------------------------------------------------- /R/tip_with_binary.R: -------------------------------------------------------------------------------- 1 | #' Tip a result with a binary confounder. 2 | #' 3 | #' @description 4 | #' Choose two of the following three to specify, and the third will be estimated: 5 | #' * `exposed_confounder_prev` 6 | #' * `unexposed_confounder_prev` 7 | #' * `confounder_outcome_effect` 8 | #' 9 | #' Alternatively, specify all three and the function will return the number of unmeasured 10 | #' confounders specified needed to tip the analysis. 11 | #' 12 | #' @details [`tip_b()`] is an alias for [`tip_with_binary()`]. 13 | #' @param effect_observed Numeric positive value. Observed exposure - outcome effect 14 | #' (assumed to be the exponentiated coefficient, so a risk ratio, odds 15 | #' ratio, or hazard ratio). This can be the point estimate, lower confidence 16 | #' bound, or upper confidence bound. 17 | #' @param exposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 18 | #' unmeasured confounder in the exposed population 19 | #' @param unexposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 20 | #' unmeasured confounder in the unexposed population 21 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 22 | #' between the unmeasured confounder and the outcome 23 | #' @param verbose Logical. Indicates whether to print informative message. 24 | #' Default: `TRUE` 25 | #' @param correction_factor Character string. Options are "none", "hr", "or". 26 | #' For common outcomes (>15%), the odds ratio or hazard ratio is not a good 27 | #' estimate for the risk ratio. In these cases, we can apply a correction 28 | #' factor. If you are supplying a hazard ratio for a common outcome, set 29 | #' this to "hr"; if you are supplying an odds ratio for a common outcome, set 30 | #' this to "or"; if you are supplying a risk ratio or your outcome is rare, 31 | #' set this to "none" (default). 32 | #' 33 | #' @examples 34 | #' ## to estimate the relationship between an unmeasured confounder and outcome 35 | #' ## needed to tip analysis 36 | #' tip_with_binary(1.2, exposed_confounder_prev = 0.5, unexposed_confounder_prev = 0) 37 | #' 38 | #' ## to estimate the number of unmeasured confounders specified needed to tip 39 | #' ## the analysis 40 | #' tip_with_binary(1.2, 41 | #' exposed_confounder_prev = 0.5, 42 | #' unexposed_confounder_prev = 0, 43 | #' confounder_outcome_effect = 1.1) 44 | #' 45 | #' ## Example with broom 46 | #' if (requireNamespace("broom", quietly = TRUE) && 47 | #' requireNamespace("dplyr", quietly = TRUE)) { 48 | #' glm(am ~ mpg, data = mtcars, family = "binomial") %>% 49 | #' broom::tidy(conf.int = TRUE, exponentiate = TRUE) %>% 50 | #' dplyr::filter(term == "mpg") %>% 51 | #' dplyr::pull(conf.low) %>% 52 | #' tip_with_binary(exposed_confounder_prev = 1, confounder_outcome_effect = 1.15) 53 | #'} 54 | #' @export 55 | tip_with_binary <- function(effect_observed, 56 | exposed_confounder_prev = NULL, 57 | unexposed_confounder_prev = NULL, 58 | confounder_outcome_effect = NULL, 59 | verbose = getOption("tipr.verbose", TRUE), 60 | correction_factor = "none") { 61 | check_arguments( 62 | "tip_with_binary()", 63 | exposed_confounder_prev, 64 | unexposed_confounder_prev, 65 | confounder_outcome_effect 66 | ) 67 | 68 | exposed_confounder_prev <- exposed_confounder_prev %||% list(NULL) 69 | unexposed_confounder_prev <- unexposed_confounder_prev %||% list(NULL) 70 | confounder_outcome_effect <- confounder_outcome_effect %||% list(NULL) 71 | 72 | o <- purrr::pmap( 73 | list(b = effect_observed, 74 | exposed_confounder_prev = exposed_confounder_prev, 75 | unexposed_confounder_prev = unexposed_confounder_prev, 76 | confounder_outcome_effect = confounder_outcome_effect, 77 | verbose = verbose, 78 | correction_factor = correction_factor), 79 | tip_with_binary_one 80 | ) 81 | do.call(rbind, o) 82 | } 83 | 84 | tip_with_binary_one <- function(b, 85 | exposed_confounder_prev, 86 | unexposed_confounder_prev, 87 | confounder_outcome_effect, 88 | verbose, 89 | correction_factor) { 90 | 91 | n_unmeasured_confounders <- 1 92 | 93 | correction <- "" 94 | if (correction_factor == "hr") { 95 | b <- hr_transform(b) 96 | confounder_outcome_effect <- hr_transform(confounder_outcome_effect) 97 | correction <- 'You opted to use the hazard ratio correction to convert your hazard ratios to approximate risk ratios.\nThis is a good idea if the outcome is common (>15%).' 98 | } 99 | 100 | if (correction_factor == "or") { 101 | b <- or_transform(b) 102 | confounder_outcome_effect <- or_transform(confounder_outcome_effect) 103 | correction <- 'You opted to use the odds ratio correction to convert your odds ratios to approximate risk ratios.\nThis is a good idea if the outcome is common (>15%).' 104 | } 105 | 106 | if (is.null(confounder_outcome_effect)) { 107 | confounder_outcome_effect <- tip_gamma(unexposed_confounder_prev, exposed_confounder_prev, b) 108 | } else if (is.null(unexposed_confounder_prev)) { 109 | unexposed_confounder_prev <- tip_p0(exposed_confounder_prev, confounder_outcome_effect, b) 110 | } else if (is.null(exposed_confounder_prev)) { 111 | exposed_confounder_prev <- tip_p1(unexposed_confounder_prev, confounder_outcome_effect, b) 112 | } else { 113 | n_unmeasured_confounders <- 114 | tip_n(unexposed_confounder_prev, exposed_confounder_prev, confounder_outcome_effect, b) 115 | 116 | if (any(n_unmeasured_confounders < 0)) { 117 | if (length(unexposed_confounder_prev) > 1) { 118 | unexposed_confounder_prevs <- unexposed_confounder_prev[n_unmeasured_confounders < 0] 119 | } else { 120 | unexposed_confounder_prevs <- unexposed_confounder_prev 121 | } 122 | if (length(exposed_confounder_prev) > 1) { 123 | exposed_confounder_prevs <- exposed_confounder_prev[n_unmeasured_confounders < 0] 124 | } else { 125 | exposed_confounder_prevs <- exposed_confounder_prev 126 | } 127 | if (length(confounder_outcome_effect) > 1) { 128 | confounder_outcome_effects <- confounder_outcome_effect[n_unmeasured_confounders < 0] 129 | } else { 130 | confounder_outcome_effects <- confounder_outcome_effect 131 | } 132 | 133 | warning_cli(c( 134 | "!" = "The observed effect {b} would not tip with the unmeasured confounder given:", 135 | "*" = "`exposed_confounder_prev`: {exposed_confounder_prevs}", 136 | "*" = "`unexposed_confounder_prev`: {unexposed_confounder_prevs}", 137 | "*" = "`confounder_outcome_effect`: {confounder_outcome_effects}" 138 | )) 139 | n_unmeasured_confounders <- max(0, n_unmeasured_confounders) 140 | } 141 | too_small <- 142 | n_unmeasured_confounders < 1 & n_unmeasured_confounders > 0 143 | if (any(too_small)) { 144 | if (length(unexposed_confounder_prev) > 1) { 145 | unexposed_confounder_prevs <- unexposed_confounder_prev[too_small] 146 | } else { 147 | unexposed_confounder_prevs <- unexposed_confounder_prev 148 | } 149 | if (length(exposed_confounder_prev) > 1) { 150 | exposed_confounder_prevs <- exposed_confounder_prev[too_small] 151 | } else { 152 | exposed_confounder_prevs <- exposed_confounder_prev 153 | } 154 | if (length(confounder_outcome_effect) > 1) { 155 | confounder_outcome_effects <- confounder_outcome_effect[too_small] 156 | } else { 157 | confounder_outcome_effects <- confounder_outcome_effect 158 | } 159 | warning_cli(c( 160 | "!" = "The observed effect {b} would tip with < 1 of the given unmeasured confounders:", 161 | "*" = "`exposed_confounder_prev`: {exposed_confounder_prevs}", 162 | "*" = "`unexposed_confounder_prev`: {unexposed_confounder_prevs}", 163 | "*" = "`confounder_outcome_effect`: {confounder_outcome_effects}" 164 | )) 165 | } 166 | } 167 | o <- tibble::tibble( 168 | effect_adjusted = 1, 169 | effect_observed = b, 170 | exposed_confounder_prev = exposed_confounder_prev, 171 | unexposed_confounder_prev = unexposed_confounder_prev, 172 | confounder_outcome_effect = confounder_outcome_effect, 173 | n_unmeasured_confounders = n_unmeasured_confounders 174 | ) 175 | if (verbose) { 176 | if (all(o$n_unmeasured_confounders == 0)) { 177 | o_notip <- o[o$n_unmeasured_confounders == 0,] 178 | 179 | message_cli(c( 180 | "i" = "The observed effect ({round(o_notip$effect_observed, 2)}) \\ 181 | cannot be tipped by an unmeasured confounder\nwith the \\ 182 | following specifications:", 183 | "*" = "estimated prevalence of the unmeasured confounder \\ 184 | in the exposed population: {round(o_notip$exposed_confounder_prev, 2)}", 185 | "*" = "estimated prevalence of \\ 186 | the unmeasured confounder in the unexposed population: \\ 187 | {round(o_notip$unexposed_confounder_prev, 2)}", 188 | "*" = "estimated relationship between the unmeasured confounder and \\ 189 | the outcome: {round(o_notip$confounder_outcome_effect, 2)}" 190 | )) 191 | 192 | if (correction != "") message_cli(c("i" = correction)) 193 | } else if (any(o$n_unmeasured_confounders == 0)) { 194 | o_notip <- o[o$n_unmeasured_confounders == 0,] 195 | message_cli(c( 196 | "i" = "The observed effect ({round(o_notip$effect_observed, 2)}) \\ 197 | cannot be tipped by an unmeasured confounder\nwith the \\ 198 | following specifications:", 199 | "*" = "estimated prevalence of the unmeasured confounder \\ 200 | in the exposed population: {round(o_notip$exposed_confounder_prev, 2)}", 201 | "*" = "estimated prevalence of \\ 202 | the unmeasured confounder in the unexposed population: \\ 203 | {round(o_notip$unexposed_confounder_prev, 2)}", 204 | "*" = "estimated relationship between the unmeasured confounder and \\ 205 | the outcome: {round(o_notip$confounder_outcome_effect, 2)}" 206 | )) 207 | 208 | if (correction != "") message_cli(c("i" = correction)) 209 | 210 | o_tip <- o[o$n_unmeasured_confounders != 0,] 211 | message_cli(c( 212 | "i" = "The observed effect ({round(o_tip$effect_observed, 2)}) WOULD \\ 213 | be tipped by {round(o_tip$n_unmeasured_confounders)} \\ 214 | unmeasured confounder{ifelse(o_tip$n_unmeasured_confounders > 1, 's', '')} \\ 215 | with the following specifications", 216 | "*" = "estimated prevalence of the unmeasured confounder \\ 217 | in the exposed population: {round(o_tip$exposed_confounder_prev, 2)}", 218 | "*" = "estimated prevalence of the unmeasured confounder in the \\ 219 | unexposed population: {round(o_tip$unexposed_confounder_prev, 2)}", 220 | "*" = "estimated relationship between the unmeasured confounder and \\ 221 | the outcome: {round(o_tip$confounder_outcome_effect, 2)}" 222 | )) 223 | 224 | if (correction != "") message_cli(c("i" = correction)) 225 | 226 | } else { 227 | message_cli(c( 228 | "i" = "The observed effect ({round(o$effect_observed, 2)}) WOULD \\ 229 | be tipped by {round(o$n_unmeasured_confounders)} \\ 230 | unmeasured confounder{ifelse(o$n_unmeasured_confounders > 1, 's', '')} \\ 231 | with the following specifications:", 232 | "*" = "estimated prevalence of the unmeasured confounder \\ 233 | in the exposed population: {round(o$exposed_confounder_prev, 2)}", 234 | "*" = "estimated prevalence of the unmeasured confounder in the \\ 235 | unexposed population: {round(o$unexposed_confounder_prev, 2)}", 236 | "*" = "estimated relationship between the unmeasured confounder and \\ 237 | the outcome: {round(o$confounder_outcome_effect, 2)}" 238 | )) 239 | 240 | if (correction != "") message_cli(c("i" = correction)) 241 | } 242 | } 243 | o 244 | } 245 | 246 | #' Tip an observed risk ratio with a binary confounder. 247 | #' 248 | #' @description 249 | #' Choose two of the following three to specify, and the third will be estimated: 250 | #' * `exposed_confounder_prev` 251 | #' * `unexposed_confounder_prev` 252 | #' * `confounder_outcome_effect` 253 | #' 254 | #' Alternatively, specify all three and the function will return the number of unmeasured 255 | #' confounders specified needed to tip the analysis. 256 | #' @param effect_observed Numeric positive value. Observed exposure - outcome risk ratio. 257 | #' This can be the point estimate, lower confidence bound, or upper 258 | #' confidence bound. 259 | #' @param exposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 260 | #' unmeasured confounder in the exposed population 261 | #' @param unexposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 262 | #' unmeasured confounder in the unexposed population 263 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 264 | #' between the unmeasured confounder and the outcome 265 | #' @param verbose Logical. Indicates whether to print informative message. 266 | #' Default: `TRUE` 267 | 268 | tip_rr_with_binary <- function(effect_observed, exposed_confounder_prev = NULL, unexposed_confounder_prev = NULL, confounder_outcome_effect = NULL, verbose = getOption("tipr.verbose", TRUE)) { 269 | check_arguments( 270 | "tip_rr_with_binary()", 271 | exposed_confounder_prev, 272 | unexposed_confounder_prev, 273 | confounder_outcome_effect 274 | ) 275 | 276 | tip_with_binary( 277 | effect_observed, 278 | exposed_confounder_prev = exposed_confounder_prev, 279 | unexposed_confounder_prev = unexposed_confounder_prev, 280 | confounder_outcome_effect = confounder_outcome_effect, 281 | verbose = verbose 282 | ) 283 | } 284 | 285 | #' Tip an observed hazard ratio with a binary confounder. 286 | #' 287 | #' @description 288 | #' Choose two of the following three to specify, and the third will be estimated: 289 | #' * `exposed_confounder_prev` 290 | #' * `unexposed_confounder_prev` 291 | #' * `confounder_outcome_effect` 292 | #' 293 | #' Alternatively, specify all three and the function will return the number of unmeasured 294 | #' confounders specified needed to tip the analysis. 295 | #' @param effect_observed Numeric positive value. Observed exposure - outcome hazard ratio. 296 | #' This can be the point estimate, lower confidence bound, or upper 297 | #' confidence bound. 298 | #' @param exposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 299 | #' unmeasured confounder in the exposed population 300 | #' @param unexposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 301 | #' unmeasured confounder in the unexposed population 302 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 303 | #' between the unmeasured confounder and the outcome 304 | #' @param verbose Logical. Indicates whether to print informative message. 305 | #' Default: `TRUE` 306 | #' @param hr_correction Logical. Indicates whether to use a correction factor. 307 | #' The methods used for this function are based on risk ratios. For rare 308 | #' outcomes, a hazard ratio approximates a risk ratio. For common outcomes, 309 | #' a correction factor is needed. If you have a common outcome (>15%), 310 | #' set this to `TRUE`. Default: `FALSE`. 311 | #' 312 | #' @return Data frame. 313 | #' @export 314 | #' 315 | #' @examples 316 | #' tip_hr_with_binary(0.9, 0.9, 0.1) 317 | 318 | tip_hr_with_binary <- function(effect_observed, exposed_confounder_prev = NULL, unexposed_confounder_prev = NULL, confounder_outcome_effect = NULL, verbose = getOption("tipr.verbose", TRUE), hr_correction = FALSE) { 319 | check_arguments( 320 | "tip_hr_with_binary()", 321 | exposed_confounder_prev, 322 | unexposed_confounder_prev, 323 | confounder_outcome_effect 324 | ) 325 | 326 | correction_factor <- ifelse(hr_correction, "hr", "none") 327 | tip_with_binary( 328 | effect_observed, 329 | exposed_confounder_prev = exposed_confounder_prev, 330 | unexposed_confounder_prev = unexposed_confounder_prev, 331 | confounder_outcome_effect = confounder_outcome_effect, 332 | verbose = verbose, 333 | correction_factor = correction_factor 334 | ) 335 | } 336 | 337 | #' Tip an observed odds ratio with a binary confounder. 338 | #' 339 | #' @description 340 | #' Choose two of the following three to specify, and the third will be estimated: 341 | #' * `exposed_confounder_prev` 342 | #' * `unexposed_confounder_prev` 343 | #' * `confounder_outcome_effect` 344 | #' 345 | #' Alternatively, specify all three and the function will return the number of unmeasured 346 | #' confounders specified needed to tip the analysis. 347 | #' @param effect_observed Numeric positive value. Observed exposure - outcome odds ratio. 348 | #' This can be the point estimate, lower confidence bound, or upper 349 | #' confidence bound. 350 | #' @param exposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 351 | #' unmeasured confounder in the exposed population 352 | #' @param unexposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 353 | #' unmeasured confounder in the unexposed population 354 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 355 | #' between the unmeasured confounder and the outcome 356 | #' @param verbose Logical. Indicates whether to print informative message. 357 | #' Default: `TRUE` 358 | #' @param or_correction Logical. Indicates whether to use a correction factor. 359 | #' The methods used for this function are based on risk ratios. For rare 360 | #' outcomes, an odds ratio approximates a risk ratio. For common outcomes, 361 | #' a correction factor is needed. If you have a common outcome (>15%), 362 | #' set this to `TRUE`. Default: `FALSE`. 363 | #' 364 | #' @return Data frame. 365 | #' @export 366 | #' 367 | #' @examples 368 | #' tip_or_with_binary(0.9, 0.9, 0.1) 369 | 370 | tip_or_with_binary <- function(effect_observed, exposed_confounder_prev = NULL, unexposed_confounder_prev = NULL, confounder_outcome_effect = NULL, verbose = getOption("tipr.verbose", TRUE), or_correction = FALSE) { 371 | check_arguments( 372 | "tip_or_with_binary()", 373 | exposed_confounder_prev, 374 | unexposed_confounder_prev, 375 | confounder_outcome_effect 376 | ) 377 | 378 | correction_factor <- ifelse(or_correction, "or", "none") 379 | tip_with_binary( 380 | effect_observed, 381 | exposed_confounder_prev = exposed_confounder_prev, 382 | unexposed_confounder_prev = unexposed_confounder_prev, 383 | confounder_outcome_effect = confounder_outcome_effect, 384 | verbose = verbose, 385 | correction_factor = correction_factor 386 | ) 387 | } 388 | 389 | #' @rdname tip_with_binary 390 | #' @export 391 | tip_b <- tip_with_binary 392 | 393 | 394 | -------------------------------------------------------------------------------- /R/adjust_coefficient.R: -------------------------------------------------------------------------------- 1 | #' Adjust an observed regression coefficient for a normally distributed 2 | #' confounder 3 | #' 4 | #' @param effect_observed Numeric. Observed exposure - outcome effect from a regression 5 | #' model. This can be the beta coefficient, the lower confidence bound of 6 | #' the beta coefficient, or the upper confidence bound of the beta 7 | #' coefficient. 8 | #' @param exposure_confounder_effect Numeric. Estimated difference in scaled means between the 9 | #' unmeasured confounder in the exposed population and unexposed population 10 | #' @param confounder_outcome_effect Numeric. Estimated relationship 11 | #' between the unmeasured confounder and the outcome. 12 | #' @param verbose Logical. Indicates whether to print informative message. 13 | #' Default: `TRUE` 14 | #' 15 | #' @return Data frame. 16 | #' @export 17 | #' 18 | #' @examples 19 | #' ## Update an observed coefficient of 0.5 with an unmeasured confounder 20 | #' ## with a difference in scaled means between exposure groups of 0.2 21 | #' ## and coefficient of 0.3 22 | #' adjust_coef(0.5, 0.2, 0.3) 23 | adjust_coef <- 24 | function(effect_observed, 25 | exposure_confounder_effect, 26 | confounder_outcome_effect, 27 | verbose = getOption("tipr.verbose", TRUE)) { 28 | effect_adj <- 29 | effect_observed - confounder_outcome_effect * exposure_confounder_effect 30 | o <- tibble::tibble( 31 | effect_adjusted = effect_adj, 32 | effect_observed = effect_observed, 33 | exposure_confounder_effect = exposure_confounder_effect, 34 | confounder_outcome_effect = confounder_outcome_effect 35 | ) 36 | if (verbose) { 37 | message_cli(c( 38 | "i" = "The observed effect ({round(effect_observed, 2)}) \\ 39 | is updated to {round(effect_adj, 2)} \\ 40 | by a confounder with the following specifications:", 41 | "*" = "estimated difference in scaled means: {exposure_confounder_effect}", 42 | "*" = "estimated relationship between the unmeasured confounder and the \\ 43 | outcome: {confounder_outcome_effect}" 44 | )) 45 | } 46 | return(o) 47 | } 48 | 49 | #' Adjust an observed coefficient from a regression model with a binary 50 | #' confounder 51 | #' 52 | #' @param effect_observed Numeric. Observed exposure - outcome effect from a 53 | #' loglinear model. This can be the beta coefficient, the lower confidence 54 | #' bound of the beta coefficient, or the upper confidence bound of the beta 55 | #' coefficient. 56 | #' @param exposed_confounder_prev Numeric between 0 and 1. Estimated prevalence 57 | #' of the unmeasured confounder in the exposed population 58 | #' @param unexposed_confounder_prev Numeric between 0 and 1. Estimated 59 | #' prevalence of the unmeasured confounder in the unexposed population 60 | #' @param confounder_outcome_effect Numeric. Estimated relationship between the 61 | #' unmeasured confounder and the outcome. 62 | #' @param loglinear Logical. Calculate the adjusted coefficient from a loglinear 63 | #' model instead of a linear model (the default). When `loglinear = FALSE`, 64 | #' `adjust_coef_with_binary()` is equivalent to `adjust_coef()` where 65 | #' `exposure_confounder_effect` is the difference in prevalences. 66 | #' @param verbose Logical. Indicates whether to print informative message. 67 | #' Default: `TRUE` 68 | #' 69 | #' @return Data frame. 70 | #' @export 71 | #' 72 | #' @examples 73 | #' adjust_coef_with_binary(1.1, 0.5, 0.3, 1.3) 74 | adjust_coef_with_binary <- 75 | function(effect_observed, 76 | exposed_confounder_prev, 77 | unexposed_confounder_prev, 78 | confounder_outcome_effect, 79 | loglinear = FALSE, 80 | verbose = getOption("tipr.verbose", TRUE)) { 81 | check_prevalences(unexposed_confounder_prev, exposed_confounder_prev) 82 | if (loglinear) { 83 | confounding_factor <- log((exp(confounder_outcome_effect) * exposed_confounder_prev + (1 - exposed_confounder_prev)) / 84 | ( 85 | exp(confounder_outcome_effect) * unexposed_confounder_prev + (1 - unexposed_confounder_prev) 86 | )) 87 | effect_adj <- effect_observed - confounding_factor 88 | o <- tibble::tibble( 89 | effect_adjusted = effect_adj, 90 | effect_observed = effect_observed, 91 | exposed_confounder_prev = exposed_confounder_prev, 92 | unexposed_confounder_prev = unexposed_confounder_prev, 93 | confounder_outcome_effect = confounder_outcome_effect 94 | ) 95 | } else { 96 | o <- adjust_coef( 97 | effect_observed = effect_observed, 98 | exposure_confounder_effect = exposed_confounder_prev - unexposed_confounder_prev, 99 | confounder_outcome_effect = confounder_outcome_effect, 100 | verbose = FALSE 101 | ) 102 | } 103 | 104 | 105 | if (verbose) { 106 | message_cli(c( 107 | "i" = "The observed effect ({round(effect_observed, 2)}) \\ 108 | is updated to {round(o$effect_adjusted, 2)} \\ 109 | by a confounder with the following specifications:", 110 | "*" = "estimated prevalence of the unmeasured confounder \\ 111 | in the exposed population: {round(exposed_confounder_prev, 2)}", 112 | "*" = "estimated prevalence of \\ 113 | the unmeasured confounder in the unexposed population: \\ 114 | {round(unexposed_confounder_prev, 2)}", 115 | 116 | "*" = "estimated relationship between the unmeasured confounder and \\ 117 | the outcome: {round(confounder_outcome_effect, 2)}" 118 | )) 119 | } 120 | return(o) 121 | } 122 | #' Adjust an observed risk ratio for a normally distributed 123 | #' confounder 124 | #' 125 | #' @param effect_observed Numeric positive value. Observed exposure - outcome risk ratio. 126 | #' This can be the point estimate, lower confidence bound, or upper 127 | #' confidence bound. 128 | #' @param exposure_confounder_effect Numeric. Estimated difference in scaled means between the 129 | #' unmeasured confounder in the exposed population and unexposed population 130 | #' @param confounder_outcome_effect Numeric. Estimated relationship 131 | #' between the unmeasured confounder and the outcome. 132 | #' @param verbose Logical. Indicates whether to print informative message. 133 | #' Default: `TRUE` 134 | #' 135 | #' @return Data frame. 136 | #' @export 137 | #' 138 | #' @examples 139 | #' adjust_rr(1.2, 0.5, 1.1) 140 | adjust_rr <- 141 | function(effect_observed, 142 | exposure_confounder_effect, 143 | confounder_outcome_effect, 144 | verbose = TRUE) { 145 | rr <- effect_observed 146 | check_gamma(confounder_outcome_effect) 147 | check_effect(rr) 148 | rr_adj <- 149 | rr / (confounder_outcome_effect ^ exposure_confounder_effect) 150 | 151 | o <- tibble::tibble( 152 | rr_adjusted = rr_adj, 153 | rr_observed = rr, 154 | exposure_confounder_effect = exposure_confounder_effect, 155 | confounder_outcome_effect = confounder_outcome_effect 156 | ) 157 | if (verbose) { 158 | message_cli(c( 159 | "i" = "The observed effect (RR: {round(rr, 2)}) \\ 160 | is updated to RR: {round(rr_adj, 2)} \\ 161 | by a confounder with the following specifications:", 162 | "*" = "estimated difference in scaled means: {exposure_confounder_effect}", 163 | "*" = "estimated relationship (RR) between the unmeasured confounder \\ 164 | and the outcome: {round(confounder_outcome_effect, 2)}" 165 | )) 166 | } 167 | return(o) 168 | } 169 | 170 | #' Adjust an observed hazard ratio for a normally distributed 171 | #' confounder 172 | #' 173 | #' @param effect_observed Numeric positive value. Observed exposure - outcome hazard ratio. 174 | #' This can be the point estimate, lower confidence bound, or upper 175 | #' confidence bound. 176 | #' @param exposure_confounder_effect Numeric. Estimated difference in scaled means between the 177 | #' unmeasured confounder in the exposed population and unexposed population 178 | #' @param confounder_outcome_effect Numeric. Estimated relationship 179 | #' between the unmeasured confounder and the outcome. 180 | #' @param verbose Logical. Indicates whether to print informative message. 181 | #' Default: `TRUE` 182 | #' @param hr_correction Logical. Indicates whether to use a correction factor. 183 | #' The methods used for this function are based on risk ratios. For rare 184 | #' outcomes, a hazard ratio approximates a risk ratio. For common outcomes, 185 | #' a correction factor is needed. If you have a common outcome (>15%), 186 | #' set this to `TRUE`. Default: `FALSE`. 187 | #' 188 | #' @return Data frame. 189 | #' @export 190 | #' 191 | #' @examples 192 | #' adjust_hr(0.9, -0.9, 1.3) 193 | adjust_hr <- 194 | function(effect_observed, 195 | exposure_confounder_effect, 196 | confounder_outcome_effect, 197 | verbose = getOption("tipr.verbose", TRUE), 198 | hr_correction = FALSE) { 199 | hr <- effect_observed 200 | if (hr_correction) { 201 | hr <- hr_transform(hr) 202 | confounder_outcome_effect <- 203 | hr_transform(confounder_outcome_effect) 204 | } 205 | o <- 206 | adjust_rr(hr, 207 | exposure_confounder_effect, 208 | confounder_outcome_effect, 209 | verbose = FALSE) 210 | 211 | output_type <- ifelse(hr_correction, 'RR', 'HR') 212 | 213 | 214 | if (verbose) { 215 | message_cli(c( 216 | "i" = "The observed effect ({output_type}: {round(o$rr_observed, 2)}) \\ 217 | is updated to {output_type}: {round(o$rr_adjusted, 2)} \\ 218 | by a confounder with the following specifications:", 219 | "*" = "estimated difference in scaled means: {exposure_confounder_effect}", 220 | "*" = "estimated relationship ({output_type}) between the unmeasured \\ 221 | confounder and the outcome: {round(confounder_outcome_effect, 2)}" 222 | )) 223 | 224 | if (hr_correction) message_cli(c( 225 | "i" = "You opted to use the hazard ratio correction to convert your \\ 226 | hazard ratios to approximate risk ratios. \\ 227 | This is a good idea if the outcome is common (>15%)" 228 | )) 229 | } 230 | 231 | if (!hr_correction) { 232 | names(o)[1] <- "hr_adjusted" 233 | names(o)[2] <- "hr_observed" 234 | } 235 | 236 | return(o) 237 | } 238 | #' Adjust an observed odds ratio for a normally distributed 239 | #' confounder 240 | #' 241 | #' @param effect_observed Numeric positive value. Observed exposure - outcome odds ratio. 242 | #' This can be the point estimate, lower confidence bound, or upper 243 | #' confidence bound. 244 | #' @param exposure_confounder_effect Numeric. Estimated difference in scaled means between the 245 | #' unmeasured confounder in the exposed population and unexposed population 246 | #' @param confounder_outcome_effect Numeric. Estimated relationship 247 | #' between the unmeasured confounder and the outcome. 248 | #' @param verbose Logical. Indicates whether to print informative message. 249 | #' Default: `TRUE` 250 | #' @param or_correction Logical. Indicates whether to use a correction factor. 251 | #' The methods used for this function are based on risk ratios. For rare 252 | #' outcomes, an odds ratio approximates a risk ratio. For common outcomes, 253 | #' a correction factor is needed. If you have a common outcome (>15%), 254 | #' set this to `TRUE`. Default: `FALSE`. 255 | #' 256 | #' @return Data frame. 257 | #' @export 258 | #' 259 | #' @examples 260 | #' adjust_or(1.2, 0.9, 1.3) 261 | adjust_or <- 262 | function(effect_observed, 263 | exposure_confounder_effect, 264 | confounder_outcome_effect, 265 | verbose = getOption("tipr.verbose", TRUE), 266 | or_correction = FALSE) { 267 | or <- effect_observed 268 | if (or_correction) { 269 | or <- or_transform(or) 270 | confounder_outcome_effect <- 271 | or_transform(confounder_outcome_effect) 272 | } 273 | o <- 274 | adjust_rr(or, 275 | exposure_confounder_effect, 276 | confounder_outcome_effect, 277 | verbose = FALSE) 278 | 279 | output_type <- ifelse(or_correction, 'RR', 'OR') 280 | 281 | if (verbose) { 282 | message_cli(c( 283 | "i" = "The observed effect ({output_type}: {round(o$rr_observed, 2)}) \\ 284 | is updated to {output_type}: {round(o$rr_adjusted, 2)} \\ 285 | by a confounder with the following specifications:", 286 | "*" = "estimated difference in scaled means: {exposure_confounder_effect}", 287 | "*" = "estimated relationship ({output_type}) between the unmeasured \\ 288 | confounder and the outcome: {round(confounder_outcome_effect, 2)}" 289 | )) 290 | 291 | 292 | if (or_correction) message_cli(c( 293 | "i" = "You opted to use the odds ratio correction to convert your \\ 294 | odds ratio to approximate risk ratios. \\ 295 | This is a good idea if the outcome is common (>15%)" 296 | )) 297 | } 298 | 299 | if (!or_correction) { 300 | names(o)[1] <- "or_adjusted" 301 | names(o)[2] <- "or_observed" 302 | } 303 | 304 | return(o) 305 | } 306 | 307 | #' Adjust an observed risk ratio with a binary confounder 308 | #' 309 | #' @param effect_observed Numeric positive value. Observed exposure - outcome risk ratio. 310 | #' This can be the point estimate, lower confidence bound, or upper 311 | #' confidence bound. 312 | #' @param exposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 313 | #' unmeasured confounder in the exposed population 314 | #' @param unexposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 315 | #' unmeasured confounder in the unexposed population 316 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 317 | #' between the unmeasured confounder and the outcome 318 | #' @param verbose Logical. Indicates whether to print informative message. 319 | #' Default: `TRUE` 320 | #' 321 | #' @return Data frame. 322 | #' @export 323 | #' 324 | #' @examples 325 | #' adjust_rr_with_binary(1.1, 0.5, 0.3, 1.3) 326 | adjust_rr_with_binary <- 327 | function(effect_observed, 328 | exposed_confounder_prev, 329 | unexposed_confounder_prev, 330 | confounder_outcome_effect, 331 | verbose = getOption("tipr.verbose", TRUE)) { 332 | rr <- effect_observed 333 | check_prevalences(unexposed_confounder_prev, exposed_confounder_prev) 334 | 335 | confounding_factor <- 336 | (confounder_outcome_effect * exposed_confounder_prev + (1 - exposed_confounder_prev)) / 337 | ((confounder_outcome_effect * unexposed_confounder_prev) + (1 - unexposed_confounder_prev)) 338 | 339 | rr_adj <- rr / confounding_factor 340 | o <- tibble::tibble( 341 | rr_adjusted = rr_adj, 342 | rr_observed = rr, 343 | exposed_confounder_prev = exposed_confounder_prev, 344 | unexposed_confounder_prev = unexposed_confounder_prev, 345 | confounder_outcome_effect = confounder_outcome_effect 346 | ) 347 | if (verbose) { 348 | message_cli(c( 349 | "The observed effect ({round(rr, 2)}) \\ 350 | is updated to {round(rr_adj, 2)} \\ 351 | by a confounder with the following specifications:", 352 | "*" = "estimated prevalence of the unmeasured confounder \\ 353 | in the exposed population: {round(exposed_confounder_prev, 2)}", 354 | "*" = "estimated prevalence of the unmeasured confounder in the \\ 355 | unexposed population: {round(unexposed_confounder_prev, 2)}", 356 | "*" = "estimated relationship between the unmeasured confounder and \\ 357 | the outcome: {round(confounder_outcome_effect, 2)}" 358 | )) 359 | } 360 | return(o) 361 | } 362 | #' Adjust an observed hazard ratio with a binary confounder 363 | #' 364 | #' @param effect_observed Numeric positive value. Observed exposure - outcome hazard ratio. 365 | #' This can be the point estimate, lower confidence bound, or upper 366 | #' confidence bound. 367 | #' @param exposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 368 | #' unmeasured confounder in the exposed population 369 | #' @param unexposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 370 | #' unmeasured confounder in the unexposed population 371 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 372 | #' between the unmeasured confounder and the outcome 373 | #' @param verbose Logical. Indicates whether to print informative message. 374 | #' Default: `TRUE` 375 | #' @param hr_correction Logical. Indicates whether to use a correction factor. 376 | #' The methods used for this function are based on risk ratios. For rare 377 | #' outcomes, a hazard ratio approximates a risk ratio. For common outcomes, 378 | #' a correction factor is needed. If you have a common outcome (>15%), 379 | #' set this to `TRUE`. Default: `FALSE`. 380 | #' 381 | #' @return Data frame. 382 | #' @export 383 | #' 384 | #' @examples 385 | #' adjust_hr_with_binary(0.8, 0.1, 0.5, 1.8) 386 | adjust_hr_with_binary <- 387 | function(effect_observed, 388 | exposed_confounder_prev, 389 | unexposed_confounder_prev, 390 | confounder_outcome_effect, 391 | verbose = getOption("tipr.verbose", TRUE), 392 | hr_correction = FALSE) { 393 | hr <- effect_observed 394 | if (hr_correction) { 395 | hr <- hr_transform(hr) 396 | confounder_outcome_effect <- 397 | hr_transform(confounder_outcome_effect) 398 | } 399 | o <- 400 | adjust_rr_with_binary(hr, 401 | exposed_confounder_prev, 402 | unexposed_confounder_prev, 403 | confounder_outcome_effect, 404 | verbose = FALSE) 405 | 406 | output_type <- ifelse(hr_correction, 'RR', 'HR') 407 | 408 | if (verbose) { 409 | message_cli(c( 410 | "i" = "The observed effect ({output_type}: {round(o$rr_observed, 2)}) \\ 411 | is updated to {output_type}: {round(o$rr_adjusted, 2)} \\ 412 | by a confounder with the following specifications:", 413 | "*" = "estimated prevalence of the unmeasured confounder \\ 414 | in the exposed population: {round(exposed_confounder_prev, 2)}", 415 | "*" = "estimated prevalence of the unmeasured confounder in the \\ 416 | unexposed population: {round(unexposed_confounder_prev, 2)}", 417 | "*" = "estimated relationship between the unmeasured confounder \\ 418 | and the outcome: {round(confounder_outcome_effect, 2)}" 419 | )) 420 | 421 | if (hr_correction) message_cli(c( 422 | "i" = "You opted to use the hazard ratio correction to convert your \\ 423 | hazard ratios to approximate risk ratios. \\ 424 | This is a good idea if the outcome is common (>15%)" 425 | )) 426 | } 427 | 428 | if (!hr_correction) { 429 | names(o)[1] <- "hr_adjusted" 430 | names(o)[2] <- "hr_observed" 431 | } 432 | return(o) 433 | } 434 | 435 | 436 | #' Adjust an observed odds ratio with a binary confounder 437 | #' 438 | #' @param effect_observed Numeric positive value. Observed exposure - outcome 439 | #' odds ratio. This can be the point estimate, lower confidence bound, or 440 | #' upper confidence bound. 441 | #' @param exposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 442 | #' unmeasured confounder in the exposed population 443 | #' @param unexposed_confounder_prev Numeric between 0 and 1. Estimated prevalence of the 444 | #' unmeasured confounder in the unexposed population 445 | #' @param confounder_outcome_effect Numeric positive value. Estimated relationship 446 | #' between the unmeasured confounder and the outcome 447 | #' @param verbose Logical. Indicates whether to print informative message. 448 | #' Default: `TRUE` 449 | #' @param or_correction Logical. Indicates whether to use a correction factor. 450 | #' The methods used for this function are based on risk ratios. For rare 451 | #' outcomes, an odds ratio approximates a risk ratio. For common outcomes, 452 | #' a correction factor is needed. If you have a common outcome (>15%), 453 | #' set this to `TRUE`. Default: `FALSE`. 454 | #' 455 | #' @return Data frame. 456 | #' @export 457 | #' 458 | #' @examples 459 | #' adjust_or_with_binary(3, 1, 0, 3) 460 | #' adjust_or_with_binary(3, 1, 0, 3, or_correction = TRUE) 461 | adjust_or_with_binary <- 462 | function(effect_observed, 463 | exposed_confounder_prev, 464 | unexposed_confounder_prev, 465 | confounder_outcome_effect, 466 | verbose = getOption("tipr.verbose", TRUE), 467 | or_correction = FALSE) { 468 | or <- effect_observed 469 | if (or_correction) { 470 | or <- or_transform(or) 471 | confounder_outcome_effect <- 472 | or_transform(confounder_outcome_effect) 473 | } 474 | o <- 475 | adjust_rr_with_binary(or, 476 | exposed_confounder_prev, 477 | unexposed_confounder_prev, 478 | confounder_outcome_effect, 479 | verbose = FALSE) 480 | 481 | output_type <- ifelse(or_correction, 'RR', 'OR') 482 | 483 | if (verbose) { 484 | message_cli(c( 485 | "*" = "The observed effect ({output_type}: {round(o$rr_observed, 2)}) \\ 486 | is updated to {output_type}: {round(o$rr_adjusted, 2)} \\ 487 | by a confounder with the following specifications:", 488 | "*" = "estimated prevalence of the unmeasured confounder \\ 489 | in the exposed population: {round(exposed_confounder_prev, 2)}", 490 | "*" = "estimated prevalence of the unmeasured confounder in the \\ 491 | unexposed population: {round(unexposed_confounder_prev, 2)}", 492 | "*" = "estimated relationship between the unmeasured confounder and \\ 493 | the outcome: {round(confounder_outcome_effect, 2)}" 494 | )) 495 | 496 | if (or_correction) message_cli(c( 497 | "i" = "You opted to use the odds ratio correction to convert your \\ 498 | odds ratios to approximate risk ratios. \\ 499 | This is a good idea if the outcome is common (>15%)" 500 | )) 501 | } 502 | 503 | if (!or_correction) { 504 | names(o)[1] <- "or_adjusted" 505 | names(o)[2] <- "or_observed" 506 | } 507 | 508 | return(o) 509 | } 510 | 511 | #' @rdname adjust_coef 512 | #' @export 513 | adjust_coef_with_continuous <- adjust_coef 514 | 515 | #' @rdname adjust_rr 516 | #' @export 517 | adjust_rr_with_continuous <- adjust_rr 518 | 519 | #' @rdname adjust_or 520 | #' @export 521 | adjust_or_with_continuous <- adjust_or 522 | 523 | #' @rdname adjust_hr 524 | #' @export 525 | adjust_hr_with_continuous <- adjust_hr 526 | --------------------------------------------------------------------------------