R/commonSeqsBar.R

In elulu3/LymphoSeqTest: Analyze high-throughput sequencing of T and B cell receptors

#' Common sequences bar plot
#' 
#' Creates an UpSetR bar plot showing the number of intersecting sequences across 
#' multiple repertoire_ids.  This function is useful when more than 3 repertoire_ids are being 
#' compared.
#' 
#' @param productive_aa A tibble of productive amino acid sequences 
#' generated by LymphoSeq function productiveSeq where the aggregate parameter 
#' was set to "junction_aa".
#' @param repertoire_ids The names of two or more repertoire_ids in the productive_aa 
#' list whose intersections will shown.
#' @param color_sample The name of a single repertoire_id in the productive_aa list whose 
#' sequences will be colored in all repertoire_ids that they appear in.
#' @param color_intersection The names of two or more repertoire_ids in the productive_aa 
#' list whose intersections will be colored.
#' @param color A character vector of a color name that will be used highlight a selected 
#' repertoire_id or multiple repertoire_id intersections.
#' @param labels A character vector indicating whether the number of 
#' intersecting sequences should be shown on the tops of the bars.  Options 
#' include "yes" or "no".
#' @return Returns an UpSetR bar plot showing the number of intersecting sequences 
#' across multiple repertoire_ids.
#' @seealso \code{\link{commonSeqs}}
#' @examples
#' file_path <- system.file("extdata", "TCRB_sequencing", package = "LymphoSeq2")
#' 
#' stable <- readImmunoSeq(path = file_path)
#' 
#' atable <- productiveSeq(stable, aggregate = "junction_aa")
#' 
#' commonSeqsBar(atable, repertoire_ids = c("TRB_CD4_949", "TRB_CD8_949",
#' "TRB_Unsorted_949", "TRB_Unsorted_1320"), color_sample = "TRB_CD8_949")
#' @export
#' @import tidyverse
commonSeqsBar <- function(productive_aa, repertoire_ids, color_sample = NULL,
                         color_intersection = NULL, color = "#377eb8", labels = "no"){
    unique_seqs <- LymphoSeq2::uniqueSeqs(productive_table = productive_aa) %>% pull(junction_aa)
    sequence_matrix <- LymphoSeq2::seqMatrix(productive_aa = productive_aa, sequences = unique_seqs) 
    junction_aa <- sequence_matrix %>% 
                   dplyr::pull(junction_aa)
    sequence_matrix <- sequence_matrix %>% 
                      dplyr::select(-junction_aa) %>%
                      base::as.matrix()
    sample_names <- colnames(sequence_matrix)
    sequence_matrix[sequence_matrix > 0] <- 1
    sequence_matrix <- sequence_matrix %>% 
                       base::as.data.frame()
    sequence_matrix[["junction_aa"]] <- junction_aa
    
    
    if(!is.null(color_sample)){
        queryFunction = function(row, sequence) {
            data <- (row[["junction_aa"]] %in% sequence)
        }
        seq_list <- productive_aa %>% 
                    dplyr::filter(repertoire_id == color_sample) %>%
                    dplyr::pull(junction_aa)
        upplot <- UpSetR::upset(sequence_matrix,
                                sets = repertoire_ids,
                                nsets = length(repertoire_ids), 
                                nintersects = NA,
                                text.scale = 1,
                                mainbar.y.label = "Number of intersecting sequences",
                                sets.x.label = "Number of sequences",
                                mb.ratio = c(0.7, 0.3),
                                show.numbers = labels,
                                matrix.dot.alpha = 0,
                                query.legend = "bottom",
                                queries = list(list(query = queryFunction, 
                                                    params = list(seq_list), 
                                                    color = "#377eb8",
                                                    active = TRUE,
                                                    query.name = color_sample)))
    } else if(!is.null(color_intersection)){
        upplot <- UpSetR::upset(sequence_matrix,
              sets = repertoire_ids,
              nsets = length(repertoire_ids), 
              nintersects = NA,
              mainbar.y.label = "Number of intersecting sequences",
              sets.x.label = "Number of sequences",
              mb.ratio = c(0.7, 0.3),
              show.numbers = labels,
              matrix.dot.alpha = 0,
              text.scale = 1,
              queries = list(list(query = UpSetR::elements,
                                  params = list(color_intersection), 
                                  color = color,
                                  active = TRUE)))
    } else if(is.null(color_sample) & is.null(color_intersection)){
        upplot <- UpSetR::upset(sequence_matrix,
              sets = repertoire_ids,
              nsets = length(repertoire_ids), 
              nintersects = NA,
              text.scale = 1,
              mainbar.y.label = "Number of intersecting sequences",
              sets.x.label = "Number of sequences",
              mb.ratio = c(0.7, 0.3),
              show.numbers = labels,
              matrix.dot.alpha = 0)
    }
    return(upplot)
}