R/quietVDJgenes.R

In ncborcherding/scRepertoire: A toolkit for single-cell immune receptor profiling

#' Remove TCR and BCR genes from variable gene results
#'
#' @description
#' `r lifecycle::badge("experimental")`
#'
#' Most single-cell workflows use highly-expressed and highly-variable
#' genes for the initial calculation of PCA and subsequent dimensional
#' reduction. This function will remove the TCR and/or BCR genes from the
#' variable features in a Seurat object or from a vector (potentially
#' generated by the Bioconductor scran workflow).
#'
#' @examples
#' example <- quietVDJgenes(scRep_example)
#' trex_example <- quietTCRgenes(scRep_example)
#' ibex_example <- quietBCRgenes(scRep_example)
#'
#' @param sc Single-cell object in Seurat format or vector of variable genes
#' to use in reduction
#' @param assay The Seurat assay slot to use to remove immune receptor genes
#' from, NULL value will default to the default assay
#' @param ... Reserved for future arguments
#'
#' @export
#' @return Seurat object or vector list with TCR genes removed.
quietVDJgenes <- function(sc, ...) {
    quietTCRgenes(quietBCRgenes(sc, ...), ...)
}

#' @rdname quietVDJgenes
#' @export
#' @author Nicky de Vrij, Nikolaj Pagh, Nick Borcherding, Qile Yang
quietTCRgenes <- function(sc, ...) {
    UseMethod("quietTCRgenes")
}

#' @rdname quietVDJgenes
#' @method quietTCRgenes default
#' @export
quietTCRgenes.default <- function(sc, ...) {
    assert_that(is.character(sc))
    sc[!shouldQuietTcrGene(sc)]
}

shouldQuietTcrGene <- function(genes) {
    grepl("^TR[ABDG][VDJ][^D]", genes)
}

#' @rdname quietVDJgenes
#' @method quietTCRgenes Seurat
#' @export
quietTCRgenes.Seurat <- function(sc, assay = NULL, ...) {
    if (is.null(assay)) {
        assay <- SeuratObject::DefaultAssay(sc)
    }
    SeuratObject::VariableFeatures(sc, assay = assay) <-
        quietTCRgenes.default(SeuratObject::VariableFeatures(sc, assay = assay))
    sc
}

#' @rdname quietVDJgenes
#' @export
quietBCRgenes <- function(sc, ...) {
    UseMethod("quietBCRgenes")
}

#' @rdname quietVDJgenes
#' @method quietBCRgenes default
#' @export
quietBCRgenes.default <- function(sc, ...) {
    assert_that(is.character(sc))
    sc[!shouldQuietBcrGene(sc)]
}

shouldQuietBcrGene <- function(genes) {
    grepl("^IG[HLK][VDJCAGM]", genes) &
        genes %!in% getHumanIgPseudoGenes() |
        genes == "JCHAIN"
}

#' @rdname quietVDJgenes
#' @method quietBCRgenes Seurat
#' @export
quietBCRgenes.Seurat <- function(sc, assay = NULL, ...) {
    if (is.null(assay)) {
        assay <- SeuratObject::DefaultAssay(sc)
    }
    SeuratObject::VariableFeatures(sc, assay = assay) <-
        quietBCRgenes.default(SeuratObject::VariableFeatures(sc, assay = assay))
    sc
}

