R/plotBar.R

In YunhuiQi/TestPMD: Post Selection Inference on Results from Penalized Matrix Decomposition (SCCA only)

#' Bar plot of canonical loadings from SCCA using PMD
#'
#' This function generates the bar plot of canonical loadings.
#' @param data Data matrix corresponding to the canonical loadings, samples are in rows, variables are in columns.
#' @param loadings A named vector containing the estimated loadings.
#' @param qvalues A vector containing qvalues for the canonical loadings.
#' @param feature_groups A vector indicating the group information of variables.
#' @param alpha Significance level, 0.05 by default.
#' @import ggplot2
#' @import grDevices
#' @import RColorBrewer
#' @export
#' @return A bar plot of canonical loadings, colored by significance, if group is not NULL, background is colored by group.
#' @examples
#' library(TestPMD)
#' data("covid")
#' out <- PMA::CCA(standsdmu(covid$metabolite), standsdmu(covid$protein),
#' typex = "standard", typez="standard",
#' penaltyx = 0.9, penaltyz = 0.9, K = 3, standardize = FALSE, trace = FALSE)
#' pvalue <- CPTloading(X = covid$metabolite, Y = covid$protein, side = "X", K = 1, r = 10,
#' penalty = "Fixed", rho_x = 0.9, rho_y = 0.9, permutation_no = 100)
#' p_bar <- plotBar(data = covid$metabolite, loadings = out$u[,1], qvalues = pvalue,
#' feature_groups = NULL, alpha = 0.1)
#' p_bar



plotBar <- function(data, loadings, qvalues, feature_groups = NULL, alpha = 0.05){
  if(!is.null(feature_groups) & ncol(data) != length(feature_groups)){stop("Feature groups do not match data")}
  if(ncol(data) != length(loadings)){stop("Loadings do not match data")}
  if(length(qvalues) != length(loadings)){stop("qvalues do not match loadings")}
  if(!is.numeric(alpha)){stop("alpha must be numeric")}
  if(alpha >= 1 | alpha <= 0){stop("alpha must be within (0, 1)")}

  index <- NULL
  names(loadings) <- colnames(data)
  names(qvalues) <- colnames(data)
  sig <- ifelse(qvalues < alpha, "aaa: significant", "aaa: insignificance")
  bar <- data.frame(loadings = loadings, sig = sig, index = 1:length(qvalues))
  p_bar <- ggplot2::ggplot(bar) +
    ggplot2::theme_linedraw()+
    ggplot2::labs(title="Bar plot of canonical loadings")+
    ggplot2::geom_bar(ggplot2::aes(x = index , y = loadings, fill = sig), position = "dodge", stat = "identity", show.legend = T)+
    ggplot2::theme(legend.title = ggplot2::element_blank(), legend.position = "bottom",legend.text = ggplot2::element_text( size = 14))+
    ggplot2::scale_fill_manual(values = c("aaa: significant"="black","aaa: insignificance"="lightgrey"),labels = c('significance', "insiginificant"))+
    ggplot2::theme(plot.title = element_text(hjust = 0.5))+
    ggplot2::theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
                   panel.background = element_blank(), axis.line = element_line(colour = "black"))
  if(!is.null(feature_groups)){
    names(feature_groups) <- colnames(data)
    n_cols <- length(unique(feature_groups))
    mycolors <- c("white","black", grDevices::colorRampPalette(RColorBrewer::brewer.pal(8, "Set3"))(n_cols))
    p_min <- c(0)
    p_max <- c()
    bar$feature_groups <- feature_groups
    for (group_ind in 1:(n_cols - 1)) {p_min <- c(p_min, sum(table(feature_groups)[1:group_ind]))}
    for (group_ind in 1:(n_cols)) {p_max <- c(p_max, sum(table(feature_groups)[1:group_ind]))}
    bar$min <- rep(p_min, table(feature_groups))
    bar$max <- rep(p_max, table(feature_groups))
    p_bar <- ggplot2::ggplot(bar) +
      ggplot2::geom_rect(ggplot2::aes(xmin = min, xmax = max, ymin = -Inf, ymax =Inf, fill = feature_groups), show.legend = T)+
      ggplot2::labs(title="Bar plot of canonical loadings")+
      ggplot2::geom_bar(ggplot2::aes(x = index , y = loadings, fill = sig), position = "dodge", stat = "identity", show.legend = T)+
      ggplot2::theme(legend.title = ggplot2::element_blank(), legend.position = "bottom",legend.text = ggplot2::element_text( size = 10))+
      ggplot2::guides(linetype = ggplot2::guide_legend(override.aes = list(fill = c("black","white"))))+
      ggplot2::theme(axis.text.x = ggplot2::element_blank())+
      ggplot2::scale_fill_manual(values = mycolors, labels = c("insignificant","significant", sort(unique(feature_groups))))+
      ggplot2::theme_linedraw()+
      ggplot2::theme(plot.title = element_text(hjust = 0.5))+
      ggplot2::theme(panel.grid.major = element_blank(), panel.grid.minor = element_blank(),
                     panel.background = element_blank(), axis.line = element_line(colour = "black"))
  }
  return(p_bar)
}