diff --git a/DESCRIPTION b/DESCRIPTION index 27ba8cf..0cea06c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,14 +1,6 @@ Package: jointVIP Title: Prioritize Variables with Joint Variable Importance Plot in Observational Study Design -<<<<<<< HEAD -<<<<<<< HEAD Version: 0.1.2.001 -======= -Version: 0.1.2 ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -Version: 0.1.2 ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 Authors@R: c(person(given = "Lauren D.", family = "Liao", role = c("aut", "cre"), @@ -28,8 +20,6 @@ Description: In the observational study design stage, matching/weighting methods plots translate variable importance into recommended values for tuning parameters in existing methods. Post-matching and/or weighting plots can also be used to visualize and assess the quality of the observational study design. The method -<<<<<<< HEAD -<<<<<<< HEAD motivation and derivation is presented in "Prioritizing Variables for Observational Study Design using the Joint Variable Importance Plot" by Liao et al. (2024) . See the package paper by Liao and Pimentel @@ -38,21 +28,6 @@ License: MIT + file LICENSE Encoding: UTF-8 Roxygen: list(markdown = TRUE) RoxygenNote: 7.3.1 -======= -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 - motivation and derivation is presented in "Using Joint Variable Importance Plots - to Prioritize Variables in Assessing the Impact of Glyburide on Adverse Birth - Outcomes" by Liao et al. (2023) . See the package paper by Liao - and Pimentel (2023) for a beginner friendly user introduction. -License: MIT + file LICENSE -Encoding: UTF-8 -Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.1 -<<<<<<< HEAD ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 Depends: R (>= 3.3) Suggests: @@ -64,8 +39,6 @@ Suggests: optmatch, optweight (>= 0.2.4), rmarkdown (>= 2.18), -<<<<<<< HEAD -<<<<<<< HEAD testthat (>= 3.0.0), stringr Config/testthat/edition: 3 @@ -81,28 +54,10 @@ Collate: 'plot.R' 'print.R' 'summary.R' -======= -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 - testthat (>= 3.0.0) -Config/testthat/edition: 3 -Collate: - 'measures.R' - 'general.R' -<<<<<<< HEAD ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 Imports: ggrepel (>= 0.9.2), ggplot2 (>= 3.4.0) VignetteBuilder: knitr URL: https://github.com/ldliao/jointVIP BugReports: https://github.com/ldliao/jointVIP/issues -<<<<<<< HEAD -<<<<<<< HEAD LazyData: true -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 diff --git a/LICENSE b/LICENSE index a216658..c31276a 100644 --- a/LICENSE +++ b/LICENSE @@ -1,12 +1,2 @@ -<<<<<<< HEAD -<<<<<<< HEAD -YEAR: 2024 -COPYRIGHT HOLDER: jointVIP authors -======= YEAR: 2022-2024 COPYRIGHT HOLDER: Lauren D. Liao ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -YEAR: 2022-2024 -COPYRIGHT HOLDER: Lauren D. Liao ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 diff --git a/LICENSE.md b/LICENSE.md index 3797ac1..990e78a 100644 --- a/LICENSE.md +++ b/LICENSE.md @@ -1,14 +1,6 @@ # MIT License -<<<<<<< HEAD -<<<<<<< HEAD -Copyright (c) 2024 jointVIP authors -======= Copyright (c) 2022-24 Lauren D. Liao ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -Copyright (c) 2022-24 Lauren D. Liao ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal diff --git a/NEWS.md b/NEWS.md index acf54e7..c3944fd 100644 --- a/NEWS.md +++ b/NEWS.md @@ -9,14 +9,8 @@ * Added one-hot encoding to process data frames -<<<<<<< HEAD -<<<<<<< HEAD * Reorganized code as per reviewer's suggestion -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 # jointVIP 0.1.2 * Post-adjusted estimation for weights are now updated accordingly diff --git a/R/general.R b/R/general.R deleted file mode 100644 index 69a1283..0000000 --- a/R/general.R +++ /dev/null @@ -1,1268 +0,0 @@ -## S3 generics and methods - - -#' support function for one-hot encoding -#' -#' @param df data.frame object for performing one-hot encoding -#' @return data.frame object with factor variables one-hot encoded for each level -one_hot <- - function(df) { - char_vars <- unlist(lapply(df[, , drop = FALSE], is.character)) - - if(sum(char_vars) > 0){ - # cat("character variables are converted into factor variables\n") - df[sapply(df, is.character)] <- - lapply(df[sapply(df, is.character)], - as.factor) - } - fac_vars <- unlist(lapply(df[, , drop = FALSE], is.factor)) - - if (sum(fac_vars) > 0) { - # cat("all factor variables are one-hot encoded\n") - lvls <- lapply(df[, fac_vars, drop = FALSE], nlevels) - - # binary - for (bin_var in names(lvls)[lvls == 2]) { - col_name_first_fac_lvl <- - paste0(c(bin_var, levels(df[[bin_var]])[1]), collapse = "_") - df[[col_name_first_fac_lvl]] <- - ifelse(df[[bin_var]] == levels(df[[bin_var]])[1], - 1, 0) - } - - # categorical with multiple levels - for (multi_var in names(lvls)[lvls > 2]) { - col_names_lvls <- paste(multi_var, levels(df[[multi_var]]), sep = "_") - one_hot_mtx <- stats::model.matrix( ~ 0 + df[[multi_var]], df) - colnames(one_hot_mtx) <- col_names_lvls - df <- cbind(df, one_hot_mtx) - } - } - - return(Filter(function(x) - ! is.factor(x), df)) - } - -#' create jointVIP object -#' -#' This is creates the jointVIP object & check inputs -#' @param treatment string denoting the name of the binary treatment variable, containing numeric values: 0 denoting control and 1 denoting treated -#' @param outcome string denoting the name of a numeric outcome variable -#' @param covariates vector of strings or list denoting column names of interest -#' @param pilot_df data.frame of the pilot data; character and factor variables are automatically one-hot encoded -#' @param analysis_df data.frame of the analysis data; character and factor variables are automatically one-hot encoded -#' -#' @return a jointVIP object -#' -#' @export -#' @examples -#' -#' data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' # random 20 percent of control as pilot data -#' pilot_sample_num = sample(which(data$trt == 0), -#' length(which(data$trt == 0)) * -#' 0.2) -#' pilot_df = data[pilot_sample_num, ] -#' analysis_df = data[-pilot_sample_num, ] -#' treatment = "trt" -#' outcome = "out" -#' covariates = names(analysis_df)[!names(analysis_df) -#' %in% c(treatment, outcome)] -#' new_jointVIP = create_jointVIP(treatment = treatment, -#' outcome = outcome, -#' covariates = covariates, -#' pilot_df = pilot_df, -#' analysis_df = analysis_df) -#' -create_jointVIP <- function(treatment, - outcome, - covariates, - pilot_df, - analysis_df) { - # support function to check inputs - input.check <- function(treatment, - outcome, - covariates, - pilot_df, - analysis_df) { - if (all(dim(pilot_df) == c(0, 0)) | - all(dim(analysis_df) == c(0, 0))) { - stop("both `pilot_df` and `analysis_df` cannot be empty data.frames") - } else if (!"data.frame" %in% class(pilot_df) | - !"data.frame" %in% class(analysis_df)) { - stop("`pilot_df` and `analysis_df` must both have data.frame classes") - } else if (all(!covariates %in% names(pilot_df)) | - all(!covariates %in% names(analysis_df))) { - stop("`covariates` must be in both pilot_df and analysis_df") - } - if (!(treatment %in% names(analysis_df))) { - stop("`treatment` variable must be in analysis_df") - } else if (!all(sapply(analysis_df[, treatment], - function(x) { - all(x %in% 0:1) - }))) { - stop("`treatment` must be binary: 0 (control) and 1 (treated)") - } else if ((!is.numeric(pilot_df[,outcome])) & (!is.numeric(analysis_df[,outcome]))) { - stop("`outcome` must be denoting a numeric variable") - } - if (var(pilot_df[, outcome]) == 0) { - stop("`pilot_df` outcome must have some variation") - } - if (!all(pilot_df[, treatment] == 0)) { - stop("`pilot_df` should only be controls only") - } - } - - - # construction function - new_jointVIP <- function(treatment, - outcome, - covariates, - pilot_df, - analysis_df) { - input.check(treatment, - outcome, - covariates, - pilot_df, - analysis_df) - - pilot_df = pilot_df[, c(treatment, outcome, covariates)] - analysis_df = analysis_df[, c(treatment, outcome, covariates)] - - ## one hot encoding - pilot_df = one_hot(pilot_df) - analysis_df = one_hot(analysis_df) - - if(!identical(names(pilot_df[, -c(1, 2)]),names(analysis_df[, -c(1, 2)]))){ - full_covs = c(names(pilot_df[, -c(1, 2)]),names(analysis_df[, -c(1, 2)])) - in_dat = duplicated(full_covs) | duplicated(full_covs, fromLast = TRUE) - covs = unique(full_covs[in_dat]) - cat("dropping some levels due to mismatch after one-hot encoding\nkeeping variables that exist in both dataframes") - pilot_df = pilot_df[,c(treatment, outcome, covs)] - analysis_df = analysis_df[,c(treatment, outcome, covs)] - covariates = covs - } - - structure( - list( - treatment = treatment, - outcome = outcome, - pilot_df = pilot_df, - analysis_df = analysis_df - ), - class = "jointVIP" - ) - } - - invisible(new_jointVIP(treatment, - outcome, - covariates, - pilot_df, - analysis_df)) -} - - -#' create jointVIP object -#' -#' This is creates the post_jointVIP object & check inputs -#' @param object a jointVIP object -#' @param post_analysis_df post matched or weighted data.frame -#' @param wts user-supplied weights -#' @return a post_jointVIP object (subclass of jointVIP) -#' -#' @export -#' @examples -#' data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' # random 20 percent of control as pilot data -#' pilot_sample_num = sample(which(data$trt == 0), -#' length(which(data$trt == 0)) * -#' 0.2) -#' pilot_df = data[pilot_sample_num, ] -#' analysis_df = data[-pilot_sample_num, ] -#' treatment = "trt" -#' outcome = "out" -#' covariates = names(analysis_df)[!names(analysis_df) -#' %in% c(treatment, outcome)] -#' new_jointVIP = create_jointVIP(treatment = treatment, -#' outcome = outcome, -#' covariates = covariates, -#' pilot_df = pilot_df, -#' analysis_df = analysis_df) -#' -#' ## at this step typically you may wish to do matching or weighting -#' ## the results after can be stored as a post_data -#' ## the post_data here is not matched or weighted, only for illustrative purposes -#' post_data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' post_dat_jointVIP = create_post_jointVIP(new_jointVIP, post_data) -create_post_jointVIP <- function(object, - post_analysis_df, - wts = NA) { - if (all(dim(post_analysis_df) == c(0, 0))) { - stop("`post_analysis_df` cannot be an empty data.frame") - } else if (!"data.frame" %in% class(post_analysis_df)) { - stop("`post_analysis_df` must be a data.frame class") - } - - post_analysis_df = one_hot(post_analysis_df) - - if (!setequal(names(post_analysis_df), names(object$analysis_df))) { - stop( - "`post_analysis_df` must have the same covariates, treatment, and outcome in `analysis_df`" - ) - } - if (!all(sapply(post_analysis_df[, object$treatment], - function(x) { - all(x %in% 0:1) - }))) { - stop("`treatment` must be binary: 0 (control) and 1 (treated)") - } - - if(!all(is.na(wts) & length(wts) == 1)){ - if(length(wts) != dim(post_analysis_df)[[1]]){ - stop("length of `wts` must be the same number of rows as `post_analysis_df`") - } - if(!all(is.numeric(wts))){ - stop("`wts` must be numeric") - } - if(any(is.na(wts) | all(wts == 0))){ - stop("`wts` cannot contain NA or all be 0") - } - } else {wts = rep(1, dim(post_analysis_df)[[1]])} - structure( - list( - treatment = object$treatment, - outcome = object$outcome, - pilot_df = object$pilot_df, - analysis_df = object$analysis_df, - post_analysis_df = post_analysis_df, - wts = wts - ), - class = c("post_jointVIP", "jointVIP") - ) -} - -#' Obtains a summary jointVIP object -#' -#' -#' @param object a jointVIP object -#' @param ... not used -#' @param smd specify the standardized mean difference is `cross-sample` or `pooled` -#' @param use_abs TRUE (default) for absolute measures -#' @param bias_tol numeric 0.01 (default) any bias above the absolute bias_tol will be summarized -#' @return no return value -#' @export -#' @examples -#' data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' # random 20 percent of control as pilot data -#' pilot_sample_num = sample(which(data$trt == 0), -#' length(which(data$trt == 0)) * -#' 0.2) -#' pilot_df = data[pilot_sample_num, ] -#' analysis_df = data[-pilot_sample_num, ] -#' treatment = "trt" -#' outcome = "out" -#' covariates = names(analysis_df)[!names(analysis_df) -#' %in% c(treatment, outcome)] -#' new_jointVIP = create_jointVIP(treatment = treatment, -#' outcome = outcome, -#' covariates = covariates, -#' pilot_df = pilot_df, -#' analysis_df = analysis_df) -#' summary(new_jointVIP) -summary.jointVIP <- function(object, - ..., - smd = 'cross-sample', - use_abs = TRUE, - bias_tol = 0.01) { - if (any(is.null(names(list(...)))) & length(list(...)) > 0) { - warning("anything passed in ... must be named or it'll be ignored") - } - - if (use_abs) { - measures = abs(get_measures(object, smd = smd)) - } else { - measures = get_measures(object, smd = smd) - } - if (bias_tol < 0) { - warning("`bias_tol` will be treated as positive") - } - measures = measures[order(abs(measures$bias), - decreasing = TRUE), ] - summary_measures = measures[abs(round(measures$bias, 3)) >= abs(bias_tol), - "bias", drop = FALSE] - - if (use_abs == TRUE) { - writeLines(sprintf("Max absolute bias is %.3f", - abs(max(measures$bias)))) - } else { - writeLines(sprintf("Max bias is %.3f", - (max(measures$bias)))) - writeLines(sprintf("Min bias is %.3f", - (min(measures$bias)))) - } - - - writeLines(sprintf( - "%d variables are above the desired %s absolute bias tolerance", - length(row.names(summary_measures)), - abs(bias_tol) - )) - - writeLines(sprintf("%d variables can be plotted", - length(row.names(measures)))) - invisible() -} - -#' Obtains a summary post_jointVIP object -#' -#' @param object a post_jointVIP object -#' @param ... not used -#' @param smd specify the standardized mean difference is `cross-sample` or `pooled` -#' @param use_abs TRUE (default) for absolute measures -#' @param bias_tol numeric 0.01 (default) any bias above the absolute bias_tol will be summarized -#' @param post_bias_tol numeric 0.005 (default) any bias above the absolute bias_tol will be summarized -#' @return no return value -#' @export -#' @examples -#' data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' # random 20 percent of control as pilot data -#' pilot_sample_num = sample(which(data$trt == 0), -#' length(which(data$trt == 0)) * -#' 0.2) -#' pilot_df = data[pilot_sample_num, ] -#' analysis_df = data[-pilot_sample_num, ] -#' treatment = "trt" -#' outcome = "out" -#' covariates = names(analysis_df)[!names(analysis_df) -#' %in% c(treatment, outcome)] -#' new_jointVIP = create_jointVIP(treatment = treatment, -#' outcome = outcome, -#' covariates = covariates, -#' pilot_df = pilot_df, -#' analysis_df = analysis_df) -#' -#' ## at this step typically you may wish to do matching or weighting -#' ## the results after can be stored as a post_data -#' ## the post_data here is not matched or weighted, only for illustrative purposes -#' post_data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' post_dat_jointVIP = create_post_jointVIP(new_jointVIP, post_data) -#' summary(post_dat_jointVIP) -summary.post_jointVIP <- function(object, - ..., - smd = 'cross-sample', - use_abs = TRUE, - bias_tol = 0.01, - post_bias_tol = 0.005) { - if (use_abs) { - post_measures = abs(get_post_measures(object, smd = smd)) - } else { - post_measures = get_post_measures(object, smd = smd) - } - post_measures = post_measures[order(abs(post_measures$bias), - decreasing = TRUE), ] - summary_post_measures = post_measures[abs(round(post_measures$bias, 3)) >= bias_tol, - c("bias", "post_bias")] - NextMethod() - writeLines(sprintf("\nMax absolute post-bias is %.3f", - abs(max( - post_measures$post_bias - )))) - writeLines( - sprintf( - "Post-measure has %d variable(s) above the desired %s absolute bias tolerance", - sum(abs(post_measures$post_bias) >= post_bias_tol), - post_bias_tol - ) - ) - invisible() -} - -#' Obtains a print for jointVIP object -#' -#' -#' @param x a jointVIP object -#' @param ... not used -#' @param smd specify the standardized mean difference is `cross-sample` or `pooled` -#' @param use_abs TRUE (default) for absolute measures -#' @param bias_tol numeric 0.01 (default) any bias above the absolute bias_tol will be printed -#' -#' @return measures used to create the plot of jointVIP -#' @export -#' @examples -#' data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' # random 20 percent of control as pilot data -#' pilot_sample_num = sample(which(data$trt == 0), -#' length(which(data$trt == 0)) * -#' 0.2) -#' pilot_df = data[pilot_sample_num, ] -#' analysis_df = data[-pilot_sample_num, ] -#' treatment = "trt" -#' outcome = "out" -#' covariates = names(analysis_df)[!names(analysis_df) -#' %in% c(treatment, outcome)] -#' new_jointVIP = create_jointVIP(treatment = treatment, -#' outcome = outcome, -#' covariates = covariates, -#' pilot_df = pilot_df, -#' analysis_df = analysis_df) -#' print(new_jointVIP) -print.jointVIP <- function(x, - ..., - smd = 'cross-sample', - use_abs = TRUE, - bias_tol = 0.01) { - if (any(is.null(names(list(...)))) & length(list(...)) > 0) { - warning("anything passed in ... must be named or it'll be ignored") - } - - if (use_abs) { - measures = abs(get_measures(x, smd = smd)) - } else { - measures = get_measures(x, smd = smd) - } - measures = measures[order(abs(measures$bias), - decreasing = TRUE), ] - summary_measures = measures[abs(round(measures$bias, 3)) >= bias_tol, - "bias", drop = FALSE] - print(round(summary_measures, 3)) - invisible() -} - -#' Obtains a print for post_jointVIP object -#' -#' -#' @param x a post_jointVIP object -#' @param ... not used -#' @param smd specify the standardized mean difference is `cross-sample` or `pooled` -#' @param use_abs TRUE (default) for absolute measures -#' @param bias_tol numeric 0.01 (default) any bias above the absolute bias_tol will be printed -#' -#' @return measures used to create the plot of jointVIP -#' @export -#' @examples -#' data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' # random 20 percent of control as pilot data -#' pilot_sample_num = sample(which(data$trt == 0), -#' length(which(data$trt == 0)) * -#' 0.2) -#' pilot_df = data[pilot_sample_num, ] -#' analysis_df = data[-pilot_sample_num, ] -#' treatment = "trt" -#' outcome = "out" -#' covariates = names(analysis_df)[!names(analysis_df) -#' %in% c(treatment, outcome)] -#' new_jointVIP = create_jointVIP(treatment = treatment, -#' outcome = outcome, -#' covariates = covariates, -#' pilot_df = pilot_df, -#' analysis_df = analysis_df) -#' -#' ## at this step typically you may wish to do matching or weighting -#' ## the results after can be stored as a post_data -#' ## the post_data here is not matched or weighted, only for illustrative purposes -#' post_data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' post_dat_jointVIP = create_post_jointVIP(new_jointVIP, post_data) -#' print(post_dat_jointVIP) -print.post_jointVIP <- function(x, - ..., - smd = 'cross-sample', - use_abs = TRUE, - bias_tol = 0.01) { - if (use_abs) { - post_measures = abs(get_post_measures(x, smd = smd)) - } else { - post_measures = get_post_measures(x, smd = smd) - } - post_measures = post_measures[order(abs(post_measures$bias), - decreasing = TRUE), ] - summary_post_measures = post_measures[abs(round(post_measures$bias, 3)) >= bias_tol, - c("bias", "post_bias")] - - print(round(summary_post_measures, 3)) - invisible() -} - - -#' plot the jointVIP object -#' -#' -#' @param x a jointVIP object -#' @param ... custom options: `bias_curve_cutoffs`, `text_size`, `max.overlaps`, `label_cut_std_md`, `label_cut_outcome_cor`, `label_cut_bias`, `bias_curves`, `add_var_labs`, `expanded_y_curvelab` -#' @param smd specify the standardized mean difference is `cross-sample` or `pooled` -#' @param use_abs TRUE (default) for absolute measures -#' @param plot_title optional string for plot title -#' -#' @return a joint variable importance plot of class `ggplot` -#' @import ggplot2 -#' @export -#' @examples -#' data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' # random 20 percent of control as pilot data -#' pilot_sample_num = sample(which(data$trt == 0), -#' length(which(data$trt == 0)) * -#' 0.2) -#' pilot_df = data[pilot_sample_num, ] -#' analysis_df = data[-pilot_sample_num, ] -#' treatment = "trt" -#' outcome = "out" -#' covariates = names(analysis_df)[!names(analysis_df) -#' %in% c(treatment, outcome)] -#' new_jointVIP = create_jointVIP(treatment = treatment, -#' outcome = outcome, -#' covariates = covariates, -#' pilot_df = pilot_df, -#' analysis_df = analysis_df) -#' plot(new_jointVIP) -plot.jointVIP <- function(x, - ..., - smd = 'cross-sample', - use_abs = TRUE, - plot_title = "Joint Variable Importance Plot") { - if (any(is.null(names(list(...)))) & length(list(...)) > 0) { - warning("anything passed in ... must be named or it'll be ignored") - } else { - params = list(...) - if ("add_post_labs" %in% names(params) & - 'post_jointVIP' %in% class(x)) { - params = within(params, - rm("add_post_labs")) - } - if ("post_label_cut_bias" %in% names(params) & - 'post_jointVIP' %in% class(x)) { - params = within(params, - rm("post_label_cut_bias")) - } - if (length(params) > 0) { - if (!all( - names(params) %in% c( - 'bias_curve_cutoffs', - 'text_size', - 'max.overlaps', - 'label_cut_std_md', - 'label_cut_outcome_cor', - 'label_cut_bias', - 'bias_curves', - 'add_var_labs', - 'expanded_y_curvelab' - ) - )) { - stop( - paste0( - "custom plot options passed into ... must be one of the following:", - 'bias_curve_cutoffs', - ' text_size', - ' max.overlaps', - ' label_cut_std_md', - ' label_cut_outcome_cor', - ' label_cut_bias', - ' bias_curves', - ' add_var_labs', - ' expanded_y_curvelab' - ) - ) - } - } - } - - if (use_abs) { - measures = abs(get_measures(x, smd = smd)) - } else { - measures = get_measures(x, smd = smd) - } - - if (smd == "pooled") { - p <- ggplot(measures, - aes(x = .data$std_md, - y = .data$outcome_cor)) + - geom_point() - } else { - p <- ggplot(measures, - aes( - x = .data$std_md, - y = .data$outcome_cor, - color = abs(.data$bias), - )) + - geom_point() + - scale_color_gradient(low = "blue", high = "red") - } - # minimal plot - p <- p + - theme_minimal() + - theme( - axis.text.x = element_text(size = 10), - axis.text.y = element_text(size = 10), - axis.title.x = element_text(size = 12), - axis.title.y = element_text(size = 12), - plot.title = element_text(size = 14) - ) + - theme( - panel.background = element_rect(fill = "white"), - axis.text.x = element_text(color = "black"), - axis.text.y = element_text(color = "black"), - panel.border = element_rect(fill = NA, color = "black"), - plot.background = element_blank(), - legend.background = element_blank(), - legend.key = element_blank() - ) - - if (use_abs) { - p <- p + labs( - x = "Absolute Standardized Mean Difference", - y = "Absolute Outcome Correlation", - title = plot_title, - subtitle = paste(smd, "SMD"), - color = "Bias" - ) + ylim(c(0, ceiling_dec(max( - abs(measures$outcome_cor) - ), 2))) - } else { - p <- p + labs( - x = "Standardized Mean Difference", - y = "Outcome Correlation", - title = plot_title, - subtitle = paste(smd, "SMD"), - color = "Bias" - ) + geom_function( - fun = function(x) { - 0 - }, - linetype = 'dashed', - color = 'grey7', - alpha = 0.4 - ) + - geom_vline( - xintercept = 0, - linetype = 'dashed', - alpha = 0.4, - color = 'grey7' - ) + - ylim(c(-ceiling_dec(max( - abs(measures$outcome_cor) - ), 2), - ceiling_dec(max( - abs(measures$outcome_cor) - ), 2))) - } - - bias_curves = list(...)[['bias_curves']] - if (is.null(bias_curves)) { - bias_curves = TRUE - } else if (!is.logical(bias_curves)) { - stop("`bias_curves` can only be set as TRUE or FALSE") - } - if (bias_curves) { - if (smd == "cross-sample") { - p <- add_bias_curves(p, - use_abs = use_abs, - measures = measures, ...) - } - } - - add_var_labs = list(...)[['add_var_labs']] - if (is.null(add_var_labs)) { - add_var_labs = TRUE - } else if (!is.logical(add_var_labs)) { - stop("`add_var_labs` can only be set as TRUE or FALSE") - } - if (add_var_labs) { - p <- add_variable_labels(p, - measures = measures, ...) - } - p -} - -#' support function to plot bias curves -#' -#' @param p plot made with jointVIP object -#' @param ... encompasses other variables needed -#' @return a joint variable importance plot of class `ggplot` with curves -#' @import ggplot2 -add_bias_curves <- function(p, ...) { - use_abs = list(...)[['use_abs']] - measures = list(...)[['measures']] - bias_curve_cutoffs = list(...)[['bias_curve_cutoffs']] - expanded_y = list(...)[['expanded_y_curvelab']] - - if (is.null(expanded_y)) { - expanded_y = 0 - } - if (is.null(bias_curve_cutoffs)) { - if (use_abs) { - bias_curve_cutoffs = c(0.005) - bias_curve_cutoffs = c(bias_curve_cutoffs, - floor_dec(seq(0.011, - max( - abs(measures$bias) - ), - length.out = 4), 2)) - bias_curve_cutoffs = bias_curve_cutoffs[abs(bias_curve_cutoffs) >= 0.01 | - abs(bias_curve_cutoffs) == 0.005] - } else { - bias_curve_cutoffs = c(0.005) - - bias_curve_cutoffs = c(bias_curve_cutoffs, - floor_dec(seq(0.011, - max( - abs(measures$bias) - ), - length.out = 4), 2)) - bias_curve_cutoffs = c(bias_curve_cutoffs, -1 * bias_curve_cutoffs) - - bias_curve_cutoffs = bias_curve_cutoffs[abs(bias_curve_cutoffs) >= 0.01 | - abs(bias_curve_cutoffs) == 0.005] - } - } else if (!is.numeric(bias_curve_cutoffs)) { - stop("`bias_curve_cutoffs` must be numeric") - } else if (0 %in% bias_curve_cutoffs) { - warning("0 in the `bias_curve_cutoffs` will not be plotted") - } - - bias_curve_cutoffs = bias_curve_cutoffs[!duplicated(bias_curve_cutoffs)] - bias_curve_cutoffs = bias_curve_cutoffs[bias_curve_cutoffs != 0] - - bias_func = function(i) { - i = force(i) - f = function(x) { - i / x - } - return(f) - } - - for (b in bias_curve_cutoffs) { - loop_input = paste( - "geom_function(fun = bias_func(", - b, - "), colour = 'grey5', linetype = 'dotted', alpha = 0.5, na.rm=TRUE)", - sep = "" - ) - p <- p + eval(parse(text = loop_input)) - } - - if (use_abs) { - text_bias_lab = data.frame( - x = c(bias_curve_cutoffs / (expanded_y + ceiling_dec(max( - abs(measures$outcome_cor) - ), 2))), - y = ceiling_dec(max(abs( - measures$outcome_cor - )), 2) - 0.002 + expanded_y, - label = as.character(bias_curve_cutoffs) - ) - text_bias_lab[text_bias_lab$label == 0.005, 'y'] = - (ceiling_dec(max(abs( - measures$outcome_cor - )), 2) - - min(c(max( - bias_curve_cutoffs - ), 0.02))) + expanded_y - p <- p + geom_text( - data = text_bias_lab, - mapping = aes( - x = as.numeric(.data$x), - y = as.numeric(.data$y), - label = .data$label - ), - color = 'grey3', - alpha = 0.7, - size = 3.5, - check_overlap = FALSE - ) - } else { - text_bias_lab = data.frame( - x = c( - bias_curve_cutoffs / - (expanded_y + ceiling_dec(max( - abs(measures$outcome_cor) - ), 2)), - bias_curve_cutoffs / - (expanded_y + ceiling_dec(max( - abs(measures$outcome_cor) - ), 2)) - ), - y = c( - rep( - ceiling_dec(max(abs( - measures$outcome_cor - )), 2) - 0.002 + expanded_y, - length(bias_curve_cutoffs) - ), - rep( - -(ceiling_dec(max( - abs(measures$outcome_cor) - ), 2) - 0.002) - expanded_y, - length(bias_curve_cutoffs) - ) - ), - label = c(bias_curve_cutoffs, -(bias_curve_cutoffs)) - ) - - text_bias_lab[abs(as.numeric(text_bias_lab$label)) == 0.005, - 'y'] = - (text_bias_lab[abs(as.numeric(text_bias_lab$label)) == 0.005, 'y'] - - min(c(max( - bias_curve_cutoffs - ), 0.1)) * - sign(text_bias_lab[abs(as.numeric(text_bias_lab$label)) == 0.005, 'y'])) - - text_bias_lab[abs(as.numeric(text_bias_lab$label)) == 0.005 & - text_bias_lab$x < 0, - 'y'] = - text_bias_lab[abs(as.numeric(text_bias_lab$label)) == 0.005 & - text_bias_lab$x < 0, - 'y'] + 0.04 - - p <- p + geom_text( - data = text_bias_lab, - mapping = aes( - x = as.numeric(.data$x), - y = as.numeric(.data$y), - label = .data$label - ), - color = 'grey3', - alpha = 0.7, - size = 3, - check_overlap = FALSE - ) - } - return(p) -} - -#' support function to plot variable text labels -#' -#' @param p plot made with jointVIP object -#' @param ... encompasses other variables needed -#' @return a joint variable importance plot of class `ggplot` with curves -#' @importFrom ggrepel geom_text_repel -add_variable_labels <- function(p, - ...) { - measures = list(...)[['measures']] - arguments <- list(...) - label_cut_std_md <- arguments$label_cut_std_md - label_cut_outcome_cor <- arguments$label_cut_outcome_cor - label_cut_bias <- arguments$label_cut_bias - text_size <- arguments$text_size - max.overlaps <- arguments$max.overlaps - - if (is.null(label_cut_std_md)) { - label_cut_std_md = 0 - } else { - if (!((is.numeric(label_cut_std_md)) & - (label_cut_std_md > 0))) { - stop("`label_cut_std_md` must be a positive numeric") - } - } - if (is.null(label_cut_outcome_cor)) { - label_cut_outcome_cor = 0 - } else { - if (!(is.numeric(label_cut_outcome_cor) & - (label_cut_outcome_cor > 0))) { - stop("`label_cut_outcome_cor` must be a positive numeric") - } - } - if (is.null(label_cut_bias)) { - label_cut_bias = 0 - } else { - if (!((is.numeric(label_cut_bias)) & - (label_cut_bias > 0))) { - stop("`label_cut_bias` must be a positive numeric") - } - } - if (is.null(text_size)) { - text_size = 3.5 - } else { - if (!((is.numeric(text_size)) & - (text_size > 0))) { - stop("`text_size` must be a positive numeric") - } - } - if (is.null(max.overlaps)) { - max.overlaps = 10 - } else { - if (!((is.numeric(max.overlaps)) & - (max.overlaps > 0))) { - stop("`max.overlaps` must be a positive numeric") - } - } - measures$text_label <- row.names(measures) - if (!(label_cut_std_md == 0 & - label_cut_outcome_cor == 0 & label_cut_bias == 0)) { - measures[!((( - abs(measures$std_md) >= label_cut_std_md - ) & ( - abs(measures$outcome_cor) >= label_cut_outcome_cor - )) & - (abs(measures$bias) >= label_cut_bias)), 'text_label'] = "" - } - - p + geom_text_repel( - data = measures, - mapping = aes(label = .data$text_label), - size = text_size, - max.overlaps = max.overlaps - ) -} - -#' support function for ceiling function with decimals -#' -#' @param num numeric -#' @param dec_place decimal place that is desired ceiling for -#' @return numeric number desired -ceiling_dec <- - function(num, dec_place = 1) { - round(num + 5 * 10 ^ (-dec_place - 1), dec_place) - } - - -#' support function for floor function with decimals -#' -#' @param num numeric -#' @param dec_place decimal place that is desired floor for -#' @return numeric number desired -floor_dec <- function(num, dec_place = 1) { - round(num - 5 * 10 ^ (-dec_place - 1), dec_place) -} - - -#' plot the post_jointVIP object -#' this plot uses the same custom options as the jointVIP object -#' -#' -#' @param x a post_jointVIP object -#' @param ... custom options: `bias_curve_cutoffs`, `text_size`, `max.overlaps`, `label_cut_std_md`, `label_cut_outcome_cor`, `label_cut_bias`, `bias_curves`, `add_var_labs`, `expanded_y_curvelab` -#' @param smd specify the standardized mean difference is `cross-sample` or `pooled` -#' @param use_abs TRUE (default) for absolute measures -#' @param plot_title optional string for plot title -#' @param add_post_labs TRUE (default) show post-measure labels -#' @param post_label_cut_bias 0.005 (default) show cutoff above this number; suppressed if show_post_labs is FALSE -#' -#' @return a post-analysis joint variable importance plot of class `ggplot` -#' @import ggplot2 -#' @importFrom ggrepel geom_text_repel -#' @export -#' @examples -#' data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' # random 20 percent of control as pilot data -#' pilot_sample_num = sample(which(data$trt == 0), -#' length(which(data$trt == 0)) * -#' 0.2) -#' pilot_df = data[pilot_sample_num, ] -#' analysis_df = data[-pilot_sample_num, ] -#' treatment = "trt" -#' outcome = "out" -#' covariates = names(analysis_df)[!names(analysis_df) -#' %in% c(treatment, outcome)] -#' new_jointVIP = create_jointVIP(treatment = treatment, -#' outcome = outcome, -#' covariates = covariates, -#' pilot_df = pilot_df, -#' analysis_df = analysis_df) -#' -#' ## at this step typically you may wish to do matching or weighting -#' ## the results after can be stored as a post_data -#' ## the post_data here is not matched or weighted, only for illustrative purposes -#' post_data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' post_dat_jointVIP = create_post_jointVIP(new_jointVIP, post_data) -#' plot(post_dat_jointVIP) -plot.post_jointVIP <- function(x, - ..., - smd = 'cross-sample', - use_abs = TRUE, - plot_title = "Joint Variable Importance Plot", - add_post_labs = TRUE, - post_label_cut_bias = 0.005) { - p <- NextMethod() - if (use_abs) { - post_measures = abs(get_post_measures(x, smd = smd)) - } else { - post_measures = get_post_measures(x, smd = smd) - } - - if (!is.logical(add_post_labs)) { - stop("`add_post_labs` can only be set as TRUE or FALSE") - } - - if (!(is.numeric(post_label_cut_bias) & - (post_label_cut_bias > 0))) { - stop("`post_label_cut_bias` must be a positive numeric") - } - - - # first turn off the original points - p$layers[[1]] <- NULL - - add_var_labs = list(...)[['add_var_labs']] - if (is.null(add_var_labs)) { - add_var_labs = TRUE - } else if (!is.logical(add_var_labs)) { - stop("`add_var_labs` can only be set as TRUE or FALSE") - } - - if (add_var_labs == TRUE) { - # turn off the variable labels - # which is the last layer - p$layers[[length(p$layers)]] <- NULL - } - - if (smd == "pooled") { - p <- p + geom_point(data = post_measures, - aes(x = .data$post_std_md, - y = .data$outcome_cor)) - } else { - p <- p + geom_point(data = post_measures, - aes( - x = .data$post_std_md, - y = .data$outcome_cor, - color = abs(.data$post_bias), - )) - } - arguments <- list(...) - text_size <- arguments$text_size - max.overlaps <- arguments$max.overlaps - - if (add_post_labs) { - if (is.null(text_size)) { - text_size = 3.5 - } else { - if (!(is.numeric(text_size) & - (text_size > 0))) { - stop("`text_size` must be a positive numeric") - } - } - if (is.null(max.overlaps)) { - max.overlaps = 10 - } else { - if (!(is.numeric(max.overlaps) & - (max.overlaps > 0))) { - stop("`max.overlaps` must be a positive numeric") - } - } - post_measures$text_label <- row.names(post_measures) - if (!(post_label_cut_bias == 0)) { - post_measures[!(abs(round(post_measures$post_bias, 4)) >= post_label_cut_bias), 'text_label'] = "" - } - - if (smd == "pooled") { - p <- p + geom_text_repel( - data = post_measures, - aes( - x = .data$post_std_md, - y = .data$outcome_cor, - label = .data$text_label, - ), - size = text_size, - max.overlaps = max.overlaps - ) - - } else { - p <- p + geom_text_repel( - data = post_measures, - aes( - x = .data$post_std_md, - y = .data$outcome_cor, - color = abs(.data$post_bias), - label = .data$text_label, - ), - size = text_size, - max.overlaps = max.overlaps - ) - } - } - if (ceiling_dec(max(abs(post_measures$post_bias)), 2) > ceiling_dec(max(abs(post_measures$bias)), 2)) { - warning( - "Color not scaled to previous pre-bias plot since the post-bias is greater than pre-bias" - ) - - } else { - sc <- scale_color_gradient(low = 'blue', - high = 'red', - limits = c(0, ceiling_dec(max( - abs(post_measures$bias) - ), 2))) - p <- p + sc - } - - return(p) -} - - -#' plot the bootstrap version of the jointVIP object -#' -#' -#' @param x a jointVIP object -#' @param ... custom options: `bias_curve_cutoffs`, `text_size`, `max.overlaps`, `label_cut_std_md`, `label_cut_outcome_cor`, `label_cut_bias`, `bias_curves`, `add_var_labs` -#' @param smd specify the standardized mean difference is `cross-sample` or `pooled` -#' @param use_abs TRUE (default) for absolute measures -#' @param plot_title optional string for plot title -#' @param B 100 (default) for the number of times the bootstrap step wished to run -#' -#' @return a joint variable importance plot of class `ggplot` -#' @import ggplot2 -#' @export -#' @examples -#' data <- data.frame(year = rnorm(50, 200, 5), -#' pop = rnorm(50, 1000, 500), -#' gdpPercap = runif(50, 100, 1000), -#' trt = rbinom(50, 1, 0.5), -#' out = rnorm(50, 1, 0.2)) -#' # random 20 percent of control as pilot data -#' pilot_sample_num = sample(which(data$trt == 0), -#' length(which(data$trt == 0)) * -#' 0.2) -#' pilot_df = data[pilot_sample_num, ] -#' analysis_df = data[-pilot_sample_num, ] -#' treatment = "trt" -#' outcome = "out" -#' covariates = names(analysis_df)[!names(analysis_df) -#' %in% c(treatment, outcome)] -#' new_jointVIP = create_jointVIP(treatment = treatment, -#' outcome = outcome, -#' covariates = covariates, -#' pilot_df = pilot_df, -#' analysis_df = analysis_df) -#' # more bootstrap number B would be typically used in real settings -#' # this is just a small example -#' set.seed(1234567891) -#' bootstrap.plot(new_jointVIP, B = 15) -bootstrap.plot <- function(x, - ..., - smd = 'cross-sample', - use_abs = TRUE, - plot_title = "Joint Variable Importance Plot", - B = 100) { - if (!all(class(x) == 'jointVIP')) { - stop("bootstrap_plot function only applicable to class jointVIP only!") - } - - bias_curves = list(...)[['bias_curves']] - if (is.null(bias_curves)) { - if (smd == "cross-sample") { - specified_bias_curves = TRUE - } else { - specified_bias_curves = FALSE - } - } else if (!is.logical(bias_curves)) { - stop("`bias_curves` can only be set as TRUE or FALSE") - } else { - specified_bias_curves = bias_curves - } - - p <- - plot( - x, - ..., - smd = smd, - bias_curves = FALSE, - use_abs = use_abs, - plot_title = plot_title - ) - - boot_measures <- get_boot_measures( - object = x, - smd = smd, - use_abs = use_abs, - B = B - ) - if (use_abs) { - og <- abs(get_measures(x, smd = smd)) - } else { - og <- get_measures(x, smd = smd) - } - - p <- - p + geom_segment( - data = data.frame(t(boot_measures[, , 'outcome_cor'])), - aes( - x = og$std_md, - xend = og$std_md, - y = .data$X2.5., - yend = .data$X97.5. - ), - color = "cornsilk4", - size = 1.5, - alpha = 0.4 - ) + - ylim(c(min(0, - ifelse( - use_abs, 0, -ceiling_dec(max(abs(data.frame( - t(boot_measures[, , 'outcome_cor']) - ))), 2) - )), - ceiling_dec(max(data.frame( - t(boot_measures[, , 'outcome_cor']) - )), 2))) + - geom_segment( - data = data.frame(t(boot_measures[, , 'std_md'])), - aes( - x = .data$X2.5., - xend = .data$X97.5., - y = og$outcome_cor, - yend = og$outcome_cor - ), - color = "cornsilk4", - size = 1.5, - alpha = 0.4 - ) - - if (smd == "cross-sample" & specified_bias_curves) { - p <- add_bias_curves( - p, - use_abs = use_abs, - measures = og, - expanded_y_curvelab = - ceiling_dec(max(abs(max( - abs(t(boot_measures[, , 'outcome_cor'])) - ))), 2) - - ceiling_dec(max(abs(og$outcome_cor)), 2), - ... - ) - } - return(p) -} diff --git a/R/measures.R b/R/measures.R deleted file mode 100644 index a77b1fd..0000000 --- a/R/measures.R +++ /dev/null @@ -1,216 +0,0 @@ -#' Prepare data frame to plot standardized omitted variable bias -#' Marginal standardized mean differences and outcome correlation -#' -#' @param object jointVIP object -#' @param smd calculate standardized mean difference either using `cross-sample` or `pooled` -#' @return measures needed for jointVIP -#' @export -#' @importFrom stats sd var cor complete.cases -get_measures = function(object, smd="cross-sample"){ - treated <- object$analysis_df[, object$treatment] - covariates <- names(object$analysis_df)[!(names(object$analysis_df) - %in% c(object$treatment, - object$outcome))] - - md <- apply(object$analysis_df[,covariates], 2, - function(x){ - mean(x[treated == 1]) - mean(x[treated == 0]) - }) - - cs_denom <- apply(object$pilot_df[,covariates], 2, stats::sd) - pooled_denom <- apply(object$analysis_df[,covariates], 2, - function(x){ - if(stats::var(x[treated == 1]) == 0 & - stats::var(x[treated == 0]) == 0){NA} - else{ - sqrt(stats::var(x[treated == 1])/2 + - stats::var(x[treated == 0])/2) - } - }) - outcome_cor <- apply(object$pilot_df[,covariates], - 2, - function(x){ - stats::cor(x, object$pilot_df[,object$outcome]) - }) - - if(!smd %in% c("cross-sample", "pooled")){ - stop("smd options only include `cross-sample` or `pooled`") - } else { - smd_calc <- if(smd=="cross-sample"){md/cs_denom}else{md/pooled_denom} - } - - measures = data.frame( - outcome_cor = outcome_cor, - std_md = smd_calc, - bias = outcome_cor * smd_calc - ) - - if('post_jointVIP' %in% class(object)){ - denom = if(smd=="cross-sample"){cs_denom}else{pooled_denom} - measures = data.frame( - outcome_cor = outcome_cor, - std_md = smd_calc, - bias = outcome_cor * smd_calc, - pre_sd = denom - ) - } - measures = check_measures(measures) - return(measures) -} - - - -#' Check measures -#' Check to see if there is any missing values or variables -#' without any variation or identical rows (only unique rows will be used) -#' -#' @param measures measures needed for jointVIP -#' @return measures needed for jointVIP -check_measures = function(measures){ - - if(nrow(measures[duplicated(measures) | - duplicated(measures, fromLast = TRUE),]) > 0){ - warning(paste0(c("Variables", - row.names(measures[duplicated(measures) | - duplicated(measures, fromLast = TRUE),]), - "measures are duplicated (all multiples are shown).", - "\nOnly unique variables will be used." - )," ")) - } - - clean_measures <- measures[!duplicated(measures),] - - if(any(rowSums(is.na(clean_measures))>0)){ - warning(paste0(c("Variable(s)", - rownames(clean_measures)[rowSums(is.na(clean_measures))>0], - "contain missing values.", - "\nThey are dropped when plotting." - )," ")) - } - - if(any(clean_measures$std_md == 0)){ - warning(paste0(c("The standardized mean difference for variable(s)", - rownames(clean_measures)[sum(clean_measures$std_md == 0)>0], - "are 0.", - "\nTheir biases cannot be calculated." - )," ")) - } - - clean_measures <- clean_measures[complete.cases(clean_measures),] - if (all(dim(clean_measures) == c(0, 0))) { - stop("measures is empty, please check for errors that may have occurred") - } - clean_measures -} - -#' Post-measures data frame to plot post-standardized omitted variable bias -#' -#' @param object post_jointVIP object -#' @param smd calculate standardized mean difference either using `cross-sample` or `pooled` -#' @return measures needed for jointVIP -#' @export -get_post_measures <- function(object, smd = "cross-sample"){ - measures <- get_measures(object, smd = smd) - - treated <- object$post_analysis_df[, object$treatment] - covariates <- names(object$post_analysis_df)[!(names(object$post_analysis_df) - %in% c(object$treatment, - object$outcome))] - - w0 = object$wts[treated == 0] - w1 = object$wts[treated == 1] - - post_md <- colSums(object$post_analysis_df[treated == 1,covariates]*w1)/sum(w1) - - colSums(object$post_analysis_df[treated == 0,covariates]*w0)/sum(w0) - - post_measures = measures - post_measures$post_std_md <- post_md/measures$pre_sd - post_measures$post_bias <- post_measures$post_std_md*post_measures$outcome_cor - post_measures[, c("outcome_cor", - "std_md", - "bias", - "post_std_md", - "post_bias")] -} - -#' Calculate bootstrapped variation -#' additional tool to help calculate the uncertainty of each variable's bias -#' -#' @param object jointVIP object -#' @param smd calculate standardized mean difference either using `cross-sample` or `pooled` -#' @param use_abs TRUE (default) for absolute measures -#' @param B 100 (default) for the number of times the bootstrap step wished to run -#' @return bootstrapped measures needed for bootstrap-jointVIP -#' @export -#' @importFrom stats sd var cor complete.cases -get_boot_measures = function(object, - smd = "cross-sample", - use_abs = TRUE, - B = 100) { - if(!is.numeric(B)){ - stop("B is the number of bootstrap step should run; please input a numeric\nThe ceiling of such number will be used.") - } else { - if(B <= 10){ - stop("B is too small please make it a larger number") - } else if (B >= 990000) { - stop("B too large, please specify this number to be under 990000") - } - } - - B = ceiling(B) - - # original measures - og = get_measures(object = object, smd = smd) - - # 3d bootstrap array result - result <- array(0, dim = c(nrow(og), - 2, - B)) - - # select from random list of large numbers - seeds <- paste(sample(1e4:(1e6 - 1), B, replace = F)) - - pilot_df = object$pilot_df - analysis_df = object$analysis_df - - for (b in (1:B)) { - set.seed(as.numeric(seeds[b])) - boot_pilot_df = pilot_df[sample(1:nrow(pilot_df), - size = nrow(pilot_df), - replace = T), ] - boot_analysis_df = analysis_df[sample(1:nrow(analysis_df), - size = nrow(analysis_df), - replace = T), ] - temp_measure = get_measures( - object = - create_jointVIP( - object$treatment, - object$outcome, - names(analysis_df)[!names(analysis_df) %in% c(object$treatment, - object$outcome)], - boot_pilot_df, - boot_analysis_df - ), - smd = smd - )[,c('outcome_cor', 'std_md')] - result[, , b] = as.matrix(temp_measure) - } - dimnames(result) = list(row.names(og), - c('outcome_cor', - 'std_md'), - seeds) - - if(use_abs){ - result = abs(result) - } - - boot_sd = apply( - result * is.finite(result), - c(1, 2), - stats::quantile, - probs = c(0.025, 0.975), - na.rm = TRUE - ) - - return(boot_sd) -} diff --git a/README.Rmd b/README.Rmd index 4c7b2e9..d0ad637 100644 --- a/README.Rmd +++ b/README.Rmd @@ -13,41 +13,6 @@ knitr::opts_chunk$set( ) devtools::load_all(".") -<<<<<<< HEAD -<<<<<<< HEAD -======= -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -library(fastDummies) -library(dplyr) - -## using brfss example -brfss <- - read.csv("http://static.lib.virginia.edu/statlab/materials/data/brfss_2015_sample.csv") -## data cleaning -brfss$COPD = ifelse(factor(brfss$COPD) == 'No', 0, 1) # reference is no -brfss$RACE = factor(brfss$RACE) -brfss$RACE <- - relevel(brfss$RACE, ref = 'White') # reference is majority in data -brfss$AGE = factor(brfss$AGE) -brfss$SEX = ifelse(factor(brfss$SEX) == 'Female', 0, 1) # reference is majority in data -## dichotimize the variables -brfss = dummy_cols(brfss) -df = (brfss[, !(names(brfss) %in% c("RACE", "AGE"))]) -outcome = 'COPD' -treatment = 'SMOKE' -covariates = names(brfss)[!names(brfss) %in% c(outcome, treatment)] -## cleaned data -df = (brfss[, !(names(brfss) %in% c("RACE", "AGE"))]) -names(df) <- c("COPD", "smoke", "sex", "weight", - "average_drinks", "race_white", "race_black", - "race_hispanic", "race_other", "age_18to24", - "age_25to34", "age_35to44", "age_45to54", - "age_55to64", "age_over65") -<<<<<<< HEAD ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 ``` # Joint variable importance plot @@ -79,9 +44,6 @@ With the cleaned data, you can specify details in the function `create_jointVIP( ```{r example} library(jointVIP) ## basic example code - -<<<<<<< HEAD -<<<<<<< HEAD library(dplyr) # load data @@ -90,50 +52,21 @@ data('brfss', package='jointVIP') treatment = 'smoke' outcome = 'COPD' covariates = names(brfss)[!names(brfss) %in% c(treatment, outcome)] -======= -treatment = 'smoke' -outcome = 'COPD' -covariates = names(df)[!names(df) %in% c(treatment, outcome)] ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -treatment = 'smoke' -outcome = 'COPD' -covariates = names(df)[!names(df) %in% c(treatment, outcome)] ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 ## select the pilot sample from random portion ## pilot data here are considered as 'external controls' ## can be a separate dataset; should be chosen with caution set.seed(1234895) -pilot_prop = 0.2 -<<<<<<< HEAD -<<<<<<< HEAD +pilot_prop = 0.2 pilot_sample_num = sample(which(brfss %>% pull(treatment) == 0), length(which(brfss %>% pull(treatment) == 0)) * -======= -pilot_sample_num = sample(which(df %>% pull(treatment) == 0), - length(which(df %>% pull(treatment) == 0)) * ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -pilot_sample_num = sample(which(df %>% pull(treatment) == 0), - length(which(df %>% pull(treatment) == 0)) * ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_prop) ## set up pilot and analysis data ## we want to make sure these two data are non-overlapping -<<<<<<< HEAD -<<<<<<< HEAD + pilot_df = brfss[pilot_sample_num, ] analysis_df = brfss[-pilot_sample_num, ] -======= -pilot_df = df[pilot_sample_num, ] -analysis_df = df[-pilot_sample_num, ] ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -pilot_df = df[pilot_sample_num, ] -analysis_df = df[-pilot_sample_num, ] ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 ## minimal example brfss_jointVIP = create_jointVIP(treatment = treatment, diff --git a/README.md b/README.md index c7c3754..48cc0b4 100644 --- a/README.md +++ b/README.md @@ -46,8 +46,6 @@ With the cleaned data, you can specify details in the function library(jointVIP) ## basic example code -<<<<<<< HEAD -<<<<<<< HEAD library(dplyr) #> #> Attaching package: 'dplyr' @@ -70,50 +68,22 @@ data('brfss', package='jointVIP') treatment = 'smoke' outcome = 'COPD' covariates = names(brfss)[!names(brfss) %in% c(treatment, outcome)] -======= -treatment = 'smoke' -outcome = 'COPD' -covariates = names(df)[!names(df) %in% c(treatment, outcome)] ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -treatment = 'smoke' -outcome = 'COPD' -covariates = names(df)[!names(df) %in% c(treatment, outcome)] ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 ## select the pilot sample from random portion ## pilot data here are considered as 'external controls' ## can be a separate dataset; should be chosen with caution set.seed(1234895) pilot_prop = 0.2 -<<<<<<< HEAD -<<<<<<< HEAD pilot_sample_num = sample(which(brfss %>% pull(treatment) == 0), length(which(brfss %>% pull(treatment) == 0)) * -======= -pilot_sample_num = sample(which(df %>% pull(treatment) == 0), - length(which(df %>% pull(treatment) == 0)) * ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -pilot_sample_num = sample(which(df %>% pull(treatment) == 0), - length(which(df %>% pull(treatment) == 0)) * ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 - pilot_prop) + ## set up pilot and analysis data ## we want to make sure these two data are non-overlapping -<<<<<<< HEAD -<<<<<<< HEAD + pilot_df = brfss[pilot_sample_num, ] analysis_df = brfss[-pilot_sample_num, ] -======= -pilot_df = df[pilot_sample_num, ] -analysis_df = df[-pilot_sample_num, ] ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -pilot_df = df[pilot_sample_num, ] -analysis_df = df[-pilot_sample_num, ] ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 + ## minimal example brfss_jointVIP = create_jointVIP(treatment = treatment, @@ -131,15 +101,10 @@ summary(brfss_jointVIP) #> Max absolute bias is 0.032 #> 3 variables are above the desired 0.01 absolute bias tolerance #> 13 variables can be plotted -<<<<<<< HEAD -<<<<<<< HEAD + ``` ``` r -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 print(brfss_jointVIP) #> bias #> age_over65 0.032 @@ -164,17 +129,5 @@ since its highly correlated with the outcome. ## Acknowledgement -<<<<<<< HEAD -<<<<<<< HEAD -Ford, C. 2018. “Getting Started with Matching Methods.” UVA Library -======= -- Centers for Disease Control and Prevention (CDC). Behavioral Risk Factor Surveillance System Survey Questionnaire. Atlanta, Georgia: U.S. Department of Health and Human Services, Centers for Disease Control and Prevention, 2015. -- Ford, C. 2018. “Getting Started with Matching Methods.” UVA Library ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= - Centers for Disease Control and Prevention (CDC). Behavioral Risk Factor Surveillance System Survey Questionnaire. Atlanta, Georgia: U.S. Department of Health and Human Services, Centers for Disease Control and Prevention, 2015. -- Ford, C. 2018. “Getting Started with Matching Methods.” UVA Library ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -StatLab. - -(accessed Jan 29, 2024). +- Ford, C. 2018. “Getting Started with Matching Methods.” UVA Library StatLab. (accessed Jan 29, 2024). diff --git a/jointVIP.Rproj b/jointVIP.Rproj index c69c0b5..69fafd4 100644 --- a/jointVIP.Rproj +++ b/jointVIP.Rproj @@ -1,17 +1,7 @@ Version: 1.0 -<<<<<<< HEAD -<<<<<<< HEAD RestoreWorkspace: No SaveWorkspace: No -======= -RestoreWorkspace: Default -SaveWorkspace: Default ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -RestoreWorkspace: Default -SaveWorkspace: Default ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 AlwaysSaveHistory: Default EnableCodeIndexing: Yes @@ -22,8 +12,6 @@ Encoding: UTF-8 RnwWeave: Sweave LaTeX: pdfLaTeX -<<<<<<< HEAD -<<<<<<< HEAD AutoAppendNewline: Yes StripTrailingWhitespace: Yes LineEndingConversion: Posix @@ -32,13 +20,3 @@ BuildType: Package PackageUseDevtools: Yes PackageInstallArgs: --no-multiarch --with-keep.source PackageRoxygenize: rd,collate,namespace -======= -BuildType: Package -PackageUseDevtools: Yes -PackageInstallArgs: --no-multiarch --with-keep.source ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -BuildType: Package -PackageUseDevtools: Yes -PackageInstallArgs: --no-multiarch --with-keep.source ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 diff --git a/man/add_bias_curves.Rd b/man/add_bias_curves.Rd index 79276d7..f56a325 100644 --- a/man/add_bias_curves.Rd +++ b/man/add_bias_curves.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/support.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{add_bias_curves} \alias{add_bias_curves} \title{support function to plot bias curves} diff --git a/man/add_variable_labels.Rd b/man/add_variable_labels.Rd index 6b3993d..d8226bf 100644 --- a/man/add_variable_labels.Rd +++ b/man/add_variable_labels.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/support.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{add_variable_labels} \alias{add_variable_labels} \title{support function to plot variable text labels} diff --git a/man/bootstrap.plot.Rd b/man/bootstrap.plot.Rd index f6275c0..fd18763 100644 --- a/man/bootstrap.plot.Rd +++ b/man/bootstrap.plot.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/plot.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{bootstrap.plot} \alias{bootstrap.plot} \title{plot the bootstrap version of the jointVIP object} @@ -46,15 +38,7 @@ data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), trt = rbinom(50, 1, 0.5), out = rnorm(50, 1, 0.2)) -<<<<<<< HEAD -<<<<<<< HEAD # random 20 percent of control as pilot data -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * 0.2) diff --git a/man/ceiling_dec.Rd b/man/ceiling_dec.Rd index 9094a39..e2a32c4 100644 --- a/man/ceiling_dec.Rd +++ b/man/ceiling_dec.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/support.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{ceiling_dec} \alias{ceiling_dec} \title{support function for ceiling function with decimals} diff --git a/man/check_measures.Rd b/man/check_measures.Rd index 346fada..db195f5 100644 --- a/man/check_measures.Rd +++ b/man/check_measures.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/check_measures.R -======= -% Please edit documentation in R/measures.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/measures.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{check_measures} \alias{check_measures} \title{Check measures diff --git a/man/create_jointVIP.Rd b/man/create_jointVIP.Rd index 314686b..af43ad1 100644 --- a/man/create_jointVIP.Rd +++ b/man/create_jointVIP.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/create_jointVIP.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{create_jointVIP} \alias{create_jointVIP} \title{create jointVIP object} @@ -38,15 +30,7 @@ data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), trt = rbinom(50, 1, 0.5), out = rnorm(50, 1, 0.2)) -<<<<<<< HEAD -<<<<<<< HEAD # random 20 percent of control as pilot data -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * 0.2) diff --git a/man/create_post_jointVIP.Rd b/man/create_post_jointVIP.Rd index aa14b48..773617d 100644 --- a/man/create_post_jointVIP.Rd +++ b/man/create_post_jointVIP.Rd @@ -1,21 +1,8 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/create_post_jointVIP.R \name{create_post_jointVIP} \alias{create_post_jointVIP} \title{create post_jointVIP object} -======= -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -% Please edit documentation in R/general.R -\name{create_post_jointVIP} -\alias{create_post_jointVIP} -\title{create jointVIP object} -<<<<<<< HEAD ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \usage{ create_post_jointVIP(object, post_analysis_df, wts = NA) } @@ -38,15 +25,7 @@ data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), trt = rbinom(50, 1, 0.5), out = rnorm(50, 1, 0.2)) -<<<<<<< HEAD -<<<<<<< HEAD # random 20 percent of control as pilot data -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * 0.2) @@ -61,15 +40,7 @@ new_jointVIP = create_jointVIP(treatment = treatment, covariates = covariates, pilot_df = pilot_df, analysis_df = analysis_df) -<<<<<<< HEAD -<<<<<<< HEAD -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 ## at this step typically you may wish to do matching or weighting ## the results after can be stored as a post_data ## the post_data here is not matched or weighted, only for illustrative purposes diff --git a/man/floor_dec.Rd b/man/floor_dec.Rd index bc09e9d..920eb03 100644 --- a/man/floor_dec.Rd +++ b/man/floor_dec.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/support.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{floor_dec} \alias{floor_dec} \title{support function for floor function with decimals} diff --git a/man/get_boot_measures.Rd b/man/get_boot_measures.Rd index 22fb1f3..91469a7 100644 --- a/man/get_boot_measures.Rd +++ b/man/get_boot_measures.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/get_boot_measures.R -======= -% Please edit documentation in R/measures.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/measures.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{get_boot_measures} \alias{get_boot_measures} \title{Calculate bootstrapped variation diff --git a/man/get_measures.Rd b/man/get_measures.Rd index 19e8cb5..ef66699 100644 --- a/man/get_measures.Rd +++ b/man/get_measures.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/get_measures.R -======= -% Please edit documentation in R/measures.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/measures.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{get_measures} \alias{get_measures} \title{Prepare data frame to plot standardized omitted variable bias diff --git a/man/get_post_measures.Rd b/man/get_post_measures.Rd index 55548a7..a4af6b4 100644 --- a/man/get_post_measures.Rd +++ b/man/get_post_measures.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/get_post_measures.R -======= -% Please edit documentation in R/measures.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/measures.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{get_post_measures} \alias{get_post_measures} \title{Post-measures data frame to plot post-standardized omitted variable bias} diff --git a/man/one_hot.Rd b/man/one_hot.Rd index c78768a..264c322 100644 --- a/man/one_hot.Rd +++ b/man/one_hot.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/support.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{one_hot} \alias{one_hot} \title{support function for one-hot encoding} diff --git a/man/plot.jointVIP.Rd b/man/plot.jointVIP.Rd index 5d58a3d..cbdf4ef 100644 --- a/man/plot.jointVIP.Rd +++ b/man/plot.jointVIP.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/plot.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{plot.jointVIP} \alias{plot.jointVIP} \title{plot the jointVIP object} @@ -43,15 +35,7 @@ data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), trt = rbinom(50, 1, 0.5), out = rnorm(50, 1, 0.2)) -<<<<<<< HEAD -<<<<<<< HEAD # random 20 percent of control as pilot data -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * 0.2) diff --git a/man/plot.post_jointVIP.Rd b/man/plot.post_jointVIP.Rd index 4617785..f5cf3e1 100644 --- a/man/plot.post_jointVIP.Rd +++ b/man/plot.post_jointVIP.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/plot.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{plot.post_jointVIP} \alias{plot.post_jointVIP} \title{plot the post_jointVIP object @@ -51,15 +43,7 @@ data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), trt = rbinom(50, 1, 0.5), out = rnorm(50, 1, 0.2)) -<<<<<<< HEAD -<<<<<<< HEAD # random 20 percent of control as pilot data -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * 0.2) @@ -74,15 +58,7 @@ new_jointVIP = create_jointVIP(treatment = treatment, covariates = covariates, pilot_df = pilot_df, analysis_df = analysis_df) -<<<<<<< HEAD -<<<<<<< HEAD -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 ## at this step typically you may wish to do matching or weighting ## the results after can be stored as a post_data ## the post_data here is not matched or weighted, only for illustrative purposes diff --git a/man/print.jointVIP.Rd b/man/print.jointVIP.Rd index 189d580..7518980 100644 --- a/man/print.jointVIP.Rd +++ b/man/print.jointVIP.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/print.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{print.jointVIP} \alias{print.jointVIP} \title{Obtains a print for jointVIP object} @@ -37,15 +29,7 @@ data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), trt = rbinom(50, 1, 0.5), out = rnorm(50, 1, 0.2)) -<<<<<<< HEAD -<<<<<<< HEAD # random 20 percent of control as pilot data -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * 0.2) diff --git a/man/print.post_jointVIP.Rd b/man/print.post_jointVIP.Rd index 6c3b083..d2cff25 100644 --- a/man/print.post_jointVIP.Rd +++ b/man/print.post_jointVIP.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/print.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{print.post_jointVIP} \alias{print.post_jointVIP} \title{Obtains a print for post_jointVIP object} @@ -37,15 +29,7 @@ data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), trt = rbinom(50, 1, 0.5), out = rnorm(50, 1, 0.2)) -<<<<<<< HEAD -<<<<<<< HEAD # random 20 percent of control as pilot data -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * 0.2) @@ -60,15 +44,7 @@ new_jointVIP = create_jointVIP(treatment = treatment, covariates = covariates, pilot_df = pilot_df, analysis_df = analysis_df) -<<<<<<< HEAD -<<<<<<< HEAD -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 ## at this step typically you may wish to do matching or weighting ## the results after can be stored as a post_data ## the post_data here is not matched or weighted, only for illustrative purposes diff --git a/man/summary.jointVIP.Rd b/man/summary.jointVIP.Rd index db7f97b..8c44893 100644 --- a/man/summary.jointVIP.Rd +++ b/man/summary.jointVIP.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/summary.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{summary.jointVIP} \alias{summary.jointVIP} \title{Obtains a summary jointVIP object} @@ -37,15 +29,7 @@ data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), trt = rbinom(50, 1, 0.5), out = rnorm(50, 1, 0.2)) -<<<<<<< HEAD -<<<<<<< HEAD # random 20 percent of control as pilot data -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * 0.2) diff --git a/man/summary.post_jointVIP.Rd b/man/summary.post_jointVIP.Rd index 2ce0fa7..3accd48 100644 --- a/man/summary.post_jointVIP.Rd +++ b/man/summary.post_jointVIP.Rd @@ -1,13 +1,5 @@ % Generated by roxygen2: do not edit by hand -<<<<<<< HEAD -<<<<<<< HEAD % Please edit documentation in R/summary.R -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -% Please edit documentation in R/general.R ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 \name{summary.post_jointVIP} \alias{summary.post_jointVIP} \title{Obtains a summary post_jointVIP object} @@ -46,15 +38,7 @@ data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), trt = rbinom(50, 1, 0.5), out = rnorm(50, 1, 0.2)) -<<<<<<< HEAD -<<<<<<< HEAD # random 20 percent of control as pilot data -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# random 20 percent of control as pilot data ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * 0.2) @@ -69,15 +53,7 @@ new_jointVIP = create_jointVIP(treatment = treatment, covariates = covariates, pilot_df = pilot_df, analysis_df = analysis_df) -<<<<<<< HEAD -<<<<<<< HEAD -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 ## at this step typically you may wish to do matching or weighting ## the results after can be stored as a post_data ## the post_data here is not matched or weighted, only for illustrative purposes diff --git a/paper/simulation/README.txt b/paper/simulation/README.txt index 355c973..bd40c84 100644 --- a/paper/simulation/README.txt +++ b/paper/simulation/README.txt @@ -1,22 +1,9 @@ -<<<<<<< HEAD -<<<<<<< HEAD The simulation in this particular folder refers to the paper "Prioritizing Variables for Observational Study Design using the Joint Variable Importance Plot" that can be found on arXiv: https://arxiv.org/abs/2301.09754 The paper is published in The American Statistician: Liao et al., (2024) . -======= -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -The simulation in this particular folder refers to the paper -"Using Joint Variable Importance Plots to Prioritize Variables -in Assessing the Impact of Glyburide on Adverse Birth Outcomes" -that can be found on arXiv: https://arxiv.org/abs/2301.09754 -<<<<<<< HEAD ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 This is a separate section from the jointVIP code introduction paper in the simulation folder. diff --git a/tests/testthat.R b/tests/testthat.R index b899568..d000d6c 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -3,18 +3,9 @@ # # Where should you do additional test configuration? # Learn more about the roles of various files in: -<<<<<<< HEAD -<<<<<<< HEAD + # * https://r-pkgs.org/testing-design.html#sec-tests-files-overview # * https://testthat.r-lib.org/articles/special-files.html -======= -# * https://r-pkgs.org/tests.html -# * https://testthat.r-lib.org/reference/test_package.html#special-files ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -# * https://r-pkgs.org/tests.html -# * https://testthat.r-lib.org/reference/test_package.html#special-files ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 library(testthat) library(jointVIP) diff --git a/tests/testthat/test-create_jointVIP.R b/tests/testthat/test-create_jointVIP.R index efea0aa..204c8f7 100644 --- a/tests/testthat/test-create_jointVIP.R +++ b/tests/testthat/test-create_jointVIP.R @@ -1,14 +1,4 @@ -<<<<<<< HEAD -<<<<<<< HEAD test_that("create_jointVIP function creates a valid jointVIP S3 object", { -======= -library(testthat) -test_that("create_jointVIP() creates a valid JointVIP object", { ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -library(testthat) -test_that("create_jointVIP() creates a valid JointVIP object", { ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 set.seed(1234567891) data <- data.frame(year = rnorm(50, 200, 5), pop = rnorm(50, 1000, 500), @@ -35,8 +25,6 @@ test_that("create_jointVIP() creates a valid JointVIP object", { expect_s3_class(new_jointVIP, "jointVIP") expect_equal(dim(new_jointVIP$pilot_df), c(4,8)) -<<<<<<< HEAD -<<<<<<< HEAD }) test_that("error arise for invalid construction", { @@ -64,10 +52,6 @@ test_that("error arise for invalid construction", { pilot_df, analysis_df) -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 expect_error(create_jointVIP(treatment, outcome, covariates, @@ -89,8 +73,6 @@ test_that("error arise for invalid construction", { analysis_df), "`covariates` must be in both pilot_df and analysis_df", fixed=TRUE) -<<<<<<< HEAD -<<<<<<< HEAD expect_error(create_jointVIP(treatment, outcome, @@ -156,16 +138,6 @@ test_that("factored and numeric data are set correctly", { expect_equal(new_jointVIP$pilot_df$metro_N, as.numeric(pilot_df$metro == 'N')) expect_true(all(c("metro_N", "three_lvl_fac_A") %in% names(new_jointVIP$pilot_df))) -======= - expect_equal(new_jointVIP$pilot_df$metro_N, as.numeric(pilot_df$metro == 'N')) - expect_true(all(c("metro_N", "three_lvl_fac_A") %in% names(new_jointVIP$pilot_df))) - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= - expect_equal(new_jointVIP$pilot_df$metro_N, as.numeric(pilot_df$metro == 'N')) - expect_true(all(c("metro_N", "three_lvl_fac_A") %in% names(new_jointVIP$pilot_df))) - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 data[['out']] = as.factor(data[['out']]) pilot_sample_num = sample(which(data$trt == 0), length(which(data$trt == 0)) * @@ -177,8 +149,6 @@ test_that("factored and numeric data are set correctly", { covariates = names(analysis_df)[!names(analysis_df) %in% c(treatment, outcome)] expect_error(create_jointVIP(treatment, -<<<<<<< HEAD -<<<<<<< HEAD outcome, covariates, pilot_df, @@ -186,19 +156,3 @@ test_that("factored and numeric data are set correctly", { "`outcome` must be denoting a numeric variable", fixed=TRUE) }) -======= -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 - outcome, - covariates, - pilot_df, - analysis_df), - "`outcome` must be denoting a numeric variable", - fixed=TRUE) - -}) - -<<<<<<< HEAD ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 diff --git a/tests/testthat/test-plot.R b/tests/testthat/test-plot.R index 8350e76..a2d0e67 100644 --- a/tests/testthat/test-plot.R +++ b/tests/testthat/test-plot.R @@ -1,5 +1,3 @@ -<<<<<<< HEAD -<<<<<<< HEAD test_that("jointVIP plot basic input checks", { set.seed(1234567891) data <- data.frame(year = rnorm(50, 200, 5), @@ -38,14 +36,6 @@ test_that("jointVIP plot basic input checks", { test_that("jointVIP plot layer checks", { -======= -library(testthat) -test_that("plot.jointVIP() is able to show the desired plot", { ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -library(testthat) -test_that("plot.jointVIP() is able to show the desired plot", { ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 set.seed(1234567891) data <- data.frame(year = rnorm(50, 200, 5), gdpPercap = runif(50, 100, 1000), @@ -84,8 +74,6 @@ test_that("plot.jointVIP() is able to show the desired plot", { "stat_identity: na.rm = FALSE\n", "position_identity ")) -<<<<<<< HEAD -<<<<<<< HEAD expect_equal(length(p1$layers), 8) expect_equal(length(plot(new_jointVIP, smd = 'pooled')$layers), 2) expect_equal(length(plot(new_jointVIP, @@ -122,21 +110,6 @@ test_that("jointVIP label checks", { plot_title = paste0("jointVIP for ", outcome)) p2 <- plot(new_jointVIP, use_abs = FALSE) p3 <- plot(new_jointVIP, smd = 'pooled') - -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 - expect_equal("jointVIP for out", p1$labels$title) - expect_equal("Joint Variable Importance Plot", p2$labels$title) - expect_equal("cross-sample SMD", p1$labels$subtitle) - expect_equal("Absolute Standardized Mean Difference", p1$labels$x) - expect_equal("Absolute Outcome Correlation", p1$labels$y) - expect_equal("pooled SMD", p3$labels$subtitle) - expect_equal("Standardized Mean Difference", p2$labels$x) - expect_equal("Outcome Correlation", p2$labels$y) -<<<<<<< HEAD -<<<<<<< HEAD }) test_that("jointVIP input expect errors", { @@ -164,18 +137,6 @@ test_that("jointVIP input expect errors", { plot_title = paste0("jointVIP for ", outcome)) p2 <- plot(new_jointVIP, use_abs = FALSE) p3 <- plot(new_jointVIP, smd = 'pooled') -======= -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 - expect_equal(length(p1$layers), 8) - expect_equal(length(plot(new_jointVIP, smd = 'pooled')$layers), 2) - expect_equal(length(plot(new_jointVIP, - smd = 'cross-sample', - bias_curve_cutoffs = c(0.05, 0.07))$layers), 5) -<<<<<<< HEAD ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 expect_error(plot(new_jointVIP, smd = 'blah'), fixed=TRUE, "smd options only include `cross-sample` or `pooled`") @@ -185,15 +146,6 @@ test_that("jointVIP input expect errors", { "`bias_curve_cutoffs` must be numeric") expect_warning(plot(new_jointVIP, bias_curve_cutoffs = c(0,0.1,0.2)), fixed=TRUE, "0 in the `bias_curve_cutoffs` will not be plotted") -<<<<<<< HEAD -<<<<<<< HEAD - -======= - expect_equal(length(plot(new_jointVIP, bias_curves = FALSE)$layers), 2) ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= - expect_equal(length(plot(new_jointVIP, bias_curves = FALSE)$layers), 2) ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 expect_error(plot(new_jointVIP, bias_curves = "a"), fixed=TRUE, "`bias_curves` can only be set as TRUE or FALSE") expect_error(plot(new_jointVIP, add_var_labs = "a"), fixed=TRUE, @@ -202,16 +154,6 @@ test_that("jointVIP input expect errors", { "`bias_curves` can only be set as TRUE or FALSE") expect_error(plot(new_jointVIP, add_var_labs = 1), fixed=TRUE, "`add_var_labs` can only be set as TRUE or FALSE") -<<<<<<< HEAD -<<<<<<< HEAD -======= - expect_equal(length(plot(new_jointVIP, add_var_labs = FALSE)$layers), - length(plot(new_jointVIP, add_var_labs = TRUE)$layers)-1) ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= - expect_equal(length(plot(new_jointVIP, add_var_labs = FALSE)$layers), - length(plot(new_jointVIP, add_var_labs = TRUE)$layers)-1) ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 expect_error(plot(new_jointVIP, max.overlaps = 0), fixed=TRUE, "`max.overlaps` must be a positive numeric") @@ -244,8 +186,7 @@ test_that("jointVIP input expect errors", { expect_warning(capture_output(plot(new_jointVIP, "standard")), fixed = TRUE, "anything passed in ... must be named or it'll be ignored") }) -<<<<<<< HEAD -<<<<<<< HEAD + test_that("post_jointVIP basic checks", { set.seed(1234567891) @@ -447,7 +388,3 @@ test_that("jointVIP bootstrap plot checks", { expect_error(bootstrap.plot(new_jointVIP, B = 0),fixed=TRUE, "B is too small please make it a larger number") }) -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 diff --git a/tests/testthat/test-print.R b/tests/testthat/test-print.R index 056924b..f4ad42a 100644 --- a/tests/testthat/test-print.R +++ b/tests/testthat/test-print.R @@ -1,14 +1,4 @@ -<<<<<<< HEAD -<<<<<<< HEAD test_that("jointVIP print check", { -======= -library(testthat) -test_that("print.jointVIP() is able to show the desired print", { ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -library(testthat) -test_that("print.jointVIP() is able to show the desired print", { ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 set.seed(1234567891) data <- data.frame(year = rnorm(50, 200, 5), pop = rnorm(50, 1000, 500), @@ -32,22 +22,13 @@ test_that("print.jointVIP() is able to show the desired print", { analysis_df) expect_output(print(new_jointVIP)) -<<<<<<< HEAD -<<<<<<< HEAD expect_output(print(new_jointVIP, use_abs = FALSE)) expect_true(all(as.numeric(unlist(stringr::str_extract_all(capture.output(print(new_jointVIP, use_abs = TRUE)), "\\d+\\.\\d+"))) > 0)) - -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 expect_warning(capture_output(print(new_jointVIP, "standard")), fixed = TRUE, "anything passed in ... must be named or it'll be ignored") expect_equal(capture_output(print(new_jointVIP)), " bias\npop 0.765\nyear 0.211\ngdpPercap 0.152\nlifeExp 0.032") }) -<<<<<<< HEAD -<<<<<<< HEAD test_that("post_jointVIP print check", { set.seed(1234567891) @@ -94,7 +75,4 @@ test_that("post_jointVIP print check", { expect_equal(capture_output(print(post_jointVIP)), " bias post_bias\npop 0.166 0.091\ngdpPercap 0.012 0.111") }) -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 + diff --git a/tests/testthat/test-summary.R b/tests/testthat/test-summary.R index e1610a5..dbdd38c 100644 --- a/tests/testthat/test-summary.R +++ b/tests/testthat/test-summary.R @@ -1,14 +1,4 @@ -<<<<<<< HEAD -<<<<<<< HEAD test_that("jointVIP summary check", { -======= -library(testthat) -test_that("summary.jointVIP() is able to show the desired summary", { ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= -library(testthat) -test_that("summary.jointVIP() is able to show the desired summary", { ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 set.seed(1234567891) data <- data.frame(year = rnorm(50, 200, 5), pop = rnorm(50, 1000, 500), @@ -32,8 +22,6 @@ test_that("summary.jointVIP() is able to show the desired summary", { analysis_df) expect_output(summary(new_jointVIP)) -<<<<<<< HEAD -<<<<<<< HEAD expect_output(summary(new_jointVIP, use_abs = FALSE)) expect_equal(capture_output(summary(new_jointVIP)), paste0("Max absolute bias is 0.765\n4 variables", @@ -88,17 +76,4 @@ test_that("post_jointVIP summary check", { "anything passed in ... must be named or it'll be ignored") expect_output(summary(post_jointVIP)) expect_output(summary(post_jointVIP, use_abs = FALSE)) -======= -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 - expect_equal(capture_output(summary(new_jointVIP)), - paste0("Max absolute bias is 0.765\n4 variables", - " are above the desired 0.01 absolute bias tolerance\n4", - " variables can be plotted")) - expect_warning(capture_output(summary(new_jointVIP, "standard")), fixed = TRUE, - "anything passed in ... must be named or it'll be ignored") -<<<<<<< HEAD ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 }) diff --git a/vignettes/additional_options.Rmd b/vignettes/additional_options.Rmd index 044b395..c72757c 100644 --- a/vignettes/additional_options.Rmd +++ b/vignettes/additional_options.Rmd @@ -7,13 +7,6 @@ vignette: > %\VignetteEncoding{UTF-8} --- -<<<<<<< HEAD -<<<<<<< HEAD - -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 ```{r, include = FALSE} knitr::opts_chunk$set( collapse = TRUE, @@ -202,10 +195,4 @@ All of the options from above can be used; below will only address additional pa * `plot()` function includes two new parameters: - `add_post_labs` TRUE (default) shows the variable labels post-matching/weighting; FALSE suppresses it. - `post_label_cut_bias` numeric number for variable labels; only used when `add_post_labs` is TRUE. -<<<<<<< HEAD -<<<<<<< HEAD - -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 + diff --git a/vignettes/ref.bib b/vignettes/ref.bib index 6f567b9..8a73eee 100644 --- a/vignettes/ref.bib +++ b/vignettes/ref.bib @@ -76,15 +76,7 @@ @Manual{weightit note = {R package version 0.12.0}, url = {https://CRAN.R-project.org/package=WeightIt}, } -<<<<<<< HEAD -<<<<<<< HEAD -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 -======= - ->>>>>>> 38802c698b7513bb5bd529d7c210b18f5081a4d5 @article{zubizarreta2015stable, title={Stable weights that balance covariates for estimation with incomplete outcome data}, author={Zubizarreta, Jos{\'e} R},