R/COTAN-getters.R
In seriph78/COTAN: COexpression Tables ANalysis
Defines functions
normalizeNameAndLabels
getClusters
getProbabilityOfZero
getNormalizedData
getLogNormData
getNuNormData
getMu
estimatorsAreReady
Documented in
estimatorsAreReady
getClusters
getLogNormData
getMu
getNormalizedData
getNuNormData
getProbabilityOfZero
normalizeNameAndLabels
# ------- `COTAN` raw data accessors --------
#' @title Raw data `COTAN` accessors
#'
#' @description These methods extract information out of a just created `COTAN`
#' object. The accessors have **read-only** access to the object.
#'
#' @name RawDataGetters
NULL
#' @aliases getRawData
#'
#' @details `getRawData()` extracts the raw count table.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getRawData()` returns the raw count sparse matrix
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#'
#' rawData <- getRawData(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getRawData",
"COTAN",
function(objCOTAN) {
return(objCOTAN@raw)
}
)
#' @aliases getNumCells
#'
#' @details `getNumCells()` extracts the number of cells in the sample (\eqn{m})
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getNumCells()` returns the number of cells in the sample (\eqn{m})
#'
#' @export
#'
#' @examples
#' numCells <- getNumCells(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getNumCells",
"COTAN",
function(objCOTAN) {
return(ncol(objCOTAN@raw))
}
)
#' @aliases getNumGenes
#'
#' @details `getNumGenes()` extracts the number of genes in the sample (\eqn{n})
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getNumGenes()` returns the number of genes in the sample (\eqn{n})
#'
#' @export
#'
#' @examples
#' numGenes <- getNumGenes(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getNumGenes",
"COTAN",
function(objCOTAN) {
return(nrow(objCOTAN@raw))
}
)
#' @aliases getCells
#'
#' @details `getCells()` extract all cells in the dataset.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getCells()` returns a character array with the cells' names
#'
#' @export
#'
#' @examples
#' cellsNames <- getCells(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getCells",
"COTAN",
function(objCOTAN) {
return(colnames(objCOTAN@raw))
}
)
#' @aliases getGenes
#'
#' @details `getGenes()` extract all genes in the dataset.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getGenes()` returns a character array with the genes' names
#'
#' @export
#'
#' @examples
#' genesNames <- getGenes(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getGenes",
"COTAN",
function(objCOTAN) {
return(rownames(objCOTAN@raw))
}
)
#' @aliases getZeroOneProj
#'
#' @details `getZeroOneProj()` extracts the raw count table where any
#' positive number has been replaced with `1`
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getZeroOneProj()` returns the raw count matrix projected to `0` or
#' `1`
#'
#' @export
#'
#' @examples
#' zeroOne <- getZeroOneProj(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getZeroOneProj",
"COTAN",
function(objCOTAN) {
return(sign(objCOTAN@raw))
}
)
#' @aliases getCellsSize
#'
#' @details `getCellsSize()` extracts the cell raw library size.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @return `getCellsSize()` returns an array with the library sizes
#'
#' @export
#'
#' @importFrom Matrix colSums
#'
#' @examples
#' cellsSize <- getCellsSize(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getCellsSize",
"COTAN",
function(objCOTAN) {
return(colSums(objCOTAN@raw))
}
)
#' @aliases getNumExpressedGenes
#'
#' @details `getNumExpressedGenes()` extracts the number of genes expressed for
#' each cell. Exploits a feature of [Matrix::CsparseMatrix-class]
#'
#' @param objCOTAN a `COTAN` object
#'
#' @return `getNumExpressedGenes()` returns an array with the library sizes
#'
#' @export
#'
#' @examples
#' numExpGenes <- getNumExpressedGenes(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getNumExpressedGenes",
"COTAN",
function(objCOTAN) {
# We expliot CsparseMatrix feature
ret <- diff(objCOTAN@raw@p)
names(ret) <- getCells(objCOTAN)
return(ret)
}
)
#' @aliases getGenesSize
#'
#' @details `getGenesSize()` extracts the genes raw library size.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @return `getGenesSize()` returns an array with the library sizes
#'
#' @export
#'
#' @importFrom Matrix rowSums
#'
#' @examples
#' genesSize <- getGenesSize(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getGenesSize",
"COTAN",
function(objCOTAN) {
return(rowSums(objCOTAN@raw))
}
)
#' @aliases getNumOfExpressingCells
#'
#' @details `getNumOfExpressingCells()` extracts, for each gene, the number of
#' cells that are expressing it. Exploits a feature of
#' [Matrix::CsparseMatrix-class]
#'
#' @param objCOTAN a `COTAN` object
#'
#' @return `getNumOfExpressingCells()` returns an array with the library sizes
#'
#' @export
#'
#' @examples
#' numExpCells <- getNumOfExpressingCells(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getNumOfExpressingCells",
"COTAN",
function(objCOTAN) {
# We exploit CsparseMatrix feature
ret <- diff(t(objCOTAN@raw)@p)
names(ret) <- getGenes(objCOTAN)
return(ret)
}
)
# ---------- Handle meta-data --------
#' @title Handling *meta-data* in `COTAN` objects
#'
#' @description Much of the information stored in the `COTAN` object is
#' compacted into three `data.frame`s:
#' * `"metaDataset"` - contains all general information about the data-set
#' * `"metaGenes"` - contains genes' related information along the `lambda`
#' and `dispersion` vectors and the fully-expressed flag
#' * `"metaCells"` - contains cells' related information along the `nu`
#' vector, the fully-expressing flag, the *clusterizations* and the
#' *conditions*
#'
#' @name HandleMetaData
NULL
#' @aliases getMetadataDataset
#'
#' @details `getMetadataDataset()` extracts the meta-data stored for the
#' current data-set.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getMetadataDataset()` returns the meta-data `data.frame`
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#'
#' objCOTAN <- initializeMetaDataset(objCOTAN, GEO = "test_GEO",
#' sequencingMethod = "distribution_sampling",
#' sampleCondition = "reconstructed_dataset")
#'
#' objCOTAN <- addElementToMetaDataset(objCOTAN, "Test",
#' c("These are ", "some values"))
#'
#' dataSetInfo <- getMetadataDataset(objCOTAN)
#'
#' @rdname HandleMetaData
#'
setMethod(
"getMetadataDataset",
"COTAN",
function(objCOTAN) {
return(objCOTAN@metaDataset)
}
)
#' @aliases getMetadataElement
#'
#' @details `getMetadataElement()` extracts the value associated with the
#' given tag if present or an empty string otherwise.
#'
#' @param objCOTAN a `COTAN` object
#' @param tag The tag associated to the wanted value
#'
#' @returns `getMetadataElement()` returns a string with the relevant value
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @examples
#' numInitialCells <- getMetadataElement(objCOTAN, "cells")
#'
#' @rdname HandleMetaData
#'
setMethod(
"getMetadataElement",
"COTAN",
function(objCOTAN, tag) {
meta <- getMetadataDataset(objCOTAN)
if (is_empty(meta) || !(tag %in% meta[[1L]])) {
out <- ""
} else {
rowPos <- which(meta[[1L]] %in% tag)
out <- meta[, -1L, drop = FALSE][rowPos, ]
}
return(out)
}
)
#' @aliases getMetadataGenes
#'
#' @details `getMetadataGenes()` extracts the meta-data stored for the genes
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getMetadataGenes()` returns the genes' meta-data `data.frame`
#'
#' @export
#'
#' @examples
#' metaGenes <- getMetadataGenes(objCOTAN)
#'
#' @rdname HandleMetaData
#'
setMethod(
"getMetadataGenes",
"COTAN",
function(objCOTAN) {
return(objCOTAN@metaGenes)
}
)
#' @aliases getMetadataCells
#'
#' @details `getMetadataCells()` extracts the meta-data stored for the cells
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getMetadataCells()` returns the cells' meta-data `data.frame`
#'
#' @export
#'
#' @examples
#' metaCells <- getMetadataCells(objCOTAN)
#'
#' @rdname HandleMetaData
#'
setMethod(
"getMetadataCells",
"COTAN",
function(objCOTAN) {
return(objCOTAN@metaCells)
}
)
#' @aliases getDims
#'
#' @details `getDims()` extracts the sizes of all slots of the `COTAN` object
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getDims()` returns a named `list` with the sizes of the slots
#'
#' @export
#'
#' @examples
#' allSizes <- getDims(objCOTAN)
#'
#' @rdname HandleMetaData
#'
setMethod(
"getDims",
"COTAN",
function(objCOTAN) {
return(list("raw" = dim(objCOTAN@raw),
"genesCoex" = dim(objCOTAN@genesCoex),
"cellsCoex" = dim(objCOTAN@cellsCoex),
"metaDataset" = nrow(objCOTAN@metaDataset),
"metaGenes" = ncol(objCOTAN@metaGenes),
"metaCells" = ncol(objCOTAN@metaCells),
"clustersCoex" = length(objCOTAN@clustersCoex)))
}
)
# ------- `COTAN` estimated data accessors ------
#' @aliases getNu
#'
#' @details `getNu()` extracts the nu array (normalized cells' counts averages)
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getNu()` returns the nu array
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname ParametersEstimations
#'
setMethod(
"getNu",
"COTAN",
function(objCOTAN) {
nu <- getMetadataCells(objCOTAN)[["nu"]]
if (is_empty(nu)) {
warning("nu is empty")
} else {
names(nu) <- getCells(objCOTAN)
}
return(nu)
}
)
#' @aliases getLambda
#'
#' @details `getLambda()` extracts the lambda array (mean expression for each
#' gene)
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getLambda()` returns the lambda array
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname ParametersEstimations
#'
setMethod(
"getLambda",
"COTAN",
function(objCOTAN) {
lambda <- getMetadataGenes(objCOTAN)[["lambda"]]
if (is_empty(lambda)) {
warning("lambda is empty")
} else {
names(lambda) <- getGenes(objCOTAN)
}
return(lambda)
}
)
#' @aliases getDispersion
#'
#' @details `getDispersion()` extracts the dispersion array
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getDispersion()` returns the dispersion array
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname ParametersEstimations
#'
setMethod(
"getDispersion",
"COTAN",
function(objCOTAN) {
dispersion <- getMetadataGenes(objCOTAN)[["dispersion"]]
if (is_empty(dispersion)) {
warning("dispersion is empty")
} else {
names(dispersion) <- getGenes(objCOTAN)
}
return(dispersion)
}
)
#' @details `estimatorsAreReady()` checks whether the estimators arrays lambda,
#' nu, dispersion are available
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `estimatorsAreReady()` returns a boolean specifying whether all
#' three arrays are non-empty
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname ParametersEstimations
#'
estimatorsAreReady <- function(objCOTAN) {
anyEmptyArrays <- is_empty(getLambda(objCOTAN)) ||
is_empty(getNu(objCOTAN)) ||
is_empty(getDispersion(objCOTAN))
if (anyEmptyArrays) {
logThis(paste0("Estimators are not ready - array sizes: lambda ",
length(getLambda(objCOTAN)), ", nu ",
length(getNu(objCOTAN)), ", dispersion ",
length(getDispersion(objCOTAN))), logLevel = 2L)
}
return(!anyEmptyArrays)
}
#' @aliases getMu
#' @aliases calculateMu
#'
#' @details `getMu()` calculates the vector \eqn{\mu = \lambda \times
#' \nu^T}
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getMu()` returns the `mu` matrix
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname CalculatingCOEX
#'
getMu <- function(objCOTAN) {
if (is_empty(getLambda(objCOTAN))) {
stop("lambda must not be empty, estimate it")
}
if (is_empty(getNu(objCOTAN))) {
stop("nu must not be empty, estimate it")
}
return(getLambda(objCOTAN) %o% getNu(objCOTAN))
}
#' @details `getNuNormData()` extracts the \eqn{\nu}*-normalized* count table
#' (i.e. where each column is divided by `nu`) and returns it
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getNuNormData()` returns the \eqn{\nu}*-normalized* count
#' `data.frame`
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @examples
#' nuNorm <- getNuNormData(objCOTAN)
#'
#' @rdname ParametersEstimations
#'
getNuNormData <- function(objCOTAN) {
if (is_empty(getNu(objCOTAN))) {
stop("nu must not be empty, estimate it")
}
return(t(t(getRawData(objCOTAN)) * (1.0 / getNu(objCOTAN))))
}
#' @details `getLogNormData()` extracts the *log-normalized* count table (i.e.
#' where each column is divided by the [getCellsSize()]), takes its `log10`
#' and returns it.
#'
#' @param objCOTAN a `COTAN` object
#' @param retLog When `TRUE` returns
#'
#' @returns `getLogNormData()` returns a `data.frame` after applying the formula
#' \eqn{\log_{10}{(10^4 * x + 1)}} to the raw counts normalized by
#' *cells-size*
#'
#' @export
#'
#' @examples
#' logNorm <- getLogNormData(objCOTAN)
#'
#' @rdname ParametersEstimations
#'
getLogNormData <- function(objCOTAN) {
normData <- t(t(getRawData(objCOTAN)) * (1.0e4 / getCellsSize(objCOTAN)))
return(log1p(normData) / log(10.0))
}
#' @details `getNormalizedData()` is deprecated: please use [getNuNormData()] or
#' [getLogNormData()] directly as appropriate
#'
#' @param objCOTAN a `COTAN` object
#' @param retLog When `TRUE` calls [getLogNormData()], calls [getNuNormData()]
#'
#' @returns `getNormalizedData()` returns a `data.frame`
#'
#' @export
#'
#' @examples
#' logNorm <- getNormalizedData(objCOTAN, retLog = TRUE)
#'
#' @rdname ParametersEstimations
#'
getNormalizedData <- function(objCOTAN, retLog = FALSE) {
if (retLog) {
return(getLogNormData(objCOTAN))
} else {
return(getNuNormData(objCOTAN))
}
}
#' @details `getProbabilityOfZero()` gives for each cell and each gene the
#' probability of observing zero reads
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getProbabilityOfZero()` returns a `data.frame` with the
#' probabilities of zero
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @examples
#' probZero <- getProbabilityOfZero(objCOTAN)
#'
#' @rdname ParametersEstimations
#'
getProbabilityOfZero <- function(objCOTAN) {
if (is_empty(getDispersion(objCOTAN))) {
stop("dispersion must not be empty, estimate it")
}
# estimate Probabilities of 0 with internal function funProbZero
return(funProbZero(getDispersion(objCOTAN), getMu(objCOTAN)))
}
# ----------- Raw data cleaning ------------
#' @title Raw data cleaning
#'
#' @description These methods are to be used to clean the raw data. That is drop
#' any number of genes/cells that are too sparse or too present to allow
#' proper calibration of the `COTAN` model.
#'
#' We call genes that are expressed in all cells *Fully-Expressed* while cells
#' that express all genes in the data are called *Fully-Expressing*. In case
#' it has been made quite easy to exclude the flagged genes/cells in the user
#' calculations.
#'
#' @name RawDataCleaning
NULL
#' @aliases flagNotFullyExpressedGenes
#'
#' @details `flagNotFullyExpressedGenes()` returns a Boolean array with TRUE for
#' those genes that are not fully-expressed.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `flagNotFullyExpressedGenes()` returns a Booleans array with TRUE
#' for genes that are not fully-expressed
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @export
#'
#' @examples
#' library(zeallot)
#'
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#'
#' genes.to.rem <- getGenes(objCOTAN)[grep('^MT', getGenes(objCOTAN))]
#' cells.to.rem <- getCells(objCOTAN)[which(getCellsSize(objCOTAN) == 0)]
#' objCOTAN <- dropGenesCells(objCOTAN, genes.to.rem, cells.to.rem)
#'
#' objCOTAN <- clean(objCOTAN)
#'
#' objCOTAN <- findFullyExpressedGenes(objCOTAN)
#' goodPos <- flagNotFullyExpressedGenes(objCOTAN)
#'
#' @rdname RawDataCleaning
#'
setMethod(
"flagNotFullyExpressedGenes",
"COTAN",
function(objCOTAN) {
if (is_empty(getMetadataGenes(objCOTAN)[["feGenes"]])) {
return(set_names(rep(TRUE, getNumGenes(objCOTAN)), getGenes(objCOTAN)))
} else {
return(!getMetadataGenes(objCOTAN)[["feGenes"]])
}
}
)
#' @aliases flagNotFullyExpressingCells
#'
#' @details `flagNotFullyExpressingCells()`returns a Boolean vector with TRUE
#' for those cells that are not expressing all genes
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `flagNotFullyExpressingCells()` returns an array of Booleans with
#' TRUE for cells that are not expressing all genes
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @export
#'
#' @examples
#' objCOTAN <- findFullyExpressingCells(objCOTAN)
#' goodPos <- flagNotFullyExpressingCells(objCOTAN)
#'
#' @rdname RawDataCleaning
#'
setMethod(
"flagNotFullyExpressingCells",
"COTAN",
function(objCOTAN) {
if (is_empty(getMetadataCells(objCOTAN)[["feCells"]])) {
return(set_names(rep(TRUE, getNumCells(objCOTAN)), getCells(objCOTAN)))
} else {
return(!getMetadataCells(objCOTAN)[["feCells"]])
}
}
)
#' @aliases getFullyExpressedGenes
#'
#' @details `getFullyExpressedGenes()` returns the genes expressed in all cells
#' of the dataset
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getFullyExpressedGenes()` returns an array containing all genes
#' that are expressed in all cells
#'
#' @export
#'
#' @examples
#' feGenes <- getFullyExpressedGenes(objCOTAN)
#'
#' @rdname RawDataCleaning
#'
setMethod(
"getFullyExpressedGenes",
"COTAN",
function(objCOTAN) {
return(getGenes(objCOTAN)[!flagNotFullyExpressedGenes(objCOTAN)])
}
)
#' @aliases getFullyExpressingCells
#'
#' @details `getFullyExpressingCells()` returns the cells that did express
#' all genes of the dataset
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getFullyExpressingCells()` returns an array containing all cells
#' that express all genes
#'
#' @export
#'
#' @examples
#' feCells <- getFullyExpressingCells(objCOTAN)
#'
#' @rdname RawDataCleaning
#'
setMethod(
"getFullyExpressingCells",
"COTAN",
function(objCOTAN) {
return(getCells(objCOTAN)[!flagNotFullyExpressingCells(objCOTAN)])
}
)
# ------- `COTAN` coex data accessors ------
#' Calculating the COEX matrix for genes and cells
#'
#' @name CalculatingCOEX
NULL
#' @aliases getGenesCoex
#'
#' @details `getGenesCoex()` extracts a complete (or a partial after genes
#' dropping) genes' `COEX` matrix from the `COTAN` object.
#'
#' @param objCOTAN a `COTAN` object
#' @param genes The given genes' names to select the wanted `COEX` columns. If
#' missing all columns will be returned. When not empty a proper result is
#' provided by calculating the partial `COEX` matrix on the fly
#' @param zeroDiagonal When TRUE the `COEX` of any element with itself is set to
#' zero
#' @param ignoreSync When `TRUE` ignores whether the `lambda`/`nu`/`dispersion`
#' have been updated since the `COEX` matrix was calculated.
#'
#' @returns `getGenesCoex()` returns the genes' `COEX` values
#'
#' @importFrom rlang is_empty
#'
#' @importFrom assertthat assert_that
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#' objCOTAN <- initializeMetaDataset(objCOTAN, GEO = "test_GEO",
#' sequencingMethod = "distribution_sampling",
#' sampleCondition = "reconstructed_dataset")
#' objCOTAN <- clean(objCOTAN)
#'
#' objCOTAN <- estimateDispersionBisection(objCOTAN, cores = 6L)
#'
#' ## Now the `COTAN` object is ready to calculate the genes' `COEX`
#'
#' ## mu <- getMu(objCOTAN)
#' ## observedY <- observedContingencyTablesYY(objCOTAN, asDspMatrices = TRUE)
#' obs <- observedContingencyTables(objCOTAN, asDspMatrices = TRUE)
#'
#' ## expectedN <- expectedContingencyTablesNN(objCOTAN, asDspMatrices = TRUE)
#' exp <- expectedContingencyTables(objCOTAN, asDspMatrices = TRUE)
#'
#' objCOTAN <- calculateCoex(objCOTAN, actOnCells = FALSE)
#'
#' stopifnot(isCoexAvailable(objCOTAN))
#' genesCoex <- getGenesCoex(objCOTAN)
#' genesSample <- sample(getNumGenes(objCOTAN), 10)
#' partialGenesCoex <- calculatePartialCoex(objCOTAN, genesSample,
#' actOnCells = FALSE)
#'
#' identical(partialGenesCoex,
#' getGenesCoex(objCOTAN, getGenes(objCOTAN)[sort(genesSample)]))
#'
#' ## S <- calculateS(objCOTAN)
#' ## G <- calculateG(objCOTAN)
#' ## pValue <- calculatePValue(objCOTAN)
#' gdiDF <- calculateGDI(objCOTAN)
#' objCOTAN <- storeGDI(objCOTAN, genesGDI = gdiDF)
#'
#' ## Touching any of the lambda/nu/dispersino parameters invalidates the `COEX`
#' ## matrix and derivatives, so it can be dropped it from the `COTAN` object
#' objCOTAN <- dropGenesCoex(objCOTAN)
#' stopifnot(!isCoexAvailable(objCOTAN))
#'
#'
#' objCOTAN <- estimateDispersionNuBisection(objCOTAN, cores = 6L)
#'
#' ## Now the `COTAN` object is ready to calculate the cells' `COEX`
#' ## In case one need to caclualte both it is more sensible to run the above
#' ## before any `COEX` evaluation
#'
#' g1 <- getGenes(objCOTAN)[sample(getNumGenes(objCOTAN), 1)]
#' g2 <- getGenes(objCOTAN)[sample(getNumGenes(objCOTAN), 1)]
#' tables <- contingencyTables(objCOTAN, g1 = g1, g2 = g2)
#' tables
#'
#' objCOTAN <- calculateCoex(objCOTAN, actOnCells = TRUE)
#' stopifnot(isCoexAvailable(objCOTAN, actOnCells = TRUE, ignoreSync = TRUE))
#' cellsCoex <- getCellsCoex(objCOTAN)
#'
#' cellsSample <- sample(getNumCells(objCOTAN), 10)
#' partialCellsCoex <- calculatePartialCoex(objCOTAN, cellsSample,
#' actOnCells = TRUE)
#'
#' identical(partialCellsCoex, cellsCoex[, sort(cellsSample)])
#'
#' objCOTAN <- dropCellsCoex(objCOTAN)
#' stopifnot(!isCoexAvailable(objCOTAN, actOnCells = TRUE))
#'
#' @rdname CalculatingCOEX
#'
setMethod(
"getGenesCoex",
"COTAN",
function(objCOTAN, genes = vector(mode = "character"),
zeroDiagonal = TRUE, ignoreSync = FALSE) {
coexIsReady <- isCoexAvailable(objCOTAN, ignoreSync = ignoreSync)
if (is_empty(genes)) {
assert_that(coexIsReady,
msg = paste0("Cannot return genes' coex as the matrix was ",
"never calculated or is out-of-sync with the ",
"estimators."))
ret <- objCOTAN@genesCoex
if (isTRUE(zeroDiagonal)) {
diag(ret) <- 0.0
ret <- pack(forceSymmetric(ret))
}
return(ret)
} else {
genes <- handleNamesSubsets(getGenes(objCOTAN), genes)
ret <- objCOTAN@genesCoex
if (!coexIsReady) {
warning("Missing or out-of-sync genes' coex:",
"calculating the required subset now!")
ret <- calculatePartialCoex(objCOTAN, columnsSubset = genes,
actOnCells = FALSE)
} else {
ret <- ret[, genes, drop = FALSE]
}
if (isTRUE(zeroDiagonal)) {
diag(ret[genes, , drop = FALSE]) <- 0.0
}
return(ret)
}
}
)
#' @aliases getCellsCoex
#'
#' @details `getCellsCoex()` extracts a complete (or a partial after cells
#' dropping) cells' `COEX` matrix from the `COTAN` object.
#'
#' @param objCOTAN a `COTAN` object
#' @param cells The given cells' names to select the wanted `COEX` columns. If
#' missing all columns will be returned. When not empty a proper result is
#' provided by calculating the partial `COEX` matrix on the fly
#' @param zeroDiagonal When `TRUE` sets the diagonal to zero.
#' @param ignoreSync When `TRUE` ignores whether the `lambda`/`nu`/`dispersion`
#' have been updated since the `COEX` matrix was calculated.
#'
#' @returns `getCellsCoex()` returns the cells' `COEX` values
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname CalculatingCOEX
#'
setMethod(
"getCellsCoex",
"COTAN",
function(objCOTAN, cells = vector(mode = "character"),
zeroDiagonal = TRUE, ignoreSync = FALSE) {
coexIsReady <- isCoexAvailable(objCOTAN, actOnCells = TRUE,
ignoreSync = ignoreSync)
if (is_empty(cells)) {
assert_that(coexIsReady,
msg = paste0("Cannot return cells' coex as the matrix was ",
"never calculated or is out-of-sync with the ",
"estimators."))
ret <- objCOTAN@cellsCoex
if (isTRUE(zeroDiagonal)) {
diag(ret) <- 0.0
ret <- pack(forceSymmetric(ret))
}
return(ret)
} else {
cells <- handleNamesSubsets(getCells(objCOTAN), cells)
ret <- objCOTAN@cellsCoex
if (!coexIsReady) {
warning("Missing or out-of-sync cells' coex:",
"calculating the required subset now!")
ret <- calculatePartialCoex(objCOTAN, columnsSubset = cells,
actOnCells = TRUE)
} else {
ret <- ret[, cells, drop = FALSE]
}
if (isTRUE(zeroDiagonal)) {
diag(ret[cells, , drop = FALSE]) <- 0.0
}
return(ret)
}
}
)
#' @aliases isCoexAvailable
#'
#' @details `isCoexAvailable()` allows to query whether the relevant `COEX`
#' matrix from the `COTAN` object is available to use
#'
#' @param objCOTAN a `COTAN` object
#' @param actOnCells Boolean; when `TRUE` the function works for the cells,
#' otherwise for the genes
#' @param ignoreSync When `TRUE` ignores whether the `lambda`/`nu`/`dispersion`
#' have been updated since the `COEX` matrix was calculated.
#'
#' @returns `isCoexAvailable()` returns whether relevant `COEX` matrix has been
#' calculated and, in case, if it is still aligned to the estimators.
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname CalculatingCOEX
#'
setMethod(
"isCoexAvailable",
"COTAN",
function(objCOTAN, actOnCells = FALSE, ignoreSync = FALSE) {
if (isTRUE(actOnCells)) {
isInSync <- as.logical(getMetadataElement(objCOTAN,
datasetTags()[["csync"]]))
return(!is_empty(objCOTAN@cellsCoex) && (isTRUE(ignoreSync) || isInSync))
} else {
isInSync <- as.logical(getMetadataElement(objCOTAN,
datasetTags()[["gsync"]]))
return(!is_empty(objCOTAN@genesCoex) && (isTRUE(ignoreSync) || isInSync))
}
}
)
#' @aliases getGDI
#'
#' @details `getGDI()` extracts the genes' **GDI** array as it was stored by the
#' method [storeGDI()]
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getGDI()` returns the genes' **GDI** array if available or `NULL`
#' otherwise
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname GenesStatistics
#'
setMethod(
"getGDI",
"COTAN",
function(objCOTAN) {
gdi <- getMetadataGenes(objCOTAN)[["GDI"]]
if (is_empty(gdi)) {
warning("no GDI data has been stored")
} else {
names(gdi) <- getGenes(objCOTAN)
}
return(gdi)
}
)
#' @aliases getClusterizations
#'
#' @details `getClusterizations()` extracts the list of the *clusterizations*
#' defined in the `COTAN` object.
#'
#' @param objCOTAN a `COTAN` object
#' @param dropNoCoex When `TRUE` drops the names from the *clusterizations* with
#' empty associated coex `data.frame`
#' @param keepPrefix When `TRUE` returns the internal name of the
#' *clusterization*: the one with the `CL_` prefix.
#'
#' @returns `getClusterizations()` returns a vector of *clusterization* names,
#' usually without the `CL_` prefix
#'
#' @importFrom rlang is_empty
#'
#' @importFrom methods validObject
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#' objCOTAN <- proceedToCoex(objCOTAN, cores = 6L, calcCoex = FALSE,
#' optimizeForSpeed = TRUE, saveObj = FALSE)
#'
#' data("test.dataset.clusters1")
#' clusters <- test.dataset.clusters1
#'
#' coexDF <- DEAOnClusters(objCOTAN, clusters = clusters)
#'
#' groupMarkers <- list(G1 = c("g-000010", "g-000020", "g-000030",
#' "g-000150", "g-000160", "g-000170"),
#' G2 = c("g-000300", "g-000330", "g-000450",
#' "g-000460", "g-000470"),
#' G3 = c("g-000510", "g-000530", "g-000550",
#' "g-000570", "g-000590"))
#'
#' geneClusters <- rep(1:3, each = 240)[1:600]
#' names(geneClusters) <- getGenes(objCOTAN)
#'
#' umapPlot <- UMAPPlot(coexDF, clusters = NULL, elements = groupMarkers)
#' plot(umapPlot)
#'
#' objCOTAN <- addClusterization(objCOTAN, clName = "first_clusterization",
#' clusters = clusters, coexDF = coexDF)
#'
#' lfcDF <- logFoldChangeOnClusters(objCOTAN, clusters = clusters)
#' umapPlot2 <- UMAPPlot(lfcDF, clusters = geneClusters)
#' plot(umapPlot2)
#'
#' objCOTAN <- estimateNuLinearByCluster(objCOTAN, clusters = clusters)
#'
#' clSummaryPlotAndData <-
#' clustersSummaryPlot(objCOTAN, clName = "first_clusterization",
#' plotTitle = "first clusterization")
#' plot(clSummaryPlotAndData[["plot"]])
#'
#' if (FALSE) {
#' objCOTAN <- dropClusterization(objCOTAN, "first_clusterization")
#' }
#'
#' clusterizations <- getClusterizations(objCOTAN, dropNoCoex = TRUE)
#' stopifnot(length(clusterizations) == 1)
#'
#' cellsUmapPlotAndDF <- cellsUMAPPlot(objCOTAN, dataMethod = "LogNormalized",
#' clName = "first_clusterization",
#' genesSel = "HVG_Seurat")
#' plot(cellsUmapPlotAndDF[["plot"]])
#'
#' enrichment <- geneSetEnrichment(clustersCoex = coexDF,
#' groupMarkers = groupMarkers)
#'
#' clHeatmapPlotAndData <- clustersMarkersHeatmapPlot(objCOTAN, groupMarkers)
#'
#' conditions <- as.integer(substring(getCells(objCOTAN), 3L))
#' conditions <- factor(ifelse(conditions <= 600, "L", "H"))
#' names(conditions) <- getCells(objCOTAN)
#'
#' clHeatmapPlotAndData2 <-
#' clustersMarkersHeatmapPlot(objCOTAN, groupMarkers, kCuts = 2,
#' condNameList = list("High/Low"),
#' conditionsList = list(conditions))
#'
#' @rdname HandlingClusterizations
#'
setMethod(
"getClusterizations",
"COTAN",
function(objCOTAN, dropNoCoex = FALSE, keepPrefix = FALSE) {
validObject(objCOTAN)
clsCoex <- getClustersCoex(objCOTAN)
if (isTRUE(dropNoCoex)) {
emptyClsCoex <- vapply(clsCoex, is_empty, logical(1L))
out <- names(clsCoex[!emptyClsCoex])
} else {
out <- names(clsCoex)
}
# drop the internal 'CL_' prefix
if (isFALSE(keepPrefix)) {
out <- substring(out, 4L)
}
return(out)
}
)
#' @aliases getClusterizationName
#'
#' @details `getClusterizationName()` normalizes the given *clusterization* name
#' or, if none were given, returns the name of last available *clusterization*
#' in the `COTAN` object. It can return the *clusterization* **internal name**
#' if needed
#'
#' @param objCOTAN a `COTAN` object
#' @param clName The name of the *clusterization*. If not given the last
#' available
#' *clusterization* will be returned, as it is probably the most significant!
#' @param keepPrefix When `TRUE` returns the internal name of the
#' *clusterization*: the one with the `CL_` prefix.
#'
#' @returns `getClusterizationName()` returns the normalized *clusterization*
#' name or `NULL` if no *clusterizations* are present
#'
#' @export
#'
#' @examples
#' clName <- getClusterizationName(objCOTAN)
#'
#' @rdname HandlingClusterizations
#'
setMethod(
"getClusterizationName",
"COTAN",
function(objCOTAN, clName = "", keepPrefix = FALSE) {
allClustNames <- getClusterizations(objCOTAN, keepPrefix = TRUE)
if (isEmptyName(clName)) {
# pick last clusterization
outName <- allClustNames[length(allClustNames)]
} else {
outName <- clName
if (!startsWith(clName, "CL_")) {
outName <- paste0("CL_", clName)
}
assert_that(outName %in% allClustNames,
msg = paste0("Given cluster name '", clName,
"' is not among the stored clusterizations"))
}
# drop the internal 'CL_' prefix
if (isFALSE(keepPrefix)) {
outName <- substring(outName, 4L)
}
return(outName)
}
)
#' @aliases getClusterizationData
#'
#' @details `getClusterizationData()` extracts the asked *clusterization* and
#' its associated `COEX` `data.frame` from the `COTAN` object
#'
#' @param objCOTAN a `COTAN` object
#' @param clName The name of the *clusterization*. If not given the last
#' available *clusterization* will be returned, as it is probably the most
#' significant!
#'
#' @returns `getClusterizationData()` returns a `list` with 2 elements:
#' * `"clusters"` the named cluster labels array
#' * `"coex"` the associated `COEX` `data.frame`. This will be an **empty**
#' `data.frame` when not specified for the relevant *clusterization*
#'
#' @export
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @examples
#' clusterDataList <- getClusterizationData(objCOTAN, clName = clName)
#'
#' @rdname HandlingClusterizations
#'
setMethod(
"getClusterizationData",
"COTAN",
function(objCOTAN, clName = "") {
internalName <- getClusterizationName(objCOTAN, clName = clName,
keepPrefix = TRUE)
# clName can still be empty if no clusterization was store in the objCOTAN
assert_that(!isEmptyName(internalName),
msg = "No clusterizations are present in the 'COTAN' object")
clusters <- factor(set_names(getMetadataCells(objCOTAN)[[internalName]],
getCells(objCOTAN)))
coexDF <- getClustersCoex(objCOTAN)[[internalName]]
return(list("clusters" = clusters, "coex" = coexDF))
}
)
#'
#' @details `getClusters()` extracts the asked *clusterization* from the `COTAN`
#' object
#'
#' @param objCOTAN a `COTAN` object
#' @param clName The name of the *clusterization*. If not given the last
#' available *clusterization* will be returned, as it is probably the most
#' significant!
#'
#' @returns `getClusters()` returns the named cluster labels array
#'
#' @export
#'
#' @examples
#' clusters <- getClusters(objCOTAN, clName = clName)
#'
#' @rdname HandlingClusterizations
#'
getClusters <- function(objCOTAN, clName = "") {
return(getClusterizationData(objCOTAN, clName = clName)[["clusters"]])
}
#' @aliases getClustersCoex
#'
#' @details `getClustersCoex()` extracts the full `clusterCoex` member `list`
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getClustersCoex()` returns the list with a `COEX` `data.frame` for
#' each *clusterization*. When not empty, each `data.frame` contains a `COEX`
#' column for each *cluster*.
#'
#' @export
#'
#' @examples
#' allClustersCoexDF <- getClustersCoex(objCOTAN)
#'
#' @rdname HandlingClusterizations
#'
setMethod(
"getClustersCoex",
"COTAN",
function(objCOTAN) {
return(objCOTAN@clustersCoex)
}
)
# ------- `COTAN` conditions data accessors ------
#' @title Handling cells' *conditions* and related functions
#'
#' @description These functions manage the *conditions*.
#'
#' A *condition* is a set of **labels** that can be assigned to cells:
#' one **label** per cell. This is especially useful in cases when the
#' `data-set` is the result of merging multiple experiments' raw data
#'
#' @name HandlingConditions
NULL
#' @aliases getAllConditions
#'
#' @details `getAllConditions()` extracts the list of the *conditions* defined
#' in the `COTAN` object.
#'
#' @param objCOTAN a `COTAN` object
#' @param keepPrefix When `TRUE` returns the internal name of the
#' *condition*: the one with the `COND_` prefix.
#'
#' @returns `getAllConditions()` returns a vector of *conditions* names,
#' usually without the `COND_` prefix
#'
#' @importFrom rlang is_empty
#'
#' @importFrom methods validObject
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#'
#' cellLine <- rep(c("A", "B"), getNumCells(objCOTAN) / 2)
#' names(cellLine) <- getCells(objCOTAN)
#' objCOTAN <- addCondition(objCOTAN, condName = "Line", conditions = cellLine)
#'
#' ##objCOTAN <- dropCondition(objCOTAN, "Genre")
#'
#' conditionsNames <- getAllConditions(objCOTAN)
#'
#' @rdname HandlingConditions
#'
setMethod(
"getAllConditions",
"COTAN",
function(objCOTAN, keepPrefix = FALSE) {
validObject(objCOTAN)
cNames <- colnames(getMetadataCells(objCOTAN))
areCondNames <- vapply(cNames, startsWith, logical(1L), "COND_")
out <- cNames[areCondNames]
# drop the internal 'COND_' prefix
if (isFALSE(keepPrefix)) {
out <- substring(out, 6L)
}
return(out)
}
)
#' @aliases getConditionName
#'
#' @details `getConditionName()` normalizes the given *condition* name or, if
#' none were given, returns the name of last available *condition* in the
#' `COTAN` object. It can return the *condition* **internal name** if needed
#'
#' @param objCOTAN a `COTAN` object
#' @param condName The name of the *condition*. If not given an empty string
#' will be returned!
#' @param keepPrefix When `TRUE` returns the internal name of the
#' *condition*: the one with the `COND_` prefix.
#'
#' @returns `getConditionName()` returns the normalized *condition* name or
#' `NULL` if no *conditions* are present
#'
#' @export
#'
#' @examples
#' condName <- getConditionName(objCOTAN)
#'
#' @rdname HandlingConditions
#'
setMethod(
"getConditionName",
"COTAN",
function(objCOTAN, condName = "", keepPrefix = FALSE) {
allCondNames <- getAllConditions(objCOTAN, keepPrefix = TRUE)
if (isEmptyName(condName)) {
# return a default name
outName <- "COND_"
} else {
outName <- condName
if (!startsWith(condName, "COND_")) {
outName <- paste0("COND_", condName)
}
assert_that(outName %in% allCondNames,
msg = paste0("Given condition name '", condName,
"' is not among the stored conditions"))
}
# drop the internal 'COND_' prefix
if (isFALSE(keepPrefix)) {
outName <- substring(outName, 6L)
}
return(outName)
}
)
#' @aliases getCondition
#'
#' @details `getCondition()` extracts the asked *condition* from the `COTAN`
#' object
#'
#' @param objCOTAN a `COTAN` object
#' @param condName The name of the *condition*. If not given a dummy constant
#' **label** *condition* will be returned.
#'
#' @returns `getCondition()` returns a named `factor` with the *condition*
#'
#' @export
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @examples
#' condition <- getCondition(objCOTAN, condName = condName)
#' isa(condition, "factor")
#'
#' @rdname HandlingConditions
#'
setMethod(
"getCondition",
"COTAN",
function(objCOTAN, condName = "") {
internalName <- getConditionName(objCOTAN, condName = condName,
keepPrefix = TRUE)
if (internalName == "COND_") {
# no corresponding condition
conditions <- factor(rep_len("NoCond", getNumCells(objCOTAN)))
} else {
conditions <- getMetadataCells(objCOTAN)[[internalName]]
}
return(set_names(conditions, getCells(objCOTAN)))
}
)
#' @details `normalizeNameAndLabels()` takes a pair of name/labels and
#' normalize them based on the available information in the `COTAN` object
#'
#' @param objCOTAN a `COTAN` object
#' @param name the name of the *clusterization*/*condition*. If not given the
#' last available *clusterization* will be used, or no *conditions*
#' @param labels a *clusterization*/*condition* to use. If given it will take
#' precedence on the one indicated by `name`
#' @param isCond a Boolean to indicate whether the function is dealing with
#' *clusterizations* [`FALSE`] or *conditions* [`TRUE`]
#'
#' @returns `normalizeNameAndLabels()` returns a `list` with:
#' * `"name"` the relevant name
#' * `"labels"` the relevant *clusterization*/*condition*
#'
#' @export
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @importFrom assertthat assert_that
#'
#' @examples
#' nameAndCond <- normalizeNameAndLabels(objCOTAN, name = condName,
#' isCond = TRUE)
#' isa(nameAndCond[["labels"]], "factor")
#'
#' @rdname HandlingConditions
#'
normalizeNameAndLabels <- function(objCOTAN, name = "",
labels = NULL, isCond = FALSE) {
if (is_empty(labels)) {
if (isFALSE(isCond)) {
name <- getClusterizationName(objCOTAN, clName = name)
labels <- getClusters(objCOTAN, clName = name)
} else {
name <- getConditionName(objCOTAN, condName = name)
labels <- getCondition(objCOTAN, condName = name)
}
} else {
assert_that(!is_empty(names(labels)),
msg = "No names attached to the given labels")
assert_that(setequal(names(labels), getCells(objCOTAN)),
msg = "Non compatible labels")
if (isEmptyName(name)) {
name <- "DummyName"
}
if (!inherits(labels, "factor")) {
labels <- factor(labels)
}
}
return(list("name" = name, "labels" = labels))
}
seriph78/COTAN documentation built on Jan. 30, 2025, 4:20 a.m.
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Defines functions normalizeNameAndLabels getClusters getProbabilityOfZero getNormalizedData getLogNormData getNuNormData getMu estimatorsAreReady
Documented in estimatorsAreReady getClusters getLogNormData getMu getNormalizedData getNuNormData getProbabilityOfZero normalizeNameAndLabels
# ------- `COTAN` raw data accessors --------
#' @title Raw data `COTAN` accessors
#'
#' @description These methods extract information out of a just created `COTAN`
#' object. The accessors have **read-only** access to the object.
#'
#' @name RawDataGetters
NULL
#' @aliases getRawData
#'
#' @details `getRawData()` extracts the raw count table.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getRawData()` returns the raw count sparse matrix
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#'
#' rawData <- getRawData(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getRawData",
"COTAN",
function(objCOTAN) {
return(objCOTAN@raw)
}
)
#' @aliases getNumCells
#'
#' @details `getNumCells()` extracts the number of cells in the sample (\eqn{m})
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getNumCells()` returns the number of cells in the sample (\eqn{m})
#'
#' @export
#'
#' @examples
#' numCells <- getNumCells(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getNumCells",
"COTAN",
function(objCOTAN) {
return(ncol(objCOTAN@raw))
}
)
#' @aliases getNumGenes
#'
#' @details `getNumGenes()` extracts the number of genes in the sample (\eqn{n})
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getNumGenes()` returns the number of genes in the sample (\eqn{n})
#'
#' @export
#'
#' @examples
#' numGenes <- getNumGenes(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getNumGenes",
"COTAN",
function(objCOTAN) {
return(nrow(objCOTAN@raw))
}
)
#' @aliases getCells
#'
#' @details `getCells()` extract all cells in the dataset.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getCells()` returns a character array with the cells' names
#'
#' @export
#'
#' @examples
#' cellsNames <- getCells(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getCells",
"COTAN",
function(objCOTAN) {
return(colnames(objCOTAN@raw))
}
)
#' @aliases getGenes
#'
#' @details `getGenes()` extract all genes in the dataset.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getGenes()` returns a character array with the genes' names
#'
#' @export
#'
#' @examples
#' genesNames <- getGenes(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getGenes",
"COTAN",
function(objCOTAN) {
return(rownames(objCOTAN@raw))
}
)
#' @aliases getZeroOneProj
#'
#' @details `getZeroOneProj()` extracts the raw count table where any
#' positive number has been replaced with `1`
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getZeroOneProj()` returns the raw count matrix projected to `0` or
#' `1`
#'
#' @export
#'
#' @examples
#' zeroOne <- getZeroOneProj(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getZeroOneProj",
"COTAN",
function(objCOTAN) {
return(sign(objCOTAN@raw))
}
)
#' @aliases getCellsSize
#'
#' @details `getCellsSize()` extracts the cell raw library size.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @return `getCellsSize()` returns an array with the library sizes
#'
#' @export
#'
#' @importFrom Matrix colSums
#'
#' @examples
#' cellsSize <- getCellsSize(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getCellsSize",
"COTAN",
function(objCOTAN) {
return(colSums(objCOTAN@raw))
}
)
#' @aliases getNumExpressedGenes
#'
#' @details `getNumExpressedGenes()` extracts the number of genes expressed for
#' each cell. Exploits a feature of [Matrix::CsparseMatrix-class]
#'
#' @param objCOTAN a `COTAN` object
#'
#' @return `getNumExpressedGenes()` returns an array with the library sizes
#'
#' @export
#'
#' @examples
#' numExpGenes <- getNumExpressedGenes(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getNumExpressedGenes",
"COTAN",
function(objCOTAN) {
# We expliot CsparseMatrix feature
ret <- diff(objCOTAN@raw@p)
names(ret) <- getCells(objCOTAN)
return(ret)
}
)
#' @aliases getGenesSize
#'
#' @details `getGenesSize()` extracts the genes raw library size.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @return `getGenesSize()` returns an array with the library sizes
#'
#' @export
#'
#' @importFrom Matrix rowSums
#'
#' @examples
#' genesSize <- getGenesSize(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getGenesSize",
"COTAN",
function(objCOTAN) {
return(rowSums(objCOTAN@raw))
}
)
#' @aliases getNumOfExpressingCells
#'
#' @details `getNumOfExpressingCells()` extracts, for each gene, the number of
#' cells that are expressing it. Exploits a feature of
#' [Matrix::CsparseMatrix-class]
#'
#' @param objCOTAN a `COTAN` object
#'
#' @return `getNumOfExpressingCells()` returns an array with the library sizes
#'
#' @export
#'
#' @examples
#' numExpCells <- getNumOfExpressingCells(objCOTAN)
#'
#' @rdname RawDataGetters
#'
setMethod(
"getNumOfExpressingCells",
"COTAN",
function(objCOTAN) {
# We exploit CsparseMatrix feature
ret <- diff(t(objCOTAN@raw)@p)
names(ret) <- getGenes(objCOTAN)
return(ret)
}
)
# ---------- Handle meta-data --------
#' @title Handling *meta-data* in `COTAN` objects
#'
#' @description Much of the information stored in the `COTAN` object is
#' compacted into three `data.frame`s:
#' * `"metaDataset"` - contains all general information about the data-set
#' * `"metaGenes"` - contains genes' related information along the `lambda`
#' and `dispersion` vectors and the fully-expressed flag
#' * `"metaCells"` - contains cells' related information along the `nu`
#' vector, the fully-expressing flag, the *clusterizations* and the
#' *conditions*
#'
#' @name HandleMetaData
NULL
#' @aliases getMetadataDataset
#'
#' @details `getMetadataDataset()` extracts the meta-data stored for the
#' current data-set.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getMetadataDataset()` returns the meta-data `data.frame`
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#'
#' objCOTAN <- initializeMetaDataset(objCOTAN, GEO = "test_GEO",
#' sequencingMethod = "distribution_sampling",
#' sampleCondition = "reconstructed_dataset")
#'
#' objCOTAN <- addElementToMetaDataset(objCOTAN, "Test",
#' c("These are ", "some values"))
#'
#' dataSetInfo <- getMetadataDataset(objCOTAN)
#'
#' @rdname HandleMetaData
#'
setMethod(
"getMetadataDataset",
"COTAN",
function(objCOTAN) {
return(objCOTAN@metaDataset)
}
)
#' @aliases getMetadataElement
#'
#' @details `getMetadataElement()` extracts the value associated with the
#' given tag if present or an empty string otherwise.
#'
#' @param objCOTAN a `COTAN` object
#' @param tag The tag associated to the wanted value
#'
#' @returns `getMetadataElement()` returns a string with the relevant value
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @examples
#' numInitialCells <- getMetadataElement(objCOTAN, "cells")
#'
#' @rdname HandleMetaData
#'
setMethod(
"getMetadataElement",
"COTAN",
function(objCOTAN, tag) {
meta <- getMetadataDataset(objCOTAN)
if (is_empty(meta) || !(tag %in% meta[[1L]])) {
out <- ""
} else {
rowPos <- which(meta[[1L]] %in% tag)
out <- meta[, -1L, drop = FALSE][rowPos, ]
}
return(out)
}
)
#' @aliases getMetadataGenes
#'
#' @details `getMetadataGenes()` extracts the meta-data stored for the genes
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getMetadataGenes()` returns the genes' meta-data `data.frame`
#'
#' @export
#'
#' @examples
#' metaGenes <- getMetadataGenes(objCOTAN)
#'
#' @rdname HandleMetaData
#'
setMethod(
"getMetadataGenes",
"COTAN",
function(objCOTAN) {
return(objCOTAN@metaGenes)
}
)
#' @aliases getMetadataCells
#'
#' @details `getMetadataCells()` extracts the meta-data stored for the cells
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getMetadataCells()` returns the cells' meta-data `data.frame`
#'
#' @export
#'
#' @examples
#' metaCells <- getMetadataCells(objCOTAN)
#'
#' @rdname HandleMetaData
#'
setMethod(
"getMetadataCells",
"COTAN",
function(objCOTAN) {
return(objCOTAN@metaCells)
}
)
#' @aliases getDims
#'
#' @details `getDims()` extracts the sizes of all slots of the `COTAN` object
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getDims()` returns a named `list` with the sizes of the slots
#'
#' @export
#'
#' @examples
#' allSizes <- getDims(objCOTAN)
#'
#' @rdname HandleMetaData
#'
setMethod(
"getDims",
"COTAN",
function(objCOTAN) {
return(list("raw" = dim(objCOTAN@raw),
"genesCoex" = dim(objCOTAN@genesCoex),
"cellsCoex" = dim(objCOTAN@cellsCoex),
"metaDataset" = nrow(objCOTAN@metaDataset),
"metaGenes" = ncol(objCOTAN@metaGenes),
"metaCells" = ncol(objCOTAN@metaCells),
"clustersCoex" = length(objCOTAN@clustersCoex)))
}
)
# ------- `COTAN` estimated data accessors ------
#' @aliases getNu
#'
#' @details `getNu()` extracts the nu array (normalized cells' counts averages)
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getNu()` returns the nu array
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname ParametersEstimations
#'
setMethod(
"getNu",
"COTAN",
function(objCOTAN) {
nu <- getMetadataCells(objCOTAN)[["nu"]]
if (is_empty(nu)) {
warning("nu is empty")
} else {
names(nu) <- getCells(objCOTAN)
}
return(nu)
}
)
#' @aliases getLambda
#'
#' @details `getLambda()` extracts the lambda array (mean expression for each
#' gene)
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getLambda()` returns the lambda array
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname ParametersEstimations
#'
setMethod(
"getLambda",
"COTAN",
function(objCOTAN) {
lambda <- getMetadataGenes(objCOTAN)[["lambda"]]
if (is_empty(lambda)) {
warning("lambda is empty")
} else {
names(lambda) <- getGenes(objCOTAN)
}
return(lambda)
}
)
#' @aliases getDispersion
#'
#' @details `getDispersion()` extracts the dispersion array
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getDispersion()` returns the dispersion array
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname ParametersEstimations
#'
setMethod(
"getDispersion",
"COTAN",
function(objCOTAN) {
dispersion <- getMetadataGenes(objCOTAN)[["dispersion"]]
if (is_empty(dispersion)) {
warning("dispersion is empty")
} else {
names(dispersion) <- getGenes(objCOTAN)
}
return(dispersion)
}
)
#' @details `estimatorsAreReady()` checks whether the estimators arrays lambda,
#' nu, dispersion are available
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `estimatorsAreReady()` returns a boolean specifying whether all
#' three arrays are non-empty
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname ParametersEstimations
#'
estimatorsAreReady <- function(objCOTAN) {
anyEmptyArrays <- is_empty(getLambda(objCOTAN)) ||
is_empty(getNu(objCOTAN)) ||
is_empty(getDispersion(objCOTAN))
if (anyEmptyArrays) {
logThis(paste0("Estimators are not ready - array sizes: lambda ",
length(getLambda(objCOTAN)), ", nu ",
length(getNu(objCOTAN)), ", dispersion ",
length(getDispersion(objCOTAN))), logLevel = 2L)
}
return(!anyEmptyArrays)
}
#' @aliases getMu
#' @aliases calculateMu
#'
#' @details `getMu()` calculates the vector \eqn{\mu = \lambda \times
#' \nu^T}
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getMu()` returns the `mu` matrix
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname CalculatingCOEX
#'
getMu <- function(objCOTAN) {
if (is_empty(getLambda(objCOTAN))) {
stop("lambda must not be empty, estimate it")
}
if (is_empty(getNu(objCOTAN))) {
stop("nu must not be empty, estimate it")
}
return(getLambda(objCOTAN) %o% getNu(objCOTAN))
}
#' @details `getNuNormData()` extracts the \eqn{\nu}*-normalized* count table
#' (i.e. where each column is divided by `nu`) and returns it
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getNuNormData()` returns the \eqn{\nu}*-normalized* count
#' `data.frame`
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @examples
#' nuNorm <- getNuNormData(objCOTAN)
#'
#' @rdname ParametersEstimations
#'
getNuNormData <- function(objCOTAN) {
if (is_empty(getNu(objCOTAN))) {
stop("nu must not be empty, estimate it")
}
return(t(t(getRawData(objCOTAN)) * (1.0 / getNu(objCOTAN))))
}
#' @details `getLogNormData()` extracts the *log-normalized* count table (i.e.
#' where each column is divided by the [getCellsSize()]), takes its `log10`
#' and returns it.
#'
#' @param objCOTAN a `COTAN` object
#' @param retLog When `TRUE` returns
#'
#' @returns `getLogNormData()` returns a `data.frame` after applying the formula
#' \eqn{\log_{10}{(10^4 * x + 1)}} to the raw counts normalized by
#' *cells-size*
#'
#' @export
#'
#' @examples
#' logNorm <- getLogNormData(objCOTAN)
#'
#' @rdname ParametersEstimations
#'
getLogNormData <- function(objCOTAN) {
normData <- t(t(getRawData(objCOTAN)) * (1.0e4 / getCellsSize(objCOTAN)))
return(log1p(normData) / log(10.0))
}
#' @details `getNormalizedData()` is deprecated: please use [getNuNormData()] or
#' [getLogNormData()] directly as appropriate
#'
#' @param objCOTAN a `COTAN` object
#' @param retLog When `TRUE` calls [getLogNormData()], calls [getNuNormData()]
#'
#' @returns `getNormalizedData()` returns a `data.frame`
#'
#' @export
#'
#' @examples
#' logNorm <- getNormalizedData(objCOTAN, retLog = TRUE)
#'
#' @rdname ParametersEstimations
#'
getNormalizedData <- function(objCOTAN, retLog = FALSE) {
if (retLog) {
return(getLogNormData(objCOTAN))
} else {
return(getNuNormData(objCOTAN))
}
}
#' @details `getProbabilityOfZero()` gives for each cell and each gene the
#' probability of observing zero reads
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getProbabilityOfZero()` returns a `data.frame` with the
#' probabilities of zero
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @examples
#' probZero <- getProbabilityOfZero(objCOTAN)
#'
#' @rdname ParametersEstimations
#'
getProbabilityOfZero <- function(objCOTAN) {
if (is_empty(getDispersion(objCOTAN))) {
stop("dispersion must not be empty, estimate it")
}
# estimate Probabilities of 0 with internal function funProbZero
return(funProbZero(getDispersion(objCOTAN), getMu(objCOTAN)))
}
# ----------- Raw data cleaning ------------
#' @title Raw data cleaning
#'
#' @description These methods are to be used to clean the raw data. That is drop
#' any number of genes/cells that are too sparse or too present to allow
#' proper calibration of the `COTAN` model.
#'
#' We call genes that are expressed in all cells *Fully-Expressed* while cells
#' that express all genes in the data are called *Fully-Expressing*. In case
#' it has been made quite easy to exclude the flagged genes/cells in the user
#' calculations.
#'
#' @name RawDataCleaning
NULL
#' @aliases flagNotFullyExpressedGenes
#'
#' @details `flagNotFullyExpressedGenes()` returns a Boolean array with TRUE for
#' those genes that are not fully-expressed.
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `flagNotFullyExpressedGenes()` returns a Booleans array with TRUE
#' for genes that are not fully-expressed
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @export
#'
#' @examples
#' library(zeallot)
#'
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#'
#' genes.to.rem <- getGenes(objCOTAN)[grep('^MT', getGenes(objCOTAN))]
#' cells.to.rem <- getCells(objCOTAN)[which(getCellsSize(objCOTAN) == 0)]
#' objCOTAN <- dropGenesCells(objCOTAN, genes.to.rem, cells.to.rem)
#'
#' objCOTAN <- clean(objCOTAN)
#'
#' objCOTAN <- findFullyExpressedGenes(objCOTAN)
#' goodPos <- flagNotFullyExpressedGenes(objCOTAN)
#'
#' @rdname RawDataCleaning
#'
setMethod(
"flagNotFullyExpressedGenes",
"COTAN",
function(objCOTAN) {
if (is_empty(getMetadataGenes(objCOTAN)[["feGenes"]])) {
return(set_names(rep(TRUE, getNumGenes(objCOTAN)), getGenes(objCOTAN)))
} else {
return(!getMetadataGenes(objCOTAN)[["feGenes"]])
}
}
)
#' @aliases flagNotFullyExpressingCells
#'
#' @details `flagNotFullyExpressingCells()`returns a Boolean vector with TRUE
#' for those cells that are not expressing all genes
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `flagNotFullyExpressingCells()` returns an array of Booleans with
#' TRUE for cells that are not expressing all genes
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @export
#'
#' @examples
#' objCOTAN <- findFullyExpressingCells(objCOTAN)
#' goodPos <- flagNotFullyExpressingCells(objCOTAN)
#'
#' @rdname RawDataCleaning
#'
setMethod(
"flagNotFullyExpressingCells",
"COTAN",
function(objCOTAN) {
if (is_empty(getMetadataCells(objCOTAN)[["feCells"]])) {
return(set_names(rep(TRUE, getNumCells(objCOTAN)), getCells(objCOTAN)))
} else {
return(!getMetadataCells(objCOTAN)[["feCells"]])
}
}
)
#' @aliases getFullyExpressedGenes
#'
#' @details `getFullyExpressedGenes()` returns the genes expressed in all cells
#' of the dataset
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getFullyExpressedGenes()` returns an array containing all genes
#' that are expressed in all cells
#'
#' @export
#'
#' @examples
#' feGenes <- getFullyExpressedGenes(objCOTAN)
#'
#' @rdname RawDataCleaning
#'
setMethod(
"getFullyExpressedGenes",
"COTAN",
function(objCOTAN) {
return(getGenes(objCOTAN)[!flagNotFullyExpressedGenes(objCOTAN)])
}
)
#' @aliases getFullyExpressingCells
#'
#' @details `getFullyExpressingCells()` returns the cells that did express
#' all genes of the dataset
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getFullyExpressingCells()` returns an array containing all cells
#' that express all genes
#'
#' @export
#'
#' @examples
#' feCells <- getFullyExpressingCells(objCOTAN)
#'
#' @rdname RawDataCleaning
#'
setMethod(
"getFullyExpressingCells",
"COTAN",
function(objCOTAN) {
return(getCells(objCOTAN)[!flagNotFullyExpressingCells(objCOTAN)])
}
)
# ------- `COTAN` coex data accessors ------
#' Calculating the COEX matrix for genes and cells
#'
#' @name CalculatingCOEX
NULL
#' @aliases getGenesCoex
#'
#' @details `getGenesCoex()` extracts a complete (or a partial after genes
#' dropping) genes' `COEX` matrix from the `COTAN` object.
#'
#' @param objCOTAN a `COTAN` object
#' @param genes The given genes' names to select the wanted `COEX` columns. If
#' missing all columns will be returned. When not empty a proper result is
#' provided by calculating the partial `COEX` matrix on the fly
#' @param zeroDiagonal When TRUE the `COEX` of any element with itself is set to
#' zero
#' @param ignoreSync When `TRUE` ignores whether the `lambda`/`nu`/`dispersion`
#' have been updated since the `COEX` matrix was calculated.
#'
#' @returns `getGenesCoex()` returns the genes' `COEX` values
#'
#' @importFrom rlang is_empty
#'
#' @importFrom assertthat assert_that
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#' objCOTAN <- initializeMetaDataset(objCOTAN, GEO = "test_GEO",
#' sequencingMethod = "distribution_sampling",
#' sampleCondition = "reconstructed_dataset")
#' objCOTAN <- clean(objCOTAN)
#'
#' objCOTAN <- estimateDispersionBisection(objCOTAN, cores = 6L)
#'
#' ## Now the `COTAN` object is ready to calculate the genes' `COEX`
#'
#' ## mu <- getMu(objCOTAN)
#' ## observedY <- observedContingencyTablesYY(objCOTAN, asDspMatrices = TRUE)
#' obs <- observedContingencyTables(objCOTAN, asDspMatrices = TRUE)
#'
#' ## expectedN <- expectedContingencyTablesNN(objCOTAN, asDspMatrices = TRUE)
#' exp <- expectedContingencyTables(objCOTAN, asDspMatrices = TRUE)
#'
#' objCOTAN <- calculateCoex(objCOTAN, actOnCells = FALSE)
#'
#' stopifnot(isCoexAvailable(objCOTAN))
#' genesCoex <- getGenesCoex(objCOTAN)
#' genesSample <- sample(getNumGenes(objCOTAN), 10)
#' partialGenesCoex <- calculatePartialCoex(objCOTAN, genesSample,
#' actOnCells = FALSE)
#'
#' identical(partialGenesCoex,
#' getGenesCoex(objCOTAN, getGenes(objCOTAN)[sort(genesSample)]))
#'
#' ## S <- calculateS(objCOTAN)
#' ## G <- calculateG(objCOTAN)
#' ## pValue <- calculatePValue(objCOTAN)
#' gdiDF <- calculateGDI(objCOTAN)
#' objCOTAN <- storeGDI(objCOTAN, genesGDI = gdiDF)
#'
#' ## Touching any of the lambda/nu/dispersino parameters invalidates the `COEX`
#' ## matrix and derivatives, so it can be dropped it from the `COTAN` object
#' objCOTAN <- dropGenesCoex(objCOTAN)
#' stopifnot(!isCoexAvailable(objCOTAN))
#'
#'
#' objCOTAN <- estimateDispersionNuBisection(objCOTAN, cores = 6L)
#'
#' ## Now the `COTAN` object is ready to calculate the cells' `COEX`
#' ## In case one need to caclualte both it is more sensible to run the above
#' ## before any `COEX` evaluation
#'
#' g1 <- getGenes(objCOTAN)[sample(getNumGenes(objCOTAN), 1)]
#' g2 <- getGenes(objCOTAN)[sample(getNumGenes(objCOTAN), 1)]
#' tables <- contingencyTables(objCOTAN, g1 = g1, g2 = g2)
#' tables
#'
#' objCOTAN <- calculateCoex(objCOTAN, actOnCells = TRUE)
#' stopifnot(isCoexAvailable(objCOTAN, actOnCells = TRUE, ignoreSync = TRUE))
#' cellsCoex <- getCellsCoex(objCOTAN)
#'
#' cellsSample <- sample(getNumCells(objCOTAN), 10)
#' partialCellsCoex <- calculatePartialCoex(objCOTAN, cellsSample,
#' actOnCells = TRUE)
#'
#' identical(partialCellsCoex, cellsCoex[, sort(cellsSample)])
#'
#' objCOTAN <- dropCellsCoex(objCOTAN)
#' stopifnot(!isCoexAvailable(objCOTAN, actOnCells = TRUE))
#'
#' @rdname CalculatingCOEX
#'
setMethod(
"getGenesCoex",
"COTAN",
function(objCOTAN, genes = vector(mode = "character"),
zeroDiagonal = TRUE, ignoreSync = FALSE) {
coexIsReady <- isCoexAvailable(objCOTAN, ignoreSync = ignoreSync)
if (is_empty(genes)) {
assert_that(coexIsReady,
msg = paste0("Cannot return genes' coex as the matrix was ",
"never calculated or is out-of-sync with the ",
"estimators."))
ret <- objCOTAN@genesCoex
if (isTRUE(zeroDiagonal)) {
diag(ret) <- 0.0
ret <- pack(forceSymmetric(ret))
}
return(ret)
} else {
genes <- handleNamesSubsets(getGenes(objCOTAN), genes)
ret <- objCOTAN@genesCoex
if (!coexIsReady) {
warning("Missing or out-of-sync genes' coex:",
"calculating the required subset now!")
ret <- calculatePartialCoex(objCOTAN, columnsSubset = genes,
actOnCells = FALSE)
} else {
ret <- ret[, genes, drop = FALSE]
}
if (isTRUE(zeroDiagonal)) {
diag(ret[genes, , drop = FALSE]) <- 0.0
}
return(ret)
}
}
)
#' @aliases getCellsCoex
#'
#' @details `getCellsCoex()` extracts a complete (or a partial after cells
#' dropping) cells' `COEX` matrix from the `COTAN` object.
#'
#' @param objCOTAN a `COTAN` object
#' @param cells The given cells' names to select the wanted `COEX` columns. If
#' missing all columns will be returned. When not empty a proper result is
#' provided by calculating the partial `COEX` matrix on the fly
#' @param zeroDiagonal When `TRUE` sets the diagonal to zero.
#' @param ignoreSync When `TRUE` ignores whether the `lambda`/`nu`/`dispersion`
#' have been updated since the `COEX` matrix was calculated.
#'
#' @returns `getCellsCoex()` returns the cells' `COEX` values
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname CalculatingCOEX
#'
setMethod(
"getCellsCoex",
"COTAN",
function(objCOTAN, cells = vector(mode = "character"),
zeroDiagonal = TRUE, ignoreSync = FALSE) {
coexIsReady <- isCoexAvailable(objCOTAN, actOnCells = TRUE,
ignoreSync = ignoreSync)
if (is_empty(cells)) {
assert_that(coexIsReady,
msg = paste0("Cannot return cells' coex as the matrix was ",
"never calculated or is out-of-sync with the ",
"estimators."))
ret <- objCOTAN@cellsCoex
if (isTRUE(zeroDiagonal)) {
diag(ret) <- 0.0
ret <- pack(forceSymmetric(ret))
}
return(ret)
} else {
cells <- handleNamesSubsets(getCells(objCOTAN), cells)
ret <- objCOTAN@cellsCoex
if (!coexIsReady) {
warning("Missing or out-of-sync cells' coex:",
"calculating the required subset now!")
ret <- calculatePartialCoex(objCOTAN, columnsSubset = cells,
actOnCells = TRUE)
} else {
ret <- ret[, cells, drop = FALSE]
}
if (isTRUE(zeroDiagonal)) {
diag(ret[cells, , drop = FALSE]) <- 0.0
}
return(ret)
}
}
)
#' @aliases isCoexAvailable
#'
#' @details `isCoexAvailable()` allows to query whether the relevant `COEX`
#' matrix from the `COTAN` object is available to use
#'
#' @param objCOTAN a `COTAN` object
#' @param actOnCells Boolean; when `TRUE` the function works for the cells,
#' otherwise for the genes
#' @param ignoreSync When `TRUE` ignores whether the `lambda`/`nu`/`dispersion`
#' have been updated since the `COEX` matrix was calculated.
#'
#' @returns `isCoexAvailable()` returns whether relevant `COEX` matrix has been
#' calculated and, in case, if it is still aligned to the estimators.
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname CalculatingCOEX
#'
setMethod(
"isCoexAvailable",
"COTAN",
function(objCOTAN, actOnCells = FALSE, ignoreSync = FALSE) {
if (isTRUE(actOnCells)) {
isInSync <- as.logical(getMetadataElement(objCOTAN,
datasetTags()[["csync"]]))
return(!is_empty(objCOTAN@cellsCoex) && (isTRUE(ignoreSync) || isInSync))
} else {
isInSync <- as.logical(getMetadataElement(objCOTAN,
datasetTags()[["gsync"]]))
return(!is_empty(objCOTAN@genesCoex) && (isTRUE(ignoreSync) || isInSync))
}
}
)
#' @aliases getGDI
#'
#' @details `getGDI()` extracts the genes' **GDI** array as it was stored by the
#' method [storeGDI()]
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getGDI()` returns the genes' **GDI** array if available or `NULL`
#' otherwise
#'
#' @importFrom rlang is_empty
#'
#' @export
#'
#' @rdname GenesStatistics
#'
setMethod(
"getGDI",
"COTAN",
function(objCOTAN) {
gdi <- getMetadataGenes(objCOTAN)[["GDI"]]
if (is_empty(gdi)) {
warning("no GDI data has been stored")
} else {
names(gdi) <- getGenes(objCOTAN)
}
return(gdi)
}
)
#' @aliases getClusterizations
#'
#' @details `getClusterizations()` extracts the list of the *clusterizations*
#' defined in the `COTAN` object.
#'
#' @param objCOTAN a `COTAN` object
#' @param dropNoCoex When `TRUE` drops the names from the *clusterizations* with
#' empty associated coex `data.frame`
#' @param keepPrefix When `TRUE` returns the internal name of the
#' *clusterization*: the one with the `CL_` prefix.
#'
#' @returns `getClusterizations()` returns a vector of *clusterization* names,
#' usually without the `CL_` prefix
#'
#' @importFrom rlang is_empty
#'
#' @importFrom methods validObject
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#' objCOTAN <- proceedToCoex(objCOTAN, cores = 6L, calcCoex = FALSE,
#' optimizeForSpeed = TRUE, saveObj = FALSE)
#'
#' data("test.dataset.clusters1")
#' clusters <- test.dataset.clusters1
#'
#' coexDF <- DEAOnClusters(objCOTAN, clusters = clusters)
#'
#' groupMarkers <- list(G1 = c("g-000010", "g-000020", "g-000030",
#' "g-000150", "g-000160", "g-000170"),
#' G2 = c("g-000300", "g-000330", "g-000450",
#' "g-000460", "g-000470"),
#' G3 = c("g-000510", "g-000530", "g-000550",
#' "g-000570", "g-000590"))
#'
#' geneClusters <- rep(1:3, each = 240)[1:600]
#' names(geneClusters) <- getGenes(objCOTAN)
#'
#' umapPlot <- UMAPPlot(coexDF, clusters = NULL, elements = groupMarkers)
#' plot(umapPlot)
#'
#' objCOTAN <- addClusterization(objCOTAN, clName = "first_clusterization",
#' clusters = clusters, coexDF = coexDF)
#'
#' lfcDF <- logFoldChangeOnClusters(objCOTAN, clusters = clusters)
#' umapPlot2 <- UMAPPlot(lfcDF, clusters = geneClusters)
#' plot(umapPlot2)
#'
#' objCOTAN <- estimateNuLinearByCluster(objCOTAN, clusters = clusters)
#'
#' clSummaryPlotAndData <-
#' clustersSummaryPlot(objCOTAN, clName = "first_clusterization",
#' plotTitle = "first clusterization")
#' plot(clSummaryPlotAndData[["plot"]])
#'
#' if (FALSE) {
#' objCOTAN <- dropClusterization(objCOTAN, "first_clusterization")
#' }
#'
#' clusterizations <- getClusterizations(objCOTAN, dropNoCoex = TRUE)
#' stopifnot(length(clusterizations) == 1)
#'
#' cellsUmapPlotAndDF <- cellsUMAPPlot(objCOTAN, dataMethod = "LogNormalized",
#' clName = "first_clusterization",
#' genesSel = "HVG_Seurat")
#' plot(cellsUmapPlotAndDF[["plot"]])
#'
#' enrichment <- geneSetEnrichment(clustersCoex = coexDF,
#' groupMarkers = groupMarkers)
#'
#' clHeatmapPlotAndData <- clustersMarkersHeatmapPlot(objCOTAN, groupMarkers)
#'
#' conditions <- as.integer(substring(getCells(objCOTAN), 3L))
#' conditions <- factor(ifelse(conditions <= 600, "L", "H"))
#' names(conditions) <- getCells(objCOTAN)
#'
#' clHeatmapPlotAndData2 <-
#' clustersMarkersHeatmapPlot(objCOTAN, groupMarkers, kCuts = 2,
#' condNameList = list("High/Low"),
#' conditionsList = list(conditions))
#'
#' @rdname HandlingClusterizations
#'
setMethod(
"getClusterizations",
"COTAN",
function(objCOTAN, dropNoCoex = FALSE, keepPrefix = FALSE) {
validObject(objCOTAN)
clsCoex <- getClustersCoex(objCOTAN)
if (isTRUE(dropNoCoex)) {
emptyClsCoex <- vapply(clsCoex, is_empty, logical(1L))
out <- names(clsCoex[!emptyClsCoex])
} else {
out <- names(clsCoex)
}
# drop the internal 'CL_' prefix
if (isFALSE(keepPrefix)) {
out <- substring(out, 4L)
}
return(out)
}
)
#' @aliases getClusterizationName
#'
#' @details `getClusterizationName()` normalizes the given *clusterization* name
#' or, if none were given, returns the name of last available *clusterization*
#' in the `COTAN` object. It can return the *clusterization* **internal name**
#' if needed
#'
#' @param objCOTAN a `COTAN` object
#' @param clName The name of the *clusterization*. If not given the last
#' available
#' *clusterization* will be returned, as it is probably the most significant!
#' @param keepPrefix When `TRUE` returns the internal name of the
#' *clusterization*: the one with the `CL_` prefix.
#'
#' @returns `getClusterizationName()` returns the normalized *clusterization*
#' name or `NULL` if no *clusterizations* are present
#'
#' @export
#'
#' @examples
#' clName <- getClusterizationName(objCOTAN)
#'
#' @rdname HandlingClusterizations
#'
setMethod(
"getClusterizationName",
"COTAN",
function(objCOTAN, clName = "", keepPrefix = FALSE) {
allClustNames <- getClusterizations(objCOTAN, keepPrefix = TRUE)
if (isEmptyName(clName)) {
# pick last clusterization
outName <- allClustNames[length(allClustNames)]
} else {
outName <- clName
if (!startsWith(clName, "CL_")) {
outName <- paste0("CL_", clName)
}
assert_that(outName %in% allClustNames,
msg = paste0("Given cluster name '", clName,
"' is not among the stored clusterizations"))
}
# drop the internal 'CL_' prefix
if (isFALSE(keepPrefix)) {
outName <- substring(outName, 4L)
}
return(outName)
}
)
#' @aliases getClusterizationData
#'
#' @details `getClusterizationData()` extracts the asked *clusterization* and
#' its associated `COEX` `data.frame` from the `COTAN` object
#'
#' @param objCOTAN a `COTAN` object
#' @param clName The name of the *clusterization*. If not given the last
#' available *clusterization* will be returned, as it is probably the most
#' significant!
#'
#' @returns `getClusterizationData()` returns a `list` with 2 elements:
#' * `"clusters"` the named cluster labels array
#' * `"coex"` the associated `COEX` `data.frame`. This will be an **empty**
#' `data.frame` when not specified for the relevant *clusterization*
#'
#' @export
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @examples
#' clusterDataList <- getClusterizationData(objCOTAN, clName = clName)
#'
#' @rdname HandlingClusterizations
#'
setMethod(
"getClusterizationData",
"COTAN",
function(objCOTAN, clName = "") {
internalName <- getClusterizationName(objCOTAN, clName = clName,
keepPrefix = TRUE)
# clName can still be empty if no clusterization was store in the objCOTAN
assert_that(!isEmptyName(internalName),
msg = "No clusterizations are present in the 'COTAN' object")
clusters <- factor(set_names(getMetadataCells(objCOTAN)[[internalName]],
getCells(objCOTAN)))
coexDF <- getClustersCoex(objCOTAN)[[internalName]]
return(list("clusters" = clusters, "coex" = coexDF))
}
)
#'
#' @details `getClusters()` extracts the asked *clusterization* from the `COTAN`
#' object
#'
#' @param objCOTAN a `COTAN` object
#' @param clName The name of the *clusterization*. If not given the last
#' available *clusterization* will be returned, as it is probably the most
#' significant!
#'
#' @returns `getClusters()` returns the named cluster labels array
#'
#' @export
#'
#' @examples
#' clusters <- getClusters(objCOTAN, clName = clName)
#'
#' @rdname HandlingClusterizations
#'
getClusters <- function(objCOTAN, clName = "") {
return(getClusterizationData(objCOTAN, clName = clName)[["clusters"]])
}
#' @aliases getClustersCoex
#'
#' @details `getClustersCoex()` extracts the full `clusterCoex` member `list`
#'
#' @param objCOTAN a `COTAN` object
#'
#' @returns `getClustersCoex()` returns the list with a `COEX` `data.frame` for
#' each *clusterization*. When not empty, each `data.frame` contains a `COEX`
#' column for each *cluster*.
#'
#' @export
#'
#' @examples
#' allClustersCoexDF <- getClustersCoex(objCOTAN)
#'
#' @rdname HandlingClusterizations
#'
setMethod(
"getClustersCoex",
"COTAN",
function(objCOTAN) {
return(objCOTAN@clustersCoex)
}
)
# ------- `COTAN` conditions data accessors ------
#' @title Handling cells' *conditions* and related functions
#'
#' @description These functions manage the *conditions*.
#'
#' A *condition* is a set of **labels** that can be assigned to cells:
#' one **label** per cell. This is especially useful in cases when the
#' `data-set` is the result of merging multiple experiments' raw data
#'
#' @name HandlingConditions
NULL
#' @aliases getAllConditions
#'
#' @details `getAllConditions()` extracts the list of the *conditions* defined
#' in the `COTAN` object.
#'
#' @param objCOTAN a `COTAN` object
#' @param keepPrefix When `TRUE` returns the internal name of the
#' *condition*: the one with the `COND_` prefix.
#'
#' @returns `getAllConditions()` returns a vector of *conditions* names,
#' usually without the `COND_` prefix
#'
#' @importFrom rlang is_empty
#'
#' @importFrom methods validObject
#'
#' @export
#'
#' @examples
#' data("test.dataset")
#' objCOTAN <- COTAN(raw = test.dataset)
#'
#' cellLine <- rep(c("A", "B"), getNumCells(objCOTAN) / 2)
#' names(cellLine) <- getCells(objCOTAN)
#' objCOTAN <- addCondition(objCOTAN, condName = "Line", conditions = cellLine)
#'
#' ##objCOTAN <- dropCondition(objCOTAN, "Genre")
#'
#' conditionsNames <- getAllConditions(objCOTAN)
#'
#' @rdname HandlingConditions
#'
setMethod(
"getAllConditions",
"COTAN",
function(objCOTAN, keepPrefix = FALSE) {
validObject(objCOTAN)
cNames <- colnames(getMetadataCells(objCOTAN))
areCondNames <- vapply(cNames, startsWith, logical(1L), "COND_")
out <- cNames[areCondNames]
# drop the internal 'COND_' prefix
if (isFALSE(keepPrefix)) {
out <- substring(out, 6L)
}
return(out)
}
)
#' @aliases getConditionName
#'
#' @details `getConditionName()` normalizes the given *condition* name or, if
#' none were given, returns the name of last available *condition* in the
#' `COTAN` object. It can return the *condition* **internal name** if needed
#'
#' @param objCOTAN a `COTAN` object
#' @param condName The name of the *condition*. If not given an empty string
#' will be returned!
#' @param keepPrefix When `TRUE` returns the internal name of the
#' *condition*: the one with the `COND_` prefix.
#'
#' @returns `getConditionName()` returns the normalized *condition* name or
#' `NULL` if no *conditions* are present
#'
#' @export
#'
#' @examples
#' condName <- getConditionName(objCOTAN)
#'
#' @rdname HandlingConditions
#'
setMethod(
"getConditionName",
"COTAN",
function(objCOTAN, condName = "", keepPrefix = FALSE) {
allCondNames <- getAllConditions(objCOTAN, keepPrefix = TRUE)
if (isEmptyName(condName)) {
# return a default name
outName <- "COND_"
} else {
outName <- condName
if (!startsWith(condName, "COND_")) {
outName <- paste0("COND_", condName)
}
assert_that(outName %in% allCondNames,
msg = paste0("Given condition name '", condName,
"' is not among the stored conditions"))
}
# drop the internal 'COND_' prefix
if (isFALSE(keepPrefix)) {
outName <- substring(outName, 6L)
}
return(outName)
}
)
#' @aliases getCondition
#'
#' @details `getCondition()` extracts the asked *condition* from the `COTAN`
#' object
#'
#' @param objCOTAN a `COTAN` object
#' @param condName The name of the *condition*. If not given a dummy constant
#' **label** *condition* will be returned.
#'
#' @returns `getCondition()` returns a named `factor` with the *condition*
#'
#' @export
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @examples
#' condition <- getCondition(objCOTAN, condName = condName)
#' isa(condition, "factor")
#'
#' @rdname HandlingConditions
#'
setMethod(
"getCondition",
"COTAN",
function(objCOTAN, condName = "") {
internalName <- getConditionName(objCOTAN, condName = condName,
keepPrefix = TRUE)
if (internalName == "COND_") {
# no corresponding condition
conditions <- factor(rep_len("NoCond", getNumCells(objCOTAN)))
} else {
conditions <- getMetadataCells(objCOTAN)[[internalName]]
}
return(set_names(conditions, getCells(objCOTAN)))
}
)
#' @details `normalizeNameAndLabels()` takes a pair of name/labels and
#' normalize them based on the available information in the `COTAN` object
#'
#' @param objCOTAN a `COTAN` object
#' @param name the name of the *clusterization*/*condition*. If not given the
#' last available *clusterization* will be used, or no *conditions*
#' @param labels a *clusterization*/*condition* to use. If given it will take
#' precedence on the one indicated by `name`
#' @param isCond a Boolean to indicate whether the function is dealing with
#' *clusterizations* [`FALSE`] or *conditions* [`TRUE`]
#'
#' @returns `normalizeNameAndLabels()` returns a `list` with:
#' * `"name"` the relevant name
#' * `"labels"` the relevant *clusterization*/*condition*
#'
#' @export
#'
#' @importFrom rlang is_empty
#' @importFrom rlang set_names
#'
#' @importFrom assertthat assert_that
#'
#' @examples
#' nameAndCond <- normalizeNameAndLabels(objCOTAN, name = condName,
#' isCond = TRUE)
#' isa(nameAndCond[["labels"]], "factor")
#'
#' @rdname HandlingConditions
#'
normalizeNameAndLabels <- function(objCOTAN, name = "",
labels = NULL, isCond = FALSE) {
if (is_empty(labels)) {
if (isFALSE(isCond)) {
name <- getClusterizationName(objCOTAN, clName = name)
labels <- getClusters(objCOTAN, clName = name)
} else {
name <- getConditionName(objCOTAN, condName = name)
labels <- getCondition(objCOTAN, condName = name)
}
} else {
assert_that(!is_empty(names(labels)),
msg = "No names attached to the given labels")
assert_that(setequal(names(labels), getCells(objCOTAN)),
msg = "Non compatible labels")
if (isEmptyName(name)) {
name <- "DummyName"
}
if (!inherits(labels, "factor")) {
labels <- factor(labels)
}
}
return(list("name" = name, "labels" = labels))
}
R Package Documentation
Browse R Packages
We want your feedback!
Note that we can't provide technical support on individual packages. You should contact the package authors for that.
Embedding an R snippet on your website
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.