R/difference_asymmetry_plot.R

Defines functions plot_diff_asym

Documented in plot_diff_asym

#' Plot difference asymmetry functions
#'
#' Plot one or more difference asymmetry functions generated by \code{\link{asymhd}} or \code{\link{asymdhd}}. The function returns a list of ggplot objects, which can be
#' customised using the \code{ggplot2} package - see details
#' \href{http://docs.ggplot2.org/current/}{here}.
#'
#' @param data A list of data frames generated by \code{asymhd} or \code{asymdhd}.
#' @param symb_col Contour colour of quantile symbol.
#' @param symb_fill Fill colour(s) of quantile symbol. Defaults are "white" for theme 1,
#' c("darkviolet","darkorange2") for theme 2, c("white", "grey") for theme 3.
#' @param symb_size Size of quantile symbol - default = 5.
#' @param symb_shape Shape of the quantile symbol - default = 21 (disc).
#' @param diffint_col Colour of the lines marking the quantile difference intervals.
#' @param diffint_size Size of the lines marking the quantile difference intervals
#'   - default = .5.
#' @param q_line_col Colour of the line joining the quantiles.
#' @param q_line_alpha Alpha of the line joining the quantiles - default = .5.
#' @param q_line_size Size of the line joining the quantiles - default = 1.5.
#'
#' @return A list of ggplot objects.
#'
#' @examples
#' # using asymhd
#' set.seed(21) # generate data
#' n <- 100 # sample size
#' df <- tibble(gr = factor(c(rep("group1",n),rep("group2",n),rep("group3",n))),
#'              obs= c(rnorm(n)+6, rnorm(n)+4, rnorm(n)*1.5+6)) # make tibble
#' out <- asymhd(df, obs ~ gr, doall = TRUE, nboot = 100) # compute all comparisons
#' plist <- plot_diff_asym(out)
#'
#' # using asymdhd
#' set.seed(21) # generate data
#' n <- 100 # sample size per condition
#' C1 <- rnorm(n) # condition 1
#' C2 <- C1 + rnorm(n) + 2 # condition 2
#' # Data with 3 independent groups and 2 dependent conditions per group
#' library(tibble)
#' df <- tibble(gr = factor(c(rep("group1",n),rep("group2",n),rep("group3",n))),
#'   cond1 = c(C1, C1+rnorm(n), C1+rnorm(n)),
#'   cond2 = c(C2, C2 + 1, C2 + 3) ) # make tibble
#' library(dplyr)
#' df <- mutate(df, diff = cond1 - cond2)
#' out <- asymdhd(data = df, formula = diff ~ gr, nboot = 100, doall = TRUE)
#' plist <- plot_diff_asym(data = out)
#' plist
#'
#' @export
plot_diff_asym <- function(data = df,
                           symb_col = NULL,
                           symb_fill = NULL,
                           symb_size = 5,
                           symb_shape = 21,
                           diffint_col = NULL,
                           diffint_size = .5,
                           q_line_col = NULL,
                           q_line_alpha = .5,
                           q_line_size = 1.5){
  # check input is a list of data frames
  if(!is.list(data)){
    stop("data must be a list")
  }
  for (pc in 1:length(data)) {
    if(!is.data.frame(data[[pc]])){
      stop("input data list must contain data.frames")
    }
  }
  plist <- vector("list", length(data)) # declare list of plot objects
  for (pc in 1:length(data)) {
    df <- data[[pc]]
    ylim <- max(max(abs(df$ci.up)),max(abs(df$ci.low)))
    ylim <- c(-ylim,ylim)
    df$deco <- seq(1,nrow(df))
    if (is.null(symb_col)){
      symb_col <- "black"
    }
    if (is.null(symb_fill)){
      symb_fill <- c("white","grey30")
    }
    if (is.null(diffint_col)){
      diffint_col <- "black"
    }
    if (is.null(q_line_col)){
      q_line_col <- "grey50"
    }
    p <- ggplot(df, aes_string(x="quantile", y="SUM")) +
      geom_hline(yintercept=0,linetype=2,alpha=0.5) + # x=0 reference line
      # vertical bars for uncertainty intervals
      geom_linerange(aes(ymin=ci.low, ymax=ci.up), colour = diffint_col,
        size = diffint_size) +
      # line joining the quantiles
      geom_line(colour = q_line_col, alpha = q_line_alpha, linetype = "solid",
        size = q_line_size) +
      # symbols marking the quantiles
      geom_point(aes(fill = deco), colour="black", size = symb_size, shape = symb_shape) +
      scale_fill_gradient(low = symb_fill[1], high = symb_fill[2], guide = FALSE) +
      xlab("Quantiles") +
      ylab(paste0("Quantile sum = q + 1-q \n (",names(data[pc])," differences)")) +
      theme_bw() +
      theme(axis.text.x = element_text(size=14),
        axis.text.y = element_text(size=14),
        axis.title.x = element_text(size=16,face="bold"),
        axis.title.y = element_text(size=16,face="bold")) +
      scale_y_continuous(limits = ylim) +
      scale_x_continuous(breaks = df$quantile)
    # print(p)
    plist[[pc]] <- p
  }
  suppressMessages(plist)
}
GRousselet/rogme documentation built on Nov. 12, 2022, 4:38 a.m.