ACCEPT analysis

# ACCEPT: https://www.ncbi.nlm.nih.gov/pmc/articles/PMC7613267/

source(url("https://github.com/guhjy/guhjy/raw/main/shrinkage.R"))

# ORBITA: https://www.semanticscholar.org/paper/Percutaneous-coronary-intervention-in-stable-angina-Al-Lamee-Thompson/1ba069c9f4a819503735daa7ca8abdcbd69f9200

onetailed_p <- function(estimate, lower, upper) {

  se <- (upper - lower) / 3.92

  z <- estimate/se;p <- pnorm(z)

  cat("One-tailed p-value (more than):", p, "\n")

  return(p)}

onetailed_p(16.6, -8.9, 42)

# DanGer Shock: https://www.nejm.org/doi/full/10.1056/NEJMoa2312572

onetailed_p <- function(estimate, lower, upper) {

   se <- (log(upper) - log(lower)) / 3.92

   z <- log(estimate)/se;p <- pnorm(z)

   cat("One-tailed p-value (more than):", p, "\n")

   return(p)}

onetailed_p(0.74, 0.55, 0.99)

accept <- function(estimate, lower_ci, upper_ci, threshold) {

  se <- (log(upper_ci) - log(lower_ci)) / (2 * qnorm(0.975))

  sapply(threshold, function(x) pnorm(log(x), mean = log(estimate), sd = se, lower.tail = FALSE))

}

accept(0.86, 0.74, 1, 1)

library(ggplot2)

library(dplyr)

library(tidyr)

# Function to calculate accept probabilities greater than the threshold

calculate_accept_probability <- function(estimate, lower_ci, upper_ci, thresholds) {

  sd_estimate <- (upper_ci - lower_ci) / (2 * qnorm(0.975))

  sapply(thresholds, function(x) pnorm(x, mean = estimate, sd = sd_estimate, lower.tail = FALSE))

}

# Main function to plot ACCEPT curves

plot_accept_curves <- function(trial_data, thresholds, designated_thresholds) {

  # Calculate probabilities for each trial

  accept_probs <- mapply(calculate_accept_probability,

                         estimate = trial_data$estimate,

                         lower_ci = trial_data$lower_ci,

                         upper_ci = trial_data$upper_ci,

                         MoreArgs = list(thresholds = thresholds))

  # Convert matrix to data frame and reshape for ggplot

  accept_probs_df <- as.data.frame(t(accept_probs))

  colnames(accept_probs_df) <- thresholds

  accept_probs_df$trial <- trial_data$trial  

# Reshape the data frame from wide to long format

  accept_probs_long <- pivot_longer(accept_probs_df, cols = -trial, names_to = "Threshold", values_to = "Probability")  

  # Filter for specific thresholds

  accept_at_designated <- accept_probs_long %>%

    filter(Threshold %in% designated_thresholds) %>%

    mutate(Threshold = as.numeric(Threshold))  # ensure Threshold is numeric if not already

  # Plot the ACCEPT curves with annotations for designated thresholds

  accept_plot <- ggplot(accept_probs_long, aes(x = as.numeric(Threshold), y = Probability, color = trial)) +

    geom_line(size = 1.2) +

    geom_text(data = accept_at_designated, aes(label = sprintf("%.2f", Probability), y = Probability + 0.05), 

              hjust = 0.5, vjust = 0, size = 3.5, color = "black") +

    labs(title = "ACCEPT Curves for Clinical Trials", x = "Threshold (Effect Size)", y = "Probability") +

    scale_color_manual(name = "Trial", values = c("EARNEST" = "blue", "SECOND-LINE" = "red")) +

    theme_minimal()

    print(accept_plot)

}

# Example usage

trial_data <- data.frame(

  trial = c("EARNEST", "SECOND-LINE"),

  estimate = c(-2.4, -4.7),

  lower_ci = c(-5.2, -8.1),

  upper_ci = c(0.4, -1.3)

)

thresholds <- seq(-10, 10, by = 0.5)

designated_thresholds <- c("-5", "0", "5")

plot_accept_curves(trial_data, thresholds, designated_thresholds)