R/plot_nreps.R

Defines functions plot.nreps

Documented in plot.nreps

#' plot.nreps
#'
#' S3 method for plotting _nreps_ objects output by [calc_nreps()]).
#'
#' @param x list object of class _nreps_ (generated by [calc_nreps()])
#'               or of class _CAISEr_ (in which case an `instance.name`
#'               must be provided).
#' @param y unused. Included for consistency with generic `plot` method.
#' @param ... other parameters to be passed down to specific
#'            plotting functions (currently unused)
#' @param instance.name name for instance to be plotted if `object` is
#'                      of class _CAISEr_. Ignored otherwise.
#' @param latex logical: should labels be formatted for LaTeX? (useful for
#'              later saving using library `TikzDevice`)
#' @param show.SE logical: should standard errors be plotted?
#' @param show.CI logical: should confidence intervals be plotted?
#' @param sig.level significance level for the confidence interval.
#'                  0 < sig.level < 1
#' @param show.text logical: should text be plotted?
#'
#' @return `ggplot` object (invisibly)
#'
#' @method plot nreps
#'
#' @export
#'
plot.nreps <- function(x, y = NULL, ...,
                       instance.name = NULL,
                       latex = FALSE,
                       show.SE = TRUE,
                       show.CI = TRUE,
                       sig.level = 0.05,
                       show.text = TRUE)
{

  object <- x
  # Extract a single instance if plotting from CAISEr object
  if ("CAISEr" %in% class(object)){
    assertthat::assert_that(is.character(instance.name),
                            length(instance.name) == 1,
                            instance.name %in% unique(object$data.summary$Instance))
    obj <- list()
    obj$Diffk <- object$data.summary[object$data.summary$Instance == instance.name, ]
    nk <- table(object$data.raw$Algorithm[object$data.raw$Instance == instance.name])
    obj$Nk <- as.numeric(nk)
    names(obj$Nk) <- names(nk)
    obj$instance <- instance.name
    object <- obj
    class(object) <- "nreps"
  }

  assertthat::assert_that(all(c("Diffk", "Nk", "instance") %in% names(object)),
                          is.logical(latex), length(latex) == 1,
                          is.logical(show.SE), length(show.SE) == 1,
                          is.logical(show.CI), length(show.CI) == 1,
                          is.logical(show.text), length(show.text) == 1,
                          is.numeric(sig.level), length(sig.level) == 1,
                          sig.level > 0, sig.level < 1,
                          any(c("CAISEr", "nreps") %in% class(object)))


  df      <- object$Diffk
  algs    <- names(object$Nk)
  df$Alg1 <- algs[df$Alg1]
  df$Alg2 <- algs[df$Alg2]
  df$CIHW <- df$SE * stats::qt(p = 1 - sig.level / 2,
                               df = df$N1 + df$N2)

  if (latex){
    pairx <- " $\\times$ "
    ylabtxt <- "$\\phi_{ij}$"
    setxt <- paste0("$SE_{ij} = ", signif(df$SE, 2), "$")
    citxt <- paste0("$CI_{",
                    1 - sig.level,
                    "} = [", signif(df$Phi - df$CIHW, 2), ", ",
                    signif(df$Phi + df$CIHW, 3), "]$")
  } else {
    pairx <- " x "
    ylabtxt <- "diff"
    setxt <- paste0("SE = ", signif(df$SE, 2))
    citxt <- paste0("CI(",
                    1 - sig.level,
                    ") = [", signif(df$Phi - df$CIHW, 2), ", ",
                    signif(df$Phi + df$CIHW, 2), "]")
  }

  df$pair <- paste0(df$Alg1, pairx, df$Alg2)

  mp <- ggplot2::ggplot(df,
                        ggplot2::aes_string(x = "pair",
                                            y = "Phi",
                                            ymin = "Phi - SE",
                                            ymax = "Phi + SE")) +
    ggplot2::theme_minimal() +
    ggplot2::geom_abline(slope = 0, intercept = 0,
                         lty = 3, col = "red", lwd = 1.4,
                         alpha = .5)
  if (show.CI){
    mp <- mp +
      ggplot2::geom_errorbar(ggplot2::aes_string(ymin = "Phi - CIHW",
                                                 ymax = "Phi + CIHW"),
                             alpha = .5, col = 2,
                             width = .12, size = 1.2)
  }

  if (show.SE){
    mp <- mp +
      ggplot2::geom_linerange(size = 1.8)
  }

  mp <- mp + ggplot2::geom_point(size = 2.5) +
    ggplot2::coord_flip() +
    ggplot2::xlab("Pair") +
    ggplot2::ylab(ylabtxt) +
    ggplot2::labs(caption = paste0("Instance: ", object$instance))

  if(show.text & show.SE){
    mp <- mp +
      ggplot2::geom_text(ggplot2::aes(label = setxt),
                         nudge_x = .2, size = 2.5)
  }

  if(show.text & show.CI){
    mp <- mp +
      ggplot2::geom_text(ggplot2::aes(label = citxt),
                         nudge_x = -.2, size = 2.5)
  }

  return(mp)
}

Try the CAISEr package in your browser

Any scripts or data that you put into this service are public.

CAISEr documentation built on Nov. 17, 2022, 1:07 a.m.