R/visualize.R

In maxwestphal/DTAmc: Diagnostic Test Accuracy studies with multiple comparisons

#' Visualize diagnostic accuracy results
#'
#' @param x, a \code{DTAmc_result} object, see \code{\link{study_dta}} 
#' @param ... further arguments (currently ignored)
#'
#' @details early development version
#'
#' @return a ggplot
#' @export
#' @importFrom ggplot2 ggplot
#' @importFrom ggplot2 theme
#' @importFrom ggplot2 element_text
#' @importFrom ggplot2 scale_y_continuous
#' @importFrom ggplot2 scale_x_continuous
#' @importFrom ggplot2 aes
#' @importFrom ggplot2 geom_linerange
#' @importFrom ggplot2 geom_rect
#' @importFrom ggplot2 geom_point
visualize <- function(x, ...){
  ## TODO: remove
  # set.seed(1337)
  # data <- generate_data_roc(n=120, prev=c(0.25, 0.75), m=4,
  #                           delta=0.05, e=10, auc=seq(0.025, 0.975, 0.025), rho=c(0.25, 0.25))
  # x <- data %>% study_dta(regu=c(1,1/2,1/4)*2, alt="greater", alpha=0.025, adj="maxt", nboot=5000)
  specificity <- sensitivity <- test <- sp_lower <- se_lower <- NULL
  
  stopifnot(inherits(x, "DTAmc_result"))
  if(length(x) != 2){stop("visualize currently implemented for 2 subgroups")}
  
  ## derived vars
  G <- length(x)
  nn <- names(x)
  n <- substr(nn, 1, 2)
  
  ## transform data
  results <- lapply(1:G, function(g){
    d <- data.frame(x[[g]][,c("estimate", "lower", "upper")])
    names(d) <- c(nn[g], paste0(n[g], "_", c("lower", "upper")))
    return(d)
  }) 
  results <- cbind(test=x[[1]]$parameter, do.call(cbind, results))
    
  #results 
  benchmark <- attr(x, "benchmark")
  se0 <- benchmark[1]; sp0 <- benchmark[2]
  
  ## plot settings
  lw <- 1.4
  lw2 <- 1.2
  xmin <- 0.45
  ymin <- 0.45
  col <- "#3eb489"
  col2 <- "#cfffe5" #alpha(col, 0.0001)
  lty <- 2
  # https://www.color-hex.com/color-palette/63160
  cols <- c("#ed6d50", "#fc910d", "#239cd3", "#1674b1") # TODO: color def
  # TODO: attr(x, "benchmark")
  # TODO: se0, sp0
  # TODO: axis labels
  
  ## construct plot
  ggplot2::ggplot() +
    ## plot theme:
    ggplot2::theme(#legend.position = "none",
          title= ggplot2::element_text(face="bold", size=24),
          axis.title = ggplot2::element_text(face="bold", size=20),
          legend.text = ggplot2::element_text(face="plain", size=20),
          legend.title = ggplot2::element_text(face="bold", size=20),
          axis.text = ggplot2::element_text(size=16)) +
    ggplot2::scale_y_continuous(nn[1], breaks=seq(0.5, 1, 0.1), limits=c(ymin,1.05)) +
    ggplot2::scale_x_continuous(nn[2], breaks=seq(0.5, 1, 0.1), limits=c(xmin,1.05)) +
    ## plot/axis setup: 
    ggplot2::geom_linerange(ggplot2::aes(x=1, ymin = ymin, ymax = 1), lwd=lw, inherit.aes=F) +
    ggplot2::geom_linerange(ggplot2::aes(y=1, xmin = xmin, xmax = 1), lwd=lw, inherit.aes=F) +
    ggplot2::geom_linerange(ggplot2::aes(x=0.5, ymin = ymin, ymax = 1), lwd=lw2, lty=3, inherit.aes=F) +
    ggplot2::geom_linerange(ggplot2::aes(y=0.5, xmin = xmin, xmax = 1), lwd=lw2, lty=3, inherit.aes=F) +
    ## region of interest:
    ggplot2::geom_rect(ggplot2::aes(xmin=sp0, xmax=1, ymin=se0, ymax=1), fill=col2, inherit.aes=F) +
    ggplot2::geom_linerange(ggplot2::aes(x=sp0, ymin = se0, ymax = 1), lwd=lw, inherit.aes=F, color=col, lty=lty) +
    ggplot2::geom_linerange(ggplot2::aes(y=se0, xmin = sp0, xmax = 1), lwd=lw, inherit.aes=F, color=col, lty=lty) +
    ggplot2::geom_linerange(ggplot2::aes(x=1, ymin = se0, ymax = 1), lwd=lw, inherit.aes=F, color=col, lty=lty) +
    ggplot2::geom_linerange(ggplot2::aes(y=1, xmin = sp0, xmax = 1), lwd=lw, inherit.aes=F, color=col, lty=lty) +
    ## point estimates:
    ggplot2::geom_point(data=results, ggplot2::aes(specificity, sensitivity, colour=test), size=4, pch=16) +
    ggplot2::scale_colour_manual(limits=results$test, values=cols) +
    ## comparison regions:
    ggplot2::geom_linerange(data=results, ggplot2::aes(y=sensitivity, xmin = sp_lower, xmax = specificity, colour=test), lwd=lw2*0.5, lty=2) +
    ggplot2::geom_linerange(data=results, ggplot2::aes(x=specificity, ymin = se_lower, ymax = sensitivity, colour=test), lwd=lw2*0.5, lty=2) +
    ggplot2::geom_linerange(data=results, ggplot2::aes(x=sp_lower, ymin = se_lower, ymax = 1, colour=test), lwd=lw2) +
    ggplot2::geom_linerange(data=results, ggplot2::aes(y=se_lower, xmin = sp_lower, xmax = 1, colour=test), lwd=lw2) 

}