#' Get Human Immunoglobulin pseudogenes
#'
#' This function returns a character vector of human immunoglobulin
#' pseudogenes. These are also the genes that are removed from the
#' variable gene list in [quietVDJgenes()].
#'
#' @return Character vector of human immunoglobulin pseudogenes.
#' @keywords internal
getHumanIgPseudoGenes <- function() {
    unique(c(
        "IGHJ1P", "IGHJ2P", "IGHJ3P", "IGLC4", "IGLC5", "IGHEP1", "IGHEP2",
        "IGHV1-12","IGHV1-14", "IGHV1-17", "IGHV1-67", "IGHV1-68",
        "IGHV2-10", "IGHV3-6", "IGHV3-19", "IGHV3-22", "IGHV3-25",
        "IGHV3-29", "IGHV3-32", "IGHV3-36", "IGHV3-37", "IGHV3-41",
        "IGHV3-42", "IGHV3-47", "IGHV3-50", "IGHV3-52", "IGHV3-54",
        "IGHV3-57", "IGHV3-60", "IGHV3-62", "IGHV3-63", "IGHV3-65",
        "IGHV3-71", "IGHV3-75", "IGHV3-76", "IGHV3-79", "IGHV4-55",
        "IGHV4-80", "IGHV5-78", "IGHV7-27", "IGHV7-40", "IGHV7-56",
        "IGHVIII-44", "IGHVIII-82", "IGKV1-22", "IGKV1-32", "IGKV1-35",
        "IGKV1D-22", "IGKV1D-27", "IGKV1D-32", "IGKV1D-35", "IGKVOR-2",
        "IGKVOR-3", "IGKVOR-4", "IGKV2-4", "IGKV2-10", "IGKV2-14", "IGKV2-18",
        "IGKV2-19", "IGKV2-23", "IGKV2-26", "IGKV2-36", "IGKV2-38",
        "IGKV2D-10", "IGKV2D-14", "IGKV2D-18", "IGKV2D-19", "IGKV2D-23",
        "IGKV2D-36", "IGKV2D-38", "IGKV3-25", "IGKV3-31", "IGKV3-34",
        "IGKV7-3", "IGLCOR22-1", "IGLCOR22-2", "IGLJCOR18", "IGLV1-41",
        "IGLV1-62", "IGLV2-5", "IGLV2-28", "IGLV2-34", "IGLV3-2",
        "IGLV3-4", "IGLV3-6", "IGLV3-7", "IGLV3-13", "IGLV3-15",
        "IGLV3-17", "IGLV3-24", "IGLV3-26", "IGLV3-29", "IGLV3-30",
        "IGLV3-31", "IGLV7-35", "IGLV10-67", "IGLVI-20", "IGLVI-38",
        "IGLVI-42", "IGLVI-56", "IGLVI-63", "IGLVI-68", "IGLVI-70",
        "IGLVIV-53", "IGLVIV-59", "IGLVIV-64", "IGLVIV-65", "IGLVV-58",
        "IGLVV-66", "IGHV1OR15-2", "IGHV1OR15-3", "IGHV1OR15-4", "IGHV1OR15-6",
        "IGHV1OR16-1", "IGHV1OR16-2", "IGHV1OR16-3", "IGHV1OR16-4", "IGHV3-30-2",
        "IGHV3-33-2", "IGHV3-69-1", "IGHV3OR15-7", "IGHV3OR16-6", "IGHV3OR16-7",
        "IGHV3OR16-11", "IGHV3OR16-14", "IGHV3OR16-15", "IGHV3OR16-16", "IGHV7-34-1",
        "IGHVII-1-1", "IGHVII-15-1", "IGHVII-20-1", "IGHVII-22-1", "IGHVII-26-2",
        "IGHVII-28-1", "IGHVII-30-1", "IGHVII-30-21", "IGHVII-31-1", "IGHVII-33-1",
        "IGHVII-40-1", "IGHVII-43-1", "IGHVII-44-2", "IGHVII-46-1", "IGHVII-49-1",
        "IGHVII-51-2", "IGHVII-53-1", "IGHVII-60-1", "IGHVII-62-1", "IGHVII-65-1",
        "IGHVII-67-1", "IGHVII-74-1", "IGHVII-78-1", "IGHVIII-2-1", "IGHVIII-5-1",
        "IGHVIII-5-2", "IGHVIII-11-1", "IGHVIII-13-1", "IGHVIII-16-1", "IGHVIII-22-2",
        "IGHVIII-25-1", "IGHVIII-26-1", "IGHVIII-38-1", "IGHVIII-47-1", "IGHVIII-67-2",
        "IGHVIII-67-3", "IGHVIII-67-4", "IGHVIII-76-1", "IGHVIV-44-1", "IGKV1OR1-1",
        "IGKV1OR2-1", "IGKV1OR2-2", "IGKV1OR2-3", "IGKV1OR2-6", "IGKV1OR2-9",
        "IGKV1OR2-11", "IGKV1OR2-118", "IGKV1OR9-1", "IGKV1OR9-2", "IGKV1OR10-1",
        "IGKV1OR15-118", "IGKV1OR22-1", "IGKV1OR22-5", "IGKV1ORY-1", "IGKV2OR2-1",
        "IGKV2OR2-2", "IGKV2OR2-4", "IGKV2OR2-7", "IGKV2OR2-7D", "IGKV2OR2-8",
        "IGKV2OR2-10", "IGKV2OR22-3", "IGKV2OR22-4", "IGKV3OR2-5", "IGKV3OR22-2",
        "IGKV8OR8-1", "IGLVIV-66-1", "IGLVIVOR22-1", "IGLVIVOR22-2", "IGLVVI-22-1",
        "IGLVVI-25-1", "IGLVVII-41-1"
    ))
}