R/profile.uicausal.R

In ui: Uncertainty Intervals and Sensitivity Analysis for Missing Data

#' Plot of UI and CI
#'
#' Plot function for objects returned from \code{\link{ui_causal}}.
#' Plots confidence intervals for different values of rho and the uncertainty interval.
#' @param x An object of class uicausal
#' @param dr If TRUE the doubly robust estimator is plotted, otherwise the outcome regression estimator is plotted.
#' @param profile Character specifying profile type (\code{"ui.only"} or \code{"all"}).
#'   If ui.only, only the UI range is plotted; if all, the full profile is shown.
#' @param title Main title
#' @param ylab Title for y axis, default is no title.
#' @param xlab Title for xaxis, default is \code{expression(rho)}.
#' @param ... discouraged from use
#' @importFrom ggplot2 ggplot aes geom_ribbon geom_line geom_hline geom_segment annotate labs scale_x_continuous scale_y_continuous theme_minimal
#' @importFrom grid arrow unit
#' @export


profile.uicausal <- function(x,  dr = TRUE, profile="all" , title = NULL, xlab = NULL, ylab = NULL,...) {
  # Extract data
  ex <- if (dr) x$plot$dr else x$plot$or
  rho <- x$plot$gridrho0

  if (is.null(x$rho1)) {
    coef <- ex$coef
    ci <- ex$ci
  } else {
    coef <- diag(ex$coef)
    ci <- cbind(diag(ex$ci[,,1]), diag(ex$ci[,,2]))
  }


  # Prepare data frame
  df <- data.frame(
    rho = rho,
    coef = coef,
    ci_low = ci[,1],
    ci_high = ci[,2]
  )

  # Compute UI markers
  Stn <- x$plot$gridn
  Fin <- x$plot$gridn * 2 - 1

  if(profile=="all"){
  nv <- sort(Stn + round((Fin - Stn)/3) * 0:3)
  minR <- which(ci[Stn:Fin,1] == min(ci[Stn:Fin,1])) + (Stn - 1)
  maxR <- which(ci[Stn:Fin,2] == max(ci[Stn:Fin,2])) + (Stn - 1)
}
  if(profile=="ui.only"){
    df <-df[Stn:Fin,]
}
  n0 <- which.min(abs(df$rho))


  if (is.null(xlab)) xlab <- expression(rho)
  if (is.null(ylab)) ylab <- ""
  esttype<-if(dr){"DR"}else{"OR"}
  if(is.null(title)){
    if(profile=="all"){
      title=paste0("Profile of ",esttype ," estimates and ",100*(1-2*pnorm(-x$zalpha)) ,"% CI for different values of rho, as well as ",100*(1-2*pnorm(-x$zalpha)) ,"% UI assuming rho in [",rho[Stn],", ",rho[Fin],"]")
    }else{
      title=paste0("Profile of ",esttype ," estimates and ",100*(1-2*pnorm(-x$zalpha)) ,"% CI for different values of rho")
    }}


  ymin_plot <- min(df$ci_low) - 0.03 * diff(range(df$ci_low))  # small margin
  ymax_plot <- max(df$ci_high)

  # Build ggplot
  p <- ggplot(df, aes(x = rho, y = coef)) +
    ggplot2::scale_y_continuous(limits = c(ymin_plot, ymax_plot),expand = c(0, 0))+
    # Confidence ribbon
    geom_ribbon(aes(ymin = ci_low, ymax = ci_high), fill = "grey90") +
    # Main coefficient line
    geom_line(linewidth = 1) +
    ## Dashed CI bounds
    #geom_line(aes(y = ci_low), linetype = "dashed") +
    #geom_line(aes(y = ci_high), linetype = "dashed") +
    # Horizontal reference line
    geom_hline(yintercept = 0, color = "black") +

    # Labels and theme
    labs(title = title, x = xlab, y = ylab)+
    theme_minimal(base_size = 14)
    if(profile=="all"){
      layers <- list(
        # Red arrow at rho = 0
        annotate("segment",
                 x = 0, xend = 0,
                 y = ci[n0,1], yend = ci[n0,2],
                 arrow = grid::arrow(length = grid::unit(0.1, "inches"),ends = "both"),
                 color = "red"),
        # Blue horizontal lines for min/max CI
      annotate("segment",
               x = rho[4], xend = rho[minR],
               y = ci[minR,1], yend = ci[minR,1],
               linetype = "dashed", color = "blue"),

        annotate("segment",
                 x = rho[4], xend = rho[maxR],
                 y = ci[maxR,2], yend = ci[maxR,2],
                 linetype = "dashed", color = "blue"),


        # Blue arrows for UI range
        annotate("segment",
                 x = rho[Stn], xend = rho[Stn],
                 y = ymin_plot, yend = ci[Stn,1],
                 linetype = "dashed", color = "blue",
                 arrow = grid::arrow(length = grid::unit(0.1, "inches"))),

        annotate("segment",
                 x = rho[Fin], xend = rho[Fin],
                 y = ymin_plot, yend = ci[Fin,1],
                 linetype = "dashed", color = "blue",
                 arrow = grid::arrow(length = grid::unit(0.1, "inches"))),

    # Grey arrows for intermediate nv points
    geom_segment(data = df[nv,], aes(x = rho, xend = rho, y = ci_low, yend = ci_high),
                 arrow = grid::arrow(length = grid::unit(0.1, "inches"),ends = "both"),
                 linetype = "dotted", color = "black"),

    # Blue arrow spanning full UI range

    annotate("segment",
             x = rho[4], xend = rho[4],
             y = min(ci[Stn:Fin,1]), yend = max(ci[Stn:Fin,2]),
             arrow = grid::arrow(length = grid::unit(0.1, "inches"),ends = "both"),
             color = "blue"),


    # UI text annotation
    annotate("text", x = mean(rho[2:3]), y = mean(ci), label = "UI", color = "blue"))

      p<-p+layers

      p<-p+scale_x_continuous(
        breaks = sort(unique(c(pretty(rho), rho[Stn], rho[Fin]))))
      }


  return(p)
}