R/helper_plot_threshold.R

In jrosen48/konfound: Quantify the Robustness of Causal Inferences

# Function to output the plot

#' Plot Effect Threshold Diagram
#'
#' This function creates a plot to illustrate the threshold of an effect 
#' estimate in relation to a specified beta threshold. It uses ggplot2 
#' for graphical representation.
#'
#' @param beta_threshold The threshold value for the effect.
#' @param est_eff The estimated effect size.
#' @return A ggplot object representing the effect threshold diagram.
#' @importFrom ggplot2 ggplot aes geom_col geom_hline annotate 
#' scale_fill_manual theme_bw theme xlab ylab
#' @importFrom dplyr tibble mutate rename select filter pull
#' @importFrom tidyr gather
plot_threshold <- function(beta_threshold, est_eff) {
  beta_threshold <- abs(beta_threshold)
  est_eff <- abs(est_eff)

  if (est_eff > beta_threshold) { # beta is above threshold
    dd <- dplyr::tibble(
      est_eff = est_eff,
      beta_threshold = beta_threshold
    )

    dd <- dplyr::mutate(dd, `Above Threshold` = est_eff - beta_threshold)
    dd <- dplyr::rename(dd, `Below Threshold` = beta_threshold)

    dd <- dplyr::select(dd, -est_eff)
    dd <- tidyr::gather(dd, key, val)
    dd <- dplyr::mutate(dd, inference = "group")

    y_thresh <- dplyr::filter(dd, key == "Below Threshold")
    y_thresh <- dplyr::pull(dplyr::select(y_thresh, val))
    y_thresh_text <- y_thresh + sqrt(.005 * abs(y_thresh))

    effect_text <- est_eff + (.025 * est_eff) # y-value of text

    cols <- c("#A6CEE3", "#1F78B4") # dark blue and light blue
  } else if (est_eff < beta_threshold) { # beta is below threshold

    dd <- dplyr::tibble(est_eff = est_eff, beta_threshold = beta_threshold)
    dd <- dplyr::mutate(dd, `Above Estimated Effect, 
                        Below Threshold` = abs(est_eff - beta_threshold))
    dd <- dplyr::mutate(dd, `Below Threshold` = est_eff)
    dd <- dplyr::select(dd, -beta_threshold)

    dd <- dplyr::select(dd, -est_eff)
    dd <- tidyr::gather(dd, key, val)
    dd <- dplyr::mutate(dd, inference = "group")

    y_thresh <- sum(abs(dd$val))
    if (est_eff < 0) {
      y_thresh <- y_thresh * -1
    }

    y_thresh_text <- y_thresh + sqrt(.005 * abs(y_thresh))
    effect_text <- est_eff + sqrt(.025 * abs(est_eff)) # y-value of text

    cols <- c("lightgray", "#1F78B4") 
    # dark blue and green (green not used right now)
  }

  p <- ggplot2::ggplot(dd, ggplot2::aes(x = inference, y = val, fill = key)) +
    ggplot2::geom_col(position = "stack") +

    ggplot2::geom_hline(yintercept = est_eff, color = "black") +
    ggplot2::annotate("text", x = 1, y = effect_text, 
                      label = "Estimated Effect") +
    ggplot2::geom_hline(yintercept = y_thresh, color = "red") +
    ggplot2::annotate("text", x = 1, y = y_thresh_text, 
                      label = "Threshold") +
    # ggplot2::geom_text(aes(label = "Effect"), vjust = -.5) + 
    #this is discussed here: https://github.com/jrosen48/konfound/issues/5

    ggplot2::scale_fill_manual("", values = cols) +
    ggplot2::theme_bw() +
    ggplot2::theme(axis.text.x = ggplot2::element_blank(), 
                   axis.ticks = ggplot2::element_blank()) +
    ggplot2::xlab(NULL) +
    ggplot2::ylab("Effect (abs. value)") +
    ggplot2::theme(legend.position = "top")

  return(p)
}